From 792b5d29ebae8f917043d9dd226692919b5d6ca1 Mon Sep 17 00:00:00 2001
From: Stefano Zacchiroli <zack@upsilon.cc>
Date: Thu, 12 Jan 2006 10:51:15 +0000
Subject: [PATCH] test branch
---
helm/matita/.depend | 59 +
helm/matita/.ocamlinit | 44 +
helm/matita/AUTHORS | 5 +
helm/matita/LICENSE | 23 +
helm/matita/Makefile.in | 350 ++
helm/matita/applyTransformation.ml | 72 +
helm/matita/applyTransformation.mli | 57 +
helm/matita/buildTimeConf.ml.in | 56 +
helm/matita/buildTimeConf.mli | 51 +
helm/matita/closed.xml | 17 +
helm/matita/configure.ac | 136 +
helm/matita/contribs/LAMBDA-TYPES/Makefile | 57 +
.../contribs/LAMBDA-TYPES/lref_map_defs.ma | 22 +
.../contribs/LAMBDA-TYPES/terms_defs.ma | 47 +
helm/matita/contribs/LAMBDA-TYPES/tlt_defs.ma | 53 +
.../contribs/PREDICATIVE-TOPOLOGY/Makefile | 57 +
.../PREDICATIVE-TOPOLOGY/class_defs.ma | 51 +
.../contribs/PREDICATIVE-TOPOLOGY/class_eq.ma | 38 +
.../contribs/PREDICATIVE-TOPOLOGY/class_le.ma | 28 +
.../contribs/PREDICATIVE-TOPOLOGY/coa_defs.ma | 61 +
.../PREDICATIVE-TOPOLOGY/coa_props.ma | 29 +
.../PREDICATIVE-TOPOLOGY/domain_data.ma | 40 +
.../PREDICATIVE-TOPOLOGY/domain_defs.ma | 58 +
.../contribs/PREDICATIVE-TOPOLOGY/iff.ma | 31 +
.../PREDICATIVE-TOPOLOGY/subset_defs.ma | 66 +
helm/matita/core_notation.moo | 115 +
helm/matita/dictionary-matita.xml | 15 +
helm/matita/dist/Makefile | 17 +
helm/matita/dist/fill_db.sh | 53 +
helm/matita/dist/static_link/Makefile | 5 +
helm/matita/dist/static_link/static_link.ml | 162 +
helm/matita/dump_moo.ml | 58 +
helm/matita/gtkmathview.matita.conf.xml.in | 15 +
helm/matita/icons/matita-bulb-high.png | Bin 0 -> 1149 bytes
helm/matita/icons/matita-bulb-low.png | Bin 0 -> 1072 bytes
helm/matita/icons/matita-bulb-medium.png | Bin 0 -> 1272 bytes
helm/matita/icons/matita-folder.png | Bin 0 -> 706 bytes
helm/matita/icons/matita-object.png | Bin 0 -> 893 bytes
helm/matita/icons/matita-theory.png | Bin 0 -> 1287 bytes
helm/matita/icons/matita.png | Bin 0 -> 17605 bytes
helm/matita/icons/matita_medium.png | Bin 0 -> 12270 bytes
helm/matita/icons/matita_small.png | Bin 0 -> 4786 bytes
helm/matita/icons/meegg.png | Bin 0 -> 157131 bytes
helm/matita/icons/whelp.png | Bin 0 -> 1072 bytes
helm/matita/icons/whelp.svg | 221 +
helm/matita/library/Makefile | 57 +
helm/matita/library/Q/q.ma | 320 ++
helm/matita/library/Z/compare.ma | 143 +
helm/matita/library/Z/orders.ma | 130 +
helm/matita/library/Z/plus.ma | 301 ++
helm/matita/library/Z/times.ma | 235 +
helm/matita/library/Z/z.ma | 173 +
helm/matita/library/datatypes/bool.ma | 126 +
helm/matita/library/datatypes/compare.ma | 27 +
helm/matita/library/datatypes/constructors.ma | 38 +
.../library/higher_order_defs/functions.ma | 67 +
.../library/higher_order_defs/ordering.ma | 22 +
.../library/higher_order_defs/relations.ma | 33 +
helm/matita/library/legacy/coq.ma | 44 +
helm/matita/library/list/list.ma | 112 +
helm/matita/library/list/sort.ma | 172 +
helm/matita/library/logic/connectives.ma | 90 +
helm/matita/library/logic/equality.ma | 214 +
helm/matita/library/nat/chinese_reminder.ma | 251 ++
helm/matita/library/nat/compare.ma | 227 +
helm/matita/library/nat/congruence.ma | 177 +
helm/matita/library/nat/count.ma | 246 +
helm/matita/library/nat/div_and_mod.ma | 298 ++
helm/matita/library/nat/exp.ma | 97 +
helm/matita/library/nat/factorial.ma | 61 +
helm/matita/library/nat/factorization.ma | 613 +++
.../library/nat/fermat_little_theorem.ma | 250 ++
helm/matita/library/nat/gcd.ma | 608 +++
helm/matita/library/nat/le_arith.ma | 95 +
helm/matita/library/nat/lt_arith.ma | 217 +
helm/matita/library/nat/minimization.ma | 222 +
helm/matita/library/nat/minus.ma | 300 ++
helm/matita/library/nat/nat.ma | 106 +
helm/matita/library/nat/nth_prime.ma | 200 +
helm/matita/library/nat/ord.ma | 193 +
helm/matita/library/nat/orders.ma | 312 ++
helm/matita/library/nat/permutation.ma | 740 +++
helm/matita/library/nat/plus.ma | 72 +
helm/matita/library/nat/primes.ma | 591 +++
helm/matita/library/nat/primes1.ma | 38 +
helm/matita/library/nat/relevant_equations.ma | 50 +
helm/matita/library/nat/sigma_and_pi.ma | 79 +
helm/matita/library/nat/times.ma | 87 +
helm/matita/library/nat/totient.ma | 102 +
helm/matita/matita.conf.xml.sample.in | 36 +
helm/matita/matita.glade | 3952 +++++++++++++++++
helm/matita/matita.gtkrc | 80 +
helm/matita/matita.lang | 186 +
helm/matita/matita.ma.templ | 16 +
helm/matita/matita.ml | 216 +
helm/matita/matita.txt | 426 ++
helm/matita/matitaEngine.ml | 142 +
helm/matita/matitaEngine.mli | 68 +
helm/matita/matitaExcPp.ml | 111 +
helm/matita/matitaExcPp.mli | 27 +
helm/matita/matitaGtkMisc.ml | 439 ++
helm/matita/matitaGtkMisc.mli | 157 +
helm/matita/matitaGui.ml | 1278 ++++++
helm/matita/matitaGui.mli | 49 +
helm/matita/matitaGuiTypes.mli | 151 +
helm/matita/matitaInit.ml | 223 +
helm/matita/matitaInit.mli | 37 +
helm/matita/matitaMathView.ml | 1103 +++++
helm/matita/matitaMathView.mli | 87 +
helm/matita/matitaMisc.ml | 152 +
helm/matita/matitaMisc.mli | 75 +
helm/matita/matitaScript.ml | 818 ++++
helm/matita/matitaScript.mli | 102 +
helm/matita/matitaTypes.ml | 74 +
helm/matita/matitaTypes.mli | 46 +
helm/matita/matitac.ml | 39 +
helm/matita/matitacLib.ml | 265 ++
helm/matita/matitacLib.mli | 37 +
helm/matita/matitaclean.ml | 73 +
helm/matita/matitaclean.mli | 27 +
helm/matita/matitadep.ml | 93 +
helm/matita/matitadep.mli | 27 +
helm/matita/matitamake.ml | 162 +
helm/matita/matitamakeLib.ml | 299 ++
helm/matita/matitamakeLib.mli | 54 +
helm/matita/matitatop.ml | 31 +
helm/matita/scripts/README | 20 +
helm/matita/scripts/bench.sql | 13 +
helm/matita/scripts/crontab | 4 +
helm/matita/scripts/crontab.sh | 78 +
helm/matita/scripts/do_tests.sh | 85 +
helm/matita/scripts/insert.awk | 17 +
helm/matita/scripts/profile_svn.sh | 70 +
helm/matita/scripts/public_html/bench.php | 147 +
helm/matita/scripts/public_html/common.php | 89 +
.../scripts/public_html/composequery.php | 46 +
helm/matita/scripts/public_html/index.html | 15 +
helm/matita/scripts/public_html/showquery.php | 62 +
helm/matita/scripts/public_html/style.css | 55 +
helm/matita/scripts/shell_adder.php | 6 +
helm/matita/scripts/shell_time2cents.php | 4 +
helm/matita/template_makefile.in | 28 +
helm/matita/tests/Makefile | 57 +
helm/matita/tests/absurd.ma | 26 +
helm/matita/tests/apply.ma | 57 +
helm/matita/tests/assumption.ma | 39 +
helm/matita/tests/bad_tests/Makefile | 57 +
helm/matita/tests/bad_tests/auto.log | 100 +
helm/matita/tests/bad_tests/auto.ma | 27 +
helm/matita/tests/bad_tests/baseuri.log | 4 +
helm/matita/tests/bad_tests/baseuri.ma | 16 +
helm/matita/tests/change.ma | 40 +
helm/matita/tests/clear.ma | 30 +
helm/matita/tests/clearbody.ma | 31 +
helm/matita/tests/coercions.ma | 64 +
helm/matita/tests/comments.ma | 36 +
helm/matita/tests/constructor.ma | 23 +
helm/matita/tests/continuationals.ma | 80 +
helm/matita/tests/contradiction.ma | 31 +
helm/matita/tests/cut.ma | 25 +
helm/matita/tests/decompose.ma | 28 +
helm/matita/tests/discriminate.ma | 40 +
helm/matita/tests/elim.ma | 80 +
helm/matita/tests/fguidi.ma | 114 +
helm/matita/tests/first.ma | 37 +
helm/matita/tests/fix_betareduction.ma | 26 +
helm/matita/tests/fold.ma | 26 +
helm/matita/tests/generalize.ma | 37 +
.../tests/interactive/automatic_insertion.ma | 17 +
helm/matita/tests/interactive/drop.ma | 8 +
helm/matita/tests/interactive/grafite.ma | 34 +
helm/matita/tests/interactive/test5.ma | 7 +
helm/matita/tests/interactive/test6.ma | 7 +
helm/matita/tests/interactive/test7.ma | 7 +
.../matita/tests/interactive/test_instance.ma | 16 +
helm/matita/tests/inversion.ma | 61 +
helm/matita/tests/inversion2.ma | 63 +
helm/matita/tests/letrec.ma | 25 +
helm/matita/tests/match_inference.ma | 52 +
helm/matita/tests/metasenv_ordering.ma | 139 +
helm/matita/tests/mysql_escaping.ma | 17 +
helm/matita/tests/paramodulation.ma | 32 +
helm/matita/tests/record.ma | 39 +
helm/matita/tests/replace.ma | 39 +
helm/matita/tests/rewrite.ma | 64 +
helm/matita/tests/second.ma | 24 +
helm/matita/tests/simpl.ma | 51 +
helm/matita/tests/test2.ma | 26 +
helm/matita/tests/test3.ma | 31 +
helm/matita/tests/test4.ma | 38 +
helm/matita/tests/third.ma | 24 +
helm/matita/tests/unfold.ma | 41 +
helm/ocaml/METAS/meta.helm-acic_content.src | 4 +
helm/ocaml/METAS/meta.helm-cic.src | 5 +
helm/ocaml/METAS/meta.helm-cic_acic.src | 4 +
.../ocaml/METAS/meta.helm-cic_annotations.src | 5 +
.../METAS/meta.helm-cic_annotations_cache.src | 5 +
helm/ocaml/METAS/meta.helm-cic_cache.src | 5 +
.../METAS/meta.helm-cic_disambiguation.src | 4 +
.../METAS/meta.helm-cic_proof_checking.src | 7 +
.../METAS/meta.helm-cic_textual_parser.src | 5 +
.../ocaml/METAS/meta.helm-cic_unification.src | 5 +
helm/ocaml/METAS/meta.helm-content_pres.src | 4 +
helm/ocaml/METAS/meta.helm-extlib.src | 5 +
helm/ocaml/METAS/meta.helm-getter.src | 5 +
helm/ocaml/METAS/meta.helm-grafite.src | 4 +
helm/ocaml/METAS/meta.helm-grafite_engine.src | 5 +
helm/ocaml/METAS/meta.helm-grafite_parser.src | 5 +
helm/ocaml/METAS/meta.helm-hbugs.src | 4 +
helm/ocaml/METAS/meta.helm-hgdome.src | 4 +
helm/ocaml/METAS/meta.helm-hmysql.src | 4 +
helm/ocaml/METAS/meta.helm-lexicon.src | 4 +
helm/ocaml/METAS/meta.helm-library.src | 5 +
helm/ocaml/METAS/meta.helm-logger.src | 5 +
helm/ocaml/METAS/meta.helm-mathql.src | 5 +
.../METAS/meta.helm-mathql_generator.src | 5 +
.../METAS/meta.helm-mathql_interpreter.src | 6 +
helm/ocaml/METAS/meta.helm-metadata.src | 4 +
helm/ocaml/METAS/meta.helm-paramodulation.src | 5 +
helm/ocaml/METAS/meta.helm-pxp.src | 5 +
helm/ocaml/METAS/meta.helm-registry.src | 4 +
helm/ocaml/METAS/meta.helm-tactics.src | 4 +
.../meta.helm-tex_cic_textual_parser.src | 5 +
helm/ocaml/METAS/meta.helm-thread.src | 7 +
helm/ocaml/METAS/meta.helm-urimanager.src | 5 +
helm/ocaml/METAS/meta.helm-utf8_macros.src | 7 +
helm/ocaml/METAS/meta.helm-whelp.src | 4 +
helm/ocaml/METAS/meta.helm-xml.src | 5 +
helm/ocaml/METAS/meta.helm-xmldiff.src | 4 +
helm/ocaml/Makefile.common.in | 124 +
helm/ocaml/Makefile.in | 111 +
helm/ocaml/TODO | 0
helm/ocaml/acic_content/.depend | 30 +
helm/ocaml/acic_content/Makefile | 19 +
helm/ocaml/acic_content/acic2astMatcher.ml | 98 +
helm/ocaml/acic_content/acic2astMatcher.mli | 34 +
helm/ocaml/acic_content/acic2content.ml | 994 +++++
helm/ocaml/acic_content/acic2content.mli | 33 +
helm/ocaml/acic_content/cicNotationEnv.ml | 153 +
helm/ocaml/acic_content/cicNotationEnv.mli | 92 +
helm/ocaml/acic_content/cicNotationPp.ml | 325 ++
helm/ocaml/acic_content/cicNotationPp.mli | 37 +
helm/ocaml/acic_content/cicNotationPt.ml | 190 +
helm/ocaml/acic_content/cicNotationUtil.ml | 388 ++
helm/ocaml/acic_content/cicNotationUtil.mli | 91 +
helm/ocaml/acic_content/content.ml | 169 +
helm/ocaml/acic_content/content.mli | 157 +
helm/ocaml/acic_content/content2cic.ml | 270 ++
helm/ocaml/acic_content/content2cic.mli | 35 +
helm/ocaml/acic_content/contentPp.ml | 158 +
helm/ocaml/acic_content/contentPp.mli | 30 +
helm/ocaml/acic_content/termAcicContent.ml | 371 ++
helm/ocaml/acic_content/termAcicContent.mli | 68 +
helm/ocaml/cic/.depend | 27 +
helm/ocaml/cic/Makefile | 19 +
helm/ocaml/cic/cic.ml | 240 +
helm/ocaml/cic/cicParser.ml | 780 ++++
helm/ocaml/cic/cicParser.mli | 46 +
helm/ocaml/cic/cicUniv.ml | 949 ++++
helm/ocaml/cic/cicUniv.mli | 152 +
helm/ocaml/cic/cicUtil.ml | 365 ++
helm/ocaml/cic/cicUtil.mli | 61 +
helm/ocaml/cic/deannotate.ml | 126 +
helm/ocaml/cic/deannotate.mli | 36 +
helm/ocaml/cic/discrimination_tree.ml | 343 ++
helm/ocaml/cic/discrimination_tree.mli | 43 +
helm/ocaml/cic/helmLibraryObjects.ml | 230 +
helm/ocaml/cic/helmLibraryObjects.mli | 182 +
helm/ocaml/cic/libraryObjects.ml | 116 +
helm/ocaml/cic/libraryObjects.mli | 44 +
helm/ocaml/cic/path_indexing.ml | 227 +
helm/ocaml/cic/path_indexing.mli | 42 +
helm/ocaml/cic/test.ml | 88 +
helm/ocaml/cic/unshare.ml | 84 +
helm/ocaml/cic/unshare.mli | 26 +
helm/ocaml/cic_acic/.depend | 9 +
helm/ocaml/cic_acic/Makefile | 12 +
helm/ocaml/cic_acic/cic2Xml.ml | 483 ++
helm/ocaml/cic_acic/cic2Xml.mli | 46 +
helm/ocaml/cic_acic/cic2acic.ml | 739 +++
helm/ocaml/cic_acic/cic2acic.mli | 61 +
helm/ocaml/cic_acic/doubleTypeInference.ml | 734 +++
helm/ocaml/cic_acic/doubleTypeInference.mli | 25 +
helm/ocaml/cic_acic/eta_fixing.ml | 313 ++
helm/ocaml/cic_acic/eta_fixing.mli | 28 +
helm/ocaml/cic_disambiguation/.depend | 12 +
helm/ocaml/cic_disambiguation/Makefile | 27 +
helm/ocaml/cic_disambiguation/disambiguate.ml | 1009 +++++
.../ocaml/cic_disambiguation/disambiguate.mli | 73 +
.../cic_disambiguation/disambiguateChoices.ml | 69 +
.../disambiguateChoices.mli | 53 +
.../cic_disambiguation/disambiguateTypes.ml | 119 +
.../cic_disambiguation/disambiguateTypes.mli | 96 +
.../cic_disambiguation/doc/precedence.txt | 32 +
.../cic_disambiguation/number_notation.ml | 55 +
.../cic_disambiguation/tests/aliases.txt | 6 +
helm/ocaml/cic_disambiguation/tests/eq.txt | 1 +
helm/ocaml/cic_disambiguation/tests/match.txt | 49 +
helm/ocaml/cic_proof_checking/.depend | 24 +
helm/ocaml/cic_proof_checking/Makefile | 39 +
.../cic_proof_checking/cicEnvironment.ml | 545 +++
.../cic_proof_checking/cicEnvironment.mli | 136 +
helm/ocaml/cic_proof_checking/cicLogger.ml | 62 +
helm/ocaml/cic_proof_checking/cicLogger.mli | 42 +
.../cic_proof_checking/cicMiniReduction.ml | 76 +
.../cic_proof_checking/cicMiniReduction.mli | 26 +
helm/ocaml/cic_proof_checking/cicPp.ml | 480 ++
helm/ocaml/cic_proof_checking/cicPp.mli | 55 +
helm/ocaml/cic_proof_checking/cicReduction.ml | 1137 +++++
.../ocaml/cic_proof_checking/cicReduction.mli | 42 +
.../cic_proof_checking/cicSubstitution.ml | 427 ++
.../cic_proof_checking/cicSubstitution.mli | 56 +
.../cic_proof_checking/cicTypeChecker.ml | 2167 +++++++++
.../cic_proof_checking/cicTypeChecker.mli | 61 +
helm/ocaml/cic_proof_checking/cicUnivUtils.ml | 153 +
.../ocaml/cic_proof_checking/cicUnivUtils.mli | 32 +
.../cic_proof_checking/doc/inductive.txt | 41 +
.../cic_proof_checking/freshNamesGenerator.ml | 354 ++
.../freshNamesGenerator.mli | 46 +
.../cic_proof_checking/utilities/Makefile | 15 +
.../utilities/create_environment.ml | 73 +
.../cic_proof_checking/utilities/list_uris.ml | 30 +
.../utilities/parse_library.ml | 54 +
helm/ocaml/cic_unification/.depend | 10 +
helm/ocaml/cic_unification/Makefile | 12 +
helm/ocaml/cic_unification/cicMetaSubst.ml | 898 ++++
helm/ocaml/cic_unification/cicMetaSubst.mli | 92 +
helm/ocaml/cic_unification/cicMkImplicit.ml | 122 +
helm/ocaml/cic_unification/cicMkImplicit.mli | 60 +
helm/ocaml/cic_unification/cicRefine.ml | 1379 ++++++
helm/ocaml/cic_unification/cicRefine.mli | 48 +
helm/ocaml/cic_unification/cicUnification.ml | 750 ++++
helm/ocaml/cic_unification/cicUnification.mli | 58 +
helm/ocaml/clusters.dot | 58 +
helm/ocaml/configure.ac | 60 +
helm/ocaml/content_pres/.depend | 36 +
helm/ocaml/content_pres/Makefile | 58 +
helm/ocaml/content_pres/box.ml | 152 +
helm/ocaml/content_pres/box.mli | 78 +
helm/ocaml/content_pres/boxPp.ml | 241 +
helm/ocaml/content_pres/boxPp.mli | 33 +
helm/ocaml/content_pres/cicNotationLexer.ml | 353 ++
helm/ocaml/content_pres/cicNotationLexer.mli | 48 +
helm/ocaml/content_pres/cicNotationParser.ml | 647 +++
helm/ocaml/content_pres/cicNotationParser.mli | 66 +
helm/ocaml/content_pres/cicNotationPres.ml | 429 ++
helm/ocaml/content_pres/cicNotationPres.mli | 52 +
helm/ocaml/content_pres/content2pres.ml | 817 ++++
helm/ocaml/content_pres/content2pres.mli | 39 +
.../ocaml/content_pres/content2presMatcher.ml | 233 +
.../content_pres/content2presMatcher.mli | 34 +
helm/ocaml/content_pres/mpresentation.ml | 258 ++
helm/ocaml/content_pres/mpresentation.mli | 86 +
helm/ocaml/content_pres/renderingAttrs.ml | 50 +
helm/ocaml/content_pres/renderingAttrs.mli | 57 +
helm/ocaml/content_pres/sequent2pres.ml | 106 +
helm/ocaml/content_pres/sequent2pres.mli | 39 +
helm/ocaml/content_pres/termContentPres.ml | 649 +++
helm/ocaml/content_pres/termContentPres.mli | 52 +
helm/ocaml/content_pres/test_lexer.ml | 60 +
helm/ocaml/daemons.dot | 19 +
helm/ocaml/deps.patch | 11 +
helm/ocaml/extlib/.depend | 10 +
helm/ocaml/extlib/Makefile | 16 +
helm/ocaml/extlib/hExtlib.ml | 343 ++
helm/ocaml/extlib/hExtlib.mli | 95 +
helm/ocaml/extlib/hLog.ml | 64 +
helm/ocaml/extlib/hLog.mli | 36 +
helm/ocaml/extlib/hMarshal.ml | 72 +
helm/ocaml/extlib/hMarshal.mli | 59 +
helm/ocaml/extlib/patternMatcher.ml | 191 +
helm/ocaml/extlib/patternMatcher.mli | 62 +
helm/ocaml/extlib/trie.ml | 153 +
helm/ocaml/extlib/trie.mli | 43 +
helm/ocaml/getter/.depend | 30 +
helm/ocaml/getter/.ocamlinit | 3 +
helm/ocaml/getter/Makefile | 20 +
helm/ocaml/getter/http_getter.ml | 363 ++
helm/ocaml/getter/http_getter.mli | 66 +
helm/ocaml/getter/http_getter_common.ml | 168 +
helm/ocaml/getter/http_getter_common.mli | 70 +
helm/ocaml/getter/http_getter_const.ml | 102 +
helm/ocaml/getter/http_getter_const.mli | 39 +
helm/ocaml/getter/http_getter_env.ml | 114 +
helm/ocaml/getter/http_getter_env.mli | 52 +
helm/ocaml/getter/http_getter_logger.ml | 63 +
helm/ocaml/getter/http_getter_logger.mli | 49 +
helm/ocaml/getter/http_getter_misc.ml | 315 ++
helm/ocaml/getter/http_getter_misc.mli | 102 +
helm/ocaml/getter/http_getter_storage.ml | 275 ++
helm/ocaml/getter/http_getter_storage.mli | 71 +
helm/ocaml/getter/http_getter_types.ml | 72 +
helm/ocaml/getter/http_getter_wget.ml | 70 +
helm/ocaml/getter/http_getter_wget.mli | 35 +
helm/ocaml/getter/mkindexes.pl | 40 +
helm/ocaml/getter/sample.conf.xml | 50 +
helm/ocaml/getter/test.ml | 12 +
helm/ocaml/grafite/.depend | 6 +
helm/ocaml/grafite/Makefile | 13 +
helm/ocaml/grafite/grafiteAst.ml | 167 +
helm/ocaml/grafite/grafiteAstPp.ml | 253 ++
helm/ocaml/grafite/grafiteAstPp.mli | 76 +
helm/ocaml/grafite/grafiteMarshal.ml | 60 +
helm/ocaml/grafite/grafiteMarshal.mli | 33 +
helm/ocaml/grafite_engine/.depend | 12 +
helm/ocaml/grafite_engine/Makefile | 12 +
helm/ocaml/grafite_engine/grafiteEngine.ml | 714 +++
helm/ocaml/grafite_engine/grafiteEngine.mli | 55 +
helm/ocaml/grafite_engine/grafiteMisc.ml | 33 +
helm/ocaml/grafite_engine/grafiteMisc.mli | 27 +
helm/ocaml/grafite_engine/grafiteSync.ml | 74 +
helm/ocaml/grafite_engine/grafiteSync.mli | 38 +
helm/ocaml/grafite_engine/grafiteTypes.ml | 195 +
helm/ocaml/grafite_engine/grafiteTypes.mli | 77 +
helm/ocaml/grafite_parser/.depend | 10 +
helm/ocaml/grafite_parser/Makefile | 42 +
helm/ocaml/grafite_parser/cicNotation2.ml | 49 +
helm/ocaml/grafite_parser/cicNotation2.mli | 35 +
.../grafite_parser/dependenciesParser.ml | 92 +
.../grafite_parser/dependenciesParser.mli | 39 +
.../grafite_parser/grafiteDisambiguate.ml | 288 ++
.../grafite_parser/grafiteDisambiguate.mli | 48 +
.../grafite_parser/grafiteDisambiguator.ml | 178 +
.../grafite_parser/grafiteDisambiguator.mli | 51 +
helm/ocaml/grafite_parser/grafiteParser.ml | 565 +++
helm/ocaml/grafite_parser/grafiteParser.mli | 41 +
helm/ocaml/grafite_parser/print_grammar.ml | 287 ++
helm/ocaml/grafite_parser/test_dep.ml | 40 +
helm/ocaml/grafite_parser/test_parser.ml | 133 +
helm/ocaml/hbugs/.depend | 20 +
helm/ocaml/hbugs/Makefile | 97 +
helm/ocaml/hbugs/broker.ml | 293 ++
helm/ocaml/hbugs/client.ml | 46 +
helm/ocaml/hbugs/data/hbugs_tutor.TPL.ml | 42 +
helm/ocaml/hbugs/data/tutors_index.xml | 140 +
helm/ocaml/hbugs/doc/hbugs.dia | Bin 0 -> 1927 bytes
helm/ocaml/hbugs/hbugs_broker_registry.ml | 317 ++
helm/ocaml/hbugs/hbugs_broker_registry.mli | 87 +
helm/ocaml/hbugs/hbugs_client.ml | 526 +++
helm/ocaml/hbugs/hbugs_client.mli | 33 +
helm/ocaml/hbugs/hbugs_client_gui.glade | 672 +++
helm/ocaml/hbugs/hbugs_common.ml | 48 +
helm/ocaml/hbugs/hbugs_common.mli | 32 +
helm/ocaml/hbugs/hbugs_id_generator.ml | 67 +
helm/ocaml/hbugs/hbugs_id_generator.mli | 35 +
helm/ocaml/hbugs/hbugs_messages.ml | 368 ++
helm/ocaml/hbugs/hbugs_messages.mli | 49 +
helm/ocaml/hbugs/hbugs_misc.ml | 122 +
helm/ocaml/hbugs/hbugs_misc.mli | 50 +
helm/ocaml/hbugs/hbugs_tutors.ml | 266 ++
helm/ocaml/hbugs/hbugs_tutors.mli | 60 +
helm/ocaml/hbugs/hbugs_types.mli | 104 +
helm/ocaml/hbugs/scripts/brokerctl.sh | 15 +
helm/ocaml/hbugs/scripts/build_tutors.ml | 112 +
helm/ocaml/hbugs/scripts/ls_tutors.ml | 68 +
helm/ocaml/hbugs/scripts/sabba.sh | 47 +
.../ocaml/hbugs/search_pattern_apply_tutor.ml | 147 +
helm/ocaml/hbugs/test/HBUGS_MESSAGES.xml | 144 +
helm/ocaml/hbugs/test/Makefile | 5 +
helm/ocaml/hbugs/test/test_serialization.ml | 70 +
helm/ocaml/hgdome/.depend | 4 +
helm/ocaml/hgdome/Makefile | 11 +
helm/ocaml/hgdome/domMisc.ml | 43 +
helm/ocaml/hgdome/domMisc.mli | 42 +
helm/ocaml/hgdome/xml2Gdome.ml | 135 +
helm/ocaml/hgdome/xml2Gdome.mli | 27 +
helm/ocaml/hmysql/.depend | 2 +
helm/ocaml/hmysql/Makefile | 11 +
helm/ocaml/hmysql/hMysql.ml | 80 +
helm/ocaml/hmysql/hMysql.mli | 56 +
helm/ocaml/lexicon/.depend | 20 +
helm/ocaml/lexicon/Makefile | 17 +
helm/ocaml/lexicon/cicNotation.ml | 83 +
helm/ocaml/lexicon/cicNotation.mli | 40 +
helm/ocaml/lexicon/disambiguatePp.ml | 53 +
helm/ocaml/lexicon/disambiguatePp.mli | 30 +
helm/ocaml/lexicon/lexiconAst.ml | 55 +
helm/ocaml/lexicon/lexiconAstPp.ml | 84 +
helm/ocaml/lexicon/lexiconAstPp.mli | 29 +
helm/ocaml/lexicon/lexiconEngine.ml | 150 +
helm/ocaml/lexicon/lexiconEngine.mli | 40 +
helm/ocaml/lexicon/lexiconMarshal.ml | 67 +
helm/ocaml/lexicon/lexiconMarshal.mli | 32 +
helm/ocaml/lexicon/lexiconSync.ml | 119 +
helm/ocaml/lexicon/lexiconSync.mli | 40 +
helm/ocaml/library/.depend | 25 +
helm/ocaml/library/Makefile | 19 +
helm/ocaml/library/cicCoercion.ml | 156 +
helm/ocaml/library/cicCoercion.mli | 31 +
helm/ocaml/library/cicElim.ml | 421 ++
helm/ocaml/library/cicElim.mli | 41 +
helm/ocaml/library/cicRecord.ml | 88 +
helm/ocaml/library/cicRecord.mli | 28 +
helm/ocaml/library/coercDb.ml | 90 +
helm/ocaml/library/coercDb.mli | 58 +
helm/ocaml/library/coercGraph.ml | 97 +
helm/ocaml/library/coercGraph.mli | 40 +
helm/ocaml/library/libraryClean.ml | 238 +
helm/ocaml/library/libraryClean.mli | 26 +
helm/ocaml/library/libraryDb.ml | 168 +
helm/ocaml/library/libraryDb.mli | 34 +
helm/ocaml/library/libraryMisc.ml | 38 +
helm/ocaml/library/libraryMisc.mli | 28 +
helm/ocaml/library/libraryNoDb.ml | 51 +
helm/ocaml/library/libraryNoDb.mli | 35 +
helm/ocaml/library/librarySync.ml | 406 ++
helm/ocaml/library/librarySync.mli | 52 +
helm/ocaml/license | 25 +
helm/ocaml/logger/.depend | 2 +
helm/ocaml/logger/Makefile | 9 +
helm/ocaml/logger/helmLogger.ml | 62 +
helm/ocaml/logger/helmLogger.mli | 27 +
helm/ocaml/mathql/.depend | 0
helm/ocaml/mathql/Makefile | 13 +
helm/ocaml/mathql/mathQL.ml | 133 +
helm/ocaml/mathql_generator/.depend | 15 +
helm/ocaml/mathql_generator/Makefile | 15 +
.../mathql_generator/cGLocateInductive.ml | 42 +
.../mathql_generator/cGLocateInductive.mli | 31 +
.../mathql_generator/cGMatchConclusion.ml | 161 +
.../mathql_generator/cGMatchConclusion.mli | 33 +
.../ocaml/mathql_generator/cGSearchPattern.ml | 197 +
.../mathql_generator/cGSearchPattern.mli | 39 +
helm/ocaml/mathql_generator/mQGTypes.ml | 77 +
helm/ocaml/mathql_generator/mQGUtil.ml | 150 +
helm/ocaml/mathql_generator/mQGUtil.mli | 69 +
.../ocaml/mathql_generator/mQueryGenerator.ml | 191 +
.../mathql_generator/mQueryGenerator.mli | 42 +
helm/ocaml/mathql_interpreter/.depend | 27 +
helm/ocaml/mathql_interpreter/Makefile | 19 +
helm/ocaml/mathql_interpreter/mQIConn.ml | 130 +
helm/ocaml/mathql_interpreter/mQIConn.mli | 65 +
helm/ocaml/mathql_interpreter/mQIMap.ml | 93 +
helm/ocaml/mathql_interpreter/mQIMap.mli | 47 +
helm/ocaml/mathql_interpreter/mQIMySql.ml | 96 +
helm/ocaml/mathql_interpreter/mQIMySql.mli | 36 +
helm/ocaml/mathql_interpreter/mQIPostgres.ml | 96 +
helm/ocaml/mathql_interpreter/mQIPostgres.mli | 36 +
helm/ocaml/mathql_interpreter/mQIProperty.ml | 103 +
helm/ocaml/mathql_interpreter/mQIProperty.mli | 32 +
helm/ocaml/mathql_interpreter/mQITypes.ml | 43 +
helm/ocaml/mathql_interpreter/mQIUtil.ml | 155 +
helm/ocaml/mathql_interpreter/mQIUtil.mli | 69 +
.../mathql_interpreter/mQueryInterpreter.ml | 247 ++
.../mathql_interpreter/mQueryInterpreter.mli | 29 +
.../ocaml/mathql_interpreter/mQueryTLexer.mll | 133 +
.../mathql_interpreter/mQueryTParser.mly | 314 ++
helm/ocaml/mathql_interpreter/mQueryUtil.ml | 220 +
helm/ocaml/mathql_interpreter/mQueryUtil.mli | 49 +
helm/ocaml/metadata/.depend | 20 +
helm/ocaml/metadata/Makefile | 37 +
helm/ocaml/metadata/dump_db/dump.sh | 20 +
helm/ocaml/metadata/extractor/.depend | 0
helm/ocaml/metadata/extractor/Makefile | 30 +
.../metadata/extractor/extractor.conf.xml | 19 +
helm/ocaml/metadata/extractor/extractor.ml | 78 +
.../metadata/extractor/extractor_manager.ml | 306 ++
helm/ocaml/metadata/metadataConstraints.ml | 649 +++
helm/ocaml/metadata/metadataConstraints.mli | 111 +
helm/ocaml/metadata/metadataDb.ml | 193 +
helm/ocaml/metadata/metadataDb.mli | 41 +
helm/ocaml/metadata/metadataExtractor.ml | 350 ++
helm/ocaml/metadata/metadataExtractor.mli | 42 +
helm/ocaml/metadata/metadataPp.ml | 117 +
helm/ocaml/metadata/metadataPp.mli | 49 +
helm/ocaml/metadata/metadataTypes.ml | 115 +
helm/ocaml/metadata/metadataTypes.mli | 84 +
helm/ocaml/metadata/sqlStatements.ml | 200 +
helm/ocaml/metadata/sqlStatements.mli | 45 +
helm/ocaml/metadata/table_creator/.depend | 4 +
helm/ocaml/metadata/table_creator/Makefile | 31 +
helm/ocaml/metadata/table_creator/sync_db.sh | 28 +
.../metadata/table_creator/table_creator.ml | 83 +
helm/ocaml/paramodulation/.depend | 12 +
helm/ocaml/paramodulation/Makefile | 38 +
helm/ocaml/paramodulation/README | 43 +
.../ocaml/paramodulation/equality_indexing.ml | 131 +
.../paramodulation/equality_indexing.mli | 43 +
helm/ocaml/paramodulation/indexing.ml | 1021 +++++
helm/ocaml/paramodulation/inference.ml | 952 ++++
helm/ocaml/paramodulation/inference.mli | 133 +
helm/ocaml/paramodulation/saturate_main.ml | 161 +
helm/ocaml/paramodulation/saturation.ml | 2379 ++++++++++
helm/ocaml/paramodulation/test_indexing.ml | 253 ++
helm/ocaml/paramodulation/utils.ml | 596 +++
helm/ocaml/paramodulation/utils.mli | 82 +
helm/ocaml/patch_deps.sh | 32 +
helm/ocaml/registry/.depend | 2 +
helm/ocaml/registry/.ocamlinit | 4 +
helm/ocaml/registry/Makefile | 7 +
helm/ocaml/registry/helm_registry.ml | 422 ++
helm/ocaml/registry/helm_registry.mli | 199 +
helm/ocaml/registry/test.ml | 32 +
helm/ocaml/registry/tests/sample.xml | 34 +
helm/ocaml/registry/tests/sample_include.xml | 15 +
helm/ocaml/tactics/.depend | 128 +
helm/ocaml/tactics/Makefile | 23 +
helm/ocaml/tactics/autoTactic.ml | 348 ++
helm/ocaml/tactics/autoTactic.mli | 38 +
helm/ocaml/tactics/continuationals.ml | 357 ++
helm/ocaml/tactics/continuationals.mli | 126 +
helm/ocaml/tactics/discriminationTactics.ml | 554 +++
helm/ocaml/tactics/discriminationTactics.mli | 30 +
helm/ocaml/tactics/doc/Makefile | 124 +
helm/ocaml/tactics/doc/body.tex | 474 ++
helm/ocaml/tactics/doc/infernce.sty | 217 +
helm/ocaml/tactics/doc/ligature.sty | 169 +
helm/ocaml/tactics/doc/main.tex | 70 +
helm/ocaml/tactics/doc/reserved.sty | 80 +
helm/ocaml/tactics/doc/semantic.sty | 137 +
helm/ocaml/tactics/doc/shrthand.sty | 96 +
helm/ocaml/tactics/doc/tdiagram.sty | 166 +
helm/ocaml/tactics/eliminationTactics.ml | 217 +
helm/ocaml/tactics/eliminationTactics.mli | 33 +
helm/ocaml/tactics/equalityTactics.ml | 363 ++
helm/ocaml/tactics/equalityTactics.mli | 41 +
helm/ocaml/tactics/fourier.ml | 244 +
helm/ocaml/tactics/fourier.mli | 27 +
helm/ocaml/tactics/fourierR.ml | 1205 +++++
helm/ocaml/tactics/fourierR.mli | 5 +
helm/ocaml/tactics/fwdSimplTactic.ml | 144 +
helm/ocaml/tactics/fwdSimplTactic.mli | 32 +
helm/ocaml/tactics/hashtbl_equiv.ml | 190 +
helm/ocaml/tactics/hashtbl_equiv.mli | 38 +
helm/ocaml/tactics/history.ml | 86 +
helm/ocaml/tactics/history.mli | 35 +
helm/ocaml/tactics/introductionTactics.ml | 49 +
helm/ocaml/tactics/introductionTactics.mli | 31 +
helm/ocaml/tactics/inversion.ml | 253 ++
helm/ocaml/tactics/inversion.mli | 26 +
helm/ocaml/tactics/metadataQuery.ml | 367 ++
helm/ocaml/tactics/metadataQuery.mli | 55 +
helm/ocaml/tactics/negationTactics.ml | 88 +
helm/ocaml/tactics/negationTactics.mli | 28 +
helm/ocaml/tactics/primitiveTactics.ml | 567 +++
helm/ocaml/tactics/primitiveTactics.mli | 59 +
helm/ocaml/tactics/proofEngineHelpers.ml | 688 +++
helm/ocaml/tactics/proofEngineHelpers.mli | 118 +
helm/ocaml/tactics/proofEngineReduction.ml | 973 ++++
helm/ocaml/tactics/proofEngineReduction.mli | 49 +
.../tactics/proofEngineStructuralRules.ml | 195 +
.../tactics/proofEngineStructuralRules.mli | 34 +
helm/ocaml/tactics/proofEngineTypes.ml | 101 +
helm/ocaml/tactics/proofEngineTypes.mli | 76 +
helm/ocaml/tactics/reductionTactics.ml | 220 +
helm/ocaml/tactics/reductionTactics.mli | 47 +
helm/ocaml/tactics/ring.ml | 596 +++
helm/ocaml/tactics/ring.mli | 12 +
helm/ocaml/tactics/statefulProofEngine.ml | 214 +
helm/ocaml/tactics/statefulProofEngine.mli | 120 +
helm/ocaml/tactics/tacticChaser.ml | 259 ++
helm/ocaml/tactics/tacticals.ml | 351 ++
helm/ocaml/tactics/tacticals.mli | 92 +
helm/ocaml/tactics/tactics.ml | 73 +
helm/ocaml/tactics/tactics.mli | 90 +
helm/ocaml/tactics/variousTactics.ml | 178 +
helm/ocaml/tactics/variousTactics.mli | 35 +
helm/ocaml/thread/.depend | 4 +
helm/ocaml/thread/Makefile | 27 +
helm/ocaml/thread/extThread.ml | 110 +
helm/ocaml/thread/extThread.mli | 35 +
helm/ocaml/thread/fake/threadSafe.ml | 35 +
helm/ocaml/thread/fake/threadSafe.mli | 44 +
helm/ocaml/thread/threadSafe.ml | 100 +
helm/ocaml/thread/threadSafe.mli | 44 +
helm/ocaml/urimanager/.depend | 2 +
helm/ocaml/urimanager/Makefile | 9 +
helm/ocaml/urimanager/uriManager.ml | 225 +
helm/ocaml/urimanager/uriManager.mli | 71 +
helm/ocaml/utf8_macros/.depend | 2 +
helm/ocaml/utf8_macros/Makefile | 36 +
helm/ocaml/utf8_macros/README.syntax | 15 +
.../ocaml/utf8_macros/data/dictionary-tex.xml | 378 ++
.../ocaml/utf8_macros/data/entities-table.xml | 2079 +++++++++
.../ocaml/utf8_macros/data/extra-entities.xml | 16 +
helm/ocaml/utf8_macros/make_table.ml | 102 +
helm/ocaml/utf8_macros/pa_unicode_macro.ml | 67 +
helm/ocaml/utf8_macros/test.ml | 3 +
helm/ocaml/utf8_macros/utf8Macro.ml | 47 +
helm/ocaml/utf8_macros/utf8Macro.mli | 40 +
helm/ocaml/utf8_macros/utf8MacroTable.ml | 3625 +++++++++++++++
helm/ocaml/whelp/.depend | 4 +
helm/ocaml/whelp/Makefile | 10 +
helm/ocaml/whelp/fwdQueries.ml | 115 +
helm/ocaml/whelp/fwdQueries.mli | 28 +
helm/ocaml/whelp/whelp.ml | 215 +
helm/ocaml/whelp/whelp.mli | 30 +
helm/ocaml/xml/.depend | 4 +
helm/ocaml/xml/Makefile | 11 +
helm/ocaml/xml/test.ml | 60 +
helm/ocaml/xml/xml.ml | 177 +
helm/ocaml/xml/xml.mli | 75 +
helm/ocaml/xml/xmlPushParser.ml | 118 +
helm/ocaml/xml/xmlPushParser.mli | 78 +
helm/ocaml/xmldiff/.depend | 2 +
helm/ocaml/xmldiff/Makefile | 9 +
helm/ocaml/xmldiff/xmlDiff.ml | 345 ++
helm/ocaml/xmldiff/xmlDiff.mli | 30 +
698 files changed, 98923 insertions(+)
create mode 100644 helm/matita/.depend
create mode 100644 helm/matita/.ocamlinit
create mode 100644 helm/matita/AUTHORS
create mode 100644 helm/matita/LICENSE
create mode 100644 helm/matita/Makefile.in
create mode 100644 helm/matita/applyTransformation.ml
create mode 100644 helm/matita/applyTransformation.mli
create mode 100644 helm/matita/buildTimeConf.ml.in
create mode 100644 helm/matita/buildTimeConf.mli
create mode 100644 helm/matita/closed.xml
create mode 100644 helm/matita/configure.ac
create mode 100644 helm/matita/contribs/LAMBDA-TYPES/Makefile
create mode 100644 helm/matita/contribs/LAMBDA-TYPES/lref_map_defs.ma
create mode 100644 helm/matita/contribs/LAMBDA-TYPES/terms_defs.ma
create mode 100644 helm/matita/contribs/LAMBDA-TYPES/tlt_defs.ma
create mode 100644 helm/matita/contribs/PREDICATIVE-TOPOLOGY/Makefile
create mode 100644 helm/matita/contribs/PREDICATIVE-TOPOLOGY/class_defs.ma
create mode 100644 helm/matita/contribs/PREDICATIVE-TOPOLOGY/class_eq.ma
create mode 100644 helm/matita/contribs/PREDICATIVE-TOPOLOGY/class_le.ma
create mode 100644 helm/matita/contribs/PREDICATIVE-TOPOLOGY/coa_defs.ma
create mode 100644 helm/matita/contribs/PREDICATIVE-TOPOLOGY/coa_props.ma
create mode 100644 helm/matita/contribs/PREDICATIVE-TOPOLOGY/domain_data.ma
create mode 100644 helm/matita/contribs/PREDICATIVE-TOPOLOGY/domain_defs.ma
create mode 100644 helm/matita/contribs/PREDICATIVE-TOPOLOGY/iff.ma
create mode 100644 helm/matita/contribs/PREDICATIVE-TOPOLOGY/subset_defs.ma
create mode 100644 helm/matita/core_notation.moo
create mode 100644 helm/matita/dictionary-matita.xml
create mode 100644 helm/matita/dist/Makefile
create mode 100755 helm/matita/dist/fill_db.sh
create mode 100644 helm/matita/dist/static_link/Makefile
create mode 100644 helm/matita/dist/static_link/static_link.ml
create mode 100644 helm/matita/dump_moo.ml
create mode 100644 helm/matita/gtkmathview.matita.conf.xml.in
create mode 100644 helm/matita/icons/matita-bulb-high.png
create mode 100644 helm/matita/icons/matita-bulb-low.png
create mode 100644 helm/matita/icons/matita-bulb-medium.png
create mode 100644 helm/matita/icons/matita-folder.png
create mode 100644 helm/matita/icons/matita-object.png
create mode 100644 helm/matita/icons/matita-theory.png
create mode 100644 helm/matita/icons/matita.png
create mode 100644 helm/matita/icons/matita_medium.png
create mode 100644 helm/matita/icons/matita_small.png
create mode 100644 helm/matita/icons/meegg.png
create mode 100644 helm/matita/icons/whelp.png
create mode 100644 helm/matita/icons/whelp.svg
create mode 100644 helm/matita/library/Makefile
create mode 100644 helm/matita/library/Q/q.ma
create mode 100644 helm/matita/library/Z/compare.ma
create mode 100644 helm/matita/library/Z/orders.ma
create mode 100644 helm/matita/library/Z/plus.ma
create mode 100644 helm/matita/library/Z/times.ma
create mode 100644 helm/matita/library/Z/z.ma
create mode 100644 helm/matita/library/datatypes/bool.ma
create mode 100644 helm/matita/library/datatypes/compare.ma
create mode 100644 helm/matita/library/datatypes/constructors.ma
create mode 100644 helm/matita/library/higher_order_defs/functions.ma
create mode 100644 helm/matita/library/higher_order_defs/ordering.ma
create mode 100644 helm/matita/library/higher_order_defs/relations.ma
create mode 100644 helm/matita/library/legacy/coq.ma
create mode 100644 helm/matita/library/list/list.ma
create mode 100644 helm/matita/library/list/sort.ma
create mode 100644 helm/matita/library/logic/connectives.ma
create mode 100644 helm/matita/library/logic/equality.ma
create mode 100644 helm/matita/library/nat/chinese_reminder.ma
create mode 100644 helm/matita/library/nat/compare.ma
create mode 100644 helm/matita/library/nat/congruence.ma
create mode 100644 helm/matita/library/nat/count.ma
create mode 100644 helm/matita/library/nat/div_and_mod.ma
create mode 100644 helm/matita/library/nat/exp.ma
create mode 100644 helm/matita/library/nat/factorial.ma
create mode 100644 helm/matita/library/nat/factorization.ma
create mode 100644 helm/matita/library/nat/fermat_little_theorem.ma
create mode 100644 helm/matita/library/nat/gcd.ma
create mode 100644 helm/matita/library/nat/le_arith.ma
create mode 100644 helm/matita/library/nat/lt_arith.ma
create mode 100644 helm/matita/library/nat/minimization.ma
create mode 100644 helm/matita/library/nat/minus.ma
create mode 100644 helm/matita/library/nat/nat.ma
create mode 100644 helm/matita/library/nat/nth_prime.ma
create mode 100644 helm/matita/library/nat/ord.ma
create mode 100644 helm/matita/library/nat/orders.ma
create mode 100644 helm/matita/library/nat/permutation.ma
create mode 100644 helm/matita/library/nat/plus.ma
create mode 100644 helm/matita/library/nat/primes.ma
create mode 100644 helm/matita/library/nat/primes1.ma
create mode 100644 helm/matita/library/nat/relevant_equations.ma
create mode 100644 helm/matita/library/nat/sigma_and_pi.ma
create mode 100644 helm/matita/library/nat/times.ma
create mode 100644 helm/matita/library/nat/totient.ma
create mode 100644 helm/matita/matita.conf.xml.sample.in
create mode 100644 helm/matita/matita.glade
create mode 100644 helm/matita/matita.gtkrc
create mode 100644 helm/matita/matita.lang
create mode 100644 helm/matita/matita.ma.templ
create mode 100644 helm/matita/matita.ml
create mode 100644 helm/matita/matita.txt
create mode 100644 helm/matita/matitaEngine.ml
create mode 100644 helm/matita/matitaEngine.mli
create mode 100644 helm/matita/matitaExcPp.ml
create mode 100644 helm/matita/matitaExcPp.mli
create mode 100644 helm/matita/matitaGtkMisc.ml
create mode 100644 helm/matita/matitaGtkMisc.mli
create mode 100644 helm/matita/matitaGui.ml
create mode 100644 helm/matita/matitaGui.mli
create mode 100644 helm/matita/matitaGuiTypes.mli
create mode 100644 helm/matita/matitaInit.ml
create mode 100644 helm/matita/matitaInit.mli
create mode 100644 helm/matita/matitaMathView.ml
create mode 100644 helm/matita/matitaMathView.mli
create mode 100644 helm/matita/matitaMisc.ml
create mode 100644 helm/matita/matitaMisc.mli
create mode 100644 helm/matita/matitaScript.ml
create mode 100644 helm/matita/matitaScript.mli
create mode 100644 helm/matita/matitaTypes.ml
create mode 100644 helm/matita/matitaTypes.mli
create mode 100644 helm/matita/matitac.ml
create mode 100644 helm/matita/matitacLib.ml
create mode 100644 helm/matita/matitacLib.mli
create mode 100644 helm/matita/matitaclean.ml
create mode 100644 helm/matita/matitaclean.mli
create mode 100644 helm/matita/matitadep.ml
create mode 100644 helm/matita/matitadep.mli
create mode 100644 helm/matita/matitamake.ml
create mode 100644 helm/matita/matitamakeLib.ml
create mode 100644 helm/matita/matitamakeLib.mli
create mode 100644 helm/matita/matitatop.ml
create mode 100644 helm/matita/scripts/README
create mode 100644 helm/matita/scripts/bench.sql
create mode 100644 helm/matita/scripts/crontab
create mode 100644 helm/matita/scripts/crontab.sh
create mode 100755 helm/matita/scripts/do_tests.sh
create mode 100644 helm/matita/scripts/insert.awk
create mode 100755 helm/matita/scripts/profile_svn.sh
create mode 100644 helm/matita/scripts/public_html/bench.php
create mode 100644 helm/matita/scripts/public_html/common.php
create mode 100644 helm/matita/scripts/public_html/composequery.php
create mode 100644 helm/matita/scripts/public_html/index.html
create mode 100644 helm/matita/scripts/public_html/showquery.php
create mode 100644 helm/matita/scripts/public_html/style.css
create mode 100755 helm/matita/scripts/shell_adder.php
create mode 100755 helm/matita/scripts/shell_time2cents.php
create mode 100644 helm/matita/template_makefile.in
create mode 100644 helm/matita/tests/Makefile
create mode 100644 helm/matita/tests/absurd.ma
create mode 100644 helm/matita/tests/apply.ma
create mode 100644 helm/matita/tests/assumption.ma
create mode 100644 helm/matita/tests/bad_tests/Makefile
create mode 100644 helm/matita/tests/bad_tests/auto.log
create mode 100755 helm/matita/tests/bad_tests/auto.ma
create mode 100644 helm/matita/tests/bad_tests/baseuri.log
create mode 100644 helm/matita/tests/bad_tests/baseuri.ma
create mode 100644 helm/matita/tests/change.ma
create mode 100644 helm/matita/tests/clear.ma
create mode 100644 helm/matita/tests/clearbody.ma
create mode 100644 helm/matita/tests/coercions.ma
create mode 100644 helm/matita/tests/comments.ma
create mode 100644 helm/matita/tests/constructor.ma
create mode 100644 helm/matita/tests/continuationals.ma
create mode 100644 helm/matita/tests/contradiction.ma
create mode 100644 helm/matita/tests/cut.ma
create mode 100644 helm/matita/tests/decompose.ma
create mode 100644 helm/matita/tests/discriminate.ma
create mode 100644 helm/matita/tests/elim.ma
create mode 100644 helm/matita/tests/fguidi.ma
create mode 100644 helm/matita/tests/first.ma
create mode 100644 helm/matita/tests/fix_betareduction.ma
create mode 100644 helm/matita/tests/fold.ma
create mode 100644 helm/matita/tests/generalize.ma
create mode 100644 helm/matita/tests/interactive/automatic_insertion.ma
create mode 100644 helm/matita/tests/interactive/drop.ma
create mode 100644 helm/matita/tests/interactive/grafite.ma
create mode 100644 helm/matita/tests/interactive/test5.ma
create mode 100644 helm/matita/tests/interactive/test6.ma
create mode 100644 helm/matita/tests/interactive/test7.ma
create mode 100644 helm/matita/tests/interactive/test_instance.ma
create mode 100644 helm/matita/tests/inversion.ma
create mode 100644 helm/matita/tests/inversion2.ma
create mode 100644 helm/matita/tests/letrec.ma
create mode 100644 helm/matita/tests/match_inference.ma
create mode 100644 helm/matita/tests/metasenv_ordering.ma
create mode 100644 helm/matita/tests/mysql_escaping.ma
create mode 100644 helm/matita/tests/paramodulation.ma
create mode 100644 helm/matita/tests/record.ma
create mode 100644 helm/matita/tests/replace.ma
create mode 100644 helm/matita/tests/rewrite.ma
create mode 100644 helm/matita/tests/second.ma
create mode 100644 helm/matita/tests/simpl.ma
create mode 100644 helm/matita/tests/test2.ma
create mode 100644 helm/matita/tests/test3.ma
create mode 100644 helm/matita/tests/test4.ma
create mode 100644 helm/matita/tests/third.ma
create mode 100644 helm/matita/tests/unfold.ma
create mode 100644 helm/ocaml/METAS/meta.helm-acic_content.src
create mode 100644 helm/ocaml/METAS/meta.helm-cic.src
create mode 100644 helm/ocaml/METAS/meta.helm-cic_acic.src
create mode 100644 helm/ocaml/METAS/meta.helm-cic_annotations.src
create mode 100644 helm/ocaml/METAS/meta.helm-cic_annotations_cache.src
create mode 100644 helm/ocaml/METAS/meta.helm-cic_cache.src
create mode 100644 helm/ocaml/METAS/meta.helm-cic_disambiguation.src
create mode 100644 helm/ocaml/METAS/meta.helm-cic_proof_checking.src
create mode 100644 helm/ocaml/METAS/meta.helm-cic_textual_parser.src
create mode 100644 helm/ocaml/METAS/meta.helm-cic_unification.src
create mode 100644 helm/ocaml/METAS/meta.helm-content_pres.src
create mode 100644 helm/ocaml/METAS/meta.helm-extlib.src
create mode 100644 helm/ocaml/METAS/meta.helm-getter.src
create mode 100644 helm/ocaml/METAS/meta.helm-grafite.src
create mode 100644 helm/ocaml/METAS/meta.helm-grafite_engine.src
create mode 100644 helm/ocaml/METAS/meta.helm-grafite_parser.src
create mode 100644 helm/ocaml/METAS/meta.helm-hbugs.src
create mode 100644 helm/ocaml/METAS/meta.helm-hgdome.src
create mode 100644 helm/ocaml/METAS/meta.helm-hmysql.src
create mode 100644 helm/ocaml/METAS/meta.helm-lexicon.src
create mode 100644 helm/ocaml/METAS/meta.helm-library.src
create mode 100644 helm/ocaml/METAS/meta.helm-logger.src
create mode 100644 helm/ocaml/METAS/meta.helm-mathql.src
create mode 100644 helm/ocaml/METAS/meta.helm-mathql_generator.src
create mode 100644 helm/ocaml/METAS/meta.helm-mathql_interpreter.src
create mode 100644 helm/ocaml/METAS/meta.helm-metadata.src
create mode 100644 helm/ocaml/METAS/meta.helm-paramodulation.src
create mode 100644 helm/ocaml/METAS/meta.helm-pxp.src
create mode 100644 helm/ocaml/METAS/meta.helm-registry.src
create mode 100644 helm/ocaml/METAS/meta.helm-tactics.src
create mode 100644 helm/ocaml/METAS/meta.helm-tex_cic_textual_parser.src
create mode 100644 helm/ocaml/METAS/meta.helm-thread.src
create mode 100644 helm/ocaml/METAS/meta.helm-urimanager.src
create mode 100644 helm/ocaml/METAS/meta.helm-utf8_macros.src
create mode 100644 helm/ocaml/METAS/meta.helm-whelp.src
create mode 100644 helm/ocaml/METAS/meta.helm-xml.src
create mode 100644 helm/ocaml/METAS/meta.helm-xmldiff.src
create mode 100644 helm/ocaml/Makefile.common.in
create mode 100644 helm/ocaml/Makefile.in
create mode 100644 helm/ocaml/TODO
create mode 100644 helm/ocaml/acic_content/.depend
create mode 100644 helm/ocaml/acic_content/Makefile
create mode 100644 helm/ocaml/acic_content/acic2astMatcher.ml
create mode 100644 helm/ocaml/acic_content/acic2astMatcher.mli
create mode 100644 helm/ocaml/acic_content/acic2content.ml
create mode 100644 helm/ocaml/acic_content/acic2content.mli
create mode 100644 helm/ocaml/acic_content/cicNotationEnv.ml
create mode 100644 helm/ocaml/acic_content/cicNotationEnv.mli
create mode 100644 helm/ocaml/acic_content/cicNotationPp.ml
create mode 100644 helm/ocaml/acic_content/cicNotationPp.mli
create mode 100644 helm/ocaml/acic_content/cicNotationPt.ml
create mode 100644 helm/ocaml/acic_content/cicNotationUtil.ml
create mode 100644 helm/ocaml/acic_content/cicNotationUtil.mli
create mode 100644 helm/ocaml/acic_content/content.ml
create mode 100644 helm/ocaml/acic_content/content.mli
create mode 100644 helm/ocaml/acic_content/content2cic.ml
create mode 100644 helm/ocaml/acic_content/content2cic.mli
create mode 100644 helm/ocaml/acic_content/contentPp.ml
create mode 100644 helm/ocaml/acic_content/contentPp.mli
create mode 100644 helm/ocaml/acic_content/termAcicContent.ml
create mode 100644 helm/ocaml/acic_content/termAcicContent.mli
create mode 100644 helm/ocaml/cic/.depend
create mode 100644 helm/ocaml/cic/Makefile
create mode 100644 helm/ocaml/cic/cic.ml
create mode 100644 helm/ocaml/cic/cicParser.ml
create mode 100644 helm/ocaml/cic/cicParser.mli
create mode 100644 helm/ocaml/cic/cicUniv.ml
create mode 100644 helm/ocaml/cic/cicUniv.mli
create mode 100644 helm/ocaml/cic/cicUtil.ml
create mode 100644 helm/ocaml/cic/cicUtil.mli
create mode 100644 helm/ocaml/cic/deannotate.ml
create mode 100644 helm/ocaml/cic/deannotate.mli
create mode 100644 helm/ocaml/cic/discrimination_tree.ml
create mode 100644 helm/ocaml/cic/discrimination_tree.mli
create mode 100644 helm/ocaml/cic/helmLibraryObjects.ml
create mode 100644 helm/ocaml/cic/helmLibraryObjects.mli
create mode 100644 helm/ocaml/cic/libraryObjects.ml
create mode 100644 helm/ocaml/cic/libraryObjects.mli
create mode 100644 helm/ocaml/cic/path_indexing.ml
create mode 100644 helm/ocaml/cic/path_indexing.mli
create mode 100644 helm/ocaml/cic/test.ml
create mode 100644 helm/ocaml/cic/unshare.ml
create mode 100644 helm/ocaml/cic/unshare.mli
create mode 100644 helm/ocaml/cic_acic/.depend
create mode 100644 helm/ocaml/cic_acic/Makefile
create mode 100644 helm/ocaml/cic_acic/cic2Xml.ml
create mode 100644 helm/ocaml/cic_acic/cic2Xml.mli
create mode 100644 helm/ocaml/cic_acic/cic2acic.ml
create mode 100644 helm/ocaml/cic_acic/cic2acic.mli
create mode 100644 helm/ocaml/cic_acic/doubleTypeInference.ml
create mode 100644 helm/ocaml/cic_acic/doubleTypeInference.mli
create mode 100644 helm/ocaml/cic_acic/eta_fixing.ml
create mode 100644 helm/ocaml/cic_acic/eta_fixing.mli
create mode 100644 helm/ocaml/cic_disambiguation/.depend
create mode 100644 helm/ocaml/cic_disambiguation/Makefile
create mode 100644 helm/ocaml/cic_disambiguation/disambiguate.ml
create mode 100644 helm/ocaml/cic_disambiguation/disambiguate.mli
create mode 100644 helm/ocaml/cic_disambiguation/disambiguateChoices.ml
create mode 100644 helm/ocaml/cic_disambiguation/disambiguateChoices.mli
create mode 100644 helm/ocaml/cic_disambiguation/disambiguateTypes.ml
create mode 100644 helm/ocaml/cic_disambiguation/disambiguateTypes.mli
create mode 100644 helm/ocaml/cic_disambiguation/doc/precedence.txt
create mode 100644 helm/ocaml/cic_disambiguation/number_notation.ml
create mode 100644 helm/ocaml/cic_disambiguation/tests/aliases.txt
create mode 100644 helm/ocaml/cic_disambiguation/tests/eq.txt
create mode 100644 helm/ocaml/cic_disambiguation/tests/match.txt
create mode 100644 helm/ocaml/cic_proof_checking/.depend
create mode 100644 helm/ocaml/cic_proof_checking/Makefile
create mode 100644 helm/ocaml/cic_proof_checking/cicEnvironment.ml
create mode 100644 helm/ocaml/cic_proof_checking/cicEnvironment.mli
create mode 100644 helm/ocaml/cic_proof_checking/cicLogger.ml
create mode 100644 helm/ocaml/cic_proof_checking/cicLogger.mli
create mode 100644 helm/ocaml/cic_proof_checking/cicMiniReduction.ml
create mode 100644 helm/ocaml/cic_proof_checking/cicMiniReduction.mli
create mode 100644 helm/ocaml/cic_proof_checking/cicPp.ml
create mode 100644 helm/ocaml/cic_proof_checking/cicPp.mli
create mode 100644 helm/ocaml/cic_proof_checking/cicReduction.ml
create mode 100644 helm/ocaml/cic_proof_checking/cicReduction.mli
create mode 100644 helm/ocaml/cic_proof_checking/cicSubstitution.ml
create mode 100644 helm/ocaml/cic_proof_checking/cicSubstitution.mli
create mode 100644 helm/ocaml/cic_proof_checking/cicTypeChecker.ml
create mode 100644 helm/ocaml/cic_proof_checking/cicTypeChecker.mli
create mode 100644 helm/ocaml/cic_proof_checking/cicUnivUtils.ml
create mode 100644 helm/ocaml/cic_proof_checking/cicUnivUtils.mli
create mode 100644 helm/ocaml/cic_proof_checking/doc/inductive.txt
create mode 100755 helm/ocaml/cic_proof_checking/freshNamesGenerator.ml
create mode 100644 helm/ocaml/cic_proof_checking/freshNamesGenerator.mli
create mode 100644 helm/ocaml/cic_proof_checking/utilities/Makefile
create mode 100644 helm/ocaml/cic_proof_checking/utilities/create_environment.ml
create mode 100644 helm/ocaml/cic_proof_checking/utilities/list_uris.ml
create mode 100644 helm/ocaml/cic_proof_checking/utilities/parse_library.ml
create mode 100644 helm/ocaml/cic_unification/.depend
create mode 100644 helm/ocaml/cic_unification/Makefile
create mode 100644 helm/ocaml/cic_unification/cicMetaSubst.ml
create mode 100644 helm/ocaml/cic_unification/cicMetaSubst.mli
create mode 100644 helm/ocaml/cic_unification/cicMkImplicit.ml
create mode 100644 helm/ocaml/cic_unification/cicMkImplicit.mli
create mode 100644 helm/ocaml/cic_unification/cicRefine.ml
create mode 100644 helm/ocaml/cic_unification/cicRefine.mli
create mode 100644 helm/ocaml/cic_unification/cicUnification.ml
create mode 100644 helm/ocaml/cic_unification/cicUnification.mli
create mode 100644 helm/ocaml/clusters.dot
create mode 100644 helm/ocaml/configure.ac
create mode 100644 helm/ocaml/content_pres/.depend
create mode 100644 helm/ocaml/content_pres/Makefile
create mode 100644 helm/ocaml/content_pres/box.ml
create mode 100644 helm/ocaml/content_pres/box.mli
create mode 100644 helm/ocaml/content_pres/boxPp.ml
create mode 100644 helm/ocaml/content_pres/boxPp.mli
create mode 100644 helm/ocaml/content_pres/cicNotationLexer.ml
create mode 100644 helm/ocaml/content_pres/cicNotationLexer.mli
create mode 100644 helm/ocaml/content_pres/cicNotationParser.ml
create mode 100644 helm/ocaml/content_pres/cicNotationParser.mli
create mode 100644 helm/ocaml/content_pres/cicNotationPres.ml
create mode 100644 helm/ocaml/content_pres/cicNotationPres.mli
create mode 100644 helm/ocaml/content_pres/content2pres.ml
create mode 100644 helm/ocaml/content_pres/content2pres.mli
create mode 100644 helm/ocaml/content_pres/content2presMatcher.ml
create mode 100644 helm/ocaml/content_pres/content2presMatcher.mli
create mode 100644 helm/ocaml/content_pres/mpresentation.ml
create mode 100644 helm/ocaml/content_pres/mpresentation.mli
create mode 100644 helm/ocaml/content_pres/renderingAttrs.ml
create mode 100644 helm/ocaml/content_pres/renderingAttrs.mli
create mode 100644 helm/ocaml/content_pres/sequent2pres.ml
create mode 100644 helm/ocaml/content_pres/sequent2pres.mli
create mode 100644 helm/ocaml/content_pres/termContentPres.ml
create mode 100644 helm/ocaml/content_pres/termContentPres.mli
create mode 100644 helm/ocaml/content_pres/test_lexer.ml
create mode 100644 helm/ocaml/daemons.dot
create mode 100644 helm/ocaml/deps.patch
create mode 100644 helm/ocaml/extlib/.depend
create mode 100644 helm/ocaml/extlib/Makefile
create mode 100644 helm/ocaml/extlib/hExtlib.ml
create mode 100644 helm/ocaml/extlib/hExtlib.mli
create mode 100644 helm/ocaml/extlib/hLog.ml
create mode 100644 helm/ocaml/extlib/hLog.mli
create mode 100644 helm/ocaml/extlib/hMarshal.ml
create mode 100644 helm/ocaml/extlib/hMarshal.mli
create mode 100644 helm/ocaml/extlib/patternMatcher.ml
create mode 100644 helm/ocaml/extlib/patternMatcher.mli
create mode 100644 helm/ocaml/extlib/trie.ml
create mode 100644 helm/ocaml/extlib/trie.mli
create mode 100644 helm/ocaml/getter/.depend
create mode 100644 helm/ocaml/getter/.ocamlinit
create mode 100644 helm/ocaml/getter/Makefile
create mode 100644 helm/ocaml/getter/http_getter.ml
create mode 100644 helm/ocaml/getter/http_getter.mli
create mode 100644 helm/ocaml/getter/http_getter_common.ml
create mode 100644 helm/ocaml/getter/http_getter_common.mli
create mode 100644 helm/ocaml/getter/http_getter_const.ml
create mode 100644 helm/ocaml/getter/http_getter_const.mli
create mode 100644 helm/ocaml/getter/http_getter_env.ml
create mode 100644 helm/ocaml/getter/http_getter_env.mli
create mode 100644 helm/ocaml/getter/http_getter_logger.ml
create mode 100644 helm/ocaml/getter/http_getter_logger.mli
create mode 100644 helm/ocaml/getter/http_getter_misc.ml
create mode 100644 helm/ocaml/getter/http_getter_misc.mli
create mode 100644 helm/ocaml/getter/http_getter_storage.ml
create mode 100644 helm/ocaml/getter/http_getter_storage.mli
create mode 100644 helm/ocaml/getter/http_getter_types.ml
create mode 100644 helm/ocaml/getter/http_getter_wget.ml
create mode 100644 helm/ocaml/getter/http_getter_wget.mli
create mode 100755 helm/ocaml/getter/mkindexes.pl
create mode 100644 helm/ocaml/getter/sample.conf.xml
create mode 100644 helm/ocaml/getter/test.ml
create mode 100644 helm/ocaml/grafite/.depend
create mode 100644 helm/ocaml/grafite/Makefile
create mode 100644 helm/ocaml/grafite/grafiteAst.ml
create mode 100644 helm/ocaml/grafite/grafiteAstPp.ml
create mode 100644 helm/ocaml/grafite/grafiteAstPp.mli
create mode 100644 helm/ocaml/grafite/grafiteMarshal.ml
create mode 100644 helm/ocaml/grafite/grafiteMarshal.mli
create mode 100644 helm/ocaml/grafite_engine/.depend
create mode 100644 helm/ocaml/grafite_engine/Makefile
create mode 100644 helm/ocaml/grafite_engine/grafiteEngine.ml
create mode 100644 helm/ocaml/grafite_engine/grafiteEngine.mli
create mode 100644 helm/ocaml/grafite_engine/grafiteMisc.ml
create mode 100644 helm/ocaml/grafite_engine/grafiteMisc.mli
create mode 100644 helm/ocaml/grafite_engine/grafiteSync.ml
create mode 100644 helm/ocaml/grafite_engine/grafiteSync.mli
create mode 100644 helm/ocaml/grafite_engine/grafiteTypes.ml
create mode 100644 helm/ocaml/grafite_engine/grafiteTypes.mli
create mode 100644 helm/ocaml/grafite_parser/.depend
create mode 100644 helm/ocaml/grafite_parser/Makefile
create mode 100644 helm/ocaml/grafite_parser/cicNotation2.ml
create mode 100644 helm/ocaml/grafite_parser/cicNotation2.mli
create mode 100644 helm/ocaml/grafite_parser/dependenciesParser.ml
create mode 100644 helm/ocaml/grafite_parser/dependenciesParser.mli
create mode 100644 helm/ocaml/grafite_parser/grafiteDisambiguate.ml
create mode 100644 helm/ocaml/grafite_parser/grafiteDisambiguate.mli
create mode 100644 helm/ocaml/grafite_parser/grafiteDisambiguator.ml
create mode 100644 helm/ocaml/grafite_parser/grafiteDisambiguator.mli
create mode 100644 helm/ocaml/grafite_parser/grafiteParser.ml
create mode 100644 helm/ocaml/grafite_parser/grafiteParser.mli
create mode 100644 helm/ocaml/grafite_parser/print_grammar.ml
create mode 100644 helm/ocaml/grafite_parser/test_dep.ml
create mode 100644 helm/ocaml/grafite_parser/test_parser.ml
create mode 100644 helm/ocaml/hbugs/.depend
create mode 100644 helm/ocaml/hbugs/Makefile
create mode 100644 helm/ocaml/hbugs/broker.ml
create mode 100644 helm/ocaml/hbugs/client.ml
create mode 100644 helm/ocaml/hbugs/data/hbugs_tutor.TPL.ml
create mode 100644 helm/ocaml/hbugs/data/tutors_index.xml
create mode 100644 helm/ocaml/hbugs/doc/hbugs.dia
create mode 100644 helm/ocaml/hbugs/hbugs_broker_registry.ml
create mode 100644 helm/ocaml/hbugs/hbugs_broker_registry.mli
create mode 100644 helm/ocaml/hbugs/hbugs_client.ml
create mode 100644 helm/ocaml/hbugs/hbugs_client.mli
create mode 100644 helm/ocaml/hbugs/hbugs_client_gui.glade
create mode 100644 helm/ocaml/hbugs/hbugs_common.ml
create mode 100644 helm/ocaml/hbugs/hbugs_common.mli
create mode 100644 helm/ocaml/hbugs/hbugs_id_generator.ml
create mode 100644 helm/ocaml/hbugs/hbugs_id_generator.mli
create mode 100644 helm/ocaml/hbugs/hbugs_messages.ml
create mode 100644 helm/ocaml/hbugs/hbugs_messages.mli
create mode 100644 helm/ocaml/hbugs/hbugs_misc.ml
create mode 100644 helm/ocaml/hbugs/hbugs_misc.mli
create mode 100644 helm/ocaml/hbugs/hbugs_tutors.ml
create mode 100644 helm/ocaml/hbugs/hbugs_tutors.mli
create mode 100644 helm/ocaml/hbugs/hbugs_types.mli
create mode 100755 helm/ocaml/hbugs/scripts/brokerctl.sh
create mode 100755 helm/ocaml/hbugs/scripts/build_tutors.ml
create mode 100755 helm/ocaml/hbugs/scripts/ls_tutors.ml
create mode 100755 helm/ocaml/hbugs/scripts/sabba.sh
create mode 100644 helm/ocaml/hbugs/search_pattern_apply_tutor.ml
create mode 100644 helm/ocaml/hbugs/test/HBUGS_MESSAGES.xml
create mode 100644 helm/ocaml/hbugs/test/Makefile
create mode 100644 helm/ocaml/hbugs/test/test_serialization.ml
create mode 100644 helm/ocaml/hgdome/.depend
create mode 100644 helm/ocaml/hgdome/Makefile
create mode 100644 helm/ocaml/hgdome/domMisc.ml
create mode 100644 helm/ocaml/hgdome/domMisc.mli
create mode 100644 helm/ocaml/hgdome/xml2Gdome.ml
create mode 100644 helm/ocaml/hgdome/xml2Gdome.mli
create mode 100644 helm/ocaml/hmysql/.depend
create mode 100644 helm/ocaml/hmysql/Makefile
create mode 100644 helm/ocaml/hmysql/hMysql.ml
create mode 100644 helm/ocaml/hmysql/hMysql.mli
create mode 100644 helm/ocaml/lexicon/.depend
create mode 100644 helm/ocaml/lexicon/Makefile
create mode 100644 helm/ocaml/lexicon/cicNotation.ml
create mode 100644 helm/ocaml/lexicon/cicNotation.mli
create mode 100644 helm/ocaml/lexicon/disambiguatePp.ml
create mode 100644 helm/ocaml/lexicon/disambiguatePp.mli
create mode 100644 helm/ocaml/lexicon/lexiconAst.ml
create mode 100644 helm/ocaml/lexicon/lexiconAstPp.ml
create mode 100644 helm/ocaml/lexicon/lexiconAstPp.mli
create mode 100644 helm/ocaml/lexicon/lexiconEngine.ml
create mode 100644 helm/ocaml/lexicon/lexiconEngine.mli
create mode 100644 helm/ocaml/lexicon/lexiconMarshal.ml
create mode 100644 helm/ocaml/lexicon/lexiconMarshal.mli
create mode 100644 helm/ocaml/lexicon/lexiconSync.ml
create mode 100644 helm/ocaml/lexicon/lexiconSync.mli
create mode 100644 helm/ocaml/library/.depend
create mode 100644 helm/ocaml/library/Makefile
create mode 100644 helm/ocaml/library/cicCoercion.ml
create mode 100644 helm/ocaml/library/cicCoercion.mli
create mode 100644 helm/ocaml/library/cicElim.ml
create mode 100644 helm/ocaml/library/cicElim.mli
create mode 100644 helm/ocaml/library/cicRecord.ml
create mode 100644 helm/ocaml/library/cicRecord.mli
create mode 100644 helm/ocaml/library/coercDb.ml
create mode 100644 helm/ocaml/library/coercDb.mli
create mode 100644 helm/ocaml/library/coercGraph.ml
create mode 100644 helm/ocaml/library/coercGraph.mli
create mode 100644 helm/ocaml/library/libraryClean.ml
create mode 100644 helm/ocaml/library/libraryClean.mli
create mode 100644 helm/ocaml/library/libraryDb.ml
create mode 100644 helm/ocaml/library/libraryDb.mli
create mode 100644 helm/ocaml/library/libraryMisc.ml
create mode 100644 helm/ocaml/library/libraryMisc.mli
create mode 100644 helm/ocaml/library/libraryNoDb.ml
create mode 100644 helm/ocaml/library/libraryNoDb.mli
create mode 100644 helm/ocaml/library/librarySync.ml
create mode 100644 helm/ocaml/library/librarySync.mli
create mode 100644 helm/ocaml/license
create mode 100644 helm/ocaml/logger/.depend
create mode 100644 helm/ocaml/logger/Makefile
create mode 100644 helm/ocaml/logger/helmLogger.ml
create mode 100644 helm/ocaml/logger/helmLogger.mli
create mode 100644 helm/ocaml/mathql/.depend
create mode 100644 helm/ocaml/mathql/Makefile
create mode 100644 helm/ocaml/mathql/mathQL.ml
create mode 100644 helm/ocaml/mathql_generator/.depend
create mode 100644 helm/ocaml/mathql_generator/Makefile
create mode 100644 helm/ocaml/mathql_generator/cGLocateInductive.ml
create mode 100644 helm/ocaml/mathql_generator/cGLocateInductive.mli
create mode 100644 helm/ocaml/mathql_generator/cGMatchConclusion.ml
create mode 100644 helm/ocaml/mathql_generator/cGMatchConclusion.mli
create mode 100644 helm/ocaml/mathql_generator/cGSearchPattern.ml
create mode 100644 helm/ocaml/mathql_generator/cGSearchPattern.mli
create mode 100644 helm/ocaml/mathql_generator/mQGTypes.ml
create mode 100644 helm/ocaml/mathql_generator/mQGUtil.ml
create mode 100644 helm/ocaml/mathql_generator/mQGUtil.mli
create mode 100644 helm/ocaml/mathql_generator/mQueryGenerator.ml
create mode 100644 helm/ocaml/mathql_generator/mQueryGenerator.mli
create mode 100644 helm/ocaml/mathql_interpreter/.depend
create mode 100644 helm/ocaml/mathql_interpreter/Makefile
create mode 100644 helm/ocaml/mathql_interpreter/mQIConn.ml
create mode 100644 helm/ocaml/mathql_interpreter/mQIConn.mli
create mode 100644 helm/ocaml/mathql_interpreter/mQIMap.ml
create mode 100644 helm/ocaml/mathql_interpreter/mQIMap.mli
create mode 100644 helm/ocaml/mathql_interpreter/mQIMySql.ml
create mode 100644 helm/ocaml/mathql_interpreter/mQIMySql.mli
create mode 100644 helm/ocaml/mathql_interpreter/mQIPostgres.ml
create mode 100644 helm/ocaml/mathql_interpreter/mQIPostgres.mli
create mode 100644 helm/ocaml/mathql_interpreter/mQIProperty.ml
create mode 100644 helm/ocaml/mathql_interpreter/mQIProperty.mli
create mode 100644 helm/ocaml/mathql_interpreter/mQITypes.ml
create mode 100644 helm/ocaml/mathql_interpreter/mQIUtil.ml
create mode 100644 helm/ocaml/mathql_interpreter/mQIUtil.mli
create mode 100644 helm/ocaml/mathql_interpreter/mQueryInterpreter.ml
create mode 100644 helm/ocaml/mathql_interpreter/mQueryInterpreter.mli
create mode 100644 helm/ocaml/mathql_interpreter/mQueryTLexer.mll
create mode 100644 helm/ocaml/mathql_interpreter/mQueryTParser.mly
create mode 100644 helm/ocaml/mathql_interpreter/mQueryUtil.ml
create mode 100644 helm/ocaml/mathql_interpreter/mQueryUtil.mli
create mode 100644 helm/ocaml/metadata/.depend
create mode 100644 helm/ocaml/metadata/Makefile
create mode 100755 helm/ocaml/metadata/dump_db/dump.sh
create mode 100644 helm/ocaml/metadata/extractor/.depend
create mode 100644 helm/ocaml/metadata/extractor/Makefile
create mode 100644 helm/ocaml/metadata/extractor/extractor.conf.xml
create mode 100644 helm/ocaml/metadata/extractor/extractor.ml
create mode 100644 helm/ocaml/metadata/extractor/extractor_manager.ml
create mode 100644 helm/ocaml/metadata/metadataConstraints.ml
create mode 100644 helm/ocaml/metadata/metadataConstraints.mli
create mode 100644 helm/ocaml/metadata/metadataDb.ml
create mode 100644 helm/ocaml/metadata/metadataDb.mli
create mode 100644 helm/ocaml/metadata/metadataExtractor.ml
create mode 100644 helm/ocaml/metadata/metadataExtractor.mli
create mode 100644 helm/ocaml/metadata/metadataPp.ml
create mode 100644 helm/ocaml/metadata/metadataPp.mli
create mode 100644 helm/ocaml/metadata/metadataTypes.ml
create mode 100644 helm/ocaml/metadata/metadataTypes.mli
create mode 100644 helm/ocaml/metadata/sqlStatements.ml
create mode 100644 helm/ocaml/metadata/sqlStatements.mli
create mode 100644 helm/ocaml/metadata/table_creator/.depend
create mode 100644 helm/ocaml/metadata/table_creator/Makefile
create mode 100755 helm/ocaml/metadata/table_creator/sync_db.sh
create mode 100644 helm/ocaml/metadata/table_creator/table_creator.ml
create mode 100644 helm/ocaml/paramodulation/.depend
create mode 100644 helm/ocaml/paramodulation/Makefile
create mode 100644 helm/ocaml/paramodulation/README
create mode 100644 helm/ocaml/paramodulation/equality_indexing.ml
create mode 100644 helm/ocaml/paramodulation/equality_indexing.mli
create mode 100644 helm/ocaml/paramodulation/indexing.ml
create mode 100644 helm/ocaml/paramodulation/inference.ml
create mode 100644 helm/ocaml/paramodulation/inference.mli
create mode 100644 helm/ocaml/paramodulation/saturate_main.ml
create mode 100644 helm/ocaml/paramodulation/saturation.ml
create mode 100644 helm/ocaml/paramodulation/test_indexing.ml
create mode 100644 helm/ocaml/paramodulation/utils.ml
create mode 100644 helm/ocaml/paramodulation/utils.mli
create mode 100755 helm/ocaml/patch_deps.sh
create mode 100644 helm/ocaml/registry/.depend
create mode 100644 helm/ocaml/registry/.ocamlinit
create mode 100644 helm/ocaml/registry/Makefile
create mode 100644 helm/ocaml/registry/helm_registry.ml
create mode 100644 helm/ocaml/registry/helm_registry.mli
create mode 100644 helm/ocaml/registry/test.ml
create mode 100644 helm/ocaml/registry/tests/sample.xml
create mode 100644 helm/ocaml/registry/tests/sample_include.xml
create mode 100644 helm/ocaml/tactics/.depend
create mode 100644 helm/ocaml/tactics/Makefile
create mode 100644 helm/ocaml/tactics/autoTactic.ml
create mode 100644 helm/ocaml/tactics/autoTactic.mli
create mode 100644 helm/ocaml/tactics/continuationals.ml
create mode 100644 helm/ocaml/tactics/continuationals.mli
create mode 100644 helm/ocaml/tactics/discriminationTactics.ml
create mode 100644 helm/ocaml/tactics/discriminationTactics.mli
create mode 100644 helm/ocaml/tactics/doc/Makefile
create mode 100644 helm/ocaml/tactics/doc/body.tex
create mode 100644 helm/ocaml/tactics/doc/infernce.sty
create mode 100644 helm/ocaml/tactics/doc/ligature.sty
create mode 100644 helm/ocaml/tactics/doc/main.tex
create mode 100644 helm/ocaml/tactics/doc/reserved.sty
create mode 100644 helm/ocaml/tactics/doc/semantic.sty
create mode 100644 helm/ocaml/tactics/doc/shrthand.sty
create mode 100644 helm/ocaml/tactics/doc/tdiagram.sty
create mode 100644 helm/ocaml/tactics/eliminationTactics.ml
create mode 100644 helm/ocaml/tactics/eliminationTactics.mli
create mode 100644 helm/ocaml/tactics/equalityTactics.ml
create mode 100644 helm/ocaml/tactics/equalityTactics.mli
create mode 100644 helm/ocaml/tactics/fourier.ml
create mode 100644 helm/ocaml/tactics/fourier.mli
create mode 100644 helm/ocaml/tactics/fourierR.ml
create mode 100644 helm/ocaml/tactics/fourierR.mli
create mode 100644 helm/ocaml/tactics/fwdSimplTactic.ml
create mode 100644 helm/ocaml/tactics/fwdSimplTactic.mli
create mode 100644 helm/ocaml/tactics/hashtbl_equiv.ml
create mode 100644 helm/ocaml/tactics/hashtbl_equiv.mli
create mode 100644 helm/ocaml/tactics/history.ml
create mode 100644 helm/ocaml/tactics/history.mli
create mode 100644 helm/ocaml/tactics/introductionTactics.ml
create mode 100644 helm/ocaml/tactics/introductionTactics.mli
create mode 100644 helm/ocaml/tactics/inversion.ml
create mode 100644 helm/ocaml/tactics/inversion.mli
create mode 100644 helm/ocaml/tactics/metadataQuery.ml
create mode 100644 helm/ocaml/tactics/metadataQuery.mli
create mode 100644 helm/ocaml/tactics/negationTactics.ml
create mode 100644 helm/ocaml/tactics/negationTactics.mli
create mode 100644 helm/ocaml/tactics/primitiveTactics.ml
create mode 100644 helm/ocaml/tactics/primitiveTactics.mli
create mode 100644 helm/ocaml/tactics/proofEngineHelpers.ml
create mode 100644 helm/ocaml/tactics/proofEngineHelpers.mli
create mode 100644 helm/ocaml/tactics/proofEngineReduction.ml
create mode 100644 helm/ocaml/tactics/proofEngineReduction.mli
create mode 100644 helm/ocaml/tactics/proofEngineStructuralRules.ml
create mode 100644 helm/ocaml/tactics/proofEngineStructuralRules.mli
create mode 100644 helm/ocaml/tactics/proofEngineTypes.ml
create mode 100644 helm/ocaml/tactics/proofEngineTypes.mli
create mode 100644 helm/ocaml/tactics/reductionTactics.ml
create mode 100644 helm/ocaml/tactics/reductionTactics.mli
create mode 100644 helm/ocaml/tactics/ring.ml
create mode 100644 helm/ocaml/tactics/ring.mli
create mode 100644 helm/ocaml/tactics/statefulProofEngine.ml
create mode 100644 helm/ocaml/tactics/statefulProofEngine.mli
create mode 100644 helm/ocaml/tactics/tacticChaser.ml
create mode 100644 helm/ocaml/tactics/tacticals.ml
create mode 100644 helm/ocaml/tactics/tacticals.mli
create mode 100644 helm/ocaml/tactics/tactics.ml
create mode 100644 helm/ocaml/tactics/tactics.mli
create mode 100644 helm/ocaml/tactics/variousTactics.ml
create mode 100644 helm/ocaml/tactics/variousTactics.mli
create mode 100644 helm/ocaml/thread/.depend
create mode 100644 helm/ocaml/thread/Makefile
create mode 100644 helm/ocaml/thread/extThread.ml
create mode 100644 helm/ocaml/thread/extThread.mli
create mode 100644 helm/ocaml/thread/fake/threadSafe.ml
create mode 100644 helm/ocaml/thread/fake/threadSafe.mli
create mode 100644 helm/ocaml/thread/threadSafe.ml
create mode 100644 helm/ocaml/thread/threadSafe.mli
create mode 100644 helm/ocaml/urimanager/.depend
create mode 100644 helm/ocaml/urimanager/Makefile
create mode 100644 helm/ocaml/urimanager/uriManager.ml
create mode 100644 helm/ocaml/urimanager/uriManager.mli
create mode 100644 helm/ocaml/utf8_macros/.depend
create mode 100644 helm/ocaml/utf8_macros/Makefile
create mode 100644 helm/ocaml/utf8_macros/README.syntax
create mode 100644 helm/ocaml/utf8_macros/data/dictionary-tex.xml
create mode 100644 helm/ocaml/utf8_macros/data/entities-table.xml
create mode 100644 helm/ocaml/utf8_macros/data/extra-entities.xml
create mode 100644 helm/ocaml/utf8_macros/make_table.ml
create mode 100644 helm/ocaml/utf8_macros/pa_unicode_macro.ml
create mode 100644 helm/ocaml/utf8_macros/test.ml
create mode 100644 helm/ocaml/utf8_macros/utf8Macro.ml
create mode 100644 helm/ocaml/utf8_macros/utf8Macro.mli
create mode 100644 helm/ocaml/utf8_macros/utf8MacroTable.ml
create mode 100644 helm/ocaml/whelp/.depend
create mode 100644 helm/ocaml/whelp/Makefile
create mode 100644 helm/ocaml/whelp/fwdQueries.ml
create mode 100644 helm/ocaml/whelp/fwdQueries.mli
create mode 100644 helm/ocaml/whelp/whelp.ml
create mode 100644 helm/ocaml/whelp/whelp.mli
create mode 100644 helm/ocaml/xml/.depend
create mode 100644 helm/ocaml/xml/Makefile
create mode 100644 helm/ocaml/xml/test.ml
create mode 100644 helm/ocaml/xml/xml.ml
create mode 100644 helm/ocaml/xml/xml.mli
create mode 100644 helm/ocaml/xml/xmlPushParser.ml
create mode 100644 helm/ocaml/xml/xmlPushParser.mli
create mode 100644 helm/ocaml/xmldiff/.depend
create mode 100644 helm/ocaml/xmldiff/Makefile
create mode 100644 helm/ocaml/xmldiff/xmlDiff.ml
create mode 100644 helm/ocaml/xmldiff/xmlDiff.mli
diff --git a/helm/matita/.depend b/helm/matita/.depend
new file mode 100644
index 000000000..06c32e01d
--- /dev/null
+++ b/helm/matita/.depend
@@ -0,0 +1,59 @@
+applyTransformation.cmo: applyTransformation.cmi
+applyTransformation.cmx: applyTransformation.cmi
+buildTimeConf.cmo: buildTimeConf.cmi
+buildTimeConf.cmx: buildTimeConf.cmi
+dump_moo.cmo: buildTimeConf.cmi
+dump_moo.cmx: buildTimeConf.cmx
+matitaclean.cmo: matitaInit.cmi matitaclean.cmi
+matitaclean.cmx: matitaInit.cmx matitaclean.cmi
+matitacLib.cmo: matitaInit.cmi matitaExcPp.cmi matitaEngine.cmi \
+ buildTimeConf.cmi matitacLib.cmi
+matitacLib.cmx: matitaInit.cmx matitaExcPp.cmx matitaEngine.cmx \
+ buildTimeConf.cmx matitacLib.cmi
+matitac.cmo: matitamake.cmo matitadep.cmi matitaclean.cmi matitacLib.cmi
+matitac.cmx: matitamake.cmx matitadep.cmx matitaclean.cmx matitacLib.cmx
+matitadep.cmo: matitaInit.cmi matitadep.cmi
+matitadep.cmx: matitaInit.cmx matitadep.cmi
+matitaEngine.cmo: matitaEngine.cmi
+matitaEngine.cmx: matitaEngine.cmi
+matitaExcPp.cmo: matitaExcPp.cmi
+matitaExcPp.cmx: matitaExcPp.cmi
+matitaGeneratedGui.cmo: matitaGeneratedGui.cmi
+matitaGeneratedGui.cmx: matitaGeneratedGui.cmi
+matitaGtkMisc.cmo: matitaTypes.cmi matitaGeneratedGui.cmi matitaGtkMisc.cmi
+matitaGtkMisc.cmx: matitaTypes.cmx matitaGeneratedGui.cmx matitaGtkMisc.cmi
+matitaGui.cmo: matitamakeLib.cmi matitaTypes.cmi matitaScript.cmi \
+ matitaMisc.cmi matitaMathView.cmi matitaGtkMisc.cmi \
+ matitaGeneratedGui.cmi matitaExcPp.cmi buildTimeConf.cmi matitaGui.cmi
+matitaGui.cmx: matitamakeLib.cmx matitaTypes.cmx matitaScript.cmx \
+ matitaMisc.cmx matitaMathView.cmx matitaGtkMisc.cmx \
+ matitaGeneratedGui.cmx matitaExcPp.cmx buildTimeConf.cmx matitaGui.cmi
+matitaInit.cmo: matitamakeLib.cmi buildTimeConf.cmi matitaInit.cmi
+matitaInit.cmx: matitamakeLib.cmx buildTimeConf.cmx matitaInit.cmi
+matitamakeLib.cmo: buildTimeConf.cmi matitamakeLib.cmi
+matitamakeLib.cmx: buildTimeConf.cmx matitamakeLib.cmi
+matitamake.cmo: matitamakeLib.cmi matitaInit.cmi
+matitamake.cmx: matitamakeLib.cmx matitaInit.cmx
+matitaMathView.cmo: matitaTypes.cmi matitaScript.cmi matitaMisc.cmi \
+ matitaGuiTypes.cmi matitaGtkMisc.cmi matitaExcPp.cmi buildTimeConf.cmi \
+ applyTransformation.cmi matitaMathView.cmi
+matitaMathView.cmx: matitaTypes.cmx matitaScript.cmx matitaMisc.cmx \
+ matitaGuiTypes.cmi matitaGtkMisc.cmx matitaExcPp.cmx buildTimeConf.cmx \
+ applyTransformation.cmx matitaMathView.cmi
+matitaMisc.cmo: buildTimeConf.cmi matitaMisc.cmi
+matitaMisc.cmx: buildTimeConf.cmx matitaMisc.cmi
+matita.cmo: matitaTypes.cmi matitaScript.cmi matitaMathView.cmi \
+ matitaInit.cmi matitaGui.cmi matitaGtkMisc.cmi buildTimeConf.cmi
+matita.cmx: matitaTypes.cmx matitaScript.cmx matitaMathView.cmx \
+ matitaInit.cmx matitaGui.cmx matitaGtkMisc.cmx buildTimeConf.cmx
+matitaScript.cmo: matitamakeLib.cmi matitaTypes.cmi matitaMisc.cmi \
+ matitaEngine.cmi buildTimeConf.cmi matitaScript.cmi
+matitaScript.cmx: matitamakeLib.cmx matitaTypes.cmx matitaMisc.cmx \
+ matitaEngine.cmx buildTimeConf.cmx matitaScript.cmi
+matitaTypes.cmo: matitaTypes.cmi
+matitaTypes.cmx: matitaTypes.cmi
+matitaGtkMisc.cmi: matitaGeneratedGui.cmi
+matitaGui.cmi: matitaGuiTypes.cmi
+matitaGuiTypes.cmi: matitaTypes.cmi matitaGeneratedGui.cmi
+matitaMathView.cmi: matitaTypes.cmi matitaGuiTypes.cmi
+matitaScript.cmi: matitaTypes.cmi
diff --git a/helm/matita/.ocamlinit b/helm/matita/.ocamlinit
new file mode 100644
index 000000000..1585f71b2
--- /dev/null
+++ b/helm/matita/.ocamlinit
@@ -0,0 +1,44 @@
+(* directories *)
+#directory "../ocaml/cic"
+#directory "../ocaml/cic_notation"
+#directory "../ocaml/cic_omdoc"
+#directory "../ocaml/cic_proof_checking"
+#directory "../ocaml/cic_textual_parser2"
+#directory "../ocaml/cic_transformations"
+#directory "../ocaml/cic_unification"
+#directory "../ocaml/getter"
+#directory "../ocaml/hbugs"
+#directory "../ocaml/mathql"
+#directory "../ocaml/mathql_generator"
+#directory "../ocaml/mathql_interpreter"
+#directory "../ocaml/metadata"
+#directory "../ocaml/paramodulation"
+#directory "../ocaml/registry"
+#directory "../ocaml/tactics"
+#directory "../ocaml/thread"
+#directory "../ocaml/urimanager"
+#directory "../ocaml/xml"
+#directory "../ocaml/xmldiff"
+
+(* custom printers *)
+let fppuri ppf uri =
+ let s = UriManager.string_of_uri uri in
+ Format.pp_print_string ppf s
+;;
+
+#install_printer CicMetaSubst.fppsubst;;
+#install_printer CicMetaSubst.fppterm;;
+#install_printer CicMetaSubst.fppmetasenv;;
+#install_printer fppuri;;
+
+(* utility functions *)
+let go = MatitacLib.interactive_loop;;
+
+(* let's go! *)
+let _ =
+ at_exit (fun () -> MatitacLib.clean_exit None);
+ if Array.length Sys.argv > 1 then
+ MatitacLib.main `TOPLEVEL
+ else
+ MatitacLib.go ()
+;;
diff --git a/helm/matita/AUTHORS b/helm/matita/AUTHORS
new file mode 100644
index 000000000..a2da427a5
--- /dev/null
+++ b/helm/matita/AUTHORS
@@ -0,0 +1,5 @@
+Andrea Asperti <asperti@cs.unibo.it>
+Luca Padovani <lpadovan@cs.unibo.it>
+Enrico Tassi <tassi@cs.unibo.it>
+Claudio Sacerdoti Coen <sacerdot@cs.unibo.it>
+Stefano Zacchiroli <zacchiro@cs.unibo.it>
diff --git a/helm/matita/LICENSE b/helm/matita/LICENSE
new file mode 100644
index 000000000..7665cd2ce
--- /dev/null
+++ b/helm/matita/LICENSE
@@ -0,0 +1,23 @@
+Copyright (C) 2000-2005, HELM Team.
+
+Matita is part of HELM, an Hypertextual, Electronic
+Library of Mathematics, developed at the Computer Science
+Department, University of Bologna, Italy.
+
+HELM 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 2
+of the License, or (at your option) any later version.
+
+HELM 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 HELM; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+MA 02111-1307, USA.
+
+For details, see the HELM World-Wide-Web page,
+http://helm.cs.unibo.it/
diff --git a/helm/matita/Makefile.in b/helm/matita/Makefile.in
new file mode 100644
index 000000000..0614bda3d
--- /dev/null
+++ b/helm/matita/Makefile.in
@@ -0,0 +1,350 @@
+export SHELL=/bin/bash
+
+NULL =
+
+MAKEFLAGS+=--no-print-directory
+OCAMLPATH = ../ocaml/METAS/
+OCAMLFIND = OCAMLPATH=$(OCAMLPATH):$$OCAMLPATH @OCAMLFIND@
+CAMLP4O = @CAMLP4O@
+LABLGLADECC = @LABLGLADECC@
+REQUIRES = @FINDLIB_REQUIRES@
+CREQUIRES = @FINDLIB_CREQUIRES@
+DEPREQUIRES = @FINDLIB_DEPREQUIRES@
+CLEANREQUIRES = @FINDLIB_CLEANREQUIRES@
+MAKEREQUIRES = @FINDLIB_MAKEREQUIRES@
+HAVE_OCAMLOPT = @HAVE_OCAMLOPT@
+
+OCAML_FLAGS = -pp $(CAMLP4O)
+PKGS = -package "$(REQUIRES)"
+CPKGS = -package "$(CREQUIRES)"
+DEPPKGS = -package "$(DEPREQUIRES)"
+CLEANPKGS = -package "$(CLEANREQUIRES)"
+MAKEPKGS = -package "$(MAKEREQUIRES)"
+OCAML_THREADS_FLAGS = -thread
+OCAML_DEBUG_FLAGS = -g
+OCAMLC_FLAGS = $(OCAML_FLAGS) $(OCAML_THREADS_FLAGS)
+OCAMLC = $(OCAMLFIND) ocamlc $(OCAMLC_FLAGS) $(OCAML_DEBUG_FLAGS)
+OCAMLOPT = $(OCAMLFIND) opt $(OCAMLC_FLAGS)
+OCAMLDEP = $(OCAMLFIND) ocamldep $(OCAML_FLAGS)
+
+MATITA_FLAGS = -noprofile
+NODB=false
+ifeq ($(NODB),true)
+ MATITA_FLAGS += -nodb
+endif
+
+# objects for matita (GTK GUI)
+CMOS = \
+ buildTimeConf.cmo \
+ matitaTypes.cmo \
+ matitaMisc.cmo \
+ matitamakeLib.cmo \
+ matitaInit.cmo \
+ matitaExcPp.cmo \
+ matitaEngine.cmo \
+ matitacLib.cmo \
+ matitaScript.cmo \
+ matitaGeneratedGui.cmo \
+ matitaGtkMisc.cmo \
+ applyTransformation.cmo \
+ matitaMathView.cmo \
+ matitaGui.cmo \
+ $(NULL)
+# objects for matitac (batch compiler)
+CCMOS = \
+ buildTimeConf.cmo \
+ matitaTypes.cmo \
+ matitaMisc.cmo \
+ matitamakeLib.cmo \
+ matitaInit.cmo \
+ matitaExcPp.cmo \
+ matitaEngine.cmo \
+ matitacLib.cmo \
+ $(NULL)
+MAINCMOS = \
+ matitadep.cmo \
+ matitaclean.cmo \
+ matitamake.cmo \
+ $(NULL)
+DEPCMOS = $(CCMOS)
+CLEANCMOS = $(CCMOS)
+MAKECMOS = \
+ buildTimeConf.cmo \
+ matitamakeLib.cmo \
+ $(NULL)
+PROGRAMS_BYTE = matita matitac cicbrowser matitadep matitaclean matitamake dump_moo
+PROGRAMS = $(PROGRAMS_BYTE) matitatop
+PROGRAMS_OPT = $(patsubst %,%.opt,$(PROGRAMS_BYTE))
+
+.PHONY: all
+all: matita.conf.xml $(PROGRAMS) coq.moo
+
+matita.conf.xml: matita.conf.xml.sample
+ @if diff matita.conf.xml.sample matita.conf.xml 1>/dev/null 2>/dev/null; then\
+ touch matita.conf.xml;\
+ else\
+ echo;\
+ echo "matita.conf.xml.sample is newer than matita.conf.xml";\
+ echo;\
+ echo "PLEASE update your configuration file!";\
+ echo "(copying matita.conf.xml.sample should work)";\
+ echo;\
+ false;\
+ fi
+
+matita.conf.xml.sample: matita.conf.xml.sample.in
+ autoconf
+ ./configure
+ @echo
+ @echo "WARNING: The configuration sample file has changed!"
+ @echo
+
+coq.moo: library/legacy/coq.ma matitac
+ ./matitac $(MATITA_FLAGS) $<
+coq.moo.opt: library/legacy/coq.ma matitac.opt
+ ./matitac.opt $(MATITA_FLAGS) $<
+
+ifeq ($(HAVE_OCAMLOPT),yes)
+
+CMXS = $(patsubst %.cmo,%.cmx,$(CMOS))
+CCMXS = $(patsubst %.cmo,%.cmx,$(CCMOS))
+MAINCMXS = $(patsubst %.cmo,%.cmx,$(MAINCMOS))
+DEPCMXS = $(patsubst %.cmo,%.cmx,$(DEPCMOS))
+CLEANCMXS = $(patsubst %.cmo,%.cmx,$(CLEANCMOS))
+MAKECMXS = $(patsubst %.cmo,%.cmx,$(MAKECMOS))
+LIB_DEPS := $(shell $(OCAMLFIND) query -recursive -predicates "byte" -format "%d/%a" $(REQUIRES))
+LIBX_DEPS := $(shell $(OCAMLFIND) query -recursive -predicates "native" -format "%d/%a" $(REQUIRES))
+CLIB_DEPS := $(shell $(OCAMLFIND) query -recursive -predicates "byte" -format "%d/%a" $(CREQUIRES))
+CLIBX_DEPS := $(shell $(OCAMLFIND) query -recursive -predicates "native" -format "%d/%a" $(CREQUIRES))
+DEPLIB_DEPS := $(shell $(OCAMLFIND) query -recursive -predicates "byte" -format "%d/%a" $(DEPREQUIRES))
+DEPLIBX_DEPS := $(shell $(OCAMLFIND) query -recursive -predicates "native" -format "%d/%a" $(DEPREQUIRES))
+CLEANLIB_DEPS := $(shell $(OCAMLFIND) query -recursive -predicates "byte" -format "%d/%a" $(CLEANREQUIRES))
+CLEANLIBX_DEPS := $(shell $(OCAMLFIND) query -recursive -predicates "native" -format "%d/%a" $(CLEANREQUIRES))
+MAKELIB_DEPS := $(shell $(OCAMLFIND) query -recursive -predicates "byte" -format "%d/%a" $(MAKEREQUIRES))
+MAKELIBX_DEPS := $(shell $(OCAMLFIND) query -recursive -predicates "native" -format "%d/%a" $(MAKEREQUIRES))
+.PHONY: opt
+opt: $(PROGRAMS_OPT) coq.moo.opt
+.PHONY: upx
+upx: $(PROGRAMS_UPX) coq.moo.opt
+
+else
+
+opt:
+ @echo "Native code compilation is disabled"
+
+endif
+
+matita: $(LIB_DEPS) $(CMOS) matita.ml
+ $(OCAMLC) $(PKGS) -linkpkg -o $@ $(CMOS) matita.ml
+matita.opt: $(LIBX_DEPS) $(CMXS) matita.ml
+ $(OCAMLOPT) $(PKGS) -linkpkg -o $@ $(CMXS) matita.ml
+
+dump_moo: buildTimeConf.cmo dump_moo.ml
+ $(OCAMLC) $(PKGS) -linkpkg -o $@ $^
+dump_moo.opt: buildTimeConf.cmx dump_moo.ml
+ $(OCAMLOPT) $(PKGS) -linkpkg -o $@ $^
+
+matitac: $(CLIB_DEPS) $(CCMOS) $(MAINCMOS) matitac.ml
+ $(OCAMLC) $(CPKGS) -linkpkg -o $@ $(CCMOS) $(MAINCMOS) matitac.ml
+matitac.opt: $(CLIBX_DEPS) $(CCMXS) $(MAINCMXS) matitac.ml
+ $(OCAMLOPT) $(CPKGS) -linkpkg -o $@ $(CCMXS) $(MAINCMXS) matitac.ml
+
+matitatop: matitatop.ml $(CLIB_DEPS) $(CCMOS)
+ $(OCAMLC) $(CPKGS) -linkpkg -o $@ toplevellib.cma $(CCMOS) $<
+
+# matitadep: matitadep.ml $(DEPLIB_DEPS) $(DEPCMOS)
+# $(OCAMLC) $(DEPPKGS) -linkpkg -o $@ $(DEPCMOS) $<
+# matitadep.opt: matitadep.ml $(DEPLIB_DEPS) $(DEPCMXS)
+# $(OCAMLOPT) $(DEPPKGS) -linkpkg -o $@ $(DEPCMXS) $<
+matitadep: matitac
+ @test -f $@ || ln -s $< $@
+matitadep.opt: matitac.opt
+ @test -f $@ || ln -s $< $@
+
+# matitaclean: matitaclean.ml $(CLEANLIB_DEPS) $(CLEANCMOS)
+# $(OCAMLC) $(CLEANPKGS) -linkpkg -o $@ $(CLEANCMOS) $<
+# matitaclean.opt: matitaclean.ml $(CLEANLIB_DEPS) $(CLEANCMXS)
+# $(OCAMLOPT) $(CLEANPKGS) -linkpkg -o $@ $(CLEANCMXS) $<
+matitaclean: matitac
+ @test -f $@ || ln -s $< $@
+matitaclean.opt: matitac.opt
+ @test -f $@ || ln -s $< $@
+
+# matitamake: matitamake.ml $(MAKECMOS)
+# $(OCAMLC) $(MAKEPKGS) -linkpkg -o $@ $(MAKECMOS) $<
+# matitamake.opt: matitamake.ml $(MAKECMXS)
+# $(OCAMLOPT) $(MAKEPKGS) -linkpkg -o $@ $(MAKECMXS) $<
+matitamake: matitac
+ @test -f $@ || ln -s $< $@
+matitamake.opt: matitac.opt
+ @test -f $@ || ln -s $< $@
+
+cicbrowser: matita
+ @test -f $@ || ln -s $< $@
+cicbrowser.opt: matita.opt
+ @test -f $@ || ln -s $< $@
+
+matitaGeneratedGui.ml matitaGeneratedGui.mli: matita.glade
+ $(LABLGLADECC) -embed $< > matitaGeneratedGui.ml
+ $(OCAMLC) $(PKGS) -i matitaGeneratedGui.ml > matitaGeneratedGui.mli
+
+.PHONY: clean
+clean:
+ rm -rf *.cma *.cmo *.cmi *.cmx *.cmxa *.a *.o \
+ $(PROGRAMS) \
+ $(PROGRAMS_OPT) \
+ $(PROGRAMS_STATIC) \
+ $(PROGRAMS_UPX) \
+ $(NULL)
+
+TEST_DIRS = \
+ library \
+ tests \
+ tests/bad_tests \
+ contribs/LAMBDA-TYPES \
+ contribs/PREDICATIVE-TOPOLOGY \
+ $(NULL)
+
+.PHONY: tests tests.opt cleantests cleantests.opt
+tests: $(foreach d,$(TEST_DIRS),$(d)-test)
+tests.opt: $(foreach d,$(TEST_DIRS),$(d)-test-opt)
+cleantests: $(foreach d,$(TEST_DIRS),$(d)-cleantests)
+cleantests.opt: $(foreach d,$(TEST_DIRS),$(d)-cleantests-opt)
+
+%-test: matitac matitadep matitaclean coq.moo
+ -cd $* && make -k clean all
+%-test-opt: matitac.opt matitadep.opt matitaclean.opt
+ -cd $* && make -k clean.opt opt
+%-cleantests: matitaclean
+ -cd $* && make clean
+%-cleantests-opt: matitaclean.opt
+ -cd $* && make clean.opt
+
+# {{{ Distribution stuff
+
+STATIC_LINK = dist/static_link/static_link
+# for matita
+STATIC_LIBS = \
+ t1 t1x \
+ gtkmathview_gmetadom mathview mathview_backend_gtk mathview_frontend_gmetadom \
+ gtksourceview-1.0 \
+ gdome gmetadom_gdome_cpp_smart \
+ stdc++ \
+ mysqlclient \
+ expat \
+ $(NULL)
+STATIC_EXTRA_LIBS = -cclib -lt1x -cclib -lstdc++
+# for matitac & co
+STATIC_CLIBS = \
+ gdome \
+ mysqlclient \
+ $(NULL)
+STATIC_EXTRA_CLIBS =
+PROGRAMS_STATIC = $(patsubst %,%.static,$(PROGRAMS_OPT))
+PROGRAMS_UPX = $(patsubst %,%.upx,$(PROGRAMS_STATIC))
+
+ifeq ($(HAVE_OCAMLOPT),yes)
+static: $(STATIC_LINK) $(PROGRAMS_STATIC) coq.moo.opt
+else
+upx:
+ @echo "Native code compilation is disabled"
+static:
+ @echo "Native code compilation is disabled"
+endif
+
+$(STATIC_LINK):
+ $(MAKE) -C dist/ $(STATIC_LINK)
+
+matita.opt.static: $(STATIC_LINK) $(LIBX_DEPS) $(CMXS) matita.ml
+ $(STATIC_LINK) $(STATIC_LIBS) -- \
+ $(OCAMLOPT) $(PKGS) -linkpkg -o $@ $(CMXS) matita.ml \
+ $(STATIC_EXTRA_LIBS)
+ strip $@
+dump_moo.opt.static: $(STATIC_LINK) buildTimeConf.cmx dump_moo.ml
+ $(STATIC_LINK) $(STATIC_CLIBS) -- \
+ $(OCAMLOPT) $(PKGS) -linkpkg -o $@ $^ \
+ $(STATIC_EXTRA_CLIBS)
+ strip $@
+matitac.opt.static: $(STATIC_LINK) $(CLIBX_DEPS) $(CCMXS) $(MAINCMXS) matitac.ml
+ $(STATIC_LINK) $(STATIC_CLIBS) -- \
+ $(OCAMLOPT) $(CPKGS) -linkpkg -o $@ $(CCMXS) $(MAINCMXS) matitac.ml \
+ $(STATIC_EXTRA_CLIBS)
+ strip $@
+# matitadep.opt.static: $(STATIC_LINK) matitadep.ml $(DEPLIB_DEPS) $(DEPCMXS)
+# $(STATIC_LINK) $(STATIC_CLIBS) -- \
+# $(OCAMLOPT) $(DEPPKGS) -linkpkg -o $@ $(DEPCMXS) $< \
+# $(STATIC_EXTRA_CLIBS)
+# strip $@
+matitadep.opt.static: matitac.opt.static
+ @test -f $@ || ln -s $< $@
+# matitaclean.opt.static: $(STATIC_LINK) matitaclean.ml $(CLEANLIB_DEPS) $(CLEANCMXS)
+# $(STATIC_LINK) $(STATIC_CLIBS) -- \
+# $(OCAMLOPT) $(CLEANPKGS) -linkpkg -o $@ $(CLEANCMXS) $< \
+# $(STATIC_EXTRA_CLIBS)
+# strip $@
+matitaclean.opt.static: matitac.opt.static
+ @test -f $@ || ln -s $< $@
+# matitamake.opt.static: $(STATIC_LINK) matitamake.ml $(MAKECMXS)
+# $(STATIC_LINK) $(STATIC_CLIBS) -- \
+# $(OCAMLOPT) $(PKGS) -linkpkg -o $@ $(MAKECMXS) $< \
+# $(STATIC_EXTRA_CLIBS)
+# strip $@
+matitamake.opt.static: matitac.opt.static
+ @test -f $@ || ln -s $< $@
+cicbrowser.opt.static: matita.opt.static
+ @test -f $@ || ln -s $< $@
+cicbrowser.opt.static.upx: matita.opt.static.upx
+ @test -f $@ || ln -s $< $@
+
+.PHONY: distclean
+distclean: clean
+ $(MAKE) -C dist/ clean
+ rm -f matitaGeneratedGui.ml matitaGeneratedGui.mli
+ rm -f config.log config.status Makefile buildTimeConf.ml
+ rm -f matita.glade.bak matita.gladep.bak
+ rm -rf autom4te.cache/
+ rm -f configure matita.conf.xml.sample
+
+%.upx: %
+ cp $< $@
+ strip $@
+ upx $@
+
+# }}} End of distribution stuff
+
+tags: TAGS
+.PHONY: TAGS
+TAGS:
+ cd ..; otags -vi -r ocaml/ matita/
+
+#.depend: matitaGeneratedGui.ml matitaGeneratedGui.mli *.ml *.mli
+
+.PHONY: depend
+depend:
+ $(OCAMLDEP) *.ml *.mli > .depend
+
+include .depend
+
+%.cmi: %.mli
+ $(OCAMLC) $(PKGS) -c $<
+%.cmo %.cmi: %.ml
+ $(OCAMLC) $(PKGS) -c $<
+%.cmx: %.ml
+ $(OCAMLOPT) $(PKGS) -c $<
+%.annot: %.ml
+ $(OCAMLC) -dtypes $(PKGS) -c $<
+
+$(CMOS): $(LIB_DEPS)
+$(CMOS:%.cmo=%.cmx): $(LIBX_DEPS)
+
+ifeq ($(MAKECMDGOALS),all)
+ $(CMOS:%.cmo=%.cmi): $(LIB_DEPS)
+endif
+ifeq ($(MAKECMDGOALS),)
+ $(CMOS:%.cmo=%.cmi): $(LIB_DEPS)
+endif
+ifeq ($(MAKECMDGOALS),opt)
+ $(CMOS:%.cmo=%.cmi): $(LIBX_DEPS)
+endif
+
+# vim: set foldmethod=marker:
diff --git a/helm/matita/applyTransformation.ml b/helm/matita/applyTransformation.ml
new file mode 100644
index 000000000..83e5f3c18
--- /dev/null
+++ b/helm/matita/applyTransformation.ml
@@ -0,0 +1,72 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(***************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Andrea Asperti <asperti@cs.unibo.it> *)
+(* 21/11/2003 *)
+(* *)
+(* *)
+(***************************************************************************)
+
+(* $Id$ *)
+
+let mpres_document pres_box =
+ Xml.add_xml_declaration (CicNotationPres.print_box pres_box)
+
+let mml_of_cic_sequent metasenv sequent =
+ let unsh_sequent,(asequent,ids_to_terms,
+ ids_to_father_ids,ids_to_inner_sorts,ids_to_hypotheses)
+ =
+ Cic2acic.asequent_of_sequent metasenv sequent
+ in
+ let content_sequent = Acic2content.map_sequent asequent in
+ let pres_sequent =
+ (Sequent2pres.sequent2pres ~ids_to_inner_sorts content_sequent)
+ in
+ let xmlpres = mpres_document pres_sequent in
+ (Xml2Gdome.document_of_xml DomMisc.domImpl xmlpres,
+ unsh_sequent,
+ (asequent,
+ (ids_to_terms,ids_to_father_ids,ids_to_hypotheses,ids_to_inner_sorts)))
+
+let mml_of_cic_object obj =
+ let (annobj, ids_to_terms, ids_to_father_ids, ids_to_inner_sorts,
+ ids_to_inner_types, ids_to_conjectures, ids_to_hypotheses)
+ =
+ Cic2acic.acic_object_of_cic_object obj
+ in
+ let content =
+ Acic2content.annobj2content ~ids_to_inner_sorts ~ids_to_inner_types annobj
+ in
+ let pres = Content2pres.content2pres ~ids_to_inner_sorts content in
+ let xmlpres = mpres_document pres in
+ let mathml = Xml2Gdome.document_of_xml DomMisc.domImpl xmlpres in
+ (mathml,(annobj,
+ (ids_to_terms, ids_to_father_ids, ids_to_conjectures, ids_to_hypotheses,
+ ids_to_inner_sorts,ids_to_inner_types)))
+
diff --git a/helm/matita/applyTransformation.mli b/helm/matita/applyTransformation.mli
new file mode 100644
index 000000000..8e023aea6
--- /dev/null
+++ b/helm/matita/applyTransformation.mli
@@ -0,0 +1,57 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(***************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Andrea Asperti <asperti@cs.unibo.it> *)
+(* 21/11/2003 *)
+(* *)
+(* *)
+(***************************************************************************)
+
+val mml_of_cic_sequent:
+ Cic.metasenv -> (* metasenv *)
+ Cic.conjecture -> (* sequent *)
+ Gdome.document * (* Math ML *)
+ Cic.conjecture * (* unshared sequent *)
+ (Cic.annconjecture * (* annsequent *)
+ ((Cic.id, Cic.term) Hashtbl.t * (* id -> term *)
+ (Cic.id, Cic.id option) Hashtbl.t * (* id -> father id *)
+ (Cic.id, Cic.hypothesis) Hashtbl.t * (* id -> hypothesis *)
+ (Cic.id, Cic2acic.sort_kind) Hashtbl.t)) (* ids_to_inner_sorts *)
+
+val mml_of_cic_object:
+ Cic.obj -> (* object *)
+ Gdome.document * (* Math ML *)
+ (Cic.annobj * (* annobj *)
+ ((Cic.id, Cic.term) Hashtbl.t * (* id -> term *)
+ (Cic.id, Cic.id option) Hashtbl.t * (* id -> father id *)
+ (Cic.id, Cic.conjecture) Hashtbl.t * (* id -> conjecture *)
+ (Cic.id, Cic.hypothesis) Hashtbl.t * (* id -> hypothesis *)
+ (Cic.id, Cic2acic.sort_kind) Hashtbl.t * (* ids_to_inner_sorts *)
+ (Cic.id, Cic2acic.anntypes) Hashtbl.t)) (* ids_to_inner_types *)
+
diff --git a/helm/matita/buildTimeConf.ml.in b/helm/matita/buildTimeConf.ml.in
new file mode 100644
index 000000000..debafe003
--- /dev/null
+++ b/helm/matita/buildTimeConf.ml.in
@@ -0,0 +1,56 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+let debug = @DEBUG@;;
+let version = "@MATITA_VERSION@";;
+let undo_history_size = 10;;
+let console_history_size = 100;;
+let browser_history_size = 100;;
+let base_uri = "cic:/matita";;
+let phrase_sep = ".";;
+let blank_uri = "about:blank";;
+let current_proof_uri = "about:current_proof";;
+let default_font_size = 10;;
+let script_font = "Monospace";;
+
+ (** may be overridden with MATITA_RT_BASE_DIR environment variable, useful for
+ * binary distribution installed in user home directories *)
+let runtime_base_dir =
+ try
+ Sys.getenv "MATITA_RT_BASE_DIR"
+ with Not_found -> "@RT_BASE_DIR@";;
+
+let images_dir = runtime_base_dir ^ "/icons"
+let gtkrc_file = runtime_base_dir ^ "/matita.gtkrc"
+let lang_file = runtime_base_dir ^ "/matita.lang"
+let script_template = runtime_base_dir ^ "/matita.ma.templ"
+let core_notation_script = runtime_base_dir ^ "/core_notation.moo"
+let coq_notation_script = runtime_base_dir ^ "/coq.moo"
+let matita_conf = runtime_base_dir ^ "/matita.conf.xml"
+let closed_xml = runtime_base_dir ^ "/closed.xml"
+let gtkmathview_conf = runtime_base_dir ^ "/gtkmathview.matita.conf.xml"
+let matitamake_makefile_template = runtime_base_dir ^ "/template_makefile.in"
+let stdlib_dir = runtime_base_dir ^ "/library"
+
diff --git a/helm/matita/buildTimeConf.mli b/helm/matita/buildTimeConf.mli
new file mode 100644
index 000000000..949f8c5cb
--- /dev/null
+++ b/helm/matita/buildTimeConf.mli
@@ -0,0 +1,51 @@
+(* Copyright (C) 2006, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+val base_uri : string
+val blank_uri : string
+val browser_history_size : int
+val closed_xml : string
+val console_history_size : int
+val coq_notation_script : string
+val core_notation_script : string
+val current_proof_uri : string
+val debug : bool
+val default_font_size : int
+val gtkmathview_conf : string
+val gtkrc_file : string
+val images_dir : string
+val lang_file : string
+val matita_conf : string
+val matitamake_makefile_template : string
+val phrase_sep : string
+val runtime_base_dir : string
+val script_font : string
+val script_template : string
+val stdlib_dir : string
+val undo_history_size : int
+val version : string
+
diff --git a/helm/matita/closed.xml b/helm/matita/closed.xml
new file mode 100644
index 000000000..d3125efb7
--- /dev/null
+++ b/helm/matita/closed.xml
@@ -0,0 +1,17 @@
+<?xml version="1.0"?>
+<b:box xmlns:m="http://www.w3.org/1998/Math/MathML" xmlns:b="http://helm.cs.unibo.it/2003/BoxML">
+ <b:h>
+ <b:space width="2em"/>
+ <b:v>
+ <b:space height="2ex"/>
+ <b:v>
+ <b:decor style="box">
+ <b:space width="1ex" height="1ex"/>
+ </b:decor>
+ <b:space height="1ex"/>
+ <b:text>This goal has already been closed.</b:text>
+ <b:text>Use the "skip" command to throw it away.</b:text>
+ </b:v>
+ </b:v>
+ </b:h>
+</b:box>
diff --git a/helm/matita/configure.ac b/helm/matita/configure.ac
new file mode 100644
index 000000000..1075d605d
--- /dev/null
+++ b/helm/matita/configure.ac
@@ -0,0 +1,136 @@
+AC_INIT(matitaTypes.ml)
+
+# Distribution settings (i.e. settings to be manipulated before a release)
+DEBUG_DEFAULT="true"
+RT_BASE_DIR_DEFAULT="`pwd`"
+MATITA_VERSION="0.0.1"
+# End of distribution settings
+
+AC_CHECK_PROG(HAVE_OCAMLC, ocamlc, yes, no)
+if test $HAVE_OCAMLC = "no"; then
+ AC_MSG_ERROR(could not find ocamlc)
+fi
+AC_CHECK_PROG(HAVE_OCAMLOPT, ocamlopt, yes, no)
+if test $HAVE_OCAMLOPT = "no"; then
+ AC_MSG_WARN(could not find ocamlopt: native code compilation disabled)
+fi
+AC_CHECK_PROG(HAVE_OCAMLFIND, ocamlfind, yes, no)
+if test $HAVE_OCAMLFIND = "yes"; then
+ OCAMLFIND="ocamlfind"
+else
+ AC_MSG_ERROR(could not find ocamlfind)
+fi
+AC_CHECK_PROG(HAVE_LABLGLADECC, lablgladecc2, yes, no)
+if test $HAVE_LABLGLADECC = "yes"; then
+ LABLGLADECC="lablgladecc2"
+else
+ AC_MSG_ERROR(could not find lablgladecc2)
+fi
+AC_CHECK_PROG(HAVE_CAMLP4O, camlp4o, yes, no)
+if test $HAVE_CAMLP4O = "yes"; then
+ CAMLP4O="camlp4o"
+else
+ AC_MSG_ERROR(could not find camlp4o)
+fi
+FINDLIB_COMREQUIRES="\
+helm-cic_disambiguation \
+helm-grafite \
+helm-grafite_engine \
+helm-grafite_parser \
+helm-hgdome \
+helm-tactics \
+"
+FINDLIB_CLEANREQUIRES="$FINDLIB_COMREQUIRES"
+FINDLIB_DEPREQUIRES="$FINDLIB_COMREQUIRES"
+FINDLIB_MAKEREQUIRES=" \
+helm-registry \
+helm-extlib \
+"
+FINDLIB_CREQUIRES=" \
+$FINDLIB_COMREQUIRES \
+helm-paramodulation \
+"
+FINDLIB_REQUIRES="\
+$FINDLIB_CREQUIRES \
+lablgtk2.glade \
+lablgtkmathview \
+lablgtksourceview \
+helm-xmldiff \
+helm-paramodulation \
+"
+for r in $FINDLIB_REQUIRES
+do
+ AC_MSG_CHECKING(for $r ocaml library)
+ if OCAMLPATH=../ocaml/METAS $OCAMLFIND query $r &> /dev/null; then
+ AC_MSG_RESULT(yes)
+ else
+ AC_MSG_ERROR(could not find $r ocaml library)
+ fi
+done
+
+OCAMLFIND_COMMANDS=""
+# AC_CHECK_PROG(HAVE_OCAMLC_OPT, ocamlc.opt, yes, no)
+# if test $HAVE_OCAMLC_OPT = "yes"; then
+# if test "$OCAMLFIND_COMMANDS" = ""; then
+# OCAMLFIND_COMMANDS="ocamlc=ocamlc.opt"
+# else
+# OCAMLFIND_COMMANDS="$OCAMLFIND_COMMANDS ocamlc=ocamlc.opt"
+# fi
+# fi
+# AC_CHECK_PROG(HAVE_OCAMLOPT_OPT, ocamlopt.opt, yes, no)
+# if test $HAVE_OCAMLOPT_OPT = "yes"; then
+# if test "$OCAMLFIND_COMMANDS" = ""; then
+# OCAMLFIND_COMMANDS="ocamlopt=ocamlopt.opt"
+# else
+# OCAMLFIND_COMMANDS="$OCAMLFIND_COMMANDS ocamlopt=ocamlopt.opt"
+# fi
+# fi
+if test "$OCAMLFIND_COMMANDS" != ""; then
+ OCAMLFIND="OCAMLFIND_COMMANDS='$OCAMLFIND_COMMANDS' $OCAMLFIND"
+fi
+
+AC_MSG_CHECKING(--enable-debug argument)
+AC_ARG_ENABLE(debug,
+ [ --enable-debug Turn on debugging],
+ [GIVEN="yes";
+ case "${enableval}" in
+ yes) DEBUG=true ;;
+ no) DEBUG=false ;;
+ *) AC_MSG_ERROR(bad value ${enableval} for --enable-debug) ;;
+ esac],
+ [GIVEN="no"; DEBUG="$DEBUG_DEFAULT"])
+MSG=$GIVEN
+if test "$DEBUG" = "true"; then
+ MSG="$MSG, debugging enabled."
+else
+ MSG="$MSG, debugging disabled."
+fi
+AC_MSG_RESULT($MSG)
+
+AC_MSG_CHECKING(--with-runtime-dir argument)
+AC_ARG_WITH(runtime-dir,
+ [ --with-runtime-dir Runtime directory (current working directory if not given)],
+ [ RT_BASE_DIR="${withval}" ],
+ [ RT_BASE_DIR="$RT_BASE_DIR_DEFAULT" ])
+AC_MSG_RESULT($RT_BASE_DIR)
+
+AC_SUBST(CAMLP4O)
+AC_SUBST(DEBUG)
+AC_SUBST(TRANSFORMER_MODULE)
+AC_SUBST(FINDLIB_REQUIRES)
+AC_SUBST(FINDLIB_CREQUIRES)
+AC_SUBST(FINDLIB_DEPREQUIRES)
+AC_SUBST(FINDLIB_CLEANREQUIRES)
+AC_SUBST(FINDLIB_MAKEREQUIRES)
+AC_SUBST(HAVE_OCAMLOPT)
+AC_SUBST(LABLGLADECC)
+AC_SUBST(OCAMLFIND)
+AC_SUBST(RT_BASE_DIR)
+AC_SUBST(MATITA_VERSION)
+
+AC_OUTPUT([
+ matita.conf.xml.sample
+ buildTimeConf.ml
+ Makefile
+ gtkmathview.matita.conf.xml
+])
diff --git a/helm/matita/contribs/LAMBDA-TYPES/Makefile b/helm/matita/contribs/LAMBDA-TYPES/Makefile
new file mode 100644
index 000000000..5b2b2fa40
--- /dev/null
+++ b/helm/matita/contribs/LAMBDA-TYPES/Makefile
@@ -0,0 +1,57 @@
+SRC=$(shell find . -name "*.ma" -a -type f)
+
+MATITA_FLAGS = -I ../..
+NODB=false
+ifeq ($(NODB),true)
+ MATITA_FLAGS += -nodb
+endif
+
+MATITAC=../../scripts/do_tests.sh $(DO_TESTS_OPTS) "../../matitac $(MATITA_FLAGS)" "../../matitaclean $(MATITA_FLAGS)" /dev/null OK
+MATITACOPT=../../scripts/do_tests.sh $(DO_TESTS_OPTS) "../../matitac.opt $(MATITA_FLAGS)" "../../matitaclean.opt $(MATITA_FLAGS)" /dev/null OK
+VERBOSEMATITAC=../../matitac $(MATITA_FLAGS)
+VERBOSEMATITACOPT=../../matitac.opt $(MATITA_FLAGS)
+
+MATITACLEAN=../../matitaclean $(MATITA_FLAGS)
+MATITACLEANOPT=../../matitaclean.opt $(MATITA_FLAGS)
+
+MATITADEP=../../matitadep $(MATITA_FLAGS)
+MATITADEPOPT=../../matitadep.opt $(MATITA_FLAGS)
+
+DEPEND_NAME=.depend
+
+H=@
+
+all: $(SRC:%.ma=%.mo)
+
+opt:
+ $(H)$(MAKE) MATITAC='$(MATITACOPT)' MATITACLEAN='$(MATITACLEANOPT)' MATITADEP='$(MATITADEPOPT)' all
+
+verbose:
+ $(H)$(MAKE) MATITAC='$(VERBOSEMATITAC)' MATITACLEAN='$(MATITACLEAN)' MATITADEP='$(MATITADEP)' all
+
+%.opt:
+ $(H)$(MAKE) MATITAC='$(MATITACOPT)' MATITACLEAN='$(MATITACLEANOPT)' MATITADEP='$(MATITADEPOPT)' $(@:%.opt=%)
+
+clean_:
+ $(H)rm -f __*not_for_matita
+
+clean: clean_
+ $(H)$(MATITACLEAN) $(SRC)
+
+cleanall: clean_
+ $(H)rm -f $(SRC:%.ma=%.moo)
+ $(H)$(MATITACLEAN) all
+
+depend:
+ $(H)rm -f $(DEPEND_NAME)
+ $(H)$(MAKE) $(DEPEND_NAME)
+.PHONY: depend
+
+%.moo:
+ $(H)$(MATITAC) $<
+
+$(DEPEND_NAME): $(SRC)
+ $(H)$(MATITADEP) $(SRC) > $@ || rm -f $@
+
+#include $(DEPEND_NAME)
+include .depend
diff --git a/helm/matita/contribs/LAMBDA-TYPES/lref_map_defs.ma b/helm/matita/contribs/LAMBDA-TYPES/lref_map_defs.ma
new file mode 100644
index 000000000..572618808
--- /dev/null
+++ b/helm/matita/contribs/LAMBDA-TYPES/lref_map_defs.ma
@@ -0,0 +1,22 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/LAMBDA-TYPES/lref_map_defs".
+
+include "terms_defs.ma".
+
+inductive tlref_map (A: Set) (N: Set) (map: nat \to nat): nat \to (T A N) \to (T A N) \to Prop \def
+ | tlref_map_sort: \forall i. \forall k. \forall y. (tlref_map A N map i (TSort A N y k) (TSort A N y k))
+ | tlref_map_lref_lt: \forall j. \forall i. \forall y. j < i \to (tlref_map A N map i (TLRef A N y j) (TLRef A N y j))
+ | tlref_map_lref_ge: \forall j. \forall i. \forall y. i \le j \to (tlref_map A N map i (TLRef A N y j) (TLRef A N y (map j))).
diff --git a/helm/matita/contribs/LAMBDA-TYPES/terms_defs.ma b/helm/matita/contribs/LAMBDA-TYPES/terms_defs.ma
new file mode 100644
index 000000000..cf7848abe
--- /dev/null
+++ b/helm/matita/contribs/LAMBDA-TYPES/terms_defs.ma
@@ -0,0 +1,47 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/LAMBDA-TYPES/terms_defs".
+
+include "legacy/coq.ma".
+
+alias id "nat" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1)".
+alias id "S" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1/2)".
+alias id "O" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1/1)".
+alias id "plus" = "cic:/Coq/Init/Peano/plus.con".
+alias id "lt" = "cic:/Coq/Init/Peano/lt.con".
+alias id "le" = "cic:/Coq/Init/Peano/le.ind#xpointer(1/1)".
+
+inductive B : Set \def
+ | Void: B
+ | Abbr: B
+ | Abst: B.
+
+inductive F : Set \def
+ | Appl: F
+ | Cast: F.
+
+inductive W : Set \def
+ | Bind: B \to W
+ | Flat: F \to W.
+
+inductive T (A:Set) (N:Set) : Set \def
+ | TSort: A \to nat \to (T A N)
+ | TLRef: A \to nat \to (T A N)
+ | TWag : A \to W \to (T A N) \to (T A N) \to (T A N)
+ | TGRef: A \to N \to (T A N).
+
+record X (A:Set) (N:Set) : Type \def {
+ get_gref: N \to B \to (T A N) \to Prop
+}.
diff --git a/helm/matita/contribs/LAMBDA-TYPES/tlt_defs.ma b/helm/matita/contribs/LAMBDA-TYPES/tlt_defs.ma
new file mode 100644
index 000000000..390c067cc
--- /dev/null
+++ b/helm/matita/contribs/LAMBDA-TYPES/tlt_defs.ma
@@ -0,0 +1,53 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/LAMBDA-TYPES/tlt_defs".
+
+include "terms_defs.ma".
+
+definition wadd: (nat \to nat) \to nat \to (nat \to nat) \def
+ \lambda map,w,n.
+ match n with [
+ O \Rightarrow w
+ | (S m) \Rightarrow (map m)
+ ].
+
+let rec weight_map (A:Set) (N:Set) (map:nat \to nat) (t:T A N) on t : nat \def
+ match t with [
+ (TSort y k) \Rightarrow O
+ | (TLRef y i) \Rightarrow (map i)
+ | (TWag y z w u) \Rightarrow
+ match z with [
+ (Bind b) \Rightarrow
+ match b with [
+ Abbr \Rightarrow
+ (S ((weight_map A N map w) + (weight_map A N (wadd map (S (weight_map A N map w))) u)))
+ | Abst \Rightarrow
+ (S ((weight_map A N map w) + (weight_map A N (wadd map O) u)))
+ | Void \Rightarrow
+ (S ((weight_map A N map w) + (weight_map A N (wadd map O) u)))
+ ]
+ | (Flat a) \Rightarrow
+ (S ((weight_map A N map w) + (weight_map A N map u)))
+ ]
+ | (TGRef y n) \Rightarrow O
+ ].
+
+definition weight: \forall A,N. T A N \to nat \def
+ \lambda A,N.
+ (weight_map A N (\lambda _.O)).
+
+definition tlt: \forall A,N. T A N \to T A N \to Prop \def
+ \lambda A,N,t1,t2.
+ weight A N t1 < weight A N t2.
diff --git a/helm/matita/contribs/PREDICATIVE-TOPOLOGY/Makefile b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/Makefile
new file mode 100644
index 000000000..489b2c135
--- /dev/null
+++ b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/Makefile
@@ -0,0 +1,57 @@
+SRC=$(shell find . -name "*.ma" -a -type f)
+
+MATITA_FLAGS =
+NODB=false
+ifeq ($(NODB),true)
+ MATITA_FLAGS += -nodb
+endif
+
+MATITAC=../../scripts/do_tests.sh $(DO_TESTS_OPTS) "../../matitac $(MATITA_FLAGS)" "../../matitaclean $(MATITA_FLAGS)" /dev/null OK
+MATITACOPT=../../scripts/do_tests.sh $(DO_TESTS_OPTS) "../../matitac.opt $(MATITA_FLAGS)" "../../matitaclean.opt $(MATITA_FLAGS)" /dev/null OK
+VERBOSEMATITAC=../../matitac $(MATITA_FLAGS)
+VERBOSEMATITACOPT=../../matitac.opt $(MATITA_FLAGS)
+
+MATITACLEAN=../../matitaclean $(MATITA_FLAGS)
+MATITACLEANOPT=../../matitaclean.opt $(MATITA_FLAGS)
+
+MATITADEP=../../matitadep $(MATITA_FLAGS)
+MATITADEPOPT=../../matitadep.opt $(MATITA_FLAGS)
+
+DEPEND_NAME=.depend
+
+H=@
+
+all: $(SRC:%.ma=%.mo)
+
+opt:
+ $(H)$(MAKE) MATITAC='$(MATITACOPT)' MATITACLEAN='$(MATITACLEANOPT)' MATITADEP='$(MATITADEPOPT)' all
+
+verbose:
+ $(H)$(MAKE) MATITAC='$(VERBOSEMATITAC)' MATITACLEAN='$(MATITACLEAN)' MATITADEP='$(MATITADEP)' all
+
+%.opt:
+ $(H)$(MAKE) MATITAC='$(MATITACOPT)' MATITACLEAN='$(MATITACLEANOPT)' MATITADEP='$(MATITADEPOPT)' $(@:%.opt=%)
+
+clean_:
+ $(H)rm -f __*not_for_matita
+
+clean: clean_
+ $(H)$(MATITACLEAN) $(SRC)
+
+cleanall: clean_
+ $(H)rm -f $(SRC:%.ma=%.moo)
+ $(H)$(MATITACLEAN) all
+
+depend:
+ $(H)rm -f $(DEPEND_NAME)
+ $(H)$(MAKE) $(DEPEND_NAME)
+.PHONY: depend
+
+%.moo:
+ $(H)$(MATITAC) $<
+
+$(DEPEND_NAME): $(SRC)
+ $(H)$(MATITADEP) $(SRC) > $@ || rm -f $@
+
+#include $(DEPEND_NAME)
+include .depend
diff --git a/helm/matita/contribs/PREDICATIVE-TOPOLOGY/class_defs.ma b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/class_defs.ma
new file mode 100644
index 000000000..17a53f64f
--- /dev/null
+++ b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/class_defs.ma
@@ -0,0 +1,51 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+(* Project started Wed Oct 12, 2005 ***************************************)
+
+set "baseuri" "cic:/matita/PREDICATIVE-TOPOLOGY/class_defs".
+
+include "../../library/logic/connectives.ma".
+
+(* ACZEL CATEGORIES:
+ - We use typoids with a compatible membership relation
+ - The category is intended to be the domain of the membership relation
+ - The membership relation is necessary because we need to regard the
+ domain of a propositional function (ie a predicative subset) as a
+ quantification domain and therefore as a category, but there is no
+ type in CIC representing the domain of a propositional function
+ - We set up a single equality predicate, parametric on the category,
+ defined as the reflexive, symmetic, transitive and compatible closure
+ of the cle1 predicate given inside the category. Then we prove the
+ properties of the equality that usually are axiomatized inside the
+ category structure. This makes categories easier to use
+*)
+
+definition true_f \def \lambda (X:Type). \lambda (_:X). True.
+
+definition false_f \def \lambda (X:Type). \lambda (_:X). False.
+
+record Class: Type \def {
+ class:> Type;
+ cin: class \to Prop;
+ cle1: class \to class \to Prop
+}.
+
+inductive cle (C:Class) (c1:C): C \to Prop \def
+ | cle_refl: cin ? c1 \to cle ? c1 c1
+ | ceq_sing: \forall c2,c3.
+ cle ? c1 c2 \to cin ? c3 \to cle1 ? c2 c3 \to cle ? c1 c3.
+
+inductive ceq (C:Class) (c1:C) (c2:C): Prop \def
+ | ceq_intro: cle ? c1 c2 \to cle ? c2 c1 \to ceq ? c1 c2.
diff --git a/helm/matita/contribs/PREDICATIVE-TOPOLOGY/class_eq.ma b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/class_eq.ma
new file mode 100644
index 000000000..cfcb57293
--- /dev/null
+++ b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/class_eq.ma
@@ -0,0 +1,38 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/PREDICATIVE-TOPOLOGY/class_eq".
+
+include "class_le.ma".
+
+theorem ceq_cl: \forall C,c1,c2. ceq ? c1 c2 \to cin C c1 \land cin C c2.
+intros; elim H; clear H.
+lapply cle_cl to H1 using H; clear H1; decompose H;
+lapply cle_cl to H2 using H; clear H2; decompose H.
+auto.
+qed.
+
+theorem ceq_refl: \forall C,c. cin C c \to ceq ? c c.
+intros; apply ceq_intro; auto.
+qed.
+
+theorem ceq_trans: \forall C,c2,c1,c3.
+ ceq C c2 c3 \to ceq ? c1 c2 \to ceq ? c1 c3.
+intros; elim H; elim H1; clear H; clear H1.
+apply ceq_intro; apply cle_trans; [|auto|auto||auto|auto].
+qed.
+
+theorem ceq_sym: \forall C,c1,c2. ceq C c1 c2 \to ceq C c2 c1.
+intros; elim H; clear H.; auto.
+qed.
diff --git a/helm/matita/contribs/PREDICATIVE-TOPOLOGY/class_le.ma b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/class_le.ma
new file mode 100644
index 000000000..a688ec63b
--- /dev/null
+++ b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/class_le.ma
@@ -0,0 +1,28 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/PREDICATIVE-TOPOLOGY/class_le".
+
+include "class_defs.ma".
+
+theorem cle_cl: \forall C,c1,c2. cle ? c1 c2 \to cin C c1 \land cin C c2.
+intros; elim H; clear H; clear c2;
+ [| decompose H2 ]; auto.
+qed.
+
+theorem cle_trans: \forall C,c1,c2. cle C c1 c2 \to
+ \forall c3. cle ? c3 c1 \to cle ? c3 c2.
+intros 4; elim H; clear H; clear c2;
+ [| apply ceq_sing; [||| apply H4 ]]; auto.
+qed.
diff --git a/helm/matita/contribs/PREDICATIVE-TOPOLOGY/coa_defs.ma b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/coa_defs.ma
new file mode 100644
index 000000000..c840fbdaf
--- /dev/null
+++ b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/coa_defs.ma
@@ -0,0 +1,61 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/PREDICATIVE-TOPOLOGY/coa_defs".
+
+include "iff.ma".
+include "domain_data.ma".
+
+(* COMPLETE OVERLAP ALGEBRAS
+*)
+
+record COA: Type \def {
+ coa:> Class; (* carrier *)
+ le: coa \to coa \to Prop; (* inclusion *)
+ ov: coa \to coa \to Prop; (* overlap *)
+ sup: \forall (D:Domain). (D \to coa) \to coa; (* supremum *)
+ inf: \forall (D:Domain). (D \to coa) \to coa; (* infimum *)
+ le_refl: \forall p. le p p;
+ le_trans: \forall p,r. le p r \to \forall q. le r q \to le p q;
+ le_antysym: \forall q,p. le q p \to le p q \to ceq ? p q;
+ ov_sym: \forall q,p. ov q p \to ov p q;
+ sup_le: \forall D,ps,q. le (sup D ps) q \liff \iforall d. le (ps d) q;
+ inf_le: \forall D,p,qs. le p (inf D qs) \liff \iforall d. le p (qs d);
+ sup_ov: \forall D,ps,q. ov (sup D ps) q \liff \iexists d. ov (ps d) q;
+ density: \forall p,q. (\forall r. ov p r \to ov q r) \to le p q
+}.
+
+definition zero: \forall (P:COA). P \def
+ \lambda (P:COA). inf P ? (dvoid_ixfam P).
+
+definition one: \forall (P:COA). P \def
+ \lambda (P:COA). sup P ? (dvoid_ixfam P).
+
+definition binf: \forall (P:COA). P \to P \to P \def
+ \lambda (P:COA). \lambda p0,p1.
+ inf P ? (dbool_ixfam P p0 p1).
+
+definition bsup: \forall (P:COA). P \to P \to P \def
+ \lambda (P:COA). \lambda p0,p1.
+ sup P ? (dbool_ixfam P p0 p1).
+
+(*
+ inf_ov: forall p q, ov p q -> ov p (inf QDBool (bool_family _ p q))
+ properness: ov zero zero -> False;
+ distributivity: forall I p q, id _ (inf QDBool (bool_family _ (sup I p) q)) (sup I (fun i => (inf QDBool (bool_family _ (p i) q))));
+*)
+
+inductive pippo : Prop \def
+ | Pippo: let x \def zero in zero = x \to pippo.
+
\ No newline at end of file
diff --git a/helm/matita/contribs/PREDICATIVE-TOPOLOGY/coa_props.ma b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/coa_props.ma
new file mode 100644
index 000000000..6c004073e
--- /dev/null
+++ b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/coa_props.ma
@@ -0,0 +1,29 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/PREDICATIVE-TOPOLOGY/coa_props".
+
+include "coa_defs.ma".
+
+inductive True:Prop \def T:True.
+
+theorem zero_le:
+ \forall (P:COA). \forall (p:P). (le ? (zero P) p) \to True.
+ intros.
+ exact T.
+qed.
+
+
+
+
diff --git a/helm/matita/contribs/PREDICATIVE-TOPOLOGY/domain_data.ma b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/domain_data.ma
new file mode 100644
index 000000000..ed0afab4f
--- /dev/null
+++ b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/domain_data.ma
@@ -0,0 +1,40 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/PREDICATIVE-TOPOLOGY/domain_data".
+
+include "../../library/datatypes/constructors.ma".
+include "../../library/datatypes/bool.ma".
+include "domain_defs.ma".
+
+(* QUANTIFICATION DOMAINS
+ - Here we define some useful domains based on data types
+*)
+
+definition DBool : Domain \def
+ mk_Domain (mk_Class bool (true_f ?) (eq ?)).
+
+definition dbool_ixfam : \forall (C:Class). C \to C \to (DBool \to C) \def
+ \lambda C,c0,c1,b.
+ match b in bool with
+ [ false \Rightarrow c0
+ | true \Rightarrow c1
+ ].
+
+definition DVoid : Domain \def
+ mk_Domain (mk_Class void (true_f ?) (eq ?)).
+
+definition dvoid_ixfam : \forall (C:Class). (DVoid \to C) \def
+ \lambda C,v.
+ match v in void with [].
diff --git a/helm/matita/contribs/PREDICATIVE-TOPOLOGY/domain_defs.ma b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/domain_defs.ma
new file mode 100644
index 000000000..68cbd01fa
--- /dev/null
+++ b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/domain_defs.ma
@@ -0,0 +1,58 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/PREDICATIVE-TOPOLOGY/domain_defs".
+
+include "class_defs.ma".
+
+(* QUANTIFICATION DOMAINS
+ - These are the categories on which we allow quantification
+ - We set up single quantifiers, parametric on the domain, so they
+ already have the properties that usually are axiomatized inside the
+ domain structure. This makes domains easier to use
+*)
+
+record Domain: Type \def {
+ qd:> Class
+}.
+
+(* internal universal quantification *)
+inductive dall (D:Domain) (P:D \to Prop) : Prop \def
+ | dall_intro: (\forall d:D. cin D d \to P d) \to dall D P.
+
+(* internal existential quantification *)
+inductive dex (D:Domain) (P:D \to Prop) : Prop \def
+ | dex_intro: \forall d:D. cin D d \land P d \to dex D P.
+
+(* notations **************************************************************)
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "internal for all" 'iforall \eta.x =
+ (cic:/matita/PREDICATIVE-TOPOLOGY/domain_defs/dall.ind#xpointer(1/1) _ x).
+
+notation > "hvbox(\iforall ident i opt (: ty) break . p)"
+ right associative with precedence 20
+for @{ 'iforall ${default
+ @{\lambda ${ident i} : $ty. $p)}
+ @{\lambda ${ident i} . $p}}}.
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "internal exists" 'dexists \eta.x =
+ (cic:/matita/PREDICATIVE-TOPOLOGY/domain_defs/dex.ind#xpointer(1/1) _ x).
+
+notation > "hvbox(\iexists ident i opt (: ty) break . p)"
+ right associative with precedence 20
+for @{ 'dexists ${default
+ @{\lambda ${ident i} : $ty. $p)}
+ @{\lambda ${ident i} . $p}}}.
diff --git a/helm/matita/contribs/PREDICATIVE-TOPOLOGY/iff.ma b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/iff.ma
new file mode 100644
index 000000000..9a9491923
--- /dev/null
+++ b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/iff.ma
@@ -0,0 +1,31 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/logic/iff".
+
+include "../../library/logic/connectives.ma".
+
+definition Iff : Prop \to Prop \to Prop \def
+ \lambda A,B. (A \to B) \land (B \to A).
+
+ (*CSC: the URI must disappear: there is a bug now *)
+interpretation "logical iff" 'iff x y = (cic:/matita/logic/iff/Iff.con x y).
+
+notation > "hvbox(a break \liff b)"
+ left associative with precedence 25
+for @{ 'iff $a $b }.
+
+notation < "hvbox(a break \leftrightarrow b)"
+ left associative with precedence 25
+for @{ 'iff $a $b }.
diff --git a/helm/matita/contribs/PREDICATIVE-TOPOLOGY/subset_defs.ma b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/subset_defs.ma
new file mode 100644
index 000000000..5d872040a
--- /dev/null
+++ b/helm/matita/contribs/PREDICATIVE-TOPOLOGY/subset_defs.ma
@@ -0,0 +1,66 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/PREDICATIVE-TOPOLOGY/subset_defs".
+
+include "domain_defs.ma".
+
+(* SUBSETS
+ - We use predicative subsets coded as propositional functions
+ according to G.Sambin and S.Valentini "Toolbox"
+*)
+
+definition Subset \def \lambda (D:Domain). D \to Prop.
+
+(* subset membership (epsilon) *)
+definition sin : \forall D. Subset D \to D \to Prop \def
+ \lambda (D:Domain). \lambda U,d. cin D d \and U d.
+
+(* subset top (full subset) *)
+definition stop \def \lambda (D:Domain). true_f D.
+
+(* subset bottom (empty subset) *)
+definition sbot \def \lambda (D:Domain). false_f D.
+
+(* subset and (binary intersection) *)
+definition sand: \forall D. Subset D \to Subset D \to Subset D \def
+ \lambda D,U1,U2,d. U1 d \land U2 d.
+
+(* subset or (binary union) *)
+definition sor: \forall D. Subset D \to Subset D \to Subset D \def
+ \lambda D,U1,U2,d. U1 d \lor U2 d.
+
+(* subset less or equal (inclusion) *)
+definition sle: \forall D. Subset D \to Subset D \to Prop \def
+ \lambda D,U1,U2. \iforall d. U1 d \to U2 d.
+
+(* subset overlap *)
+definition sover: \forall D. Subset D \to Subset D \to Prop \def
+ \lambda D,U1,U2. \iexists d. U1 d \land U2 d.
+
+(* coercions **************************************************************)
+
+(*
+(* the class of the subsets of a domain (not an implicit coercion) *)
+definition class_of_subsets_of \def
+ \lambda D. mk_Class (Subset D) (true_f ?) (sle ?).
+*)
+
+(* the domain built upon a subset (not an implicit coercion) *)
+definition domain_of_subset: \forall D. Subset D \to Domain \def
+ \lambda (D:Domain). \lambda U.
+ mk_Domain (mk_Class D (sin D U) (cle1 D)).
+
+(* the full subset of a domain *)
+coercion stop.
diff --git a/helm/matita/core_notation.moo b/helm/matita/core_notation.moo
new file mode 100644
index 000000000..c30e5142c
--- /dev/null
+++ b/helm/matita/core_notation.moo
@@ -0,0 +1,115 @@
+notation "hvbox(a break \to b)"
+ right associative with precedence 20
+for @{ \forall $_:$a.$b }.
+
+notation < "hvbox(a break \to b)"
+ right associative with precedence 20
+for @{ \Pi $_:$a.$b }.
+
+notation "hvbox(a break = b)"
+ non associative with precedence 45
+for @{ 'eq $a $b }.
+
+notation "hvbox(a break \leq b)"
+ non associative with precedence 45
+for @{ 'leq $a $b }.
+
+notation "hvbox(a break \geq b)"
+ non associative with precedence 45
+for @{ 'geq $a $b }.
+
+notation "hvbox(a break \lt b)"
+ non associative with precedence 45
+for @{ 'lt $a $b }.
+
+notation "hvbox(a break \gt b)"
+ non associative with precedence 45
+for @{ 'gt $a $b }.
+
+notation "hvbox(a break \neq b)"
+ non associative with precedence 45
+for @{ 'neq $a $b }.
+
+notation "hvbox(a break \nleq b)"
+ non associative with precedence 45
+for @{ 'nleq $a $b }.
+
+notation "hvbox(a break \ngeq b)"
+ non associative with precedence 45
+for @{ 'ngeq $a $b }.
+
+notation "hvbox(a break \nless b)"
+ non associative with precedence 45
+for @{ 'nless $a $b }.
+
+notation "hvbox(a break \ngtr b)"
+ non associative with precedence 45
+for @{ 'ngtr $a $b }.
+
+notation "hvbox(a break \divides b)"
+ non associative with precedence 45
+for @{ 'divides $a $b }.
+
+notation "hvbox(a break \ndivides b)"
+ non associative with precedence 45
+for @{ 'ndivides $a $b }.
+
+notation "hvbox(a break + b)"
+ left associative with precedence 50
+for @{ 'plus $a $b }.
+
+notation "hvbox(a break - b)"
+ left associative with precedence 50
+for @{ 'minus $a $b }.
+
+notation "hvbox(a break * b)"
+ left associative with precedence 55
+for @{ 'times $a $b }.
+
+notation "hvbox(a break \mod b)"
+ left associative with precedence 55
+for @{ 'module $a $b }.
+
+notation "\frac a b"
+ non associative with precedence 90
+for @{ 'divide $a $b }.
+
+notation "a \over b"
+ left associative with precedence 55
+for @{ 'divide $a $b }.
+
+notation "hvbox(a break / b)"
+ left associative with precedence 55
+for @{ 'divide $a $b }.
+
+notation > "- a"
+ right associative with precedence 60
+for @{ 'uminus $a }.
+
+notation < "- a"
+ right associative with precedence 75
+for @{ 'uminus $a }.
+
+notation "a !"
+ non associative with precedence 80
+for @{ 'fact $a }.
+
+notation "(a \sup b)"
+ right associative with precedence 65
+for @{ 'exp $a $b}.
+
+notation "\sqrt a"
+ non associative with precedence 60
+for @{ 'sqrt $a }.
+
+notation "hvbox(a break \lor b)"
+ left associative with precedence 30
+for @{ 'or $a $b }.
+
+notation "hvbox(a break \land b)"
+ left associative with precedence 35
+for @{ 'and $a $b }.
+
+notation "hvbox(\lnot a)"
+ left associative with precedence 40
+for @{ 'not $a }.
diff --git a/helm/matita/dictionary-matita.xml b/helm/matita/dictionary-matita.xml
new file mode 100644
index 000000000..35903486b
--- /dev/null
+++ b/helm/matita/dictionary-matita.xml
@@ -0,0 +1,15 @@
+<?xml version="1.0"?>
+<dictionary>
+ <operator name="(" form="prefix" fence="true" stretchy="false" lspace="0em" rspace="0em"/>
+ <operator name="(" form="infix" fence="true" stretchy="false" lspace="0em" rspace="0em"/>
+ <operator name=")" form="postfix" fence="true" stretchy="false" lspace="0em" rspace="0em"/>
+ <operator name=")" form="infix" fence="true" stretchy="false" lspace="0em" rspace="0em"/>
+ <operator name="[" form="prefix" fence="true" stretchy="false" lspace="0em" rspace="0em"/>
+ <operator name="[" form="infix" fence="true" stretchy="false" lspace="0em" rspace="0em"/>
+ <operator name="]" form="postfix" fence="true" stretchy="false" lspace="0em" rspace="0em"/>
+ <operator name="]" form="infix" fence="true" stretchy="false" lspace="0em" rspace="0em"/>
+ <operator name="{" form="prefix" fence="true" stretchy="false" lspace="0em" rspace="0em"/>
+ <operator name="{" form="infix" fence="true" stretchy="false" lspace="0em" rspace="0em"/>
+ <operator name="}" form="postfix" fence="true" stretchy="false" lspace="0em" rspace="0em"/>
+ <operator name="}" form="infix" fence="true" stretchy="false" lspace="0em" rspace="0em"/>
+</dictionary>
diff --git a/helm/matita/dist/Makefile b/helm/matita/dist/Makefile
new file mode 100644
index 000000000..669137bf2
--- /dev/null
+++ b/helm/matita/dist/Makefile
@@ -0,0 +1,17 @@
+MYSQL_FLAGS = --extended_insert --lock-tables=off --no-create-info
+DB = -u helm -h mowgli.cs.unibo.it matita
+TABLE_CREATOR = ../../ocaml/metadata/table_creator/table_creator
+TABLES := $(shell $(TABLE_CREATOR) list all)
+all: static_link
+clean: static_link_clean
+.PHONY: static_link
+static_link:
+ $(MAKE) -C static_link/
+static_link_clean:
+ $(MAKE) -C static_link/ clean
+dist: matita_stdlib.sql.gz
+.PHONY: matita_stdlib.sql
+matita_stdlib.sql:
+ mysqldump $(MYSQL_FLAGS) $(DB) $(TABLES) > $@
+%.gz: %
+ gzip -c $< > $@
diff --git a/helm/matita/dist/fill_db.sh b/helm/matita/dist/fill_db.sh
new file mode 100755
index 000000000..1ae28d336
--- /dev/null
+++ b/helm/matita/dist/fill_db.sh
@@ -0,0 +1,53 @@
+#!/bin/bash
+set -e
+
+MYSQL="mysql"
+DBHOST="localhost"
+DBNAME="matita"
+DBUSER="helm"
+DBPASS=""
+
+TABLE_CREATOR="../../ocaml/metadata/table_creator/table_creator"
+
+SQL="matita_db.sql"
+STDLIB_DATA="matita_stdlib.sql.gz"
+
+grant_sql="GRANT ALL PRIVILEGES ON $DBNAME.* TO $DBUSER@$DBHOST"
+create_sql="CREATE DATABASE $DBNAME"
+drop_sql="DROP DATABASE $DBNAME"
+
+function appendsql()
+{
+ echo "$1" >> $SQL
+}
+
+echo "Step 0."
+echo " Dropping old databases, if any."
+echo " You can ignore errors output by this step"
+echo "$drop_sql" | $MYSQL -f
+echo "Step 1."
+echo " Creating database and users."
+echo "# SQL statements to create Matita DB and users" > $SQL
+appendsql "$create_sql;"
+if [ -z "$DBPASS" ]; then
+ appendsql "$grant_sql;"
+else
+ appendsql "$grant_sql IDENTIFIED BY '$DBPASS';"
+fi
+$MYSQL < $SQL
+echo "Step 2."
+echo " Creating database structure."
+echo "# SQL statements to create Matita DB structure" > $SQL
+creator_args="table fill index"
+for arg in $creator_args; do
+ appendsql "`$TABLE_CREATOR $arg all`"
+done
+$MYSQL $DBNAME < $SQL
+echo "Step 3."
+echo " Filling database with standard library metadata."
+if [ -f "$STDLIB_DATA" ]; then
+ gunzip -c "$STDLIB_DATA" | $MYSQL $DBNAME
+else
+ echo " Standard library metadata file $STDLIB_DATA not found, skipping this step."
+fi
+
diff --git a/helm/matita/dist/static_link/Makefile b/helm/matita/dist/static_link/Makefile
new file mode 100644
index 000000000..5a02bb3b7
--- /dev/null
+++ b/helm/matita/dist/static_link/Makefile
@@ -0,0 +1,5 @@
+all: static_link
+static_link: static_link.ml
+ ocamlfind ocamlc -package unix,str -linkpkg -o $@ $<
+clean:
+ rm -f static_link.cm* static_link
diff --git a/helm/matita/dist/static_link/static_link.ml b/helm/matita/dist/static_link/static_link.ml
new file mode 100644
index 000000000..8b1d57668
--- /dev/null
+++ b/helm/matita/dist/static_link/static_link.ml
@@ -0,0 +1,162 @@
+
+open Printf
+
+exception Found of string list
+
+let ocamlobjinfo = "ocamlobjinfo"
+let noautolink = "-noautolink"
+let dummy_opt_cmd = "dummy_ocamlopt"
+let opt_cmd = "ocamlopt"
+let libdirs = [ "/lib"; "/usr/lib"; "/usr/lib/gcc/i486-linux-gnu/4.0.2" ]
+let exceptions = [ "threads.cma", [ "-lthreads", "-lthreadsnat" ] ]
+
+let blanks_RE = Str.regexp "[ \t\r\n]+"
+let cmxa_RE = Str.regexp "\\.cmxa$"
+let extra_cfiles_RE = Str.regexp "^.*Extra +C +object +files:\\(.*\\)$"
+let extra_copts_RE = Str.regexp "^.*Extra +C +options:\\(.*\\)$"
+let lib_RE = Str.regexp "^lib"
+let l_RE = Str.regexp "^-l"
+let opt_line_RE = Str.regexp (sprintf "^\\+ +%s +\\(.*\\)$" dummy_opt_cmd)
+let trailing_cmxa_RE = Str.regexp ".*\\.cmxa$"
+
+let message s = prerr_endline ("STATIC_LINK: " ^ s)
+let warning s = message ("WARNING: " ^ s)
+
+let handle_exceptions ~cma cflag =
+ try
+ let cma_exns = List.assoc (Filename.basename cma) exceptions in
+ let cflag' = List.assoc cflag cma_exns in
+ message (sprintf "using %s exception %s -> %s" cma cflag cflag');
+ cflag'
+ with Not_found -> cflag
+
+let parse_cmdline () =
+ let mine, rest = ref [], ref [] in
+ let is_mine = ref true in
+ Array.iter
+ (function
+ | "--" -> is_mine := false
+ | s when !is_mine ->
+ if Str.string_match lib_RE s 0 then
+ warning (sprintf
+ ("libraries to be statically linked must be specified "
+ ^^ "without heading \"lib\", \"%s\" argument may be wrong") s);
+ mine := s :: !mine
+ | s -> rest := s :: !rest)
+ Sys.argv;
+ if !rest = [] then begin
+ prerr_endline "Usage: static_link [ CLIB .. ] -- COMMAND [ ARG .. ]";
+ prerr_endline ("Example: static_link pcre expat --"
+ ^ " ocamlfind opt -package pcre,expat -linkpkg -o foo foo.ml");
+ exit 0
+ end;
+ List.tl (List.rev !mine), List.rev !rest
+
+let extract_opt_flags cmd =
+ let ic = Unix.open_process_in cmd in
+ (try
+ while true do
+ let l = input_line ic in
+ if Str.string_match opt_line_RE l 0 then begin
+ message ("got ocamlopt line: " ^ l);
+ raise (Found (Str.split blanks_RE (Str.matched_group 1 l)));
+ end
+ done;
+ [] (* dummy value *)
+ with
+ | End_of_file -> failwith "compiler command not found"
+ | Found flags ->
+ close_in ic;
+ flags)
+
+let cma_of_cmxa = Str.replace_first cmxa_RE ".cma"
+
+let find_clib libname =
+ let rec aux =
+ function
+ | [] -> raise Not_found
+ | libdir :: tl ->
+ let fname = sprintf "%s/lib%s.a" libdir libname in
+ if Sys.file_exists fname then fname else aux tl
+ in
+ aux libdirs
+
+let a_of_cflag cflag = (* "-lfoo" -> "/usr/lib/libfoo.a" *)
+ let libname = Str.replace_first l_RE "" cflag in
+ find_clib libname
+
+let cflags_of_cma fname =
+ let ic = Unix.open_process_in (sprintf "%s %s" ocamlobjinfo fname) in
+ let extra_copts = ref "" in
+ let extra_cfiles = ref "" in
+ (try
+ while true do
+ match input_line ic with
+ | s when Str.string_match extra_copts_RE s 0 ->
+ extra_copts := Str.matched_group 1 s
+ | s when Str.string_match extra_cfiles_RE s 0 ->
+ extra_cfiles := Str.matched_group 1 s
+ | _ -> ()
+ done
+ with End_of_file -> ());
+ close_in ic;
+ let extra_cfiles = List.rev (Str.split blanks_RE !extra_cfiles) in
+ let extra_copts = Str.split blanks_RE !extra_copts in
+ extra_copts @ extra_cfiles
+
+let staticize static_libs flags =
+ let static_flags = List.map ((^) "-l") static_libs in
+ let aux ~add_cclib ~cma cflag =
+ let cflag =
+ if List.mem cflag static_flags
+ then
+ (try
+ let a = a_of_cflag cflag in
+ message (sprintf "using static %s instead of shared %s" a cflag);
+ a
+ with Not_found -> warning ("can't find lib for " ^ cflag); cflag)
+ else (handle_exceptions ~cma cflag)
+ in
+ if add_cclib then [ "-cclib"; cflag ] else [ cflag ]
+ in
+ List.fold_right
+ (fun flag acc ->
+ let cma = cma_of_cmxa flag in
+ if Str.string_match trailing_cmxa_RE flag 0 then begin
+ message ("processing native archive: " ^ flag);
+ let cflags = cflags_of_cma cma in
+ let cflags' =
+ List.fold_right
+ (fun cflag acc -> (aux ~add_cclib:true ~cma cflag) @ acc)
+ cflags []
+ in
+ flag :: (cflags' @ acc)
+ end else
+ (aux ~add_cclib:false ~cma flag) @ acc)
+ flags []
+
+let quote_if_needed s =
+ try
+ ignore (Str.search_forward blanks_RE s 0);
+ "\"" ^ s ^ "\""
+ with Not_found -> s
+
+let main () =
+ let static_libs, args = parse_cmdline () in
+ printf "C libraries to be linked-in: %s\n" (String.concat " " static_libs);
+ flush stdout;
+ let verbose_cmd =
+ sprintf "OCAMLFIND_COMMANDS='ocamlopt=%s' %s -verbose 2>&1" dummy_opt_cmd
+ (String.concat " " (List.map quote_if_needed args))
+ in
+ let orig_opt_flags = extract_opt_flags verbose_cmd in
+ message ("original ocamlopt flags: " ^ String.concat " " orig_opt_flags);
+ let opt_flags = staticize static_libs orig_opt_flags in
+ message ("new ocamlopt flags: " ^ String.concat " " opt_flags);
+ let flags = noautolink :: opt_flags in
+ let cmd = String.concat " " (opt_cmd :: flags) in
+ message ("executing command: " ^ cmd);
+ exit (Sys.command cmd)
+
+let _ = main ()
+
diff --git a/helm/matita/dump_moo.ml b/helm/matita/dump_moo.ml
new file mode 100644
index 000000000..05c21d40d
--- /dev/null
+++ b/helm/matita/dump_moo.ml
@@ -0,0 +1,58 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+let arg_spec =
+ let std_arg_spec = [] in
+ let debug_arg_spec = [] in
+ std_arg_spec @ debug_arg_spec
+
+let usage =
+ sprintf "MatitaC v%s\nUsage: dump_moo [option ...] file.moo\nOptions:"
+ BuildTimeConf.version
+
+let _ =
+ let moos = ref [] in
+ let add_moo fname = moos := fname :: !moos in
+ Arg.parse arg_spec add_moo usage;
+ if !moos = [] then begin print_endline usage; exit 1 end;
+ List.iter
+ (fun fname ->
+ if not (Sys.file_exists fname) then
+ HLog.error (sprintf "Can't find moo '%s', skipping it." fname)
+ else begin
+ printf "%s:\n" fname; flush stdout;
+ let commands = GrafiteMarshal.load_moo ~fname in
+ List.iter
+ (fun cmd ->
+ printf " %s\n%!"
+ (GrafiteAstPp.pp_command ~obj_pp:(fun _ -> assert false) cmd))
+ commands;
+ end)
+ (List.rev !moos)
+
diff --git a/helm/matita/gtkmathview.matita.conf.xml.in b/helm/matita/gtkmathview.matita.conf.xml.in
new file mode 100644
index 000000000..0a33ae6d0
--- /dev/null
+++ b/helm/matita/gtkmathview.matita.conf.xml.in
@@ -0,0 +1,15 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<math-engine-configuration>
+ <section name="dictionary">
+ <key name="path">@RT_BASE_DIR@/dictionary-matita.xml</key>
+ </section>
+ <section name="gtk-backend">
+ <section name="pango-default-shaper">
+ <section name="variants">
+ <section name="italic">
+ <key name="style">normal</key>
+ </section>
+ </section>
+ </section>
+ </section>
+</math-engine-configuration>
diff --git a/helm/matita/icons/matita-bulb-high.png b/helm/matita/icons/matita-bulb-high.png
new file mode 100644
index 0000000000000000000000000000000000000000..03b6e7f8664372aafa75a27eae71f36ba634ec49
GIT binary patch
literal 1149
zcmV-@1cLjCP)<h;3K|Lk000e1NJLTq000yK000yS1^@s6jfou%00006VoOIv0RI60
z0RN!9r;`8x010qNS#tmY3ljhU3ljkVnw%H_000McNliru)dUj@D;Q8h^HTr-1PVz+
zK~y-)ZIsJz97Pa^zv}6ko!O_o>%<TnCn3%YAr1tIW4PqRjT3(&7bNZk5aECXQUU@I
zhddNN*YSG2Yp-|b*<BpGwxWoZT2(Doebv?VQ;R;l{}u27u!`8r1dVo1qdiXTm6D`a
zIMeVdR$X31rkd1DHdsuuolvJ^L)BN+Jz!Hr4uHY}OTZFhde~-X=37gnymhm&e7CuH
z=?*4{JtBoGQ(sNCTc-yb&E3(~LNC!5O*<(KT8PLDm;%lMU63w8y_0IIH_RG$mhXNU
z+l8Bf)VfAZ&8gz8%fvLVYq$M@gj<i6`rFUqwZ(E4OInC91x7$>fi@DfG-xEFX>zUi
z;TN&(erzOO3J78agP@|eE@B(1#%gn=bVZ)l`-6=etDPW?q&gCjwyF*d5F<947PcL=
zRyuL_mPp(cY~mDA5sZigBF0EiGg9k`G*)F{d0h+Ymrirj_Np<Eh)86B8YYZRQtif#
zMb)t53F-=hh!`LM0ucfc2_#GmQAZ?f_@v&crDf1jl{!!ZYW6Ha#CalPV}r4RhyVsS
zw*U&Fh*2@ti-|x)oyVe>d7LqT2UJy6eF5rJRe1+?eil&$b*L7q>QQuF3=en%6lhh|
zte=(Hq|)L9s#NF8p9h}#>b=jrRujdg>RgExmx+)AB~Th5!xu$6(Zlgz%lPRIJ|B5?
zxl>j3s?MuA?^S(OI4wqAvwiPo1EW<|)FXE+h7?H8g?)^=b`s2z(98DG%O6&HHV)Kh
zsO<z|6DK0-%ULLH;&irExr5(zfA@71y5UBn;SY?+F>nmz78rxJaA{+y9&T@s_Bz3<
zpW3bEk37w*9urwH26dSs?c*n}IP7nR*?4FFYS(Rs0mHedCqQL^0T81us>#HxEjIq#
zIe2<|GTy&(`Tf;MBoYKfbMkDK?DzYrDGpz+E|kxb(C--|gE`{@cm$luM=On(6l)8$
z{P{uAteI{dsc_|#s?3>=k7PX9Ia*&f8}-O+8zX&S4;apeQduCIR{*HMXMv_^mXWH<
z!6?2u#g#dEo^gCKofh4suNv-x?9Ox3v)nUaG1pOl{$q?3?M{nm<igH%?+v-1kyVb9
zBG8?~VzRmvZuZ*Y%kZqbbIDu)%Q;Zzk2_P(@i+_Lq}oJ`W#&$pl@<FVubXeO;hojm
zw)Z-m!>ai%f%09T11f}UI5_zEo9`YyxcAxTL6ukX@AF-K{Kt#aSj*p<NiYnpN#BB9
zKt&(kU%wd2nKeMrKPqb9{&IMGzqs<X37elh{rmA>H{P?~Ke)H}<kR)msM8EeBT`*l
z;w|9X{{RhO^3t0hpNzV{{&R9|?Q%T0cdIqHwUW&0ao|L7bC^4C7byM%*mPI|8X#3D
P00000NkvXXu0mjfa3vHj
literal 0
HcmV?d00001
diff --git a/helm/matita/icons/matita-bulb-low.png b/helm/matita/icons/matita-bulb-low.png
new file mode 100644
index 0000000000000000000000000000000000000000..f97302e4885d652583f9592289b0d459e1356fce
GIT binary patch
literal 1072
zcmV-01kd}4P)<h;3K|Lk000e1NJLTq000yK000yS1^@s6jfou%00006VoOIv0RI60
z0RN!9r;`8x010qNS#tmY3ljhU3ljkVnw%H_000McNliru)dUj@D+|>8vW)-$1HDN^
zK~y-)g;ZN>TvZrd`*LRHOy)3YGD(`G(Ns#4Xwq0RNwi`S`%-*RAB6r41z*({@j*lo
zY7x;FL8(o>A|j^JO08O26&&=TnxxfSX3}IXXXcza*S$X<TGMfy=m#72e)tyaTi@D?
zp+gP#r*av~dgA`WbH~CknoJnR9>;ZyLEsmP#kC7J{wRL#da40HwfC|%AePJZ9T>m&
z&<l@0d17LA?r2j8vqr?jO2v+C`)1D%S1(u}o_*)XrKRhqYK`c30C6jZXnkZea&&5X
z=9L#;IysP^ebCHivli#ljbpe{Cdf>8dt+nM;pphylS{u9@*Ab{IRF6w`WN7Ee@e{c
z=bwA#+2=>cC+=gWnb=DNFAP;lYiJ^Z(m)hbG_ZH1nMjJE!cX6rUZ8&_Lijfh-<h4^
zz$1?ypPf3CS5gX}h?a?HO-c^K;D%xFgdw@XIJgG)k3V+8J~%dUES=&bt<v$9iH{zd
zp7j7x2GC%P`JA(KBEbhuQx0b`i6P4}`ctOpg3t^`vOYCEn>8dKYn@cyVaWOoBgwQT
zD5aB(p^q_^lai-72a}RVjG+-KNdbjn9H~$#iWx(umEjH`5osclQKTWI=77#g$$L2$
zNzN%jL=B?Y;1V^K1OowDE7oos*>YcASy_JIuKkmO7)3@zRiy%HrY(m6BMkgR6f4I^
z?COM4h#8CHKxmCh>y}$J{PwHGPkNipM!Ft)q3!!6$M<d9X_joq`*U-<5^vS3wkv`<
zNz$t6^aj4`29aKBHTaI0bvJI*D(j4MF+DMvk9`(J)!Np88%LW#9M^-W+NVviMk(Q=
z8ugrh>-GH~EWH0}!;P;3cWm<yV_Rvyy0Ly^CY`bdhx$j1$alKppgwG{W?vLVIS%H+
z)#)!5PVf6@;ob9VCHrjvPDf({K*NojO#2tFT>g64wTllQ$xn<+@Lr+)oC&9^x^Zpr
z)N60BPd`5U-g>EWQYqSM|If00OT}&9&UGhV-r8K5zh@si2-yv%@++Kr8Kvt5<I=_R
zh2l;3j3$&ig#+)DHrur@ure7(Z~?{%j6x_K0Zf8(?(17$jXL#8>{5Grx?M#aq3^--
z6+G{j?m}>l|ES#nNh#*IUI4}g{J=*LgeX@X?FY)c9a$Y2id_Jinbcx!b@iz(tCyF{
zCHCFr0)6)7mD;uC?Kg?=3jnWU<8IWgE}0U7AD){(@^m)a{m|m#x$nckKjQ`J5`c1h
qu>LP#%hLJ*i~%U#J}!V=b^Hr?bl%|m6rzLx0000<MNUMnLSTXmVD;z#
literal 0
HcmV?d00001
diff --git a/helm/matita/icons/matita-bulb-medium.png b/helm/matita/icons/matita-bulb-medium.png
new file mode 100644
index 0000000000000000000000000000000000000000..d3d449f934effbeddccd6155c9a34b9574acda7a
GIT binary patch
literal 1272
zcmV<U1PA+xP)<h;3K|Lk000e1NJLTq000yK000yS1^@s6jfou%00006VoOIv0RI60
z0RN!9r;`8x010qNS#tmY3ljhU3ljkVnw%H_000McNliru)dUj@DmZdC;@SWJ1cgaN
zK~y-)J<Q9G9Mu)a@!z?Rdh}zayJyVIG@gO66~_rdiikiF8y4)c&W^tl33dpCKtKXQ
z!Lpq=#>QqI_B^_$r@E`UZryv%VPmoQ>bv`pe)W%!z+8a49KIYQh2Cn-H%{jK$4JA2
zHewt@@MO(8_cSYP_iTU5JuC}9Hx5g1Sc17Cpa#%5z~(Tf1lfVcFj%zi&Ere+?$+*|
z$!NSS#uXh>yG~5ng=RFHpa1Rt^XGd9JNm<o4Lo+rEfI162|#j?&Vzgbm|@l0o4;Q2
z`+vCmZa*tGttm!@QkK+sHL+z|pLf$dPi1eo|LD<A{d}J;H~X%2mLh-%qG*r;AvRWo
z2d4}B*MnPcm-%4Z+Wu~ieA}ShHSiNM<&L+TZ<J=R>qZ;Hb~@ePc<{V_ujzDC$>y+G
zt~Se@s#+q+X7g%N3=Uo!3^s^*+Yagz%9}*RE)h8=?YYqU#9C#5gHET+C#R=}mrH%v
z8y1zdh@{*(^20(^%9o4z{@&q8Ni_jb^rnV3?^^f`0{|u)sc>LTwNf^)6qa#vW7=D`
zr#l?OGYbMBaNt%6sxijGk|6~E0pR);rmz4k0Kj@7KLC*d(keiLaBP*^&Z~HkkU~`*
z@_~nlgRP-t4P0Lp1jH4Qb_U1*0N_ZFU?4H6M1`>cSt9EJTUumU214c#ss@UpurgoQ
zS2z3pp`mi3Sf8^j{!6BR0Kh=Q8R_zu1dXbOL?N0|5{GVSxM>mEHGs8)a0JlqZDmJK
z&o15>P4+;sPEZRp#|HIrg7w5*<A9_Z=RxC=MaZ+D-I)xpY~}?d0u^-tB8&;+jqJi-
zEFK&mKmGH;;B^MiMLBsx!cbv}HECL|0FEgH^XSpj!lv1`TbtuE<1GVGAxR9ZV~~lE
zR2@$H50tX%YIb3mjp5izyEw|a>t|W0XO`pI#5TBJkIsw5{Kb=7ubF$L3D+dN2J!@Q
z(Ls0(1>g!d?CII<t?}1SUYx(Ts1}F&H}`rHYEo+e30SpZ{P@Yy61=+ims_Ln#{-@_
z#1)b>Flh~!M*}h~e31aD0kiU2o!*+-Z)WFD7hbQZH|WEAg=mYb>$y2OJw2UH?7z20
z#Y<Q818g23+(5b-an(4uJVH_p6$XchZm!OSwpoV-+~9SX0wM`fEkZK7YNZj5*Cbs9
zQwI1v0@{JQ077RVT@6hua9U#f?|qQ3v^jer>aLl3=)@ziLmLe`v8Y>#ZHOzCxCF1S
zLDazK5k6;tItP^i5eATuR&&Hv3sE1FsahrwIfTdvQE^qZx@=-Cf~9h-0NX*C0d%l7
zfif`=X`u)JS}g9LKw?Eem70t1KK|s3^vlsqUtHGs@!_$4`R)H|Px52G^fO0Tf>Q$y
zH3$JJ0oFv)&p!AQ00+Rox&>e_u4De`zvg#Nnw@{TV&m<f|9|iP8(Z}GhwqGkdh7PE
z8s?@Y)d*(<#xk5|2zR8PeQ^5~^gH${(<L$AJg6rBdA2@0*ePar_p+C7?v_niSSAAo
iYXpH|D8V{`xB44tEYEdbHPoX30000<MNUMnLSTY-h)zxb
literal 0
HcmV?d00001
diff --git a/helm/matita/icons/matita-folder.png b/helm/matita/icons/matita-folder.png
new file mode 100644
index 0000000000000000000000000000000000000000..ec0cc0839a93d4aa6ac9b015b2441998dfc59591
GIT binary patch
literal 706
zcmV;z0zLhSP)<h;3K|Lk000e1NJLTq000;O000;W1^@s6;CDUv00006VoOIv0RI60
z0RN!9r;`8x0(VJ7K~#9!-Ilv<6G0S)zm1(ciV)N&Z-9gp<sA?Ob>IO)ML|uO5>e0~
zK}8TEN=E@oLjybjR8UX>L5YHLacqa!bN)jyv+Hr}+>mG(>1e&H+4G(MTxJdb&6=5+
zSpfV5yE!&KRy(iXBKz$RAKf3i>C5M@JbAoAF;d)c`J3|qM)I4>moCz7?bB{HXzlOO
zZ0yl!>@quhg~dC!arx_0ROWVlsDhvC>o|Zr?%;CdqQ)rHic=$QHe0k>2fSE*1yIxn
zHte?}%^iT9od&BbYkyta0YIyL&<9vuS!4P6Q|9NdA&FpyyW>)Il{=Df7l)nS{P@1k
zt%b!wz`eUm0};GjdB)t_RW>%iAvwVUl8^~Wn1sv-!H^l<5ZK!KHC(~RPal|^oC0?g
z3xMNnZ*O9G<nm~qEY+-Bl7<7u$0yj`+rZs1Go&OvMH-){dlPc?sR?Gt;@)FxP)2GN
z9jXK+XC<Iak4d;i=Vl^Uz(P14&<)+pQ3SYq%(Y5jPeG~FLWqD6=yW?L06IMYUOFmM
zb|f8gq!M75MGL_O0M!I_I-Tf9S$<uFOi={Hwye4-rN|T^rQdpTUhmZ)^ioiPq5@Y>
ziOCZns<0r;W0BpfB9GRS^9utCEIC$xajRM=SCFMp5t`O?9jF0Q<&zLXR?HqCe_4uY
z^E`kM0eIgWOw`kfI+_DwpL=goj{wWa%XY35;?zb)NTXM!NWdY$yZ3KtwVNr|>L0W!
zWrn9H<7CGfiG%DEMZw0#RuymANz=fCbDZ^Ou_a)pNL^F|#<FXXS^o7a&hT}#6!{_0
oErx6;{_^NA-}CJ1|NPIyA83&HXca*ZnE(I)07*qoM6N<$f+puf>Hq)$
literal 0
HcmV?d00001
diff --git a/helm/matita/icons/matita-object.png b/helm/matita/icons/matita-object.png
new file mode 100644
index 0000000000000000000000000000000000000000..fe89a30e81ef3c6651b4256010395eed9caa9159
GIT binary patch
literal 893
zcmV-@1A_dCP)<h;3K|Lk000e1NJLTq000;O000;W1^@s6;CDUv00006VoOIv0RI60
z0RN!9r;`8x12RcOK~#9!t(MJi8&wp=e{bv%Cj{4}P!*|dDBVQe@g+qn5{g)~X-XUD
zCP)P-e?uT_`UPEfUo{K<fg(|aBa|gO5KYP=s}RwTblS+^G=LJ@Gk))07V|ugUB^j9
zpLO+~#xv*KbMCuu2A;#1n3xE5bKfU`K0{Q1fAjgg4h;?I<mBWskORzi1iHAmsFg}Z
zcN$R?X%y8oifX#Lx~gFq>cYZ;4h{~6z$-vUMY{rTlGJp4{fXYX^_`YVB~?`|7K=JO
zJnVpcgQSJ2udi=g|5P=dMZ~XRb90m4-d+GkMn;&LnhJV)daeO|fXVJu7*+Kl7!#l>
zcrLQpEOA_?P$;xN_C8PmV$+JH9f5D&{1#Qk7~_>B_nkdE&i(uMc=Yfgzs}#r0FT2J
zuFrfE0v`YmvfVOP1y$kPxsO{3R53w797PNa3~==58|>ZpGUalaCu@HJya;4ES|s99
z;09SP*SR+T{Jl<LPd=$%e?M_lW6w)DfW2J^n!q$>KPr_CRFZ42A2~uMlL0bRs}*cL
z=Fq`|^fx!k)4M1o@F6OQ2wz>f0>BraPbb$@SYG~}IF5+oh`1i7&%btHe`9Gn6F7$x
zhjR{b3E1)Xj&u3)C5p4NOizE=OhAM<s^P37lkL1AJ1S@ZTW7J>^7dPAa`MCpR#sM6
zT3Vu7ts){=YY`EGz@)vgBSEK8E|-~`o8$1|LwtJveA-yM8Bgi5&Nd6{i~PskyWE(W
z;iK_!&YbxW=N#77)2>z#)c>5g?g|p`9nRWhEy9Hh7b%tg<m%P0v9^wLmUrGAMn%Ab
zI+p~xg97oO&GSc@pI-pr)%^!rlkvdK=G0wS<fU)z?8o5)6vbc?BfK>Yg|cN=Nt;D2
z1aTav8Q}pj@cj=(42ILEPcb|DBdUqQ(b1EMO^sTpqTMXo*x2wsDwrhuAP5*cHHtCG
zRva4}MMN;ZUaIQn=GnDvk;5<q6;vga-fqFxCfoXsP=Ahz==KVJ`S~aMUoeT+>9K4O
zO)^&B|H*$Q^}7KoD$L*cEiGSreLs7~mwvan2pj`)rcKR0A3gu`OQsI20c-yOdfwOL
Tclo~_00000NkvXXu0mjf+{>YP
literal 0
HcmV?d00001
diff --git a/helm/matita/icons/matita-theory.png b/helm/matita/icons/matita-theory.png
new file mode 100644
index 0000000000000000000000000000000000000000..389152ef306f55bf5322ad4102da6526e33e2f79
GIT binary patch
literal 1287
zcmV+i1^D`jP)<h;3K|Lk000e1NJLTq000*N000;W1^@s65qxHK00006VoOIv0RI60
z0RN!9r;`8x1iVQ^K~#9!m6cm;6lE00f4e)ov)k>`cH5LoX(LOkA`mekloD!`3Q_C>
z@IXKxOh^+n8hL4e2x_93Xp9<Oj4>uwR3eGKXca*dASn{kDv?Sph1%P8d)xbEZr{xM
z(AnBTQTQh(GY|9qzW<!>obSN=aseBG^FaPCA_hc(Ffafd03^p9;7iIXtHW;}Z)0>a
zMov-CbPZM2(RB??)6jJNwnZMdM0#SFOXq&d$H)3NNq2y^wX_~X(RDQ4V0bKws;a1}
zief*7FaU5%(hOKP1ZHd$NpcBbk#in!uqaU0w0v0&sZ5UWcofq#5q6k%6l4g2Aq08y
zD5)rkc!bH3zWsnQAN-RY&+P{wtEkgZVPFb@DFi|Y@_B3S0Xe5J!q5o@{1)&j@b|6o
zGGJ%pmTg2P6GSExwrgvS^MY(9Zns1#Izeps8c%I)az47D9w2lp{GDfCI808_$mVhg
z+o?G#EbCvmWr4%tK$2VtL#N2?%y(YC#GXBS0g7kCOM#ZnPi(ak=^SHI$(j6$SutOQ
zq@v@*!#%8Bvr?_9uI9@VpHKhUtna#7THhqA=uSmZXYxD8xhZagOD-3NF!9T7Qpu!m
z<%*Sbb#(#+3#GUW2(8~x&s0Jqn#|0pj61oOBo}HXPJHMp+nXBk$!<PtzXTwFc)|Hw
zEeDR0(;Q61Q)s$@Wm%YZSa#ehuk0b4$q*>=kWR#?xv!4ii{Bf-7ll&v1A7<Oga$NS
z$Iy-cJ;;L8be!bqbwV{&EUm8QbZ5V&q~khp78sC#BdrGy@>u=4nxv{xy|5G^1cqTC
zOhGQEFd0u`nRA^hs!n)l0CU_=d9a+Snh+m-eAo$`0+K*ja(KMEHf?F<l|!#NRaN6&
zB<HiNUA>ycl|fE-4UtR54cqk~kd=ykzPg^?UMgG}%4<r*pWWS3I2=Z|FD6-*sjaQ$
z@EgY{D-GgsI*?^AvMl5Gx;gXnFJv<remikow_T@!2%t;(yv4{^jD?j!?tfr~)ZN`p
z*W)4n8k-<5ECOzc7n3=5Zr?^Gr_8wip}ie{poHF@Yurrxm>M0-7jg|`fV^|j!bPY`
zj$qvedZI3F_7C8eJv>yqoK>M}ULFxV)7;G9;2?=ulte5_Y-*B*hK-!-xJ)RtoZru$
zRLNT>fmFdYfOMm;_sJXYzkXKo6vfsx?eaLluU0H|7$p^?A|s^bB>VQigyi)id)$-+
zil^_1_daCp>N*qyrXoWQ;LL2-g^4o^v{|MxIMVk=nPrNa=RHZMHqb|EJi<3=k9Bjx
z(9U#p89$!ybh|xnihME+_3P=qeuG1=9u?VS^ef;B&||{^C`=-^UGEEkj&C0+4@Oke
zS0TF`yRSqIKn2V-jm>hPq+ALH%aJ@@Q!~-p+uoJ)rm+vW3S0+fO0LlU29U6K?YI!r
zc05?@%#Y^`tFFkE=*yWsz^N-2zFQA$04f2?Zu1X-xII7T%)a?%=;l?$(uvml7L?>H
z%kyxlS8ljCmH>9!IrRe-fX`m90R6y-ZSp@Q0b^GitJEbPhyH8Bk_<2fJZ%pXFHmf!
xaDn~qzU$6&z(HUX_*$Ay*Abuz2;55t{{!UdqH-zUjSBz(002ovPDHLkV1jP)TPOek
literal 0
HcmV?d00001
diff --git a/helm/matita/icons/matita.png b/helm/matita/icons/matita.png
new file mode 100644
index 0000000000000000000000000000000000000000..342bcb44c8e314b1be4b0e2272267d43b7215717
GIT binary patch
literal 17605
zcmb{aXIPU<*9HtnQ9uD3D!r&Q(a@#$9;pg~5Q+$)hu%AiAW97wq>CU3QY1h^2SEW7
ziUg$>5ouDT7lC&!_WgW6zF+T;cOS=n>@e4qH8X2gInQ<PXnkD`y0gq@VK5jSLR0lV
z40d7~20N)sO$l0}DLBaBU#C2k5r)*@pCD?R=iu*)UTP1$3|wu!e62iCFauW`2RHD)
z<SB-4Fc>Ecp{iu)m$5YFAC$b=uzlp)a_MA8V_g_(LP<%@nWd-KRIT~li#H|CRZC-s
z0fd6HRl~!5>kIQGZw8G<_BR^OKl<?g&D+K5%XtF&hN@TZ-D~BKgr8DAb*<*8TBOxR
zWZ!IHvjID>{`WOiDwpU0uZqZue@_(xc7gRYCWNa{`Myr)v?pSUw)-?pac;D*)`~SW
z^^uDh4Azp{kSCZdoqUVyj_@7M1l^qZ6R>8U6ixoS>vDF8KPxS_6?LgmFeP`R$ccf@
z-kUI3SnaJ%<iH(F5qFjN9Znd`YAxb^)SAkSItBTbkQ@wV9Hd2#x$WxNNdHu_I5w|<
z+dT27lO7_CZ$2WO;>3`>eE<wrYA;ZjK7Y;3O_TfzQ<`FUef|~(k1)M9f5p=pf$2{C
ze&f?DiMwH8?KTYdl!yOduYZSTag&}qB*QqB_3U^{{{Rf;cPfV#7N&85`2Xr>)KI6H
z3PJ_N##0tsEZS9x{jN;DhoItOD?adjny1$pW1>NUpy1j}yyIlEY=qOL4CR_xYs}lM
z%08c)j|sTzcyr-$SfbX;>IID9t6v^w{VUCl!=!ryAtzytb|T4vTKqnKOzB*i-BVi(
zcWc$j#@w+9-v54TFTL70j}Szp@h+Shp-a(Z=AOTgV7OVAs;3#C)o*olh`e7o*6Ocn
zjCjgTSJXg@-F!@n_Kk~M&{otCI5O_1Avka9`y6GLcatW?RXog$__K)t7pb|(hW)#x
z=>rzmIT*C0Z+;Ntsx|x?aH4b4YW<_q5XVc25v>obGmh66BtIQhy2l-04$bdJvCe!|
z^+fn~jJIzj=bgs2jIE^ItwoT7OsI~0_qGMbP><sj+WF6SX01%uvW9MP{u~^@QsTy6
z)#{Q3Z8BZf%}qX~^{n(en1oKqaG{ec)ya<$+qLV~yV(QEHQ~hyX%y$W4X!yTUlo1V
zr`j(#dXdVmG;zby<ItS0?hB>+yUwV4i_jW<$7^tB>kGW{l8h&X&Xg}czvF-VsQQuu
zkLAp+CwHB5<>YLY7L`fUHqGyU>ks~+Uac!w2>IPijzR>CJoCSva)iCYyj!i*AK*l=
z9p@@^%@VE4smRlqZs3e-(C++ehnx-{T5tGGPmEeO+bWjDvQ4(FW6e|a&^!L?y=q1d
z4|xksXV{}2=pMcCIlCWeaT;@|LLT$*)!O)qYq74xS<a4`k*6?i!*Yhq6gCGQmbVv{
zu9Z35aH!4WxOv1N3-j>JDfVS+M>yK}U7a|yE^zM)Zv1YIhAn&42X48HX>{$~0F`Ab
z4^<6>mJK>_@k$q}f%!<4EOxOY?4~g(An*u|Aly7sl)vT_k2S~PNm5y}2fNA-(>=J%
zBAK$LG%(|dV!TgR8Xl6bOA*Q+=2LbI2kh9kdTRDx{i~-bJ+Z;5_&oF0{CQ%?57lRR
zT{xpyHGynRX`?`?S3kv1<M17EO=2lOIty$S8VM1?$w;k$d;O(C7OUCP6~gyLo^qEY
zSDi0m80A`k7ZK>-P2t79k|7WFg<B?_h>J)2x(I@_SSy?uoZEf|vwU}Tm%tS)F&mAM
znQsnm<4@jj#e~3bF^ZNyAg^OA61>eK(r%}i<cj97xhi6}rx8{()3z8aQ6~I0B9rSt
zo9v1SI=F=~>W~R%{mWvquTod?tXN_05(O#JBwgfR<H5P^RV8);9I>`*jq^FPmQ=wd
zSJ;_FL9{^!N$HV&c%#lf5h^hdNT@pJA2F|VsoLQFy(c|{lplX&YGicPOB446U4}IS
z)J};!x^IjqyA{mon&ka2V%?_UId6jKh5Y=Wf?~Rh9`1(yx^uT|(EjyWWIJ5{%2sg$
zEoK8f?eqCv1y``S5v)D!R$-tny;dE!+>QCF;doz!G}pp;E|GO^-1v*`%`ZcDFyo}Z
z_@O_13v>1qY}G5dpgmNpU;0qwhukTLXT>GItp_Z>9M&nOHU(4d3~`!-Mit`GQk+f;
z3;x8zC5Ii&XxxMX9GAVOZ-QJy1@4Cuhy8L8k)rsd4d-*D!o&^z(cps~*5zE&evX!R
zxN)YA&yNrsGm`7Km;`QE0v&3wn{9kqrnT2tJoUtG?;*EA;xvwTrl#IZyVFBmK_RvK
z{;%xzxP#>N$?Y2fnSu+ep9(|lvXVE?WuMvRN&PAqU$&CWN6>e<?VyDvjNF))AufHb
zRU}(Wbu!mAI)5yls<CAeVVD&vvuSwU!Tq`^VO?X7KY3H&8Jm(B|AJeAoO4E5I8H&R
zMU^EbyD-|MTa$03rzdCh9$Dk=VcpuhJPyY6ZV{Ek;Go==kGi`Bm_5|r0~%CSK@&fL
zH=h}ykX$KB8u2bUAn22wxh>i=I)F7<yn$kq;$@)X8Y^849lvhE@>Xj88e(9^pW_uK
zM4&JwZ{KF6wxplf<UnE3uh}n<_tm14J+Ufex2IGm`SpN!WEbL_%C0jiL}-oKgyqKQ
z`+s@_Uu`l+MSYhEZk(sdoP3&Td?q391J{8(3B|pZpZ7y*v^0~Bq&t(28*l4rH^6mk
z`ZQ$>spVBsY@hM_+Hf~SJ8BA-_4F4ZN;q79EBxrbEsMni(y-=&{LnUjY)Wc$CJ52g
zwHmlh45%CK-mG2std2Fv8CC6fxm+WC)2Zp(U!0MK<THKs1ar;>ZQbY$tao#q*+fnS
zl2ch~4rv+Rxw;?1v(TaMGtB!z*skKv7KaTRy-em=6C`G&;pHa{snNDV{YH(NraK{q
z<V_Ddl}d4e+Y~}M;l)eVnCZ`YsD_fIE8*1BZzQI*W#2ExD`gg%n}i%)VG8O&n1oM#
zF4Y|Bz9m(WGcbgUv(9`OjPnunbRxN>i9GpZ#I10*Ukk(T?vB;IKs@nLIr@B{U5c5q
zKxVe)ULD2uEh$k~fspG?A9kJD61`H3`xa`R<;QUH8?F&b;ya}KG6(SAc$0&d6Y_3)
zY%!3Q6OaOS1h-<0x6#!kQ^cM{9N{1}FCLx2O^-IWVE-BEjuTJNw#hH1xa3clv*@Xi
zP*t9sv^MrareDcK@Op;rY-i0*Rx!M{ViS{hg!jj4`^`)K2{R8#`@P<tJVE(d*C8j2
z^?_h<PQ79c+QFF|k764Zo#XlKmTv7ab6Y00V>1jMW*n?WUgfgff0@@R(2Xg~$*20L
z#i+6ykvE?o)j^gviRz)PT_%?J9~Kl_W9mv?=6TZIW^lV-<oT}0+v)jjRDd&84~;dS
z!u5HBJ{6m<Ut@dgfA6unc$&^+@!5Z+e(R2qKZ+Jn2+kj&MrBJEcb@N_ywan!7X@M%
z3~4vjGO>oRDJW8D)_ik`iw?0?H9N-2rNxlO-Yfu&p#m{|LFN8#?EDEcG0CWre_dNQ
zMKlc5zvb<*csUw(2Hi1OgMSI;)y@erB_9dPsbc%Tjs?5u{CT^0{<FJw{~1+n`}e<D
zT45otin+D==M5U{pPx)dh3_hfeAFBtB?!DyNM&zU`x?iZOr$ii3lp)b#K}bP|D^hw
zwx%Q%NV^+!$~G8xxm14(+02%F<TFCl$Yyo1UQ@#sntz1xdh4z2!b^1%GqtqOKPvbb
zu_j;Rd)uZ?_SQU2pGq}fO6!BPv(xJ~nWg8b(`+=pNdNqEIrSEHv-H8E2=3$*Vqm+2
zj$Jv}8kTfzP5arJ&9hlos!8(oud@xc;foKaeNHL%oF&n}oH)5${cm7#{goD9`os1I
ze7BOrIqz=y&i&AD?An0&(5Uc*UR$W{2wB4wC#ggr1j>AFIcHyQ=*4v3`DoTmr;`+P
znD@cJCcoiiHS<l{oO)BE^^GJ{K9$f<&2t3z{bHdn7<Lc;)Ub47Qc&Y7&~xUhNgWU6
zT}I{I?0l+@a1Oiffm!gZmUv%SlB6FhTrm79K1bYQJn2F`iX6BvsXXLLHL-JleEgvK
zW=+J}5MD2F^bz7{=GPjGev5avejsg)^Yn%gAp*DUoG39cAqh{>XSdqF9DRi-jWYi^
z&QI}+%ZWH!C#@C`ZFB?f7JQcKlw9)pubnp!)+PxI7kzGm2ri`~b7FG;@;BpYhf@c;
zCpNihrpNC#)+LXWrfihCXMafC2&AYO6qpP3vXJX~$iD*aHQ~HxwT>2I;$vWfq(b7x
zt*DgA2eYZ{u+ou?-|MH>+EQP?;Of#|-8JS4UR=8!M;*WyxcRW8aL3(NW-+l+IBG<y
zCd;>|rJ>4OuaBbHyRiGz^s|b$2ZqrS_<t37lmb1!p1+C06|OJNw8o2$aHl-2H@i9S
zQAd?nRre+It0T2i0!e->!ehtTXl+TRtxihwWG44m($DpD?uIvE&g)8if$<Zz_;p`<
zL>wW|tpDrK(l^!q5o<lZ^=$YEMZ<58jFq72wR16Jb`uUZ>j$5hK45}E5;`+WE6a<U
z)>Z9n_Y;c^)-Ms|e-gry{z-UBu&gX(6VXr01aPK4jr;d4_~y|F1%sJT79{rp4{7?h
zhk9|)^d%wz@h5H8g9VCUKb-C8FZY*B{Jq{~mU+D)#UQBb^HA?ut}g6`;F-p)<l+hV
zO-@(KeMEFId=Xdk*)?YtZ$fk#&$VqUp0Y+stQX+6J4~CpJa)@dbTE4}A3I$z%PCdy
ze&VDLSg+K)6&wFL{+gqHHwqK<^^x`sw&|^-k$dC@oG$aFz)+Wreet1*F%GkbKKv55
z{+eZ{vGRvk*eumx?E8~2dv&rsM|VX?_kPG3DK&9T5Zbz|TJuzg6mnjV3tb!0-%{4H
zC|l&1C2)=L6{;)+S7ODq$&!es1To>4(*%t7>b}|2-O9YCyUc~(%Q9YakMV!FVmMn}
z-1L2X0Jt%{cE7q~1FGulV*~|CF3y(}u(-J85~nbG!sJA{Kt|oyfN&8#qg&cumM@+E
z`C|}UzIJ<`#f<s>npt+3qJME8mHuuz@7mGeYZChUaokQ*VmP9)=ePd=MF|iwl~zR9
zKE_#PmtNGm|DseEsx(FLQjoyNjpVV+S=vO>HN-8h147;eVy_9Oykl)rwzFQd0++6s
zupN+HS<w0sYPA}GjW^+0?(*zDi&(H}pgVZ9gvu)RPN>6Ga}@ZN?3!byvC{RUUX(X?
ztwo4G&7vz`d1-&0^`4sZnRu|~>ubxsb2xr;W^?%B*ONIwqUhJ-0b=0LS|;xt5f;yU
z9@MJBja>MUniqVo(`sP)P2RG*=t{Xi6R%B`oy=yHf18<Ljmx)`!fb96m#WUJKtedC
z2`)PkK7EBaTqa?Bo`3gf(m~4iY@ZP(OSgP6l<%*)Ioe=!MkLCXuIdu%s68|;TFKgm
zh3J~fR1vo@-AVs<)1+Hiy{3f1dvERCCD#wD$rL1y$Hry8tgl5=UM3;`#_5%hGMy8U
zpr=XpD|H;&Ki6`>WW`Yy(;h6AQdM^k*S=PncXKz^q({?a#hwc}V{0;Ui|an0Q(&wr
z0h#}EaeR)6n|OG>spP+fkAy^R*}9VdG00?Vy(OfRcgra}e|r{UywDgEE!KzQ!9xl*
z4(9oz134r9CV!fHuDa{Km^LCw^Wtw7ik}@V`4=xdrbo{9vd#VCh_LLLIt(C6XId8>
zk$7Lp@`-xmi(}z>?;duK+&#)T^ms9H#MQ%eu|Rd`XfoX*J^{^FCL(GpS2&I*Zm#*n
zRmd(j->xx>)7&#nGdXft7qR@hoI@NuD);X;6V!EiUUTz{hu&9HhAijwBp#eNk$I-s
zj1I+iUwp{<3eF;idzeEaRUE_95pbyKl|90Jr^|Y#_wJGM^2g#_v^Vir2#t+gcMtzT
z)_GUHiUt^_r1pK`0n^pH%xS;zaIUd8VOf{RXTaISXX$tAXqh0XMs`mH-K}B!)~Mf4
zY0A@T{ZeGa-mMzr>YYJ)cfXs}Ew}1^6MViORYReG{7ewZm`o^ctrJMuNGpzo-8hQU
zW63Dd?mt|avS}z8yWhXJYJsz0jZ4}HD`u!mEuQh0>`CRlSuwHHhs$aYxjmnbJ9HT)
z2Hg9m*Ds@^fc0K`eqN-yi5bK&qGKs_&x+CV<gwWh6T!DBB<VBXW~J9#T3vaCMe@O6
z_R<q;_S1^>KdvKo{>aYk;)@S1jnT&T;rf+qE6O{MKKfG@=;{p_)hr#_4ot&MM(89R
zOtM7TF`iU;JJwkhD9>HPA=kdd4sKlN(>B8t5rnnp>vbye+apWC<-vvEVSJ462q`t(
z+e8eRg`~{NHrO;2c~70OiuE}EStj`)ToYrSKP#!iW7;w7J5a(q#Efv79$!|_;V$X+
z98WygWyI;E;LFRgFa;93K*Fz;;(r`{UMY?y$lTeAtiAL8-EMa5q;s+0MKoU`?k?~x
zJYw~6X0>T=B+%Kg;oVE<*12lyuQ|yXHwwJk$fsMEtWh%jyonpfdHzB8lodCfrk~Ao
zxxMgQzsBY3(UFYo#ATC(#HFBmk`0=H{Nqzi*{cJ=1U;g3M!tDe&OzcO4vA|?FAYXK
zPu-2ig+4li+V@KN;pNL;mpz|QyeZy<m9t`45HVReSd%*WFt*qm*_0^iYGMv|TKH~A
z_4s)cYw~9Qg5ax=DUmv{SKdX$JH(^Y537ndS3|K?$P|XS@(JU92T9+X71^$YVuoCo
z$~_kx{&n~4_D)3cL6d7jAnzex!sf}{6=E>*g`-K`{DD#TV#}~j{~23(l3P|h>cEmw
z<~7Ye`WnL$YKh9fv6w-=#OBW6S~ZDRy5e17(pePx-mW0d=V*?9At4+6z&G<JLzO2w
zrAl`lZL;t{!Oc(ptEpgcR<XH4?f1hG3!{e|n9YbF&1E^;!XP!WgpFK2Lx=SJ`<_37
z8{a4XSUopjvGsM>ZAQmrza3jA>56}WI*3WsVlYu?4KabQQ<xl4xj0>S(wcpVItZpS
zJeZhtG-=|c;%*RJ$jlr-9SHEsOg>{tBk}7Re;syg$SrRAG)PxTM4|OJYryXmC&7L5
zwDNbw4<03IQJBPA|6WsCGE=`uq{b<m=s7;aWnIvgci1)0DJ}_3Ck<QHnHecI`*)#A
zj^gXzZ}d%#Ya21LUk(igDCqyE|1_)7ag7Pi`y(1?dw$)K<2q0y8(@Z+vQEP;oHW)f
zDr_hgl6`5sksxMFzM1Lod^q-75f<hqsX;!Ic_v${GtS!Ztx##AA$*?F)A|Ig<#*3n
zU!?ApHX3d^VR0rHr&qUu<cNqBEo?PUs0!7>2>a<^WlxF_hBZq(8OENmhJ~$Ue0Wqf
z&5mKGhk6xqRzkflQ2#~yM+~{+$OfP<=c9l9Sc7MOJ+H@{fXUCK;4=hbsM1;JV6gqq
z_~}=XcF`J)6fos4FVU$&l(2~Y?BB6?ZK$Qk3%PuAz6=_cV3QB0Z-c?Oe%eCv^}GN*
zoBtknOSo1r>>+p&e6;E6KAwBp{|JE3ra{O?v8a7cF#02+^my)O+gZLk{HPXrLKV#a
z^SOpMkC~<Rnj8=kCZPEP5>gae?W1`Rk|$=8<}@YNKQ)h?5=+A=YpRuYv+(0qK<pod
z2{fisku1P4`=rSk*vfPov5Q1cE*-ItW-u5|*qF>E!SL|)Arb(=EX-+UJN~no1>)%8
z*Q}pBx0Xf<uyABib@ku|Usi?FfPnY%s0kel^Fh^S9+`aKd!fH;gRyOKgrK*-wWPHl
ztP)A<Zp9q>zNm<tcthiRp#g7St{*W+C92YMR@a&&v9~DhHK$L<CjI?4byh{drsL+q
zfF7H)myq0x+1uu|hTPoTj{U`{^Y>)!4*%`eF4rz-$4}NSjS!r^Vz~JQ1<SUpX1dZB
zGCaF`@#vAa*$bmJ6#|Vrk0mrVig7p*^jPf!Fh#z`-()%#@d%0J6Pyf%E!F0AJ^??&
zsSF=Hc=zLjvD3<UL(%*930x(nRWI}-3(9qw!d#sv8qLou{QJlr`tNT*_-JErU{{tL
za({beAP-@O?_v^nez-9u*tny-&|l(-w%|mHp<r1lMN9<O35)HC(9lfIxF2{lvdX^q
z37*!HGx>y{k-QbF)8I#|z5R(Jfq88t&+AFG2oYFM`K_26!+7)um$BNy%1XmaXr}Qm
z(qOX0uhLUE9Ip7J)Z^hwhu(M-0&Usbn-oF<=At1$cro{1pX;%`1Xs(=l?h8E-Z@bf
z87Xm*2#eXB%Z;z}n!m5nD%rm{RFSLHS&Q<!m_ys_?GokwS&hLQbSwZJ&8+!jth-W0
zH5kmj61j#&>Z9~2e@Y5QxPM-qY;_>5-d1J`v#!6~R&GyP<p;l)>Y3XvR-*i_fT_eS
z&QCoAk7Q}Ms`fWVi&pR1#~aBfe#0Ly`p$h*Ixo8#=F)WFLy^SIFo88Lv(Vvdl~iU@
z>?S|^8^a{Jk+~Ao-fWYa18;Q#%!A2#AfpB?hrAgDCG9tGo7}xvEA|{(PHUwzQx7Zb
zdh+3|qM)0@Y2la~K$J^hqWencrXB)OPUq0R$@&=KehSTGp~Oe=d~db&d==O_o0Lc1
z_`nm!W7$uF0q<KSuQ$TWjxTtD8pZjUdaCyE$XYZ#@5W5JtK;YA7b6RlUtb_9Qoo~_
zN)@&HGcs|A5C7VEx6&n5KQbMRP^F&QuqO#c>r*O+33aognRqS|6~ivJ)qq`GR%W8+
zY>`x`M7>t#qd1|=I1+`Yr9Z249>y8k9>>;KY*HcSI$jU-C`X0rV6!ar$82_}E~ni!
zGWLd1nFZQ~F@iFOc4sh(BjmkFg{{MEcjjhGwRL-3gnQOZXDa=HBpG{x_wUx7pDKmp
z`OAalxwf6Jl`f1t0_s$ZjQl{2YSsWp+nFlrJ%T1My}n%yM&(YnMrl1B6UorvqmWM!
zh^g~gDgy5leBFtpW62MvpmOZX*TLA6+^#MppE&=rSX8(2gfS3zb7v~vX`(Us&v4a;
zoHMOfTZ==-+Q-`qy6ydZdcM+m2$$Ej^NEV%dkJCO@e$7LExZ*TA@cKDM7b|`Ch6WJ
zH`W|lKbX~Ga3!ibT%VHmdd$HyJT1_=uoDsG3cc7#F=ZyVdqqOa-wTs$yE71sf#5`S
zuP2{i$fKE};t0~G=g}4tV#28*Ba^`Hlt%FAzO`x6nW->vIdMRKo@hL6AefE<>|5o$
zT;AWQc9z$)KGmx&G!7&;KpYJ|7djWega6mY;yOpx61*dO<zJjWrL!VqlwJ@rWb=pd
z8PxAseabb^z=CG-xse>sdZ8`Bp7fC;ht?)sNL_YVWKormf@u(sP6sA0|HX?J0hTvn
zT9;aA1i!ygdb%+lxPo{Kzo8Hzl5o;0M!OU28&8V_Ds(bJ7^j4cGzUtfUMrM!#|i6F
zGkujJ>C*z3og#<!xsdwd@vj*D8!=YA!y;>Hd^eJ*ttG?pF+sp1Uuj{~&4u6Kh!9Z@
z7m7sMlRBt!VidKmv}MZp_Jh5uGPe47&UE%ZW3b?h#>XsPAX0O+F!GqYeL7u<`W>OK
z{sx>Oq(-CF?vy+#gP#f01D2uYH#FkJWUti6>8o>IXj@I&!Pnb%F)K4UTqLem0gGix
zN)gm!Zi8%|OXIFBMbZiKXpN`$r_&6YV3(p1B0<qYksP#a(#iOk;tRypSLfw-6h9c3
z0YAf1iL%N4wgFS*!MltV`A!5Izq|@BV(5V6?bA~zX$aiD)UleOiHv(#VH^9&;itEH
z`dW9U%maP>M;@noh6t|NXK84vd{-=hb7;wu3#@eL;|c!zg<-R?ABWN!3s@+roqPKd
zGS}_wft}3}<NBti%zv^K604jBiYhC`0)oH1xH4RB9hGR}QvbJY4mrrHoAK@6?mDpU
zf;TEu4Gj(LfkFptkNL)SPu`L7T^6ei%FO}iV|@ob47r}Z_xEnxaUgST#FKzvn_DBU
zABu{K#s^FZE+sO{)hd<;e~jt0XLQum)Eoy&Gv|e6-}$f4@bmM(uy7s1y(@2j4}8j>
z{u1PdS_|}wuc<^brgH!K{WZz)`}=!y*-pRixQq_Yt;I%q6zFEgG?{Lsfm10$5?ua#
z%XvC~FJ`dT`vX?cvNTsCzJK2oJj_ktCM*mJbnghI66Cf9t(osQCWB>B;DJiJ{Z!o8
zdw%hT;r;uMowEeYYgGr}+0x#3Q7BaHB90W(Wng5KKh++;&dOSV!;$CKhQ85cCGf}8
zdCk8CiZTDg*z(6<xiy_O)o<6iZ#m4eejmkMM)|&)5}ZYnCv}|XPUk{53BAMh*`6|n
z4)a>CUT~aMc0KIkKb1Lwq2b;8`!$JobJ(ejDTC5N)gbcXeA?gE^9sf3F125qZNfb5
zNt#jmz%*G$jAcl9zFolHK&L)Z2M^QuLR;7~e2gJAN)kjte}JYlDKo`!#)SU{Ln8Gf
zOQ@|mMJrKU%6zR?BZL#!hD9!2OHO2HVeDW-GyP@0>v(JaF5&}Mu!|4t&S@*!-|_eu
zKRWIP{=%lbE)1nsk+}3lS-3gl(cyN}0HJXc4m9~t%y-!g1R0QX?Y9!YVJFYX8EwsU
zJ;y7m)$HS=aA4t7I4Mk+MQol^o@Zxm=-$P)mgtk83J-+djEjn8oNw7lwadB|6E548
zDI>8b-2V9-K^YN$_eI7;akf24f5s|kDprCy?LyuU1Hu2R1)x4REOPxUH(QdJ=!|F6
zCA3uK{bzrN?6P$jDbD4<Rix<~%h5Gu_N1H&6bV~tRUf$R(!%K0k#J2#%%&q@&U@HH
zQcXD(&w4*m$l~Lp6IQg0>PU6xRWep3LWr{7ZuRG<%ISocbf{quYH*^2UTiB|-izZR
zS}H-@bsWT>@`}iFgdP3T%V;V6>sJ3dMSHktr|hzWu|kxxJdN<9DUKr{30kvPd~Ob;
z6A2EC6K<_^kvyjov_b5c+<N04UmrI3wmGB1_NZrs@K1`$X}7yq@xbM0$V_n>r$+wW
z9I$k?SB4F}fkzqO^h=Y)Zp=uxf8OG2VWbuq_SnfgJG^s%bs({0_+xscW?4aV*r%sd
z8hQ(SKvd2LV0t;eB%$#tCk89pQ=cIn;poFY6*TXV=XVHQYOh2+1^Xxl=KfNfV#haZ
zE4Mjc1vlQR+$v~suv{9L;&8V|V;+7smp+1XjJGG1f=F4FmRamMp7l~{ga~>_4LpZ5
zQ9E6-kVUoIH7nYP3uq};5jx{xT<i5NKM=Qp7hbepH7L{w!b(~l>Siu*<TlL2N>o%{
zV0xMm<pm|=xkl$FcN*ankB=lL6ZvCgd=@nsDc(onS%ZcmJc5w6P1CG-PHj_dv3<A7
z>XjKOG{Nf5Ly`PwDUEb-G;t37r!jaRC`K5^H|$gRi2e+prOAtkzZE_5Bx!3H{<$m3
zslQlQg4X$!)|*2_<us%tHM3b-j1(P1z{z+4^Q&6cv^DHRSrDG-aRyxW+0=-?z(j%E
z#XnksM;tB1=s{;N>;cX<EZv^;DcK1etP==gK!lMcMER3?*kkoKeO`_W30xWU=5?q!
z=Rm(CJ-#R$l#<j(;8}0)M%vpCd(;YrOg>|vwuY7F!l|?xb66*^6u#Pv+O2+_uZ4kX
zT<}>Wu(JA`vUf%<!yW4BwjD+TR~kU_v-%7~6J#t!OB~RH4aH7x%Q9qK#9z-IIp`zZ
zu!qp#m8?*Vq0xT1Ae4?Z_W%hV8S`<Z=n+1LtTb$kS+~)G4Xi+ht~XvUOSaJ1GWf?&
zv5se%pXNW{Sy|d%y?W){s19b!JwZYF4IA9ut-qy))MaP`t_Gw$J4VjP!!?qi14-W6
z*FFFbw_|Ptrc_+)8VneSMOU9F-0ZMNk&ygK{W{oSxC(MhkoROCJz5H=V7WDw6)mTm
zJ?U^-m5<kvM92D2S9!k0@9(cK5yD~3x$ylY16O!E0o5KK-QYge7Spl=?4EbPWtdPL
zeo;^N8O{kUb*YVpL4Ygf1SchWC^Tb~n$+tJC7OBa$Sn?DmEGz;9P~0PP{OA;0~Y$V
zv3xhQKNaM1{>K?7P6N5cP@p1p4=K<wa}LBb7;Y^fr)D^Qk%P|sVOuu0PSSTJBcy!t
z*H~bx-!oVSm0MiUx<62Az6rv8$jRW(orNihJ!*!T`%OLz*k2-Wo1kl4CmKOud)+0%
zBM;tF+#oOZLjv6Sqox|qS;wEv;h19lzkZ}^p+jFj=q5`z7tU1YQp49Pkr$9&>oibm
zinEEntEF|u2G*gJ2iK@y@0Ot~P!e$wLluS~<K8k+gvo#?y3nA&(A3n?hx7Z?%-8FW
zM{ryY^W=A8)-X3j5OTc6v*43M!t?YT)+TPeZl?5uSr)J}w|)>^<Z>7r8#`_O`O#*p
z6ztLv3`Z~^_SD}BRyzK;3qqELy{)AWB}jrJc&h?&)9|vU!&=~S|CdE}gD7yL<3{{@
z;D|wjmjT5iqPCryN3qw|pr9{FPd?fr^iN?yWynFmQ+oe)V0%mC0=G0V{lzA^>aomB
zSsgOh<6qu%iC9wusM!1;Rm=LL!+r1F>6AL5NQIz{UJYjXpz2!R6_<d^JthQ~O!YX{
zLg3@m*}r%im6{b|FqitQ{fI#Ky*B20=Qe@U|L(sa-q|g;Z5GSn%0?=ztu>`O&;Gl-
z(EHctGr1&Rk>sRj?y-;0apJrejC9h)yFLm3Lk;0j%#v<z_O@4C!8-FGx{o}^Rs>RQ
zXdRIHL4kZad#gcznPr)t!hu*ogI>10ta?@Cd5+Sfo%o~Yjkjt*z!b|Q+O}#qu5V<7
zJxpi){aJeYB{w{&QrDYeR|^rESjo4Qp6&PR%!3CHqyYH9nL2T}Md*!h`nRUl4-bsU
z%wat<RdtuOO^!QQk32cZk_qAog`H35omnYh3A#O5azEZ_rOW}NA3F9^>^aExMCqp3
zzAlI1X<^HCz<@&5yWv{4e&a*3$Mi)gQG~f!MxA35a~}K%oEgr)Cc?v+F;sMB-6YCA
z-L?zrf1)|Kd>`J2?IQ6c1MDIc@h6A2Rq~h24GndP)_gcc*giNEJ>*t`wla99hmCo~
z@dN#Ds~@IpEiyIeA}L|pz1W5u5BPX#rjm%FG1g-eKDW_KFxt29K#jNhjjDyM)dkMf
zQ_uUm(xJtKhH(;~BR#lcCX#8aSYHCkZNc~)eKIH0*(vH_5!h=Dq<EP=`K1U*dP9Q8
zyuF9lwwsQEC9cxI-m5{M?)xvbtG7tLeNbV`%+!aS?Ml}GQlxw#Oh5Qwl*+;rahBVh
zd!7m!znlx?zxNlt8!Is`B&oA=nJ7KjeuVub6!!*v0I%LNL(<#Y!kz?sbQL|s+Ve~V
zNZy$XPoJ#O$3m^l=pkCY$YUo1j&i~}Uhe9_Yy9Fly-1uP0iG=%oCY=^urN@T4HSVL
z9EVSq9b`b{L;h8NiiU9pJtQm&^hDxRfrNebq~$d)K7wPvcFN|TD-H6l;~>9*Rmb2L
z+4Z7uTnGF!wD+MK<3JC|Wt~SsX8|&ID27UB;c1rTAcDvVrv1{D<l4BK|H<JAi6KWD
z%)4$+>Rwml(*i?<V)2Wz6Tt5t??Q$ok#qZpD`{eXd^@I_0%oOx^ud-XOEtn3c7G>9
zD>0#mq#DnnKpF?j@5N?L)#>Yg$KJYii%$0xY?3~d^5!s3E{K763Hg{J%prJx>m6LC
zIpzNr-C9TSX_3n$pI(MBsv+^&t|~PT`tl(uV(`v_6aU*ZWIkRB)ba&n;xjlbqmD(h
zZbI$vNGEg8H!hSKD24w>aUj8dHtyg%cd?$c`}!_Jm4%JN6?PlaU>~ClbuPQW+Eh-n
z?#d^>8}=p%qf>K(PK4F%ZOj{#!3Vy7XUyoxK6#M{uDP%v>n*rgl09jcM)kiFfj7dN
zc4yKnr*EI;Ne1gYVn<6UgrE7pJ+ITh|8G6!iU~-zQ4M6b`5R@EBDtrR!JjcX@L2)3
z|J!lR8MFU8=8Sa3NDmUo5bl6$0^9Gl;8Zcegdo6u<l2*lXq-U=aH3gu*u&=}3-SH|
zKB%3|mobYP*76LWk*OF3G%93oz5v>{$gs!ENw)v)HWzLuu$q(c9?l`-)A>^sc0s;!
zy7QELGB>0P{RMg)=0ShI^e$9Re^$Oogr|%D7zo&ov&dEml?Sq#iTf^(&b9yd5wk%O
zwuUqq#9IyD{?iESF%QR_|LuHpc`O~Dq5NLC2Gy6p2OV_G-h$;3Gth1`<M+xYnB{lS
z(`g9Ud<*BjSgQ{i0)KGAuZ%5(C1ZUf1pbrh>I4>eKP{w@rb;SMqM2Uo0u9iL&G@y=
zv6Ya4Rj>tt%IUqcw6{Iu@}e<f#YhQnr-|`qYOI9(o@OA4#Em$8`gEGKcM(XfY@FE<
zrcEIYz}S}ptdlXb^(EvbfaU%0KdjSZ`mVY6j|chftI5D{I{?hEcL4&dfLB4gU3Zo8
znoE#B+_9$PkRP36ot~aflW?`z2mr~R*K*A)bGqHp;Q>D!9&46)%K?*4a-ExL`4!v%
zPW6u4oAT-Srr(#wcG?y0VjLYED?^V$4yFY|g~j8!x?T&bfH=koJolLHNwvNLy#aII
zv3EX8!>PbI_^gbVSRU;SKtc^w*ew84^V}j^()}%PR1QF>A%I<66|^V@_L;Q72SCR3
zasOF1gc0Ak&j`BLS7Zzi9RHxcPiC*ai;-boe^(k4GGxKF%aB|UZ{#|{gD|c4D}V9w
z<&S!QPixUTPW{^G;mUh~Pggko9=N-g4_7(0TPG>ryLT~OE2E-YS_@>yy$b+E{U!Y3
z9>_p#yVCrB3Hz^o<^56TBa;n;cY^T3UoURObY9w*u~xPpxT*2c1sIG!KR%=g)cnTG
zZ3>kk&js@l_ykHTxVN61rWw4%0yDcBs=fHpC7NyT|7RJM`ACi=Zs@_kz-#kqjA{L+
z{1G08Z}CAJbN8OopHSS1Xn@lbg_qf6jGnR5v%q4`1cJ=QnrrwH0BT^%XFb7RQ=bW_
zexP4<Eu+{o(~|HPFE=+|tC-2JcY+iY=4Jxk3J3@2bf?&rrNRT-!JDKAQvylQSgm&s
zAQC)ILLvwr29Y3I!Q&G2*9W_vEN0=ysv7}}!y-8u0Gfn#(u~xil%-BXPw5IC2wb2D
z8PAsQU`;XTr5L@2x~jj$o87x-<#ruLo&B*A44{DKyLB6#s^6^$B-t9WgI+C82>PaS
z{EZg+rvLKS<5%Cnn}5HP8`Q8t)}kyZ=g7%;76?sk7|$-}HUBO}z3gZ``-s*MY`Wrj
z^<M*UszPu;CXm@OQE~zDV@)qJe8_X1nDgEO@@=240-vR-eK+Rpk)@@j&^shSw8=DU
zh8p-j^<)tGeIQ~xc5J>FK7*ajzV}b!fkeA)4~eD{gv<gjY!dh*vnTzayDT{H|0ajl
z_CH=bdf3C;yXsT4hX&tlAsAkp0q#fr^fc}L2prvi#z4t|1b##NvG~W7_YW+LN{4n_
zygXL7-w0+Bhi=9{#1(XlJwDMOqy>oB%D}lg-#B(>BUlhNEqyqEhW7q%sMGI`#NLGv
zQ-U_%NDO2|zAO_K3&1vHI2+-5sUlyFtw;zO%u10a;qW#z+JV#~w+*mLnAuD_)bBSt
zWQ3=We{%un>+$>fvGWC#(HRug7Xk|ZnG)v9?MN!n%NCcs=NN%|dc2Du<ks4~Mru?P
zB+6}tDwOh&Rad%LZ_~yCL&M>yXHQ{${phh74uQ5#v&<w{tBX8b_HA<V1Ny<x1ax2s
z;C+zxy&kl127R=kiTjNk*RGV|r<D=GTz9yV&6OcVlkLaSaF1PgNXpyhhJ(h-6IdxC
z1FV{K11%*Ulbw9o!TIPeUmbLHdjqfW|NgD_KrRGD*+a;<9m72zmUpDYSGULjEyoXF
zbjzmkc|3?0yFk3CkmA*tR}+B)jt}-|911Gu+Rx#qcZ8N%j&o~Ea(M^cPmylU(=gl2
z(8FB_pn5xib|HZ<aFK2jXRD?LP1_mnO_BmFY|Sv}wqCu5&-yh^YqwOV-;V&TpN?BW
zNHS1nncdYz!yRjEYh{)?&(?C`_)$$@x0gmzzIHus^~(Yg-=Iw7HK0`w9=tlfjK?D$
z%pjku^`M;^Jl*^TK%e%#*IR*!s0P^RDG|CUs$^@%b^&Ti5XhlN@P%*Rwj3WlV%Q_R
zSZMt1o>jf2c%-|kip(;XF^liAp%Pk)wt}Y4yN`s#zgNGnqZ6C2n^^>mX(~I(6A)4P
z1z7=i;ii=kjg^eW_De;}<o*9+l{MkAwjivAK*`;P=-vuDy<m`WlxNqfk(b;j@Rnq4
zL_9H{GY%z|tg!dblTF6G1pt-3IchY)79$A+fX_XnVJHIWXk@_}mQBWIZaT%%=-$0V
zz?IDce4&s0PD>|#^5zJ^b>Q$|KX(8)%MW_;yPtomj(hy>xVSXlkUo*l2n^ZF^V5U8
zEPyR~LMW4atCu3+UD~wSkBsCw5#}c4{U;e@JSmG}afyV&o|ITu177ROn^Q57&z}8Z
z?89y^4&^5C>H&J9`5N$b<Pq1V5`csj=I8Sa5e`)Q_iT(A>86!tvp&46^OcZ#QeZaJ
z)D+VANNFR$#3U7XMs|>yX`xW>+G1HCW-$$THTnHT(Xo)ge??_($Xc&L;Epdhg#375
z?C|Z45+(0{dj)yOK*Sk(?f74{MMeB_dvm#_6}CD&8mnmn3(cGegArYIl^Wv$-P&Sf
z!K530y4wKpY)7Fmd4K_N0FU1BN71Xv!g?!^d)2NHZ~XxL9>AWvL6Dt)FIPPkWLrLq
zgE<sb=Tyt$8HJSrhd4vI_8N}F+XFwIv)52qT>KqM4dg&Hdqz*b7vRj0a+}t8pcV_L
z5VcC=3YX3fX;l2KW0}PZ=XeWq^AdoUvSd=h{*~fz_n~+417O>7hdWc7Cu;yjR=ZGI
zCuY@h3PPcK&HvrS+^RcUt~&&9U+4E1<pSnnmqxe|g7vFUh$Is50txT5(;z(O2jG@$
zeBDj&Q`8J%9f<5+8VE#YZV<34oSs8sQ<p)7K1W+nP_~&pNep$~kz8F~IyYe{=rVpA
zio8?bL;GmlmXq83ZcrmW<+q~whpVtEFWe&s-j^)*C#yFXS}UALygLR$21fvOXZih#
z4oY*c7vz?^>^TM~Y=f=$`NwZq^HaEOMh6GiLAseEv>3=1l6Z7PWG}*A&pr~>%~KY@
zqtb9u;Ek!hygCm!M#r(*s>!dg=HS9KcO@mIN+t;a#xJWKDUtQKs}g@;U6VIr#%L1l
ziCOKnD3}#sR~ar}e($?7etcFT|NMAQniNf7*+yJb^|z`adZE%j@f@494e+3D?d8_(
z+EMPs3U^<~?y3*tmZ(u20B$qL*A@m6N%CH51A)q#GNVQ{8CYr#dsD-_TVSszyK}8r
z7tVWB1D_)Qmu6TbEKJ&G@wH3Crja0EPwz>AI02OnQaI|gL7^-O*Q}IQNo+1~bz2uf
zU(QtrMh)QMklVn`21nol(iOzsRt_){*bwBivVoUcP4}`I1@UxKgnNWFG>{2cuqMfX
z4SRK~AQGIg!yRKSbu7~_K1*2rZ6GL;aPBdq1|R`}p!{)8q?ZhWz!?iI&-Lb}30WzB
zYn3z#LLM45`fBp+gVZ6+_;ci60Dmw=3dKqC&wqNo;J*Sq-0>#|jd=DSJAbEI0XO<M
zK04DE5)`<;=7>R|IEC29&s!v0`hjEHf9QTMu~GPuB9sY*C5fDw0@m#r5N!x@Y}xx?
zss_NLm*h_u5)cp&mn;;<LoRF<IDrghM!PRqFa;G1jLf8-$`}NKPs6~OeWb9;Ak>eD
z<gi`<F%&ru5y^Y<CqqOz`qzj@zs9bk{eq+r4;gFhJj{iFpeJybc~CT-MH^<EDe0~Z
zD2)LS6aG0>?ln`a1Nc$y=N0Q3h$EiDlDtEV3r0+#kA<FiV(q0<*^ig$5+7>wd4{o;
zev_yBtWT`I266PCZkd(u#8<Z-7#JALIz_mTUvK|>h+f*XM3{0G^31~@uWosVeFoqq
za7hWpLXFc{<o8-{r;>-|Z*@7>#j8pV`Q{%jwI|{;E-Fhs`qe`K)H<x(>fc76UPbqy
zzm#jV4j+{^u*tPA@U)7Btq(CEM%G}InY}pu4LXBb5P3$J*4mB&+FmD1)&wLFoH3b6
z2H+AX_(1gFxBBP>5=Q+*yTuOxKg<#?8EIk;kKM@MIs(SPsp<bc&OblB(qZh2G56Nq
z9PuEIawk)O#ZGZpEz<l&OHG5IVj2dphfk`E`*)3iew`B<7P)X6y7p@KsqaM(ZnX?r
zia^m`b2+#8&(JGZuJj6JDTFo_efW?IQ1#$zQ_$U+L7M;&;oK&GeZWm;KaX$+Fx(mI
zBa*$Av$E8wWq=rjm9a{BL<pVBvc}l9ndw2{;04X^*z>HCkH8a*R&A*UsZxZy&=>aU
z57{6%R+i#gZrn1x!&iA&H*|?*^=gZx7#R;W{~~+_8a;!$)CRHy-k7J{C~zbyzh^5^
z&Gfi4*5{&_ByU1`a~(9?Zegs#K%;EzNn!ic)}IkjOqzi3N){Xz`56Ov&N;y8^TZ@}
z+`wGdYwQKviPCpQmKGL**C#FmA~cuUd7dhVK6RR_w>e`HHCu9n?ud!e(!QviMy)jP
zg4zrh!0`dg6bf~QJo{``V5#l}ExQ&72|p!#ojq|w6tQGD0xa&eE62f9LfxP(#IbyL
zYCG85?Aw^{^Iq?gpznANK8GR<&J}jtYs8{Q`Q|&ZgOw;wPciF3PCVTAda}ymGSF6{
zPP$iZt@JRKLD0fE;C3?rsR!p?=dp0>By311OMOlga|AdJPLZ+onv<g-7!`-7&C_56
zth+}?FE;!)wRJThv(Ze?J%MZ2Nfl8$2BRlI*+wPm%~dPfK57(1<Bn2WLp2kKN>qe_
zzkdzb+FeGdxIz^eWl#&@2#RX*+fO=!i9t;P)Cj042jKA>CmI{Tc?1IDSX!CMn+pWY
z$jFIIS^xVWddap3T)NZ3n5E8_8^;sNJf99K3vQyBPPnc8Ml^sx0>CMH4P_VGR<Gyg
zm;rEVi(TFs(7sZp58fSIxx(-Ay<?D;VCj>JZQ9N%a&j~@FvtbU=Kx5#wwdVn@85re
zsA3Zn2LO%&w`=I&PzZR?+_!I)<7L;LkB1%|L|Cr$=0=rP|2hklxv;3{F2Fbi^z1Fv
z)Sdx`$Lsa%Pw6-g1sAVfbrt`Eg6uy+dLO-=$Lfq<@#?+@u#x)gTz_e%{7{o61_00e
zT^UjaI&?ji{_D1&IHrAv)nemsJI8`v=w8yiaLoR%mx7g#znq0)wKGlQpu}f$u2+SQ
zS?pV2)hzw_55Pn%{QUG3!V*9r_O7_N6C!=rULEW^ZG6iC0ZK+wu|-Mf(tzHWjF*sf
zJ6nonDQ4n8x4>zj=@k~sY)San%5kU<j+Mjp9WUUyi>TQBnn6ufa!QI5G5Kb|;qL50
zi6}PjD%{i_p#Fcx>ImWU_26K%0h#;&frtjnqFN*Ah8u(H%BLBaks`7sh+OsBfNyW+
zHaluj%~~LU@CI~c5r}lp#OsZ{Rigoj401NZGY%LWXZyRHo)IFLG<nBl=F6r{*AwC8
zCj>RGv;nN-&qPyG<KI}<IZ$qO?<pl6t?pTyD1CJR9Qt(uq@*wMFQoQ;IueCeDn0_?
zN2|z}$@%fj@1|E8+CxY}e}KyeaEoJ$_wi%^xKxj4?<&<<l~ZQAsW!ZZ@tt^OQ#B3B
zw!DSvuQ9iPB8<TcM9o|GkQN{eoG-udC_=d9g}%Be@EyBr)0HU6>q$cFqP8)hGy~9g
zk}vhu)kAcVkx$QY$QR!<$e#lR5}J%{2m9Ltz)_yDKE<9B6LT5Vp1@id--FI=pa_G;
zik3^A?}oJ+(AzYnr<JeqF{~Hc6dfZ(a3aCq`QU(^)&e9nV5m)U;5S&J&U5qwP9Ict
zT?c$LEGMS87n|4(%GtzF#LJ-N(tj<qfR+XaqiaukuEt2Q#hIK)KP&=jG(NKA#AN*M
zse#Bdzx@dfwRJO7gop<Kvy6)$0=`iaaKKk{V(J0mIr%L|B~8{J2M`=U8=bqJoS34D
z-d*oefQoeJ^eAO)F11;=#oPnzBVhGT(ST9h5Vo=C8X^3M68v@Lj$_`vr&Lb8k#wNU
zCj<-17HJvZ^yX^Nw}q)tqXr)j-x;u<Z;SQrhYMOZj&3~cxL`%=2P#xRE%o%PTgGH;
za2TMPpXo=U0cEAcNHMO;*D79#TDcK(!u3Y7)h&RhgIYaJ5ap4N`KsntFzXBaA{>w&
z-@!SZv2NxCEpd2fb}QN)`W)JkUToL3m=mElk|(K$ado;Gk~ttuyVMrebCKwF3O&S@
zXbV!aw@{(YiKA=DlZ?YS&vUGjZ@_JGq1!+>{=I6z0+6HfDtxWN(Zg$iT!q-6)}&pC
zL`H)DYx@P~zS0_Xy0ayg6`Dx(EoiW?b=!LoE0|W=-^)}K;N#OLVd383fh|O`xNs(%
z-~htB2f?EsC^)HdosfS@zpLfU*v|3n!<#pXK+DNvz7r)Np-LB`JQ+qPo2+&iFv~@;
zNc=JEtew7c%jh*bsSjEPg!fK>_Nv#Ri=fV-ZNJivsSX2WoEp%77XVy@)8l@)#<0i&
zcHw0N#O?tz2ZbQQ7lI;0%#@J2u|kxb;1JHBrG#4;6+!J?X%0LaoVjL%ex%cN<m09b
zzaaKd6Wqp!<svzv@!;?pV4lQ4x&Sw?O%|d|xD0A5o|V80&Q7(oDAO?tfxEk)#@Fh7
zT=5!ac7f<-4ssjjJ2uZP{2&w%dAL~7^S#E?t~F^o9*jS)%%nc*z4^m*Z@CUIA0SN9
ziGL*uXjwLD6ywDStYyGFw<R9b$AX{^#W*z!iQ{%Mht?XvF~H@&fgA|XYCw99TqFt+
z1<_LGjG$c~aBYC0{S5@a2R*alYbqP{8Y3Pc|Kriig604oX==HC&k_FjAt+lt@mdj7
z3kpKzx?zY25!p{(P@~_899lg-$M2fCQMA3vDaS0b7B$MREfd_v7lGs644{-Lrj3q8
zdK^n45|2;DvM~dY;8I{3ZouM)>@Nj?TV8Lp1aotMBBo?eAO=|D*&k3Xa0sY4@m#bg
z0i*zAnzb`&PSn=0ET|DvHLZQ24fZcaKav+fIe<je-a7!)Fehj7BqEkY{QF#vO4aIr
zjH_0Pz-A*j&I?>%(S`00W&OYCSl%9^*U=#*z)aKg>VAK5<rbJbT#2u>;@8L;z_6-N
zq^okP%@kl#MG<Bqi|>+1ji27$D!3q^g~;tiVYwH)8%v`mG}fh-0Fpe@R0cvT05e7~
zi#xvud1<w1Mik^CfaQnK;ITU25B2r30f0DJ@-B@s2d)rGt3zCWEsA7lfx2KR4YDc)
z=`@U!#gkjd!!!JuivTSsPqzEDv@k$-oBps@k*tWINdC9IUYW<so$2Ak2g^~lxK{as
z>p+w2g1F<JqQ|B4suDiq>6^+#4-5MVsv6k2&rRKw?t9JqIjBVYz9=CIO#d7V2qoT*
zxp5Yhs)IxahVKAL1V~R|9R~E%3~d*IF;Am!Jqf#@3eFveo1l4A50VI&O=t8mQwEYx
zL#uz~Ycx>3Ck%#h1J$z7_s{M!|4ox{rA+~wDip_;T=@X>P}KCl7GwPdKYak8MVNB4
zlNGBHfWRWuxnj2Y-5K>TpeqDko=W3rfl5O4BxKIPU|XvOjP1~XldWa{4cM`uM;sYM
zxBAu9bF`JaTm*>UPZg#AXu@V=sInB~ES?opFqpn2DDvYAje?3$VLwf*K+!6YBdj3e
zxLg$m)1&tMZ|<0DF$?_3l@Qz&MiRJSl|c;+s6FCtkxT@7r~^&b@+cuM7$bk#ighI&
mL*y<=`c7WG4ND*&QC#;N-F3}K{s)!cBh++NOO+oz`F{Y==@bwE
literal 0
HcmV?d00001
diff --git a/helm/matita/icons/matita_medium.png b/helm/matita/icons/matita_medium.png
new file mode 100644
index 0000000000000000000000000000000000000000..335688af2fcb78e03fa2fe3daf54a42e44ffe55b
GIT binary patch
literal 12270
zcmZ`<bzGFs*QL8zq&ozb?q=x)1tgaSmqw9pDG4b_7epEf1zbS7LqeocNokOhlu|%{
z!}tCBh0lH#cAtG_=FYw6oO@>DALwb35-|{AU|^7H!_^JJ^ArXKCI$f>_-lZU7yN^P
zhrFkyj`8pIx3Hr;1H3}$2{-ov&+z{qnnRD2FffF@wAEFN1Lybif&w8k+11Ot)14St
zggB~Lk?!4M@-j~NDol0R%xf}IZSnCLEqZG?{c}!Y*&}&F4oH2Z?E-vd=(~W;?9U{G
zNNw#Pahnvy6+hQQ&iZQWi<B?l7Tr)K2d0QK|D~-Re2U!)pNidpu&t{xL$);EjYr+I
z5k&3yBxJskT<H%u$!23H(unFYDzU8J+TG=!z)cO*RY=`FuQOe_v(|ISCkV?P?s^n4
zj%~eTr$xkfdMS70o?Bdt(cc|hI7U9`fgMIFfo<Ns*R8^uoZ<ej9&3<NH4FYM_O6$I
zTm85J+uZn8Emp0ffU}|}%`4<zM={zRc>0)2UHDUOyh&1b%{Z~DTAWr4Ds36I7)bCX
zXA#@6c&G2a0E~fRzvoa28@0WB?O?~18b#n1!in{Tv71jlBAC7=$dje=hEBGd8OC31
zIf-F~P4siHQf!5RKTcpC7D6A3!3Rsfp?2>gdvUJc(2;BscUkl*+4?PA2=jMFxttrh
z7HU!lHnGP#cQ+r`6*TonJSx;G#9@5_UmcwPm!x9Vbmyv^{y4V*Q#bJZsb8Y7>MrpH
zC(A6F=pk-0#vX-AxhAU};Sq*NPng1mk}szxOCVt&3w!L?m?&i+K{M?qb%IYcG{;9Q
znEBZL3&M8#JGe>sKd|a3ICh^?q)d$lG%#M}-^dxa-2CIUV^ozmAa}6MTVKR$*W9}J
z_>5vwGum^p1wW0#^Is<x1nX*ob^vC_xAxGl>&M0HKb9!E=M4H=ifqK5=o~rU*y*_Y
z7z3D1*lLs)cNvb87CZ-@j>i4`LE9}HnbM(9uncdqwfYt{{%;~|#9jbdQ{D6NunEfp
z<D=i_N&HJf&;F10@8TdoQ+5K^JJ<=$oP=j|uXImNuMY~yCus+=JjVo%X3Ck4MfQ$U
zte<)?<`LV;6{nqO{a)&;vq{$E5E-}W{IacV<Q|82?~p}u_VA7EQGeRghM#lYU%Fj{
zJMD1~u>WGtVtt(tSHiedj(aDtWOZ%R{ZF%b@!zi^GW!TtOk&DsVpQU7n$8i}GOW!w
z>U%89qZd!+yS9{IRahTgl#`7$w)EUpN{$rY)nVPo>%<<>`fkLCoVW~+;81t*WM<El
z%BAlM?E6*EgE7;Ly>s3hybCAnUd($s7)znma$}Sjwr7yIts3E3tZ;?v{jY;Zowkg`
zE5lNbZ)TZdQN-ibp-PAQdCo=4jiyaQRw>qG9zi{)?smzONdi$Wj<p2QxPdZxtq-$@
z9>oiHSuXEhT~tzxQC9v6L9^-)R24@ybmQiJ$x3EtXd(=pZg%%;(ZAR66i=?7R;vQ<
zFHM@~1myj^@O0>tu1c&ZiqJ{<#jr5SK$=;Pe{IhQzIKsS6?S~#;$Ye6!b+JBA3Xap
zjp4!hXEx?Myd2Xf!UOYW@w4Qe<C^xZhk1wC`6{O!iw2bBH|)_O36$FD4AC`jC<WJ~
zDbc%xSrG*sEN&M*JJws3-F0!ZAL>lISSCrQ)rk8f>z^0~%(}4tYh^WhGZ`irOqFA?
zKXXVMH&9RIrQbNWclfSNeKM4U@j;mSpy?6yiY>+YfgIrpjrxpAb?F}db<<d_62=`i
zDsr^4FqSE&g=PRmofbBp&2m;_v%amsQ-x=v-bWO_$h4IecmTIPR?Azz3~~CnAGgva
zueF=dHMj%+a`T|<TijA?g6A;JrPM^FVtJS!S9mh#4)Y$FUDUmp1q%8uL4teJ!xK-*
zewNr1i_={yaTt|&(LFp9E?O3=h-*Ox3wpiA_tU8_5ZBuJhi3c!gcvDgf%x?ua{6Vu
zlOo<eyos}n=}b*#GJvv!-qy+HRIE5cQ=f8o{rqr-BD?XxiP~1Bo(?UP5d-&lWCd#;
zEqan{61g2r>UR|s5GfJ&<ZH3s=O!9<L;Y5W0i7>4CkE~$U5X09)<qmUiS6-4u6p<P
z>3xab1E|8~qFZ$8_u&dzOHK~GkmV?QN%l1wk9f5{<N@Ym;v-A-H!H4P3Yq76{KvTu
zyLGOX6C?I7mEzn~NHVXO>!QCV5Rjw<U0zxIK#QNR2K}*M)IZ8xm?&tt7Ud8+i8WT|
zH(OH__d4gX(c(frEhXnD+6)+>ntHe*942Q<dK7;ABs5Xj{54_RF+alCPMBl+EOuf0
zmF!F36x>${+YB=tRC<c+q&Fj#wnT0c{2U?zdpnUopFVT8Zq4_WXSV;u|FkVT!2ZFq
z!ict}geu$G_bC>ZLn*m|{jeSqb`++^?;SI#=ne#<l@s)j=qPRAq2|qmz8SprE}64`
z1JyFp8c|lLe1FP*gks984+054lI;`>Iln{v=go$sOgUfBXOcdQn!b=KnYzleII{(W
zA*H#Qnur>_VCwgFQ&X-A354N=)Z!;*=n^Sb83$e%sVgog1|zajDsGNlG05gnGhAUp
zm`<?7w66*y+>60}8nT13tR~KirFedqH;z>M$EycRo~888hVO(srQw7!&&9?j#GSwN
zyRe&lsq-zBFMTC#e^ER(K1E?(a_}IcnnQD?BRlVaF!(Ix<K^6TWFeWT2W4=kR~xxm
zk_%J7m%0vKUr{x<Nti-@mst2jDDA$H+*o%FRt^Py$5@<}fYUW1cgM#aukDI7>7<b9
zU|UyXSL@20^`MW<Y5z)0dUPgsn3dFq8o7<5-sql5K1i4F3Ns_xOzoT=PvJt7_+4_o
zvxUSwg}JzG*WQ>}--?w2huYSXBUCl~&m_)@G6j91O!So*g;9hPM_G-+3$uoI2FYfB
zR#~8AYWKJA!;+fGi?5#FwCaUUQ5a>$&URI^slSeOc~O9EgQt1vxnF$j&V-))Ti$r*
z6XI{IkJJcJyHBa{3Zh#=eSEtqj$V9Tk@&N9ec1g$^P%U*VgBNAj-OFa2HgtRPcZf4
zH1E6l30sP*3b4-pyOv~TeT5>pJ82o<%UoOWOLm1k?(rIJUhdZ2ZmvG;q9(m<wP=^+
zva5IMZzgSNzPnWqvQlDCSF>f#w4v>8N}ta>rW<>5s`NBbcY57Q{M?#6OquLPlk3i<
zey+H2Sc>!FtU#Y{v1y;;)4spIG|oecvBJ01I!Lti;RP!Tu#)^#w+JiN;j*Svm<MHX
z8<d-^OsXOHD6~VLSk<M2!a4(c@j8rVF~AlX!K{?IC6MokHl#2rGFHFv=iayU&|m8$
zj6*jk&|&R7HhAdKck)UZ({^VgU;vx@++LES@8x3u@qw0v-h8jYOoKH#k%xRDj1e2E
zxDeYdyiGV1I*zA5Nj)Xl=j~@pr*Tnf37zbkyP*_BQZFgiOGk#6-Ea*(ryx~DEdMG&
zF(n4dgi@Y2DYiR>r+hI$bF!R<tNK0)SGy3$K~f}=Huw~%KBlk1xfDa@MA&lNLAaq?
zGR792L^;;WWWNyh`C~t#SXYBmlKyBD8f?S67M>SQ{TbyMwlAX<QU3E{H>F!zp<O9<
zRi9nArzLLKkJ4J-aOi>qYjiBLK$_jKB={6BAErQJ-I77N<+gaWGuzsawX9aP{qymc
zmkJ7dZOiV;`kdB@gRw5rWE?CNB;?7Y9J0r@+aCOek+af8@?w$7Z7(OCy21oyG~CoA
z<k~1MnkwnMh>%W+dmlpGo!MsI<5&C~%!vtOvEwObpK8PZ_kw)9N;&KM4-O=qpryS^
z6@4(~R^jV%2lhX+@j`=-RDE58#n|NOCPQB(1wJUIAdDENyw|r}{Oh+B5r=;>c^VdL
zq$eYE?O|KA3-<+ktA<G)(_Nz4-E$@Nrefi-=QjdKmR0<~M&rVQ8<`7^%#%kUtCH*t
z`M=J^LZi(z_S`>|HQmhGsuGA$9#7D6;CRnP*_W_cxpdyVKCAuLK5f(ard$48SutC3
zim?`VK8td!YQNSj(WNk%&1%QK)#h;!esL|Mqp~J-Zx0z;qr}l}HtBA|9v)JqIZE|P
zFh_wKkMgR2^{MBcSL4h4wfVa<7ACfFjaheD*uV1RUN!x;Cs%$yW*{SNcA9CHCHBno
zo!rxcGo)Xo4`;E;uT7S|HD9T^0X}Z3cy*36IM@I8L?y??mRWwe=T4uGRH=ILI@#mi
z3U_)Tk^nhys+lq7tTJN!&$;hU@zV`|$8?eI1hc9Dit#3fU%14`p<ZRq%nBw|0kM}J
zJE_s6)D#CbJrVW+JcTNe=z8@v4=d}T3~Bn{XFP?r?6_R<Y&>kHtQQid-n0`B`;;Jt
zu=Kd@XP%|xN292c2rer5&OV*j5q}A5Ws`W=^rg+y;Jsvmrhg(1!~=;$sLCUfR~Cgd
zsI<+*DQj~k|LFZ)eg;WZpAs}(3Gnsh)`fNT&Ba{V!ZEeE^2GAb(GpmfT78W@-fSlL
zw&x9u@W9SQt+l=cim?ZF$~7cj;{ohTZbcoxJ|{^l;XSixe;Sk8q?&-2ZwPTL>PH@5
z4Zm(xGckd18(!2)+|e+20Kv@})wHx^Bv>usPk8ptO~d4yrA&aE<TVe@uFb+@smh9q
za193*ONE>Kro-n35r3N&{Vk_2kJokI7gkh!Z}y6M`4UoGJQDg|*T+Zv+qZ8eWel=3
z?>Q5SJ@+yLf7u@{br_h~OJRP)F*Y^TeE5*P>B%CpI|5TeN^0u+_mL{|y6tb32v!r5
zt5*hx)6=F;mfE%5+$wgEa>1v(<@yB&DOoRK^z|K<J41(thExn7AD^J*D=NHypEyo^
z`4a!)h2(yFLh;1J1kBNqJ3BkOY<dn^`@n#GsrFk}c=%%}4}X(`P8)E=^z^{l-i)mG
z1_3uWcS&jK@vMD{sMnf$e#n9B`QdU3Sd8C{b(mr}V$;pdZSBw5Uh<wh-h60B;Bm43
z@`X0Mq5@erci&yG-p8!~mNzpZ2cq-b#roe;Mym^!o4b2ydwcH3=j2V)6Kdp&eQyok
z@Cpg>2nxPPN+L;SQTz;EU_!fWNP2cGIZ2w$2Q{P!<7`&`<NB)+aw&L+*xlXzWmc9v
z6R)Hs$|H2oQsMgO<9Dw?X0!KWlK!TZsGwgzYJIl!5)u+#Nx54TR#Mf&*<(b}SW`&0
z(MUrhqoAL)gTA;WlVF+ku3z3(R<7p-EV19cI|xA#X_Tb)QYd0F%X&wzt*!Z!Ng(?O
z1TxX$v&YBBkLT;-rI()?wHnfb8&X>Pt%8+rc@|P~YHrJ=vPk8;cxP1Zy&QURJSKnW
zIb$6#S&68IAtbj`Rf(|WeAskh%hx}oJMN_J)!N(JGoy{o%szn$+}Cf%kvD|1CzWF{
z$a*_8SvMcN5_8nSN2J%LQ}dNjsO!VDQdmlxn_q?9{HgWZGo40T@6lqqZY3rr+OH41
z*tgPNQzzn!-qwMIUY$GcO}{6@KWQZ1A~Y)3+l1QwCOYiALi=({m!zr^=)&gj<J94l
zP}0&4mg(jM?!9j+fwr*6K(JiCAim?CZof&9YxUG5`b49MNQblIa-)rcFwnMLW6lMk
zAR~*^VC2fzB5yQbi0Q%@g3(;!frfCEm=F@*{dq~Hn^PkYb2<?_jOEJ#X|pzecNoq_
zLJ~@jBL;%gO#I1D%K!d-5=QAK4q%RD{;RF3!z&$U)0Pk#8d1O9uP|D^6)@y&^c90&
z78i3E8XC^F`auJhL#4rp$ggh=B88sFm+9qw?zmVQ?hL*9G&B?+h)7o@!dN798O{`}
zvTRDu&1KTdlcU*Q+btgL3Ax&DDuuGgIPf1}P5tO?A?BSBO)bBlBlSKCs=;pv=b6aH
zrlF<%Qm)V1_;{{&zTr{JuQ7QwRTzT>-uO4vh*c8peK<Qk+?mYS%IZF-&!CMoEhclB
zx{IPC+9?!HQP9ORrvIC7Z?Ec~)18k$Msv)Yo>+g9O=StDZ-@JG^KmIpWk-OxFp)uo
zu)H;VN^h<%v>xN>6Ah93-Yp!>k(NgmKG^T|i^=Q>*~$yxkcy%W3;3qqO7)=Hren6=
zHG}g7vmRN=;OWkn-zQmJBO!+!v}v{JkaTk2Em#^C+Y9*kiZ=W22%f@(1R^ae6`#U}
zM>FXe8Pu7#iKG-Ncd-;AeAscp60qn;3veM)DBV?kY4HFvkI)5V4;g-fI;LxL+tf=w
zBaQ*o)7HJn&jZauf+D|i?<C@ym~e{Woty_hqF0zP8?qF|T~oTUuq7>s{yIOeV{iXv
z$MTM}wDgzRS(o|Dev2D^DD?M6hJN$Y-(m&^232OY&;0hLMT1XWii?ZizJD*daeXJT
z-|Oe=*9>2F-D}O>zI#_xS{n1`PjE$LrQ%=oH#f(#-EZy31B?&|M8tK9t9p3x`}d#C
zGfv9(@87>y3Z1#j?wa#CXB0%u021@+6`fiei3RP!zzfEgnVH@@Q{2I4yZs*=hd+&u
zI$j>Fs%vQ(85$y8LIG%OjThjnuRE5dj^!)fGcln-RNIukefz2M@M3=<E99W%xxVtv
zOMuVm>FElcwg3bH;(}q~<Ksn3JJAvn5|^in1<~M&zLlOR0O*Y^t!W-_CUA_+&3ED=
zgD(z7vB?#>f6mpJ*Ex}b#g{2fSTF>EoGr_j78OnV`qem=oOLX#^OU=~)1$${)z$Uk
z=xa%16BAMI4S03**RNlrzqxU9a(+A&vN25eIGp$;D<;*(y4QL=zq~cQL~d+g&{Jza
z$ji&?$wfI`Z95L8!6zul&CgG?-*4$u<X-N09`xR{a$U|+;7)aQlN8!_r5m$aJWx^A
zLw{R)ohglv2Vu}k^tPrZwWNgW_6`8OTK3RwaR~{<6&0VqB8H-|59*l9?q^d?hsdkH
zO#O~;*dS!3qJjys29y>$FM><a9whllj&w@b&A!LR#zrbAw??0%;t2T&C@i#)*dCHk
z1Rw6zzK;5#a|=5kQN1YM6_XX|?sFLJz_Kq7+k4`zUD)L0Bq(JwG5Y}$P%wj6hh41G
zXb5gDh7?9M_K&T4(ry!2MMdL14lW*^5B~cWJ1`zfK5&5o={0Q)&g`9StTP-%d~ceG
zkL1cDv80S85%)EHxM$4xzQ<vaVg4hn!at{YhTe#exLxKeQTvhztcZMQj3u5hk&9ZN
zRw98YVi!$ZPUv#FJt>AqBod5<=+&lAD->Y-C91+c$D)Z8dUY3$PsD6Bh)PIIY}v{W
z!LsJ+DpquqiiVEjAKd+9t<4C3UsbgM*gaRq>seo)I!o|2`|WVEwf3bE&nVojcB06Y
zRsa)_KoQ=d^LlK^Qa>E?suJBr&%76*KWA&nuo%Rhl79B$iV_kMK3;0i2Iw7=2W=sG
zM;b_J7Ux;o4x=4YjQ8A|76kCY%g4vg&K_AEezW&@wnjzn0fFdk^v3cQ#!$VO7v+aC
zy(lR#MnrRZ$Snxi4<@I*e946i>1}p8l0XnWC&|Au+J4<5zKD{eegHPr%gbxy$B&bn
z!|;NkjJv}^Rs`ZcKSs!E4d1?*$z|1YIGVOkhx+jpQs31}O-=2d={%R5es8IzrWTbH
z)r+BsAUf+{K8@bU?-3tCwNg)j#eM=iK_~r$=}uxyiqaq64dG_>!WYn(dwA7#7;1^A
z>4$}2aqxTggM)*=R-(v1gxv&#%H8s0ZDHYUhr{99D>_B@omHpA0*NE~VV%l)KUxdN
ztYKiH3P;`8WccZeO-EY8E6fUkA{+LlXhWO92x(8JqbHZaR2@ROZ4pvWzJK~J`Wyru
zUZoHATLZYc1f$AdK!f&m@(JK_4;<Eab&3?k+uKxL*~>V`9^yU;@_rD2x!COWF-<)#
zF>$@p_J$wu(@U&$8DuHg4g+Ij$cI|P0M!rdx!c^)&>Lq&mjEu;aZI+jbE8iw?5FdL
zkwW$zPZCP#d+a4FIbY-%j_>uQS2C;e0mZ~^IF!TMA*m(UXfz;@5s)m{)?C%c>ToGL
z{3BX*ylOR;R&mVt=5+(Bu%g+|@DckTBiXmRGO5KX`t<TBl~Mo1w|HJOmtJA;iJAq&
zf(fj)ww4T28$UfTA+u+pD_j{UG!l9-t_h73BK?@Jv7V(GFxK}C6V$h(zY=)}^l{%K
z351;I3dYT!Gh$z__THR#Uj`|%+dO8ze)R+pK}19p2T(4KOZBav<h6;j_+B2^Zq5{i
zUcj)oNFJ~hRPMU2W1%=2`2HRv$6U?%*LOx8!nU0w;Mu$@OfiE;mxG5V_R$QQ-qZ_7
zWOMWE84u}gzFS>8E%^EK=VqV_`L@2+m<d?5`IAzRXJ_YZ+jaz_01p7h(5-AL=5=s%
zyj7S)#KiQ9!4g1hmE|(3PgT8pH&lKY%wIxcM{`6$k(HY}QXO^%1rVhQcE-=o@9Vd3
z^cLD+OlxaqNlD52h6egzAp}IDsH`luwN<WqiF$*){sMw&j6me@m(0&wfFBnZ7m<b~
zpcC;~0wV@l!*fA~i#+)*W8^GPcNPYQ;yw~djozOBhCm?nJsv-H0JU0XGT~Hb0JMMV
z<Y7exKSbjpK#sD2<NBCHPOW5#vv!d4fIL2Y_;9~EAUIeq{PH6!ub`mge7$RO_Nr6r
zt5@3#XS*9)Q4w8g1Y0@X3vusT!?3KH<{m#@?#vs`63#Jfv12pdiikmWP*YI>{wnS4
z%wJnW8tv^q3SEpTA>5YC#cE{@q>_oJQ!~^oDfc-(b+rlp?f8YCFP>?BejZ3hB2d4p
zpVBy!58OrG5V}$vxkqEW_wT^aSl+1_X+4W`bM2RFiIkf<R6Y+(P#YT#QXWh9)zq*-
z3MGpU+x25TC9l1iw(oB1HjIwYnaJ+PpkQPk{h*!E{PbKv_#Psi4hAAn=QPS8Eu97A
zyOEI*^;b2DJ9bhvtgA5PVq#3!Sz}bKx%qt-v1sNg6c-*qpgtfo=UWVGkeHnb&#}A<
zEBZ9G>Yh$<3FXOhT5BT-fNBPeDe64N^c<?<$rC036GYa0+tW!N`n+~fq&C-SkB>lG
z5&BwlJ%l5X$meE!ba_Kl8N!3EwNu&RVo`TRNdOi}1#@u;nzqWz=P=9re=-C21(5!D
zv5ke0aK3G7xVoKc`wzSq5`Z9TJg`oQ+4!_V%FI8A;)+cJBH}B3I}5S4iOF-QwL+*x
zYkHrE(|G<Upz<iOs2O{9zJ#?TR4kd}^N|&85{_4ZQSVUI2bA6`*B|!cj(_L^2J$(&
z=HNmgUgzcs-rlsR#V|Bf@veS8$!n5)+h`m;g!hPlYHfNS8>mFzZHk7529?Q<UpcAs
zEmIRk?Ytlk6lgR=U|lDSnyNkpCG?3TzYlghiCkG98Q<+xdn>+F<Vj_!1cJdifIGV<
zgDyr2y|Jqk`E%{J34FrKY6pd|B{kdRTGbVCJh~RTor{D6!9tVA*6z1T%=aZ+3fek4
zyQw|IkT6=RW``pl{meRMu2?Y;cBj$To1a#2iPWMu4s^s!)9Ey79F9mRsp?q~tq&~t
z?ZFb8$9ldDphoUwJXG~=o=Rm;Hq!=CBB<|R-re2B%Ip!p4`)Erw<AiS+9b%aT-kjq
z!jU}sC(Wtft+kzwxHJn}3=4s@q)Io1gEqQwK_7Xa1j?iTqj%>^J5@1#yWOjCnmD=V
zh8;dWKJtA!OVi(yW?E$~+Z!{BD-r$LiZ%Kg264#=NHaHn;r1geP;p$6lHZ_v4Reok
z6@sWh`Kziv(?^}*Y8bplqknvF@hR)-{DQ3YJoqk)vAegY8_L)Z5WCrH9S_LBt)tbC
zWz%h-zNV%OK}yw_DR}I?H-%n&_aXP_x{)dfJ*Vf?Ogg%J?Mg^wYqYII$fv{;TfgB@
z{q>Ovgyof3jP1|4k3Hnd8#$Iu!Dn`}kEPJoZ3Eqr*t+4$;D#Ikh)5VDKE3pDGZVNo
zxaW;W%HU9u3M8&J9A2njpj0+(X#jD1^yv3mqA;C=ODaOu5E3K#X!@uJpY>?yZh;6;
zgh0q{9$%Q4oVC=Rn!|5G&U&HL#*nhbF!_w<WSeI*wp)yrjj3sAtH(3$QjG83y(=j%
z&-rVSb$J=sdAUZ6N5<q5j3}?DAfl+26U`9rynF`U0Sy&^CtY3A&CN|4Vr_fSGBGIx
zrh+b2Ea=3cnt{zWX2bGB&)+}9Gzx!bt(@d@mHqfP22favy0+5`KHfe)%yrD|a|=BM
z)qbKRxJ-4-JWh_ap;!KckC?fs!q?=`C8Is!^9H)qR0RElgM9=DenHYXl6<bqAt1;B
zwe1g}lKPC<8*=tjQT^x4@*B<ReH8WCtDqpte(u{<q;?<ZSX3EXe6Exacx{cN9bMRx
zP9Gxw>c50e%^o7#(V>c(@Zo+VVhvwe)5+lRI@r*b#n(sD%?ES8*;>I>hrfotU=@od
zJU9C<^MF1b`4527DaRlb?2-5IJf^tD^5nQd$<g_2jY%p*(TcFQv`+O^37l+#*|61n
zadV0XVuCshDE(EgHv}qC1gNaxBzkd~r<WptbHWanaE;+)2nIRhKAl^XD{?#nHVBDV
zX#^3W1D-yTC3s!uFO^Yu3=l^dpz3++No+vS%k}b39^nbEsA4%+)sN)&EbxKaQlUfj
z5EHSxq9uBi7TCkD`~h8JSqo^>6>sVMW#f&;*>{dDPz*8zWfUtKa9~xYUocjr_M8ct
z8lp2nFtmue9S{NpI<r`yBDYI44zsoE7TOv#d0h7=2T<3WIx5@%4H%RIMSlPOeOuno
z9#w6SBZ&CfUF&_g>2E7`sXZtxXP@Gws&^99(MisV@1+#~%V@j<^akfmWV{L=mx+mX
z&3KQzkzwyxo_uL4SFDJ~k^-2?K_aviGbd6JX7hk(h!Q%twX(TzL6U_`zhoRm-L`Zu
zP*%97*eld_Mh}Px=f_F1Ks4Z1*6$MM$XvU5?4(s;&m&OX0g-Ad(A!B$2iDj(MhVM%
z=x|xD%AtLa*EBBv>1hzSkRNfbh}2+Rl6gX0qFCBr^dhJ3iV7v8GVc0-1UTPc0Gp_R
zZ2C~{;j+CGH0l6WH1b;V-a@vChRlR!E|y$0#l(8IXyLcBE2aG#YjdNIlZmvtl~q7@
zfS$ec<|^o7F<@t=y5L>T_N^@XdmZ%4w%n!GbF~*21K4b?yF7oK$MbJ(D}WhF*GFnb
zd)BtL;{a4@<{p<x<^nYlPkr~~M~=tT{Jh+qK-{#nD`*X~Oypwd>5(a+Xg6!!pL1(b
z?-iKHJvhN}ezSMXF*T1TuqSf<JOCZE4-iUIQ&acl?-EchxB3xBEOmtB%m;$@&;S?@
zKv2xh%>m2;&2o;kM|x(a)3xbG|Dx&XX>Tx9(4n{jPYmZTh5|8U<%d%6<px~M(5S^@
zgsxWP^Mo4_q;S;f&Dn|y8ihIr4v&~!H-?dg%f2LMmXP(Wty0#xJp<4Z_=Ff@;^Mk~
zC5g1cQxg;2K(B%oCcB=QLSkZL@xbP9H7{xAeni$5R`AmbS=j+c<mu_8R()e56)mk6
zm;>Vx9tYkDK|!<xFLw+;(Li@+#VSQwkMC^%R#aZUer;A`7wK9)ZL!5?RQ75qU<Qv!
zE1Ai4Hwai+zc1HQ=t1{DOe-XD(;zgM!s@*H^<Av*zOl*X$>wnT>C`<S#G=64B2O<p
zdG5c0fhOiTIjbJdH0B|eWIoduU=9FWs(ggMb_3_cBik4|^*uTHW&Xi|5F4LNV*k46
zGMGC2t8DJ>d&2GU@W0{!6*&MOI0L7k%Az4*WaK`uDL|iv*-UUB$D48}_6gxTs}GF{
z=e}N|ZT^R3zFu7H&nhacT7Bbf|NWU6DNrsb_;<aP+;k;q*_ib6=i@3<s8o*bBN?Jv
z@_H=o{M?VyT0|65CXQ<pMM=Y-*p!tEHit8_|MJLdZx_l=*#14C_5V4$>RAY|Uxo>8
zV)9rjCuF99Y&H@uHKIn+>#q%$O|Pin>Kpj*^u%FR$Gan49Up;jQDcXxd^I-?<TS8^
zV@vO4HTtkkFmu*puwt>U7C~cPaz-XXNm=gOgeeV|K(&9qt@w<BBACd00Ud&_VEP@l
zUmDDS0$oq~3IE5GZWY8Zxx`w)-Kp7^n^1;%d-?DF@+;+VCFPqPeM~dpW&n8_Ad{LY
zb1Z_rgM!B7a$?rM<EO5xWA-^Jfokxe$xZ>0d7u9@2R9!8dShs0giB7YwT|u+HKdU6
zQ(btgZ)vIz7wITUCouthg3f|!Rl4i<i;t1UCbx!<0EphhkFk_AG~Y}}Hb_~q{;5f$
zA?e9D=Vn8<k|cpd0)Gn6u+4`}nUq6%O{EI*A-P1g&CIol2|;9O#q84a4EK8DuCnM<
z<mvV_N_9F7GM@qkkZRW*0i)Gj(~`iS?+ld(1<Wlkzu<yD^@cJKb5*CM+vdWSz+CIu
z`8pVcNEje5ljuZB__h6GDMrAFPQOn!on%s3@G0rrN4J{|Kgm(aASU%j#+)8&;{9G|
zs`K43q=&}v0*C!<*W~YMx$^PPx^eHDKYkzT>dYJ5Xw1#coq#W_8)wEx&Ws>()xyg1
z;%<ZPFRf29scENrZGNT+yINTOVAq2+C^J!EQfb!tR2JxJ@@VXxN!KdKiRzS<tD(P?
zJsv5CuyD%B$q9`1-Wuj>?3=5ufAYk41Xh4pD0%<>1xNugp#5QftF6V9t8jY?^ak5T
zOv&UJU<cv1lT)+$if52tTjN`|*8{H2!*(S;WaGuz_^h&G9}VSpQzqG=8=?`6l9u9(
zYHwG_6td<Q4^)W-x!&ggBFi=`dw-$H=g+BYEE)4WJ02iAB42|xRYt^=ll;#Z5${`q
zsCPcn(*d+nFZA6=U$OrgF7f4LN|^e+d&HHd?~(lpG|b3CiWRmoGd{}RPia>6-0oJ|
zt%i2TUn8H@6VK4RhPtcu=~TzO;8eNFUIp7B01Ud#o$>;w)!rB~e2W%u$G0Gs7FG3>
za56@)XK0Dw3AP;_o;R`+(CYSHzyZJwbNrObUS-vi&aM`V6U_8!*@eD+D-!qNCY*t=
zwpO4(BHkz_W(sv5mKZ64|7Vpv91c1dC<5)U`5E=yf5E*cbKsnomF?XBQqN2_J=Wf8
z$dSzE-`^W->#7<xpF)IfDC+w9+B1Mnks)#!)3VnPo=mb-qJ8~%oW=ieX%zI#RNKfH
z8Vgz>Rosow&%2!;@^Q_WX)_`$J~+fDp@QQoDqf;cvdBW<%xipzV9LUEAsVK;?NEk_
zInF=H1}YWBuL2YL`XHdo9<2L%1z)+awl<9hY8o9vvLV_jYZxK)^4SfFbz(n%ect9<
z#&c3?pQE2`b$@ns(k?xD6I3-caJ&B991e|-Z*2@^>@)H5@C^7FX>?h?f!RE=9pBGL
zeQjy^&h;_muB7WdOPaSHPs$o=)1-1n*MC_E-Z@}ad>tONPHGc+W^(Iifxc4VkC4nV
zfq{|HdZ2i;IS{n_p^CTNwAcZ%)(lvO-tAMHqteSI6%`4Q*!UkjS5==!SXf#DfAje2
zH;qP7OH1~TA5IL6jHK1odqE~9r40=WwEEj?8L1VF3^E9Vhi=0UjZDx>?eX7`>_T$$
zm4{_K++JE14El;U67=-+;P@%1q1+GXCqOuCqN0;uZw=0|0%da8qeqoRs#D0<U<Z!?
z^Pc>@I`jb$2jq4i=$mfOA%M^Ly*=p5QShT`zgs8wEV!~l2RK;z%V*l~ciP%XL!Wz*
zYf!!VU*FU6^^lLN5L*ov0uuH0N52$9-oAZnH<ZrJ5^ie%xjkz0_7(&CCRvI`Z|P}k
zWA-iZCN)pbM_HJf{(##T$oVAzza$-n>IW87HZWdX8F!%xsvyCD8SLQX^!ksOyom`P
zKmW<jm6G#*{cg62!G-1aXpnowXNRlcQulL`eCc%^^cGS7-w<aP^X5GHfb^`aLEy~+
zJaqsC)CX*{<3ZL$5|@Y%o<%Qz6E9TdK`rn+`ZtDh1$g5wN%DCLo%4fYV~A-_`l$6E
zAP|EIG*B}DL`}<K@{>0H1)O;`Oj_Pr9%T7VXo!#t*~@|geQj+*fKvjtow-0(Qc+W{
zZ}-N02}v7a<6t73uSW34!w{`uH*(_&zep1A2(HE7%`a?h%-kH#s`K8|IcQ!dD}M7v
zEmX=M7EhpsRSwl18*@7Cj#TQ`DFX0udrXHcOi!l*vO-?wLG-A)NOYVR7X=})d!w4R
z3TDW~!Tzym6l!m#`WL{?4=$4&ofjR4vP>@DDomJ};6!h?)RQ<PeF99~8$UL-D;#wF
z`&;8(3NEjEG$RB65u6)lk~vUOZo((R$ZU?|sUNQD0OQ!F@G$J64W#Kke6h4RZ!XVx
zl+}-wm<p(?=z{<<$g>cRXeP=n_{0)QNA)Y}^YC!cLCcm|d!Sbn8JB2&oDY}Fp^og%
z4m&mUU4@Q@M$E^^+k-8Iz?yZM3*Z+sQSQJQ=9>+9`*ct!lmciR1uW|04xetxe{c0m
zbR5pC4L)<zOrl#gGsgcwOiREql_mjNcSX-a`$je3Kour_OSWu!QVZ5V#w61Xlw+$e
zoAyea3p*GteG&CH?9k@?U~w3@quAC07+SOkzqbm?fpHIT?URrd1@$CI`_i_3bV<KX
zq&K%9-h4+$6DOXIw)R6ng}|2oByf9?C{^=l53ya9v5n2xuW{w^wf@AQ>*K+9;B<EG
zgQI{|b1INLgCCw~ds0m%<1mW{2Jy6||9~wty1xNqfwNe^13LcxQoxM^8+i|(2$RDG
z&Y%sDG)E%dw*CC|YAui_;H(-P8RFvN?&Cln*<uPX^ZKT$et6TbBP%5S5m-bwVJtIr
zZ=sml7leW(sX&bA7+Nt6-_>1X{fVxB_z|y*xvRMNnPSL!jr&656I?D0NHCmz&dcE_
zmV66+>f7kPFaRbV0s&j``30jikTGk0grLTOwH*s*Z&{H;pC*EKxM9ZT*BpwUpMSP3
zKo~4xy)T}+m5eKcU^NPoPK-vs%*a1@MSn1=$%e+_=jF9q>5ddI{}2sy#}FNFQkv=%
z`;d~jl}{<aTHmX@&!2U)NJ{)xLBfSuV`@{zuo}YUWW)lo@oEHxQ|QH=ww10eNH&Dn
z0`SwVn~$`JwDGm@#<@*jgM-_)<#$z8zP_u#1V%&I=3)|=RQ2Fa3YiDBQy_((wCzhl
zG+eh}d4#;*nRu;sA95)XYHRq0L#U-G>*rV><lNW~Sc*^~k!EsU9Lfs~iQvRFbzJ#h
zF0D;q<QuJ&^!)rW5D<E$r_E}xrS{EUYJoe6YA>C}d?(I(rj?w=YCIJKcx79gN|P}E
zO0<Xn+q4%K?+;185Bajy&~T~;XZ!3Xxe2}q@RoFR^yveO3JPj9BYV!#(b1BU5|O|o
zJ8<qzvWPM^fDA5BuC1@@F5DQ)dzhQkcLbjm+jfPO<s#$*fDd?fcE-icogHjrV$uR!
zVj3D6`AGZ-r<AV4&ELh~d!iQ@t8$e08)n{1i?Gn)e8s4R#otgfjF$A#3Um*4hhwmG
z2@GZ7_v!=+bv=lbijMdJI!UG#j3azI>{JqkIEqY&(Irw%ftZRFj&*=<gDr#=j^$0M
z7kzU`8&Mi5^j4iJshN0tyxWRxZ2w{{LU}%XynU=qooa(?4Kl$kN1F<5A*dB3^j+mn
zhpq3zz_}FXoypA*<{h1M0&YSxlArx^F**2sAwjt<a74N~Tf7XeFX1JzDl8vpzSqzp
zGi@r$OG_Bqg<b)Cq=uW)EV_<(OCQs<kKJ0Es>}szKFYH&D?)fZlw^a?hZ5}@UI-OR
zyTm5$_44OrdCbWKC%^q12O)d$1?54i-CD~Qb^+!`tWZj>$jyJ)pNpq{V}B93{T4o@
nuZEegk%yCSz(a3G3?mN*S5NSGxlTI)-o((>&{IdN+CBRp>Ww$1
literal 0
HcmV?d00001
diff --git a/helm/matita/icons/matita_small.png b/helm/matita/icons/matita_small.png
new file mode 100644
index 0000000000000000000000000000000000000000..cfb017b0f220319617cfd8a4236b19e097be346e
GIT binary patch
literal 4786
zcmV;j5>4%iP)<h;3K|Lk000e1NJLTq002(_003YJ1^@s6T+T0L00006VoOIv0RI60
z0RN!9r;`8x010qNS#tmY07w7;07w8v$!k6U01`DxL_t(|+U=cta1=*=$3HW(+FeO3
zLP!E6frJ)_K@yKM2)}Z=P>y4h*a%<6aSC4?KjPTN`07$|s*<a+lT@WH<y0yaCzs2^
zsiczB)j1@-I~$2$@B{R)eY{Kz#$XPcpchC;=z(^n-JO~I(LKwoc6N7GT3N#Ow`yyp
znVz2RZ-2Y{*Zu46g}Dz6m=6@D2~z;P1AKqB6Fb+i4tN{*Cm=sX7!~*xpuyqZF9HwF
zM8Z5%cqSiEfRMwzJirHx12LEH_sY!cKtz7q5diK0=E-nQFo69j?yUuG2LAK&Ag==W
zeVJ$z=mY)&C<h(|ZjsL&2mTH?2P_1B6W9ur06oCJ1I;pHli#@sxEt62l*(&i;QxT{
z0=>W!2qi6+q*WuTWmLxb&%jY2DBr692Z2+v0PhFNfUg6Uz_arGF`2GTTbg{pMwz!t
z`M)9a@dIGgEqMXpS7oA$flq;Bz@Gp&$(PQTi3$S02Ye6M4qQSg=Qc!j`6lqLE$#)9
zoW~@|eZT;sU0VTM1zwcoHOM&g<o#mcURj_9@IR6~Mc%in<|+BDNzxVhvHmvYw}l|^
zM^XUq1MP^Kvl4g&_>WZNIl&9m0CxhHfqvj4;OD>tz!G3Ha9(D1kNp0wR7Vx?noQ&$
z+TzUv{!)_r8L&$hMhQ?aRd-olL%wIFBqa=d0IZkSRwAmg9pAU9%Z{gje@v0rQsBqH
zpUJ|pqZVjG)I>)(DK8>3ry#0Gr40A5BnpID&P$T-0sb7J7^}TH3T#8D*uqAH;;sTu
z1N$ar!Y>K8a7lib$?N05Cz41fC@HS1q;4x8kl)`UxeZ@H>JBO%v738)5Y@z<(3t!_
zizr!pL$5o;cL$<$4*_pZy0=E&Gaa6@r$Zxm(133M2XOBERv^qHGgSoX$g>cW<fZC8
z-v+u}#8W1}FHVXp579Q}<&YRR$ODQHO@$LLTQa376L|_S44g?5=6_Q>2Z^QDFTYnJ
zswjxk|7}FaU^+Zw|KDdzuS&8C6;i9j>3S3x!MRP_glK!OOou!b7?T7#5oD%#!G!$Y
z0(=`-giz=u;Fp2F27VX#2jH&|X3s~6s{3t3Z*O5hzJC>>S9}`ySKwO?1TAn#O9;^^
zS?zm)45!O9ZAY~07V3dN0CpqV*>oeDlvsi2I8GyMJUhI=Pl0O)%YHH%<Z}^3H-DET
z`!R&+W5~>o0{<n6c}5n5Wrtbn%me-u(b1SP(?f`!+uq^r0DcDi4e(30>njm$><@q!
z5ccP9$$Le>-^%y>F~Xkxi7c1^@Iypz`~t$1NkFO|3Pew{L1y#=Nre5mdKuwKU@!&w
zs}a@XIM)@r3iz5N=e&$NBuUzUurGTM&4JbNcx8dCl<7DJe2l0S7CbWE3i<2>+r1j#
zcKMD^fD>HrBzy?tcqO75AGJNZ2vLQ@z<UTKeub~_6~4l3A{+ZqL9}r>K`t%!*}^vv
z=0|^;Fbbmc+9v<*$;FGOGM_isa1k+y@d?SJAO&IU-Y)-sSBA?8z6j)fiWoQ70w2n2
zPNbbBd2Vr9_#%*JA|^raLfC%QTqms!VH3^>oQ&jUnx?IrZARQeRaJCdR}910s;a6-
zRn-NiX&yl+Ez0#t&}l)}^$$s$eNK+l>-9c%*Ijr0eMw0PhLKw3ilSf`1``t#`2Bt|
zK~WSUkqC;Ske8Q-X_^_I35Ubv=jS`dr6>xzuG81o$H>SCrKP3ng$oxv>({T3YMQ2-
zrkQr!K0ZE<&*wu`)wF3*Rh5B(0S+8E@N^^+`4{`Wq-v{anp#y=<*lfwa7EtO*ckKX
z%_9>OMIjsxqpB)CpU)L}*REYlh<h?=gM))KHa2qq{r59AHpYuDzDQ9~QC>wwMP9nJ
zTX7c_7P=y@u&@wK(~=4!i9FLZF$@F4Fw#b94`&z#ijux&Sm6OOWo&Z%7HP3qjLVlV
zGc+_rU0oedKKUf|_4TN#%CTd|*t&Hq2M->kq@)Co$KxvQOi0JYobNC!h1*HnxpQZn
zGz+?}vuf2UMn^|Eefl)ZmMwEtsMEomBhNI=xY7*6ptrY|t5>g5UtiBN&pbn2U0nic
zcBraKQ&SU%4<9BPjiy!K7m7TKG*wlJ#bWgJ_0ikg%cf16GLmM&FbryHYS_4OBWKT^
zopJTeI(bf{4Gj%ZTU*P64?aj^V<Vd8eiW%F3QbK-yzs&cGp@c_BQF(cR`sl{t>wy<
zD^pU<iWMu^v}qG(&YYQ1_01Z2sYtV`r`z5zRoqQYO&mRXbVk+pxsx}!_pGn4XV<P>
z)YjH!Y}2wqFc?fwpBuX}Tcjk<G|h}JwC=k}n4PpxC`5gIJv(>qq^_<GP1BN;X15{T
zz{z&I@4ovua^wh+NF+gh_H<8&R7dhcp%7zZV;K`}nkJ!8C~X*f^&B1^X7%dT+;h)8
ztXZ=LkH<q_Uth|&tu`-Hd!;A}gM)*F!(saR`r?EH0s&U9Ud_34=cuf#OvumJ*jT*X
z&6NIBd2}Q%KR=(s!orNDVl~8tg@s9puto${o3?J<I<{=tLS0=QMMXs!3&yhQ7cE-k
zsyZ)RxR6jN#G*xu60Se=&_g``{PTFd-nja#d=(TFWQ<!;6vy$kMcz8D&x6GuaML?k
zVeH{2leTv4TAqFOS!!!*xpwVZLWyRAs;cpio3uEEU9n;X4Gj&BZJ%3JrwZc%ehuNt
z?_(OUk3ENnhvTHJS+gddAzjzAve|Nhne2Hzz!Ahu>`$heIBOU+JUq<0b?azqYDyq&
zwh;^lX=rHR<BvbiY0v9HOi@3I@Q!CxpVQbg8ja3L(k!T|%C>FWICA6&(P%Vh>h~a)
z9h^WcgZ*(P(yZR|^5x51y?T{Zt5&gN#|~<1YiD!@W4f5EzFd(9VlBzzh}A?1-Jla`
zR`uMqYZs-ZrIeSKXZzmI9ah_CsV^4=ZIKs7sP7J^mrf>a`}XauS+fR!%a<>^vX|xp
zYHDg|XlUT{>C-G+xNzF>*}I-&h;_%MfT1XgYA0>|`t|WP%_1rmbF<ZA?!d0TKp>FP
zewzw;Vc>+KD9;;)VfOU&Ff=rjK-y&3Z96w`Yd_k<W)t2Gg25o0H*e<f;lnIguwYv0
zo^14d7>mV>bLY;fx8Hs{k38}St5>f^(=<j#Mv@-Zb)C`CQS$TiT_t{WbTp&G#e!*?
zS;ajzHby8Ea!luBY}vAfg9i^XHa3>g?z6mp>3kR(!sFf$jYdP8Hf`d$=bnoX*i%(c
zUDsVZfUNM~&H-c?2D+}J>$)q`#~RMLiMzVGnhhH^aQ^&xs;a8eK9jDnJ&1i-8xbom
z5BfbG?X#07e<Ko!uz2y}jAX=OF^Y?eaSKh;2m}Hd!<nW@Bod*xxY$*}1OfpxO><op
z@4owPUV7;zG)=?jOTBPPQ51YWpJN(S#PZj7fPVu%^?SYMQqxr4Xl~Bwl#~@N+pyV$
zcMH=r<73|5-d+?%$>?Tvy00P@RR7$%V3;OrD=Yc9wUwUUUe^h_(V!>_+qP{Z6ben*
z?n`b=Op`*tpXI8`{+5;*nSq@PFbpFr^*O<@CH^w0uc@hN%Ib3@&ooU6{C;XQ?F+BI
z<;$0|dGqEesZUK8aeYO_7hZkVjLTHim)3wP{1T`Sn6moPl4qFamri}w8bVjkrMh8~
z*!I2A+>Bwfy{7U3ruF<x#=U&`@}!<OlLC_lb_OsM3Ndi)T71}5K7T%M9yq|)HgBeU
z$&z@ax~?-gIEY(}jEtmp<s}rJY0}>>b_cj|(hLj?5DtgqQ)HRY-`}6$Q&AL!+its!
z*49=6fk1rBo0aQP1?K1Hv#_ubU5@!m=FOvSc$j1Fzt5vjJP{A8>pF^}P*zsvO6p#(
z*Y)ts8Z(!bmAM+*78e)e_xmX;E6W(x8UvS=l_gBcmzI{&*x1O)lP9UJuEsD7R8>tm
zb>)~URZ&nC1x;1aWWv{0R`N+l2fddrp=lbLrlG28{BJiO%QcwIGcy_Y<nSJkhwa<9
zGd?~}G#W)!)wI)Mt~@nX+ZX(j^t`v+atoI(UCO+gz)ggTqQraNGi_~j_vB>v(VT>R
z%o~YB(uQ^IBm6R|&+2(o!8Lht^;K4KrnQyso}M}9pUo94^@YP>qS0u|a9QQvG))S8
zK7x69>~CqA?L5vX?CMLofIOQB6WYGkRyw=7ZU~p-R4}>iOEr_66)g3w$jjr6=H@Rf
zc_7qx>#esswS9|$yOYV2HeRZa-R?Wr-kz2EEPKigvRPhc5AO!n3W!W;Q51#k+qV;m
zM9gS3Y9iM2d=vO}AeuD7&<%sn<gmy{w<k+cU}%U}ckdQ|yMX0-EG*1?&WmZ93=9lV
zQc~ioaL$}L!}$2Pt9@`*+{MMkX$iCp<fTiO5{*W`j@Xj_5#n5}u;bpdYZDU;hr?;f
z16WpE%sU+&oT{s%qM{<L`JyNaqobo}n#RP$ge&LL)vH(I&!&T-C=3q|Gchs2;NYMu
zGiqpP2-7qj)oNYq?(Sy){{5UfbqbHiQyh!Meu(WXy(IEHn#S6tOIcG<fu4>GnZdDW
zl-T$<ciwqt#spgv18&p-VjWB-_os!Tq9Q_}5RHwEuEO{A^`#t>U%GUOy?gi4+S-cG
z=i}y^Z#K@JJ?oFfVl~)S(I&ggO%p?Y(z@diRlK&moQ^|>=-j%MWlNW)O|a$kb_4rr
z_-vfsZeUFe=(?V;VxYUbJ5HLWX;f5HP*6}ncXzj9n&$h6Ll@5=PdA$O8dIz1-QV2I
zV^2PLL-oG)>S-r!*|KH${r)(~a^v$w#BoV$5sRXxPo80#)KygQdV4!v_uiXPeRBa;
zZ`<A7&Axs6Qj#`F2qxk@(d~%yvm(<bZ?fI@_zj@G?(S}0dF2(3A3siBUY;Xq4tY=!
z2f+>@)t8f{;ksem5bEph?xv-sg|@afB9REeV37R${7j@xMjPVP+*3JQS3j54*VWa<
z-o1NiYio;F&sZ#m*XxaUGFhaz3!%PEIU~>B_I2KSFI96ueO+B$w6wI)-rk<jrWuBj
zajq@{+JSH7j6AFDTbY-~{ylqm{HdotclBBCvq)=eYs2I5B(-TdKo`)Smb`2yJPp&N
zwxWX9J38o0)AnT>Z>I2yqM&ISJv}|V{PN2jI&=t+$3s<BRYua>#GL}|j;_aHo9i(h
zbkk&5y5+1_sH#d?EXIHT=tt~$_~C@`!^6X9n&!&&Xcz|l{rxG2P*%niMWM5^lij;_
z^WJ;!v1G{-mMmF<-|r_Hji#)gGqUSZ1p@i`EGQ_*I6Tu0LmUxXPyp8AZs3++kk?O~
zAoRckRM|F+cs!o0T#vf0Q(9V@M4px5&dyF+T3YDn=wNVgkm~AcR<2y>YOAYhnmO6^
zn9R1EdQx0eFU<;TE5UhwKfmDf@%Fxb32mR<#pi}RkH>?@<4MY3S63I!&CRs8x09Eb
zM=%&95D3I4Ei(~f-<acuymY%Ba}KNLeNDD~RXN(OWGT%et-888zMgnC98xnvo@tuo
z%bxd*J$v|_r=OnMvQ?>!RHRuQ!E8CAW`sP;*AZ9WefMRpK2=re>gwXvS6}7bci(j+
zEt^d)Hw<}TQ=iWlSD#ySc6QR-+{{~Vy+t4pm~*7fIC*jPm6ylWS2TaVE7CeTI`DWr
zR905TH`vW3(q^1INL1hc=4Kw)vBNRk#ful?CWlo$y<RV)qoWC%qvslClsvooUhnAO
z!X0<8A{a~{t+~0`u}!-XmUASNXSo?w6*3u{Hd`s3E(-JWxykS6Kyx!Izw@2Aoz~IO
zf!FJ$rltm;&lfjtC!d<(_5_M-PUXn7e9S_+aE`9W3-U0SOx`oYFc=vhr+;K5Qz8rn
z_}QCps{JD)<_E`*D;|%B^73+gJ|9=EB>$v_X_|z?VMa$sU6FU?$`xX<SbQv-4p!WL
zzu%RSeC5g&$5D&oaN(u`pRZAKX**>Y9~$x<OBJ|vJQ|Hm#9|{JkLQqmE^Uf&C%#BJ
zfZRIOvyFRVVxkps0&Z&Za*V}@gC9x|PLs2UAN_a@=ilDBp)gbARdSuQ<A@&&v3}ZS
zGvdcRa{lvypEq*d+ghY8M3DAVu9Ifr1Y&>hQpBX<4U1f!O>`U3gg9cn8Sx8xPF`*u
z@v}5Ra(Kx7Y~cR^wP#WPcJUAU0000HbVXQnQ*UN;cVTj608?*dX>f03X_Vs^&;S4c
M07*qoM6N<$g4i)e%K!iX
literal 0
HcmV?d00001
diff --git a/helm/matita/icons/meegg.png b/helm/matita/icons/meegg.png
new file mode 100644
index 0000000000000000000000000000000000000000..4c2be73fbb0d0528f8a0bce7452494d329bdf0d9
GIT binary patch
literal 157131
zcmXVXc{J4D|Nm>oU@$R*M4>SxTZ~<n8e=e)5Gnf>3T4SoWiS{e`!benh3sX?z73(w
zq{4WU5fLFv#3aej=X-wloaepw+;i@^f82YY_xXH09yig#%<u%~X-)tDP8i{FmH+^v
z9QVIN!N>KEX5ij&!{Lv&4Lok$|Ic``-!P6l_#l0oAWPR!r2joXPp>;3$e?h452UNV
zzoHVr`Txf_k^ff|RXJ5u)K%4#)!fuCqS0u@V^cY{<D#teznb%v)umDZAOJ=<-D_df
zL5KDk7p6i)<DYyk$ZflBy>1d(v~lSaAVJW>Xrzi^&>rs^2*tt=12lwP58hs;MCnEu
zB0f29Ww>WF;p~tn9;0+cfAy^#bdP(~W?fuv{q5@RS<4{EhWwayZ1#3kS{B|p^X2!T
z`c}{1o<nC4Fu(s83?NY?JSkTQv7?2EUTUWQ4XvG^X4A>GI1~km0wWSh#6<j4l2lP2
z1B8rvMA|5<r%<T{3QwY8P*aj1bS)4J>z{+`4pW!vs&s99JSynZ8p-`=hwR2Gw-QpS
zrLpuXgG%b7jz6fGDEx&^D&toU3`M-n+2~r<(jC~%K%rO>iK$f`2WXfl-A=sJZjgSu
z5uVnOV~KMw%-_nqY&qd7M;(u3_jePF=S7StiN8U^0Q6{})rB(CF_qCq+i^SVEK<Y`
z1Ofqk*zjZnu>1_-i)K&H@WW;L_ESTm-r~vkk6}d8?Smm*2%xO2>?vRNYu0)<O#9Jr
zgB&AhWBu0U1CG6s%SRPQj8jKT&QW`RHX3v4<tv8JXy(w^r@n7!`SQ&o(Y%$hj)O11
zYrp(?bN1g*ebldoeK$`f*fTA{83czIN;3k9R!)DR46gS<=A705$h-GVP%)6I>Bt+(
zs3kk(bLNIF;IG*-G&Iz<)*uH`f$1?HUMiy95iAe)+Q8t#<LrGl%y8lPd-V^RZ_Lj|
z;$FxABHZji1apJ2cH?ZvfwlsWI%zwRQ1U_s!Fv_=!#s{umPxmBnh!5be3ALJO8m)C
ze>B(bETV+I`hDlVnzDeL9wN=8!$JNOa5ny#BMMdHJo_a|`NXf3e`A*q4UgVN-ES2N
z_QHLzV<G(1!2Y)|cGLd-`by2n-wlSIpBik)V<X4p%+OU4JRA^k27}Ix*Ivl!)0heT
zsRu{#a(ry(@(~IQ%@<0`ED3qy>)F+zg#myt+(2gmA}xT?NfLAwJxwPOluF6Y3Y|Mj
z`MKj*{cFKa*}jh`gkd2RY=)8F9;urM{Y8Q%A6mP73?!~|%~DA(=n-uWC@`??bgM~`
z3oRhsR+(mm17oaDtpllNB*Y2v`Ci2=Veyg{flQdU(Am@h#Ec^Y2?wzu)*V0ae-I;~
zNf1R+9K~K4_9S(Sdl=xxz$HCgxc!6t4S-}jGNd2&L1_4`kj5~wmx_cFQX#!U9KDIe
zVH(&$42=RmGGs@xOJUdu(YjC|dhLl7i?W_%X*3+3lvrIHEDM7ywG+>j1QzT4r<9SO
zpX+T=$T`f9H@gi@Du%*mg(1BNpbr73h{5~BpxW28Ah~R)m@~R)FrR?fy6d#aM=G*_
zBLTG`@QMU+gKN5u#~@rheMuzBzNJ7kU_tKFp`v5Jy~0$EM3CMU8Uhh5_>mfMLy`mq
z3}FLEuz&;>FoeYX^#Y1JZn}hyguSX?@*g6VT=NV%!M-_CM*C<NNSrL{)Hd5z|MGB$
z*3$DZB5Y@p=gaKb^3hBGAi}6pI2`<JQg`r=60~P^eSW>;VR*aH$iA!7^!>=dSd8Nt
z6mRj(!H^c{Jus&CZ^lrlfr>&I5TDRo==UE&52rL2Z-{Gp-TEvyOUc2`a1QwHsHzP{
zTogv3DYQF<%ZESM0c%=Ry_S2I1$>FRW^j*P`SDg#TO{;9SKLEoa2-p)!wVw~Lu;;r
zyi)Mql@-K?>IrBHG?Y~mK(d9767tR07-l0krM`$JOVo6Q#+1B7?}dBq?1x24Y%w>#
zFg;oy1cydO+6)&>&n#VMS9yGJpng+lcGlE9r2-1U0x1wl?jLp{kv_0t5~ZPwNkHqm
z;tbBCQ+m+`?!-4s{#>EZ&-LU4rHjg^ut1<y;A1F8-JS%B7K4e1!_qjwX{<?tpmBkT
z?&AJo_?)k3IF|^5KtX`1xuiG}nIMkBiWdlp!x3<Cia3>FtxI$}wA)m`pixjxR+J#5
zR9sUmzL)TPeuE8Eo_7P}z#-l%g`)O}u<UTKz*u^<3~(B(NEBO`GK_Crs27pTA&BKv
zjDvGa0Ll1FLpZQ>3#S)^g9JfvDw0U7vLOsWaV9~x{Ph7y3=*p6P!x-Xra{E%I_B=-
zj_A%$5uwV2rGR+=RbH%1zQI+RP}*!ZAVm<Y;x4Di5$ocISwF%>;ISYKzFbMWNvK#C
zQmPvUX$_XZU~okL-eK8C7{KN+5}ayCJk!?U725B=S({}!7%*;D)$Z_qfI#YcMncC<
zv0f!lF%TDK(nuTt(t#08$!**9?TS7Fj`wLrSs>JuLs@W=5D1U@8d#Wo>I4XkASaS|
z>rk~nz3eRsaIL?iTq6Ud7hP>vTNTBK9kvKj$?)BVe;qyl9!LE%|993oYIh`uT?oqc
z3;PrdcB@i_p1M1y!OuY|did*}uNoFMKlBJ{TFkvzhnvF@L{szgV!$)XVjzqEW@YBu
zW%%Yn00QYoXjcZImDBWz-eBodqA%^%==Od~o{JmPTD*#{I+*1z|Dp5%2ogZS`$Y{{
zsO^tnLdqrxlwEeWIPK)PpJHfiQR~7}SaVxL?i5wYWModNO!!h^ysK1MtIsCG5fqbK
zmU%(h0(W}k#mC4^JrN>8n7din06VtRA3McccT<d$FKE5-0woEj$=Diei*x{I+QxMN
z0v4DCQPOaXurLFKwvaDQPSd@4V8=5Jy?0~6^Yn(9jnH?EQZ`&4G>Auett&rN0;#0C
zjaFB^o4c)%VCWzJu@`z1-V5}<BMhI`RJaf%ea#zzZmg?X-DsN<rw64H04~V4G!F#G
z$p-a$SC{~wuVds2p^y~5+kUq7L_N5KHWqSI0tJ=Ed9PM=i|}j!?*UM}=mvLq<PF>%
zc%cRV%thXJx1iXx?*L(r{~CBeAIc$B0|GES{|Q`lLjqQU@rFpU4-)RC!Fj%J3&5ZO
zB*2cDOM13;mkWso8}qtosq=%xV2C)C9<Nj{Rk2dEn2L;`;6`H{7YMlR)0`xSMbteN
z=LBnotbKpl`w?TUc%38)`O4jnlLDh58t&7%QG7y>RxQc<ERY?b7m8g(8>CVYS0TDA
zHQ|q6Zq1g_^+ZOOGh!95d2ZYV-IRG&`3OpO^IwYfj0fUy<eH0lTu7w5y8@o{9kcch
z8x)E`c|y5J+NRo<PZ<CaQf`A(oOxPw44gAysd#Nw0`<IYv{2DW<JA|9WOW7Z2M_;L
zAMGo2AFk#kfCeAc)Cxefl#Olpbs<gNHX3poKFTR6P7i*Jj4_=Lt3;iXusqB!`8R7P
z$Vvn3Sc7{mEwJ@A6#%4denI)xtkNO!xv7p`b6_o=L_)<u$EWY-7QN?6dttbVz~~!G
zF5!ohJY78j2^8r^9fBlCDoA)h)OUe^Z{nKhD7QRGRNnIIlJ~o^u?r#MFv9EB9pOiV
z0ZF8hZ|TcZ5s&rbE8WOK?yJSCiH|`h(q(Y_wdpe`OAJULd8a>eU~g)u-npk;+B9c~
zS%&7Ln)3vwe$Jns{<}w;q-uz8rt^K?-v$Qjox2N0clPJ+D~r_X$HsGi#m;#%7)J1f
zDo-QLHZ5NFm>)F4up?O9TqeG+>M@=Gj!8ffri7<Wb1Fqqd6oH<`M0{~5SGSpUWt>p
z_%X#;eplAq;VIMyXbh(M=529x&RA8M7}gg;e7OmqOFz%243h-mc>EkUW)9EhE#S(C
zO$DoHkHfI(>3Z)7Iib~Oco9lsoUuYO&z3Jy{8jX^oGd*4?1sn35a{&>peY+{Y}~rK
znA;DQEQufKNj$=?Czj#3?+4g<Z9k9*5KWB*u^{>ZMQM3gH73a-6b4`oP;MksznjYj
z%34ahYXv?!qlodJ;lZeQ4>LngHB)iG&X1~c#mdvt<q1@rAIrs=5F7mA{WU@QFT@9i
z$c0ip8!i&;R?`D{>^=48om#0Ct{Yyu=*EG2f(AGO9F$~1o_VUq2`~hs6{$%S=~Rjy
zBaM>8#R3rHqqTaCb=dWgVNOMzQ0_ixmpY1fiDa?9AsS72QQnOz9zKys5}lvN5jlR*
zF{k<A-lC$(ks8Apolrv}TIuGd2nrgD?a$et|G9G5aZj0E36l_iR=jrqH9fYP^wP_N
zjg9p0Ur>5Z3xDA6wqX&tO0&za?~9P(ZZ;84DkK)A^mGUp)&_&8#ew>0@K|1dclybX
zkwwb_y?RgW`e)BZ^0;pG`h(pmZlcp!0fz(}Z`#F&FCsSEJ+;XSrxP8C8~{TMOjY_Q
zHs2n=^uYu%-2o;f>L~JPiQAExq13x1G=3T~p&M_xhD<7{iot>Aqe0ko(;@>|QsevP
zueXXi|NUG(%MgwK_Uk!V!D;68K1T^muld`(hhgXAh$$8ODx-l*op;;ha%?*mG`xyx
zr6Y<tkZsK*^!d}A?sQ?!`8nuqUl}Z1unrG(g^O~R{OE(m_u@neHUtrg;s%A0nVdI{
zxm?O%LLAF07C5FgL5mfQV4uIf32c|7ziidAWAQoHsl?(c5$Lf|48_3-i$FA7kRYl%
z2f~D(62rm^kklMCtHORD8qqd16D{>o%7fO=LV#Xu57#h+L*T6mrCQ|0HS#kpO@jgD
z(Z_IvyXX=$T9+T^yC`v>`Cm1r4eTvF`sNW~w*tx$m3wha0EL}beFoW*_zei6``z57
zJ{R9M2*nMH@Q^^SmI6o+Lh}B12oKRG<Q5?41NFoiV|xkEJ`w8MSP6=QH3GwleijWf
zbXDV0enQP-K@%j#z6`t-TtWb!C5^tu0&$b0NzghG68x%lzc5HJ8qu2VuRNxvfHfsR
zs8V{m$}BtvU>;*gt+zntRc(hzacJM}JLNz)y!Ev$4*G`L6dHP-*TqyxY9(Z+&?tg<
zUMJ76*MI~7(B<asEM<LyKLnTH&khM~q{BZ(=9?P`D{!~$SRH)L_Z#YA<|_<=ibY2F
z5l|P+1U@AaUfR-o{$6#6G;h)UUkzzb%}gr$Z3fF!QPdfAur5tI6_mPtInv;)%jb&X
zS^G^9#87~{r>C3R*zLO)i{$ZHUXPFvdCLr#elK9LOaIgG>yc4OO=enETciL=&5d)r
zf<zcD9|WVmZj3Z6#+;28+lj!v8$XE1ugRS{$<IpI*)IrqP0yRsK~;s68d;<}4TJNH
zoU=V@^d`%@5EK;{b;j<of7AY+#isAzjh3N~&;8e~9{m07&*>8kpI`Vo`^O<p`0xDT
zVaEY;L-9ny$k?~F`fian(Ta|tAwvTLn4$VLl&2dIIymx|ADT3*I;I=Qgvx58*px{w
z(0ov!OVC<gsu{VJANmPZ^{FE(%O9o-Hvs<tWuKz;)B0w_Kg^`!B>ch~&Kl`?IYVO;
z(>M?lAgFRg7y+JvR@O?5Q0L;|8mWl7)DM6uiK%dSG(4Idi;4l0q}E(;?(^Z!<QLUT
zf1ar#SczzqDfqUIr)vt^eh>LP&OMiQ0gRv}9sNy-VowD)q@P(~&-{mffe-T$^?tjY
zmdmHuXagV-4VCO)_u5D#1P7U8-~<OW;~5JUiFI?sN=jhglk&ds%fks$c-BhzNvtj}
z#8YnRHXA$%>3Uno)G>^JTxW=o-5JXI<EGCXr}t+RlG|}UALWuPkN`NBoJtWtQrF(T
zvUId`;Oe&iAUEf}O{=1n^huC00(B?Qe(4Pj9>d`y<iJrvWC5QNZFo(Qn7@jHPK~27
zbIETR*&fj()SGMlPZKF3AX6=3M`Y`_W<7!pAKbZ&+mkp<At9-mrvw|^dQh))A>#K~
zciQC=8wZz@0pIdzeH(J*SWZj*!|i8hqketm3$iiGY5CIg;DFIFwy^((@z~Nwnw2%N
z?^$G!9P;Layk(?z_k9k_4fBe&{Bh&q&P^U9#LXRi?|CaW@Ku-X1UIl@tC%1sU)d&9
z>1y8;sysA%r!aC;O`&SlQ3srwYYUAdr+#2$z}Ya$JnWDv51UhGKK)VWRcyD_SbU_q
z3;l2PeR2DBBHx>OH(ubqwq!lJW;AQkio7$ul+ydO8eb{LDm+7DG&hGAivRultJUGX
zFXwz$%gDD*2T{cz8b2TB4CN@Ks9PbxOwqb3PQ-wFd6k_pXrQ7ZFh4c``C`X*w8BK%
z>cT>UiacxFtJG)tz;zf0%MM!7UDCE*00p>0l}nYaq{~PWozaBX<b1!+$7e>4A`(rs
zX(d5H;($1pbt!5XLgfCgn@ltv0Pu47nvErHqvr@MT_}5C%Izf`aIT5Sc#I7>&K9b%
z{fmcR0t^eiF@l65%I$2Vlt<mCL1-k$b)35ZA{ww_>4mlV^d>Ero(GHl%tN!|B)}EG
zHC4kPz)*#q<s|`7;n{%)!XQwr1Pd0=Nz2uTCk96HVhFLZOi#v>mq7GX``Px3>|$cr
z7->#0RK?~ZEPl}f1m)n!jaVDT5x5ac(Y@S=7pF-We*Cac-I-(zD9|s_iZq}DxCpWh
zYSRHJl!cBQhK!_qh-{5L1NQfPlw`I+hz9W|F9D)rKyorU_dJLVUXzdu1Oxt1bryF*
zchhyMjdwiMlN)k3MAI3{hJmuAz!5yks%}bmgN4Z&{?Wr)+@ADlx#JmJCs^cp=h&_r
zUsb=sik$}&UF&8uwz_#$OYn+To&haeTOa(P{!j>McHBXaMG(Tu`tjq($Jbb%6>sPW
zgZnPX=j_+dKKQv`QS?vY=-1_gt}p-gL%$qOXYc&=KU$xR+S%IL^41u?3Y@svMy*va
zDSOdO*PWg1(R#?F`5ncY`#t@_7#&l2Y90td-3?$P;ZrMpxBy(TKk&$Xs&BL+Jnv;@
zOfM0pJN>|xdZN7<DzDVMQ8DJ>MAhMaPu_pm*3J?SWx2Xp_+0_v!S)RncMuv9^j2;}
zX|w7n@j|UC%1p<h&_>Jr-3{r#s*)n{VsEV9HYo+xX0?&us8}PsasvHMpA)i$TET7-
zjiW!>`^;)u!Nj?r3G)OOJTi>DZ|4wMsh#{RPe-RPO}bYGhAPX}OUi1~?v5Jwtam<w
zvb-OWv!Z>9X%F^8^bUaPY8fKFP;Hp7+zd-B6g<TcNwV1Ejqj+Q(h!D|1uakGL1|QI
zJFH*BVDs=^+Y4`GKpLtt=N_lhGSU#~_Tx$!y!eIBB)~Zz<MAzQye3!uE=ij|P1B|2
z+Hj4>FVaB7WcZGg+OU>~rxvZ5(U4Uv&c><2-V8toq{`gmHoeuw5EpIWS~239r`^AT
zYl;PJHwKYh>^vz1%<A<1=+Q4G{m(fpQWt_0M<E;0fvi}bCNvZV=E<}p;jXZd$fyrU
z;Sc>f{cgo^hAt2|2T~jk=Tnkk!^v2t#U&aUr%{?Yb0DnEW~d3&7ZWjg%pC!|Ljr<u
z?ZJzMFpaAH204s{x7gR&iGF<|nLITE5R66jS<}X!R#rtoQlUVIGLUJP;MxR5iIy8Z
z4^mcU2d_W1Aw$yd0n{%Z0_NW@fC-q)qPk&>gLkciar}8y(@Q%xRqOTWKI(A6qb>j%
zGn>6(=X2ra1qvhhLc>+Ie%MGQ`KL@=YCp_~{Psi>ldggkjN@Q|f=JJy;vBqfESxF*
z?(-WKL(zD-neh|Y=U`V2<j<8Fe4Ner-;A>l{;>D_=DB?M*8I|+MZ@9UPoMKcH>2mi
zRp<0R_g$E`Shb0Nbw(w2<@eXH18}9h$tD{JCx!T)yyVNq5J?<CFP5CQ1og_1FIwe7
zF%kp`S5!>)RC|o{o^Qp@->t16P3MSB+kNr!Yjfnv+`M4bk(rM=meY%(RcwSR0Z<$7
z3=5De?GbMKAqDo=X!_1pV7<cK)#Bl*|K1xve_>_=|1jPZ3gOR2p~_lWAWCpl-d=e3
z?M>WExn;ZGVZuBKAd0=#7lugGznvbYeb4^>^5uVvjiZ;^yUuWw_~=nT^-y<sb%O;j
z%xRC-G68K<L(UK78--W7;j0$l&d9YAOkb?UNnZIZMiak$+3nW+t7!qkYbu<9aIt$x
zmQ)r+j+_$wE+!OO4EU#%?T*Z(8g&@BY|=aEt_9_>?A|z~Bh0WvDm;<J%`5NkB{*AZ
ze7;^NSInN=dnAv$bU&JGCo+h7qf>K6>|`b7j`xizS6J|ivi6I7J~yCJmgN6vK9!*g
z8>uf;t#|GxpyJBLU9UAmrf?3cy_TsOz0346&NR8&+>0iOgprx&*XvYC*>yU>Bssz&
zXn=C`+x#InlwT0eUs)nX<bQ#YL3{*JZv5m$BG_Dr$B}mFUv(6~TSHcU`|0nELQa9|
zLJ&we70~V}I`?leeL^W1FwsnbbBMbM4mk$q>krmxjyA?EoecK>4{yzGv7Sm2kfKtA
zL0pqmT3RbVn?&QrE76Nx3QN&~qOSBb8zPMb3GNlqZeuK}CL(t9&QHHPf%inXiZ1zr
zL|tF4-r4>$S026tG^sx8#dle6eC9u#GnTFEl=~6DPd?XZmVn=um%fUUL=jcnqBFnv
z{!l=$h+zaGENJOSg7sR~Ba86EkLS&EM*7DVDjnr_{;ub5j_z!)EEo0s`JGY5r03ff
zDBQxhl(+bOQA`i^qeZf3mvFaGW4(#b*dqv9r;9;C1QySqV^mUDo}{N@aLZz#G?>vx
zvlgF_^3_m?(0n?&ytA*wtRr1pD_+8NGJJVH{B5cG4XzWrMZX{N&Z}A%(fC|2la%Ps
zlk>LNv3j5|Dm0QB>=l&be;#_Ftj2?lS(0qY$=8;jf72$rKz2t(AjU@iR*Tw|-7)ja
z`)|!JAN&|gaf%8GjMPH7`rVpvGRZB!35l3PCoRll<f0)yQ@tcG8X5~Vtz~+a6X?z1
zzcrE*7D`~v{Dp&QXySi;)*ZFmtmqRwHcPYCCY1>b0m3O|+|*C)xv}iXl9%|(V8J1;
z?^kwIuHLxIKp<T{Uh)Zr@=8;1Fv!MSc{4XENe(BiZSuyTsk@gRo1rD~^WWHl6$Ga?
z9Y*IB447c$Gm=JGg0@?CUCD5<o}xDHG`zF~IEgwC$M-&9zC>Ut=_+Cln0NJNQ0+EJ
z00e@OGj-osYNrPJMqyk8q~Bg^jRZ7~7B25U9lu>(Ani5%oIPC{Hu|YyIoXu=BuX0w
zkZ$yOTqj*m78BBZR|SW-2ls;%kJy4#t=5*x>Dx~tS`#W|;Rda7Aczt#pG#O+y2?KK
z>-ZBP0-F#R?)py`vi;IC#-Xh^TAjqrYMk{ca?(P=O$_-976{`mq3fVNT$phHA#yD(
z-75!A*ciEgrCZZz{le+0*F(9^MPoYtEDRHf(P=pvm1lT{dBpXFh2e=pXzGOAw>R*)
z>Rz6m?@zX%JO)Nzd4$pMRJfOpGI^3L8h%;POWIQ`8|osE{b{1TE=+z(0&mMYb}%NM
z^36XIFpzOaRCsU?^#6>{eViHIU0_!63O2L?g(kSVyJKtx>`x0<bgcMS=-}9pV0UDQ
zfE2GoOn6OJYKUD`sAKl5-L3Z&&EF9zeLC7NGb^i`=`?L1w~Tv1BY8*Z))qUIJ#-Y!
z$q|1&&R~1y#u0{kdR|#*sgfGqEP}jfH7fHxP>`Xw72)kDYkGSPWT!>L!Cx^8kF?Cj
z${FgM7*0uEkgITlce{gph2617ynGnh^K)$U(jm!$Cqc>V%`=}hLLneCe-RQn*YHbQ
zKlQ`?Y|b(PX*|CuTM14V|G*1=iEf9(TxgG;vf#8VZ}I8AE$VnzQy3tT5(29F@e*(U
zyuus&089{Y_##I?R<1xc?J+!qkL_6?Cv#?|AuCQWyqZ-vn^g=Ap221*a;7b!_G~JB
zNUykUqXCE;7!uf$^j*s1MYEZJFPq2l`{_P!8LxD$G~LFAQ%m!tsJC=8e%`WdoI;77
zpIh>jh6V?=Kr=F}`|UjZ$7(G7!DYc>VuX%7TX75|2Wp7<y8DCHu8rAn@E?;aSWb@}
z*2q%b2Z8`k2#cxk<Ft{Gkq<zFKBwX~8q^DA=?xH8Yd5-gVae+YEtdo6jFfTgVy>Ng
zOtK^ikqB`*6h-8z+jM0ZLx;yFBnBFi0w`fvZv^_|f|tj`l$Xsgp|jpm(l@?$4axAr
zrmw!uj*)mV?}#P$40kd$B(oE0gQY499^CrcXmIJ<CF({s6?xPpsXLl_p49>V(;?B^
z^Ol0%5r)(#i<-Rd*k~t<a+1%H0L{xtEshl~?>A1?$CqedsGx+k>I}xcuWD8=^p&T5
z(JAD*k*%pN@=k+$tl^i@YSQ66?eKGcOH1hG(<9&U^TpiBb4dhuJUqnf@jz9h-<6%%
zNxR6Ftf>^-Us5mT`7~9_jfA%R<=drDbviYu2f+NE{f(Qt)Zv`abxT@dMf9JW&t0s|
zCO*vITUYps5OJ_PKb}YaK$)LbmhbplODFHjBf9EGHa#Ru0umCPrv@7pEy&NG{GX@0
zbogs*1(}kPQX4thS|F;hV`Q!O*{Wb@{`-c&wC7saGvqdDK4%}N4J!j{S!BjQSODlF
zI9WeU$sfd~97wX01;$S|C)w8+0xvuy_yL)+Rz06U?7hmk#9_>Y{pQEhe0S|m7te6p
z(!~KlsOtPj*Fp$hbi93{X7cseuK&)}uoJwVbMK*43Qqfq?A7jovHi8G>+TpF^xcLv
zRwTZJ{%-K#QdJiixZ(82q2icP-FTZ(wK}84*7`Z3CZeW;D;I6&<EcyV6{v!tVR|+}
zR_pXD#~Amzq8pns9Cp)9>_6NM_>#|oiN?k+S$7#u7z9Lo^*S8;fitPmk^j>7bgmeD
z_{s8yJF@Qwl|J)i-&}37Z?WW5Hq=m_u;b(cs5_lk52hA9Js*La1sZ(?T$d0y2>1M@
z6DI-6Ny@n$(pDXpa-DsDyB4MVE(L1)Oa@$YrSH3IISJ2iU+;?{R+q=e8>vOR*398a
zQ1S?Uy5r&P=I54^u~KV9wkdqxBRA7^NrX~bFi!$>R3}gME0U8FNa_69TIIk2u-^3P
z4qu`o9!YQ+A)@Cf$Lu6N^C?#PA}5q9#sB{9*Ejq3ABNqo9SssZJ9^6JaAWV><j;=H
z?t@V0zpK@L-3N=`=Ft-`H|`n)ht`j2;KKtWes5GClji^1`=4u}Jm<GwLiLoCPg(Us
z&j2cGohYh}&y{%oVtwLgb`vl((G7wqf!<+!)n>NYZ%)ad`6-v=%%kjNEwdpCmo0-3
z_=zq{KIXpOma0`Sl8|d7UpyFg<GMR5<nr%!?t#y39q~ULZL^~7apUb0ZEx@xGN<yU
zP<=*WRrBoZtZ0g%+gca%+lo@r(vA=!!F3Vk*ww;HF!?r&OA*61D|o7@#}&`o6`g_&
zm;Vm&N+K@KJwhb(gQ5l2d6-O;rEy>H%a^`536!r01p%T^8d()dVTGe|c-*yAkTs3s
zI#Fy%sdI1ydQlbKfY?rzP)l8jr+0ekkC!$q@?cH2;U%~EjmiuO%odb=sP~7<JMMD?
ziJF90tsNZ^{*}}i6b|OIprZ`HoZxAk)>-pt^p5uEx>B{b^R)J8LV$$-AktuXRszN|
zSw7vKYmER|z)+QCg*oS~R8=1VSo5EJY_5=a8;LKePYWU63BtvK5SO+d4pu3omiwd=
zlh{oq@h{FJ@N)q1d+Y9;bKH362OkeQ1LwUrc}v#&l4zgv3?tPaCpS_$onw27K*Glv
z3V_IX2IVQ%fp+13EsMLl5Dr&6AwtmviWff`3S2inhf^o<m&NL(MxN)#+>+@f^inIG
zFcYi<W>-5aEjR<3({-Ih8X*7CMVQ9i`F!nFk;0j4Nq0yzES>G%&*?MYBEBp+l>u&3
z2>QR_MN4(yjQ`2&mWW)Q*)+R<H|sSn_b95mt#pZfC=njgta|<U^}&##q+P`Qe~n)>
zlD0QKEA&J$_ukMX^yTjg#aAZxKOOF1uK(Kly_D~FIpVMl03+Dsh_-pdcDaU4;R45@
zyPuz5h1b1=v6ZInM7D#9;rfMuMdPmgN_GM?i$eV{exrFjgsr}(*|EUqMVQELox;=H
z=-$1K$nelCki*f}*@W#Dzbj6&orYzZmd0+S)^(d~)%q}ad?dlAHKpv%Jj*rJCs*T9
z#|(=`(d@2)wQ+X|eL37$Pp7=jn9;5_kHxb+47~p~iAZiActtO{ek0#pS((o@uahjK
zWH2!A&!1*$9I?65deykiLB3YCF<B6o_>OVGe&t4BDQ(_Er=4`n8QG*>zhWcZN}akQ
zBIqI|T_P#YUrO%-%Mp+_Ibzs3l@Pq~I}u#tKhUDB!+DA}IAWUEujhHRQYI@xABsVx
zkG!9C#!ykdy1MM_!1{*Hx4dg>cpN|R4)h0IM9l5V2G>bBghL`ILaklx22E3pi?u|n
zX||EuHaRxtXVKByP3+#Quh)sDyi#Qi1JVdq6scJ&kp#UhTYw&<i^8h~{yd7H$eHN6
zkn8VOrrlQRy}9mp50ZkmP&eK@!5qKJTjTXI-*ws>$XqO$!96-NF#R14O#-Std3*Iv
z(mseV-lBrPB+n6K`ESC8d&J<{NGWZK>p{z=u%f5lv_a@?zm>Lh<NysN%pyj7g%$w!
zxg`DI=8`nK>-YLm*$GbGyxf;t(@c>hT(9r@CVDJ=Db8AIUGIWt`;s^bUMSoa*Ji&r
zecpC+PPDu$a`SF(ZK(g|UE3ut1Af<;OQ-AYj4|g`gjUemuM|XLeN#elopMjocoJ4x
z9xhZAJ@}V+a4*-KjZ2IeD$Qb?rPN@0H(=e&#;GUljU|pV<9R9!&QV&Vuydb{6p)uZ
z)IT5QQaYPo<-0Bv9ocfOH6g@4!q4&GQ}%vCQyl;rHhK;Q(j`h(MDb_cznm3)n14I*
zq7c>Jr3zP2;_8v14V}{I|E~NKocdr?w;Fba`4GNkV<b^pgYcIWc|~c@G*U(?L(}*@
zvC?i;-d))d+M>=g-DIcP|Gw!S{P5J1Ua%l*bVv}nPPs}>%mz!xz3T<gN$OBNq79FF
zL40NA)roiL<OPZT-ZD2=mwQlU1tmgUW$i#juZ--V#5u8>&3oLgco+#NXti$6xBbs<
z4QKkFAkZqeQ$;ApMi+xtU+6|-Ep4<<y$H|VK0&u=Oy9QMmh?opahK*V)Q(5n0Eum+
z8l}P&4Gj%mV}wAqjHLt`FW4yDwOwC`eKf18?H~e%8riT_>WMgrfckFms%w7$fqX>B
z=VUoc)>0_XhB3nfG1U40CQtym?0WFR<)ek7`aAU<hD(h}P3dPdjWwMP;<X!0{AxFm
zC_eU>dbh!(6JaL;;nHAr`Y?0462Bx+mMMc;(J+LX*n?3D7s1bM9j@CY-d?|Zi#}_e
zML^T7M=a_0L_sLEyJ;fHa{^0n<gn$^2>6u%TuSxps9jTLy#!YyDu2fA;Ag(|l(w?I
zcX!K4xES9@4bew19~R1>HJC`k?4^|&&MpL>0-pq7cjZD5Y~Fiw_50r+S?~CquAoBr
zPD8M2rW;Syj3Vm3sB4)fP|~46!b5*wjHx*4O+P*V#O21lCqb)vL`#$OR8vdN;I;m1
z54XoghxFQdqM|Nde!AS4=OoXSI>YEfPgW#U%x0TM{q-t;!#zu}!U%w{-$kp1Pa}n|
z1s5)R7=1iflcr*gf}Yl)ATAzU8kYld2Ux_Ba)1#X45?bPNT})gW_!A=8XTf)4I$OI
zs)$RXB+0z<I)T5k{H{o~yUo&efY;ux#)>nP@IbV!quOh>Gh?jiPu+%sxG>=n4Z4~_
zvj8M0(DS0{&?yDy*{+9gE>*vt&2Os?Ut_S~ARGw+1?75`RMeOTcQaYnx%5KSWBFR!
z(CipY#ZFw}<Q@Qtz1<aR9a^*+kef5&as3Lrz<O6px4Y&!EbuYXYP~FT!L{8%V7<JH
zIeR5ifR-Cx<MAT6_9b6sUR5H$KT^UhZHvzT*}7vdNXO_C2N0WjOp(3$V$D)KZnr9B
znO(k-c1_t$^nM)F<Xan!sABr;rGFZVH5Y&jfj*2CNHhdXkt9qUDl1^@R?3aTW?yK^
za2*!#d6~6x`h=K`yKuQ?lJ~0YGQR)_Xr`}(4R324or>B%hy-O+LLcKjJR!XD4ubHB
zn*4~GD`y_BlroS6X(-<(WT50iuCBl5Ym#SSI|E{D8)1@F)KS~KynMMjK$L~UBrRS4
z&ldda_!`J1%st8;m-#AWZD|F;x|+8_Hk`9-KaWJYVPkrs&#qhp=70@XP$6%5-Ie3)
zo^)FPhacFuYJBc%xYJB*TdQGh|9x8kU3M4V>wxMtWs%DeuXLZK1#81Rq-dvc!xp4)
zug12k9>F82XXbL%^a*W~uI|z%lV!{RK_8KZAD7H--ucQd0FwN|dD@ao(N^B76!<X9
z(bu0JqWTSmC+oviS?rqqR_m6cNfOgn;$_6gFiGSYfiTnl@6mo|H}iwpdm;mv#{l<i
zPt?Jh^O5(;DX#N<3pAJ6LNn$94gLA=&x*6=3LEltotKpt9M{n3oTgft=DdUcg|{^4
z&aiL|VW5{mmZm7=1Wua4Dn?ecov$&dIc4HmcID9VY)*Aly6Q@RyUQ-p9cp%4-XYgm
zt#=V+ezR#-WyYkktyGEC`Re)hHs8{+EV*|#2WRxd))`JmW)8YzDjtFF(N8Rm$9(Hh
zVS&nU`@+|BEi5#qlDBllJ77-qifU@_pCGBB&-t^5>j%s(dmtPq9W2Px#T;9CJ2PUT
zZ|qY=3tpLyu$QN3PlyHcmqC%uvsXko8tq4E;@FN`3OC2-))%O>?AJI5f*5V@9?`_2
zC>G;C)@_*!y6bd%O`Do9VL9X~@jM_8z+bp2Btcb4>6#zXsXsrKcO}>M?9jYFdHZ`B
z3U6Tyf~G0KICwasBQ^)z=Y3t_#F;CRr=LTbW>Z-c$79K>8munPDlkR~Q^j2o{O+#X
z#>(|qX}-R`a;4dXcoDaa^-s&90&{r~6p=+k!{e3|)?WT^%F!az>admfaX$A|qSsic
zgo|`prX8(8A*y<}W*f3?y<ilLp~!(rqOJ_JrO*VR@clqg91F9D@uWq3LsP5cAysub
z?u>M{{2MI_rTTp06(<%z)$i@}m7-H)RMp6rRAD4e22o}v^%!mM2CbweK_SNfVR4?X
zCP-a$EOEoL9D{)4q)=?x@tWl9@OiSpI7sVAxB5E&rv)g|{@#VO<Pdc$96sL_5kS22
z)YN?K7Rs;wjzPmopAo}PA%G88xcB=aA6n%z>{ny6xj9fDuG33F&M0_bZ2wxq_IB98
zudQEuG<%e^rFAXylBl8E{iCgi+OUP7*2v?0rFzogU4tA!<H}IVr9UsmU0>*l!o13x
zwIY%hG_H)HVMb>8%pacx6G}4sKw?tD2QuMQ2@Cg~f0oLgeL>Iu6McDFlun_(JbiI-
z>QR0G&!BI)P+FbV=Vm*T#~tYsYP(i<jAtF5Ep>-i%wKo@ih{c16rU_;a8so^HS3<=
z(x3IU)*9V8I5_a@+5fY&=dUenT<iVHXck>*ihDlr5mQyiFlE?<?x08B2UzWFS$fNR
zGJmw#?y?X|9d#`GtAJ$Ee0kNzJ8JpEHiwAG&it-W*N{fjf9aMc<v!{S?P{J+NV69%
zKlFs!7LJM+kwbpvMV&uq3_}$_tfeiD6G=lA>{g>gRePDmpsyPAfn&6<?7A7ouBvTF
z##UGPvr2b#AC@wJC$GAQNxuKv?{@xc#s_^85d7Ju@1?06i6pJ6SP9sB8QyT+hW=~3
z{AXR()<Hg2Vo^z8o(JV<{FQlc@#N3W>l?4RnocXZAszLbp1v84nf}6^>6r&ougBg=
zrcZAANBPUI-EzivZWp#T%ueYkAhN7G3WGKpujQlp+TCT0?>V&PGJ>1`5{4(gRH~%$
zB0POk?q5<?1miGpE9rB#HoNY97nR~S-m~~H<T@yme@-IW_T%FVkayiD82YWuLfMnI
z*IN(>frs5M?X%xinheY8WmY%>@J6k2>WLNO4HF4V3ylc?Ka9mcckLU9s~rCH`5@Gf
zdu)Cu<??!?jt+IXk@E?)*{8ELQZ;!Y)UW6KlG6D9pxND_dOqhIS1En&v8%5SM(_<Q
z6UvS65iDmP{Q9^yS#KiEfuH!J)Dm8}Jo3rT$HXVFIv8mexu|YlXY;LvIAz-<7JE|k
z&bQ+K1VVh_-E_69<rnQs{JxyNQC4;KwA#XT9~6r6pN6pf0AR*nmf5dzqCb_vw9R*#
zIE7u%7%z$Vy%H30@Q*fhyxyN(!=aqBCmbkPYYu-wwwdDk@L%OuCa54JBaTr3Pwb_o
z+nmQ)sje5+HTyg?uiZ8E(z)aDkU@)h*En;hP(i4XmlGb~{4_wS87G8c7EYffb5?x|
zA_O7VJXh+CCrcR<dmu2{{j)|JdxEQrr1fKe2|0c8lw5c^+K*Z@YsFgdm9$%#jySi4
z4%8<u##O;krUh)~zMkC?ouwUZxe2vK^6qahY2UBtbUT+EV1C4hSX#aEm=m{n`QX`?
zE_pq_l#+FdPW~=)*4_to(S}$rzQXeX<*<@bJ+5<SUE$Y}LOjat&fe8Yc1JbphU>4q
z@y2QauioX8_2mc5u`8PSF*?i9H7D2qYaZk1Z^;>M$=R-LMs@D?{E+-S<zbqeSDR%U
z6W$Fkn_xATZoXdHbo41n#E6OJvjRaK&fH1OmEJWcP-n9D?z{8`PCchLaIsuB_hHT+
z{9GcJG-k%wm$YSK?I(Vp*1FTl<Y^CprV%vw3P?y@&pkrjJCr3CoVN4rSCHm-KVzLs
zrBGq-P<@m7^BY4J#ogj^Z6aaFkheQ>zhOKg_f)p#iLv{(#?nn)XNk*9wd9+|Tqe>9
z{jS180m3{(mE+g++~ch%&n|R@J}o~3Y(e&XW!>P3v@NarRVVWs>s9U6%XArG3_52S
zpZ{1Fk5dZyAz6E4V*jjh@xA;k%RSE~)mAdQO{J-6zeR3q^-`6Tob(f!=J5dG!L-K`
zG{};v98kMk7QFTp8XquxPuIu9eyN;6qjNrCxg&b5?UT|33+Wfp?DEli49-vIdUIQy
zWx~s4$Faywk$}bl{X4Y^Bk3w4Kok8_byH@;&y`nvOwZS!uljArT92hKnC}hMm!<nV
zO<a{8S+HXZ^}E~F)n)r2g-G`dh6P%!zYf;lv>VqcuW+1kdh0^js#ysuzvZcO^jy(`
z?R&6cP50HX2Xa7-q&TIZeNIGL3GrBNBwfRxt_iu~G4d7;D%UuUP;{FLC0q3~M0B64
z_MU8fcmh<<yM8iUr)d51@9D9{!&$&VJ>##4bBCVpox$q|vj66CcVth^#4FXIH9pkI
zzT-0V$yi%WD=2*=w|D0|i)BE2mWnV~;|+MuOD7|IY=@dyJS-=Wi@zp9rpqsqeuX@y
z70RY`&)8*(ydzawL^r!4w)f6mdXUZO7|l9k?Y1J@?l?LlvvK)FVM!jy(gh+02gSu!
zhFb9Fw6(krORGGib7{}gk0)WWc~<9A*P0~Z;Zcw#vHSl1Htitlh|%Kw@aJSyoc8#N
zzDPU(+ff^JVDprhtM>NQQ}IeZk76>JJUl%0&YgdM-YT-%|MmG;#{YBD`QhPi3(w|R
zg&Z>n=bncbowIGUTCX46a?av^^*9w^i1)7as~UCajqOtWLow%{lRCeIG?R;5SF#7#
z?`+T#W#e8l@kRomCOWJb9jbm0&2Hk?GOoj_QCHaA#RQZaEq{jv?(9x}dA~eT-}8I-
zagJB!&;t6(*w&W+il$#P(g0^@F?MI+{l09asj<Y}J-NT{te0Kdr|#E;6wDLM25_lJ
z=ScSBEY`|hu-q%}-qeo)EVxFyQQe#pJaI4NYp%`>-HiN(Lh&bX#oirrrw6L%1qP_U
zKI(NGOVFyULQ{&VDT$=#?jwUC3ob48RNz$MhL!C$8o6<Z?F9(AnH5dE4cd))kUAlQ
z@?HGs*R~U>c~cfX_tH5o)2JP%A<E*2qs@QwXMcG8zFx~6nzKDqlmWY18!T+llYY*L
z<?YPq=n!Q#_gVE5Pf_Pr!Qu|jCf9C>Q`X*e`5ovCI`&8b|2Z`#2ct%_Z7&CMy?%2l
zG)L#D-psu||4_+9+9wSf0X_-j7_p<E^<AHg`rK=UkYo?8?*V~<Haikl&C3I~v?7tH
z)Y}JHB%dcO_4WBB!XZ<Y=ciAGUM@1P^uy1t<+@2yFNTu7ztYs?yDDm^<v*M)X1s4V
zAR{>4EsTD{PXPGkhH*>YRXHAPNh6&Fqqnfa?!v2R`pTYv0%@m#yjMm`G3U9PJ24I_
zG;0iQZF>+Nc>kns`L*YAS2zMxQ`)wzr#YNa?{p(?iugJSv-}AY{$F4n8aYI*7~8+E
zX^7br0oihnR4Hu(T!y&E%M&NlI4{-cO*x@IpQR7q_Vtw|8l?|S%D(nEJ9^@GfeonT
zQrA-@JpDP773p2;^_oUqu<2062pW5&W#JxupZ3c5S;eedg<8I|@F{ciyjuu5eDnBo
zO4P5_-I4qS+E!S^sbYeBj3rr+VjXGn2&Fz=o;P4=Y+%~zM%9t)c&)9Hf0{*(f(~w&
zooKJDAbRG<TVA_sdyH}(XMwiaomVEMmNnBZl*!$ly7_%I<VE}Y*pBH<9|gXQd|$0B
z625u!AJLnOi_g&KuGca@ssb0m1D*7eb<8mW01U}nTK28L#=NKOijSu^?U&G#!K#N9
z)~}mNrniFCYdLVz``Ehj?hyN$x2#tUWRr&<uT`}rEVRR$29<bPCOAs(5Wr)F>~u{d
z0FGplsfm?#T_0~bL7x}JPCDhOhD**Yg)VL>oKU|46?o-p?w}v}P~_G^d)Ky1$>#tm
zltB3F%_kQI^>No<s(VHlw!&R-9$ZmrlGg`TIy1E;vndZ~@vCT9?WpJ@h-Y{^&xX@G
zexE-a)iQS-lhXvw*uvjMooA1DAbGc_*jfGU59wQO#KRZF^=mA^fVDzb0t<zDrqJH5
zg^M)bEqOqm5XQg|+qxTPzp%W}YTCc!SdmV<jApjM&V4A7Unc0Yl&-C;>!2>r6p5Za
z(wsBM3DE9@x3z`ud)Me8iCR*N#2X_@$uHa9XrE`MKeONb(!C%S?<L6D)v8mtvC%EM
zc6j(~uPjq~jScZ~x|Od?TU1>@YlvNpRq@U(UMH*YHREFI)BL)hdE=gh{&BH{qLgZC
zg~M;b6+3E`eL2(M@IEv@N=Cmx#^ScdZeevF3+)Fw>22;yE8L&kyg+Arm(Petx3)eG
zcUd_8o_b87-zJ;&s-vAxS9Km@=$MC60reghf-&3_EDo6dqyRNkN812|G_rKF?rG7N
zva6upv=~;Mem-8sG4G|G>2Ghkw|SHNPIQWXj5M4PaZ*~+tUX82VHnI{=jm3j*#<mp
zfw`rnK}SZgvZSdi{j1AH<`kuUE>Wk+=gf1cuGwbkUAY(7@qV$|4(t4?YPHXqI~%7z
z|M+yjXessmgM%Hb*Dk&n)Y4+T(bYCKJ~~g$mgIM|b1c2Hv@69?e#dZq^Yt`WzacZN
zH!J?8$pApd_Q?p__wA{<2Ry+U`A9~!Y=$7-j%~MZG*z6@GKsU#A?Kdx_rDN46FZ`+
z^x$DS^h@jb;lY_t)XgZ&!p09=%s_Q4_hFmqk%K)FWn<MdOrJ1~nNb~`{jn8$H^|uF
zl~335-h<)!voB9K^!<Bgx%w|)FT>fIC!znL#G*vJJ84zJJuxHKwUI&zdUW{G@!l;p
z|19OLrTlLPi<!cWY09lOFM;r&bur7%(dC4U*;%ONn8(V_r{%I16Z<CTLbJ`~{d-YS
zN2?QSJ7r&bjy4XC2dG6yztvM(6ebqJB0u*b(jMc8dEbhEXfF#%dpxI738IJJ{Q1gJ
zyL)@T_fsxExPSl0h?4r*!PD;@ts{d@;N;`l@S9J8dx5^bEF{vgxHr$Z29e5c@FVo^
zYU{f;@%C^3&dN24useRVs^-zFwN~>mF&kp})$f11z4hP+Ejuo^^10BZI+mu7Rx9Pc
z(|=}``9X}!I^7-hCI{|HPVdbXoVw9>mq#)#zYh2Hy^ebhqZ`Y=nazO}SFM_LjEr0V
zgR~L13oYMo1cgolW+~U4FKA8579VPxvZtk^wKuP_b;zl&=lC}BJ$JaX##LK=&0R1)
zyfE~BsH5$^?oV6m+;GA8gaqckZ1ZgLP1-{%=e79Gz{~^9q1yb1j>}7)bkNzeXO*4S
z)fHX0zukLuM}4|``%=DbuXQAIFjORE2(pm7(-tWvFmG3#cMPW+_GF+~a6j6E?nV~7
zItBVq(5GXdLkm~dbb@!Z+TTJu{C?|vax~n4wO)KK7CrbVzwUwJUg(7%2os-LrcH&c
zeRAED_q&zIrV#t}9<$GZsE5ORn`<KXisi-Yo&_<(*?iMDRjp5q`WOPy{H;P38%+_b
z-l3B`%;B$}=h08iDrO?9j5BACdC!aecXYhmPeh>_n%>LlKMHv|=#^JqQE?unX=+u|
z)^_TxdW}*2`WWCPE1YFHJs4?#>#-!%hjUtFze>}HY;CvQWBiD@^ju}{7FH&%UoY}}
zJnBc?=Ildu*Y$hh%tPkkz3|<yzQPFyOh1bK+Q{L;fkMx})qKD1{eK7QDJi$oRu~-_
zLOPcmy8rw+*zAdFk$ceAwE5+}^CQ>-dfYN$y7_E!M%(VJW&7GZL2-N>_Gx{+FDUxM
zu?+3lbMW&1`@U;<`Ebhb@1WnmB^qsgB`7?s({L$0s|AfH{7j|x+q8JddD=a4u)SIH
z*E+j|DcBx@X}@(TzcQAT`3^|C=%>kEAu)0-?qV~apgh$!NgmbAiOAF9%J0})+Gq;-
zy8ScE9cL|4A%jXWH+Rgjl%RZS$%IDq2=gqQKO1$8Rji<zAWb}enmofrqag`)k4gNt
zHw(PXxSgv%y^NLxQibuoKRmnCal-M&&_qz~#hJtxbk`BrNd*03m4dAP@nzszM|<3=
zv$MC{4DWijV;C;Co|U3gaH840Ii93{tWrYcE{ErFPsv8(5g+W-kLA{h`Bk5HgvE99
z1{IIh!RFFyMyA(HZ2#P;^KAEFY51Bc_F`BDVf)Qt08tzno{hI|uBaYt|6*m+5brXe
zeS!WyJL@DjZB!C<47r-W2)?Ayc7svB&$t5jXFY$U_MlC#w$nV(+B#TxXpQgE(Or1C
zG}$I)Y%yhT!2R-J;g`Xax{W#HIlZr{b=?_5lm9-w`g~La{lj8+0zsPu<^6P>Fgb|d
zpKLmpc9i|+TW{j-_~G0mN9R(K;E*CuNx@Nu4?obL-TuhrHT%)r_P;sH%~Q*MN1MCB
zBlTW+a70YqNX-V)W_l(d)k`qz)mj4)Jjhu8InOw#U@}KmUWG;;EZGZKPV^%;3uk+J
zdZILswX&NA@K0I7oH;9dZ!l$`-c!zhw{v>_dRQI(bpCfN!fibI%kyvUlpdn-tMA>y
z<?c>lXTPs1$WowadH-NDC*Z5zc<AQru3xubZJ^M@y~d*1nVC=ie^)1+kN#9EDC8)g
zy5;F6RQ_{*#R%7sGed<=8ZpnV-b1eQ&vf1SL+iYw)u;wjO&OJws?UX7x`j_{Y&ibL
zwDA7`96{s0I5Ow4z7D=mrb0uRnV<*~6EJfvQc9t4kF1qj6>^O9m|B)4=a>-}<buo)
z<iX%VSZW~=B@!ZOy#p{9CpybeMzrRLd-ih;Yuvra0O*e7&e`foD7%O!L0qDrQVLUP
zYWu2rX5Kc?cMXFw#c!=;S#@88z6~I_hFQ-`F$mB%iZeHBiq5&#@d~?8gduQi-P|^>
zJ~T7!3IJmro;g{fV9pG9&jp`Rv)W#~-8p4|t;QeE8!ev!JW45vLt(QD1AtNr6;V}+
z5WE__i)+^vCoyMch{3$p<}$5L={;;8I<F=DpgO-1pV@PiHk!mJWrcp`nl;A^Nr_C|
zy_;nR(KWSy&17AFU4e-GTUQ%`uEOY5u->$pIeRsp^Zgac>vO@%of*S16-e%Gnp7rb
z^hq1144p(NX3Au8d-GC~HABR1Ej<GPAhf3##oZ4#H}l+DYj<~d*84oq<2bte<$T6X
z&vISX_&XzMW|kj-`n`TieEqO^o+OyPT(DYC6CyGJF>n>kjFhRMAdsmo%-q`Y?%mt(
zzWQdK7vXsE>Ta5j-@keL<yYT*^WD4m59g<|G6)gR3mgu&r5r>8i-N(Tb8F4a|JgtN
ze+Jm`c>Kfv#V<VU^msB0A~4gXsdhK-Rfft`xH6%shE;+@2P}1*4g-zD{Pfs+8;0`o
z)eV<Pq@2$4!^5oM<8X+G))quY4hUz)^q0x(A;~*mixPT`333@_I5V>Z7CQn!U<kmV
zFh`;_Eeki6aU9p7v74e}ot36QEV;sK;js=it>M7k2|OI46!CS;4*(D_6JjX?qPPju
zDB}Uz1!5%5KzSU>P3yB8FcjvJI;7;{E->$<f^LqUQ*g;0x_9?1#U<6}>3ik|h`v=v
z+%!rN-a=0hX1}6AID#W+_-dt$lq$=8Be(g2&%%%AO=_n5`V^6^ks5Mj9t62Tcn|{u
zG1Gi$`QYYCYuN{vwm47(29XC+AVfyk$ayVbmgN~CXxh4W3){?A!X3;kJ4{7tYEgF`
zah4Fa(yQ-6PXf%$BLQsYh;ZfYNfG?N`44|<KUx#7rVV(?zOt;Dg|<v&vW^y8QGRFo
zu5slxzyy4z8h2!BW_y44wb<U=Ypul326H=B!mCJq9T#{nRpVY&T3`3?imt#bKMVOu
z_nE_#<7hmXIi1rWhfF|Z>rpaL`$z6wH@bZVxkQvfb_>^Q!|D1S*5I1GVYH4tMUYb6
zqxUup14Q)RhhYGK%lXXAoMhXTXc1Qpe?$asL@I4NIG)`)H#EB4k>{E|&<9VsU&*Zn
zuoe-d)8#TR^EgdqDDyJk-@g|^0eb)b?c49Z4*(Lme|q}ji!Z+T>tB8I?RTfsYz9)N
zQl_TPTo%=(^`*70JwT^vxVyW3`{vEtH*Y`t?9-qB{?F%Sd3bz(JRV=Xx|^4o2x_gv
zP{^U{;%10Yi<l}CA8&4IE%SVNdOEdbK3^_NTaJh0r=NZH>F1yR=+htF-rWUQ>s^Xu
z_gAfHJF>b-?wQAC517=R?+9xTqnQmP*>_FTLm&t8YT*vqULj0Us8(4!cXl`4RYZkV
ziU>1N6**2*DT3h4S)1`J;xThh-T=g$kl2^*rc6}oINjX((gD+FKtO~<iVU^XG9Gw3
z)NDE=Qq{J!y&9pq=BFa*-U4R2%~tXJJFOo9uxuU?X?B5#7J!g$;CxMD!ZsjaN26PC
zl(sB?J4xDW53z}Mwjo!Pqh_9QYcOI~K|`eElx#%Kf4f6kki=%SO++PaH;^*X-h)Qo
z0yD+u=MUey=5kde_{e$`L^hys-%#!PF#%U2n}~I`YdSCxXHQK4$iBzYq+?r7;jX2u
zJ@SdgF7s&`j~`<AzXKNS5ip;&Yv*mi_Z}0k#i4LTgy(CU>NPs}ASizbMIrmj_sjyW
z-`I0N_p2vKt80<9lO*4jnaP^$KliTW7ZI5z^yVbT5mDD!@r=lj@)}qrL;zVpPpQp1
zV}_Y)sn5|iB7nuw-Irw<$1&%yk5!V(&&Vz!EU2onx()4Ovu9!KGyMEp&9bm_qlkpE
zC!|-P47Xe_Pb?+C9O;rqsLgz7CM@b$>xeAa?J(WUt^fL~FE3_D^6tC0@7}(j=Z3&6
zW2qyfAgfyV<_Xr9?x7A55jQtSRr~d?fAv@Y=70XtXP@8R9>=K$m<Sozz&H%WPy>2l
z8OJ&dgR0JR19}92d1+h=VyL#>mshXvq)d<J^X<(Gmho@?=A-}D|M1UM-Mpu?%N=?a
zPc}j(?{8u;0I0QG#n7wuhFh^B!mMwc01AzXXWg9v8Bm1BQW?_~!2uxFVF>CFrH<KH
z0kL*ZVgTpZ^z=rfbWigLT!+ScLnQP5_U%JoF6Yzf=N>O^CI|vEFokVoL4sQFWx1SB
zr&DWsI-Sm!69CXQXquUM73y^}Ltw;JoU;+^=_={W!bnUdVijW{Yi|l4v~{gIO1NrY
z+|`8co+Irda!L*$ZTtrEp6@boI5h1ZcAO4-3|*xG7>EJE5bW;SegAcUJZ~JpGKpS0
zdLt~Hfe^WC*WR}sRJ%2}VjhS{SP=2?;gm5kLRGtVOLq3E-n*&;eIo&KbaqNVZ5<Y5
zrIY}WVHoz~#WopJe(m;@dCD!zB3!RIzU!cQ{hc3>kJsh$yw(}fe;^>uA2ofZGiYnI
zz9uw(z>QvCqYng6_)LCZ$9umbJ|LcToxTz@;GVX9d4~uQRF?=$ktl6*>fuV0`25BK
zAuxwK0f4W%Q6wTa+eW9Y@<v27jjk~aQ<5)3&KleLJ4J*T%nY8}x1QAkfBPh(ttTS3
zi=Ut98bs{BxK*NYdo1R;B2xOiP#Ipld_7z5*1~)`+*x1VeEap|{gask(EIzx#j%Xj
ze7*ocDJ6%?&RwIoxwokfK{!Ye%6?e_#HHzRnk?Y|^RNEm;q>r-`oH|2fBz4Eak`wp
z`1P+p{`lk8ns@De-~eV$&Cq;0Ptzo|_N6uL#9WBobBsX)@Yc_7-h6*Lorud9U;K)Q
zQfHHPodBz{Z&k~#Lq39t)K(9NA0+iVw!*DLY%5GL0HGo?XXc)Xewy$U7ITfT)R3C3
z)Fk8D^9n$M6zknw-LgxO6ee1L5ckkJ5Fn3ISdNe0PN&ni-+p^Djkmw^+l&MV;cD7o
z3)v!~>Q7Hk4-XHm>2ulBV#m>0;n_5Kt2Y%A=D=qpEQJ7|wU$dq)w5hqn-(&)_gjAy
z^xpIO>=9?LhSyXy+p{O>Ud83Bua$qaRQSdA;N&RLAys-{7OFrP2o3;dNF~?lv;N=I
zRCQoUM8C0-KkTTC&5wASDt+b70R-?|ec9c3vqEEA;ePFf0T_nC%&c|Z+9r2(VWN^}
z89_Q|)mlZQ^_dv5f85=Po(Z^T4({&?qp;Dpt3;rbwJh$>g|=%tZ$Mmn_ni17D`HJs
zsqha%#^&_|*<!I?tmiJkzoXEETXz9&(>1aRpKl`zk?CuYef_u^d}zvmh$!db)LNL+
zKR05%6zqP56ZauVm~|TjNL{gJjjo%f-o*?faGqO&Q0<=JOI3M`n;F)#0iU)(fqzF5
za8)_=t1wDe<BGQXvg&w}-i51fu3YrJ6Ee$Cxy7s<fX8X{htj%V77Gw5gTv+ibg_r0
z+v!lJ(JXp1vuN$&8i4q8IRl~90TEkMA_C^<dOIE7y?gh~clQrZ4}bK>fAkx_{aaEB
z5-e>d;b|O+D4G&s>&yH5chLRr?(XKr-E}jfJz(!<NVQymm>J#ebUr^m-Jj2A)pam(
z)&x>azF!<#85K;U?%wsoBxhaBESU9GBFaW;%oe6iY)k;-IF4g=cQeiY&K!okQZca0
z+o;wmLg*3RGe$4-4B(|!61>da-KCHRa6uM14nrNV&@1oC1oJ#UK0Y3fbr>Z57u_wO
zyF2qSeN`f2Yo9|R>aFc)F+=Fun&CO35)oG74kY)xFUyiDEHgKAW|2~2v!=wYe<`={
z9yIpG?rq=kRuS6!M<@ali4v`rnA?8L{9qHF;yMNi0ES@-2jQqCvhWZQ<ZNJ(Qu%Z!
zW1%95+~!3D(!4r7F({z7wYzU6*#P#qp9e$EQWU9(oJ>rf5DCxs12sofh)6Q#hr<C8
ztv%=2{J;Lg-vn3(CGDpNGxy$>Wf_KH9LJ^2%zQi^0kC%^`oIkvuFOFYIA@0DMM*9Y
z5L0uyhtVCGUbn>NDU*A;ut+IFyt;bjRFB;hdjA_B`w(y)8vPt(vJAO?qSPYedY3k}
zKzEC@XiX5h^}L&#Z~hdpcf#d00f<s++9d!16Oqtr#hiMq0Ki~kuItJ}L?9|PO+QyV
zK@qNXL<A3*FXw3*5y8}It*X{qPrvMN(5`_XwIZQKU?d$L5rLZ*Dl-Sf&R&6IAPO?B
z3EgV=w5@C;!di>0#tN{vZMeHzBp<Z&{`7QKSE-VA#q;^{@c#bGufF>F+wYvXj+1+|
zwuo@Jt6Qd-BIWk>ZWYGW5&*sRd<&QJ<LzPk^2=|>1AqSG&tJZJJsl1|{mIYnUcNk^
zm)qmr;c%n9FRe|7!|ly26Puf<Lijk1wN$en;I$6ZVVZ7^h`cNdAQSQVa(Q|>fA{7s
zAPjW?z-8&_K9yRW)|PdgkLubQ-nEp%EX=Z-%Me4}*>SAXG^RTSfcLKLveYsVp{X*{
z?d|P24r)zXW1%)*TAwLA{ZA1h$FvH`G>nIFAOdhFf}xgqKD*m=7;52pnIWu7F}Das
z2w@5{5xhB0wUjjH6QOY&Kvw;05;+d+PA#YY26VO7Rn598(rR|o`zGNm1sU_Hwxr%=
z?Jz`D9qMpA9&>}2Qi@3HIYu|FA<`7Qtp3d#E4nkMiCupPTsBQ!Ceb^l1AsID4cPt8
zHrs2+H5pr0x>kEUTnYlXX*cbNa2STeVVcI_;qhU8A^;YVBIdrdB`|#FY9Reawf8;_
z69AZ|rj3~?0L*&RUZ=5+gF{%Bl9-SP0!o#oEnWLK3=y6~6?6V3|8M`3-(x}Ib;94~
zb?eDP1cZm@)W+7jhu1Rf#yMLiONhiI?veVC^x;#r)|!VGk@O<et_WCaP3dT@l|;-P
ziH33Xh|}q0YPYwy1b8}~)+(N_z_XMh#3C}33IN(V1l%5O3zu{t8ix^y5$G@-wHpM2
zXTLFIS`ZGdZt4+GiVVZByCbInsQ1Q9hvNY-R2L~c48!W85P?imC;*l=ckMSXZcCB-
zr-!+n>R7noc|MoIhvW2gK0Q4>jN@S7r^{&=s=Ig9037NlTrO?t>UGFTDytV%+AP)K
zC}lt_k;6^^O06O#6HMZqC%pQw<mxrEb@=sa&x+gB5+tc*7yuD4#;Mj(0zJ@yLan(Q
zF%wfBR)joFM<GELA`&J-f(QyE#K))0-~9UPZ@+&#H+wo?&U2f_DjZo7GzcW=8kc3c
zTv`A&ZHx$Lt(^heFk&gF?Q(N7s<$8g=+i&@&;R^C_=8`ZPRqml)9Y6so5JZdhvV_)
zM#`}CW?_Z+@!|g6`!|>6)cdlurS)c^#PW1L0bm_Qb5M8FIM2)NiyI)E=LLZ3Fh+oy
zODVl|7OW&0;|OzekTxaYlnNr#(k_?zgc7yNFxKfXl)~=ns!TKuV@`M;594$giM;FV
z*1^@i3C8W=aC>tYn8OS_3d_s8m!lL02v_h(i%r#DYbixi(pXC=!rA8z5rc@SLJq>w
zuG$HG802sqdtZu(F74@bo~9$q=pl2n(|Nwktu+gvQi^O65jC@%#L2i0RraOZtk%?e
zY6F_K)A?lGRZY99Dz9d|VFq=WN*yBLGGDZNz}n)s+0j2+jjZQ%q-q8CvJw%9@G#Wm
zF?T9Yq>7ZZyC*Kh$$xPAArVupLr#e;RZ{K40?a<2pDyPUgbTB)wq@zPMMT#g5aHI-
zvK{e!Ik(m+6&oI5>r7HpPhdw(X_&93Y0S(+RSOR&b@1@><)W^`I3Plx=U`DYRa4>s
zjJaJrRNOTOBCTb+>)hswecQ6*tb2ZFJCfxTNd3q23_s>lYYkf{KIkLb0aQlfozvYR
zZJQT&Po04f2Zp<=>7Jp7h;2O*zR!=(_vsN^lh58uj8~=q)URzv6PkyInc3xXiHP3Y
zE+{ka)Jev=7Z$rU#5~E%X+HJ7&@j|07623$8n_BDnX!}tOa#HqX0~@|ySqW)X1b0P
zxVruMs=x^C-BuL{L=ZcmdRTx#6ryksFk;&3jB6KGDMh%tyXKCSQfhrTUB<(()ooi|
zAZE%^7$8L0mWUuR^`*HxtbLULVT@9krB0=k?tWU@rK?5qVwsPrs%sAb@7;Uv3_gxk
zNK6}&-QH9pM{;8N^wr0G?mzkQXTSf4fB2)1KWg*hhS_xR$)}(H<Yzw~hT+?9zxm=<
zzx?K#uTD=7Pv5=$>dRlhdGj4mOw&-t;r7Mdi<hr&U%d{LyB8n**5Ci_Pe1#O%Vp8!
z%_kqd`gdRaYMy5iDKg9#>)kRJ8-@YU*H%tn4R&`mJ_JPMnleCS=JR|;Mivla224#Q
zpl3n{0KG4+$P_}zg%|<}DBM~PL_&~SnYk^OjWAhv44^}J1P2B|dR#tp`_nMa^K9A<
zhr=M{X}*|sxjCFJ=W@?EXKXBWs3VjSOuzp2yYsx9&!=TsV&yIXF=xnZ%|*{lx)VbL
zggGK6v!4lQmQ4t-)>>%u$H<l$bpU_%IuS#}G(yTJ-WenSU}RkNL#sA3?X9y?&79LJ
zvxx1z_e~%6!=~F(N+#I>Zdsj#9s$-3!itcH2xsq4lGl<Z>ju`+G=vHjAwoiOORttB
z?vhZ}bgkQITtoy$cQ6RvnqOHY?HGds);gi5)r>_J^Z@`QX^YLR2Hc%_pBo&>YiuTR
zfQY8H3#PWuzy2x!B-y%^D*!P-*wcS!FBTy@SBf_a;jF7LGZAM`#Xde{r!%fe*j;Y5
z3DhH3m?LCd+-r#I(oMPO8X!L4aAP;8*|gsoY6YlBUD^eK0qDBgkZ&*ZeMBrW5Q)1J
zu6|3Y58GMlT*^Dwo?YYspsLeh5D`KlDhLF?*~D^1Hm$L8KdY8y$+<Gg`g_{+AtO;v
zoIxgt0E+H?mx8-Xx>e=+_SF_;7pny_5|Q=>IcNx1W8+e|Rv8Y%;V_AC7AsQI(|cz^
z2h<+D8v}%ObVq_(NQAU?7JT*c7~!Y$Jv+R-IXvj&&2jwf<JTX3bo0?icP167{Hy=z
zUw`@Cm;d5_{2v~l?tk^GU%mP6+oz|e%j3i4@#*3I{jyx@SZb9Z9H#MbyuDl&b?~6S
z|2sebNB`-c{q(25@!97;`O|;+4}bKp|LuSK-~E$szWV;v%V8Q0Rbs1+AOQJR;f)+b
zM97#%%4p^ms|WTpO>M@)QdmkUz`)Gf`fklk0Uqk+z`@8wEQBmb4(19-rEskS3D1`$
z(s&91bHZ5;+0AKO0BPGD02Xe$i42grYq*Ac__8d=Y3!!pF)xd|w>HncT`tSx<7w%-
zVyml6+BW_ozrSN6LZm>?y7^YU*tOf~{miruqc-<aieBmG0U*GbMb)<u@qv1TH=QzF
z9UWPt&KJz@_-d^LTd%+e#+a$+P04+V{qyl2>5YgGYd3akmCU?W*lG!uJzP8ScwI&C
z&64U`kiNetFfA<wou=x^MGyjbY#;F1d@cu(U?2bpUMV`St39-dZ{dSd*E8ASS1uv>
z&Ao)O6{);;9maBHNkF&`?p)n8(yur+<x?p+hr@Q3Hv{7JbH=rUi%8#0Rt&;6KbwSR
zKVWC}3ib2JnY~6Ietg(8aY*QqnAg=H9P`a&{&F}RQtiylg=;v5BQrz5UX<KF)L!Y!
zEp4#Q=2UG6OautL-}3O)L?gm5T{E^?)AM6CtC3Wjh{!OE8Q^e}SeRMsO-eEASxl%^
zn8dC3W+}D1E)pU-Qdk&nhWwjxx<z<pzPY)%ySpo;>|>49fsx$N6y1Os3KI`d7>}us
z9H(04<}j$u-pOXI0LP&gMAvy5WID<(zx?{&fAOn-^3VSJfBRSe?z`{aw0Y^h-y9C(
zI4-BlD2yIAH+P4_=wMGz4{x5H-oAN%d;5Z=zJ2@MzyJ4t{V)Fe|M&0y?mzh7{~!L3
zzyBZn;`e{=_uhT?usr?6{oD5lCmF_4YI+Svr0q^}_khR%=&7mRR*r~_(=-kvc+Lln
zhz16&HElg-ua{DoNm#-ZFlQ))3`43eRU0FXQ>|qP1P~5F+Qb`x9+5t_L4fJB9~d6A
zQDL5<0<&n*N*TKO{o_MxEpKif-t*-|MDwzg;n37_7{(SbJR;JaU=O3)Mo4>BPl?-B
zk5~n#uvxKe>aH-?u^wa759Prbn_W?!zx)2$!`2=vuH(b5eAwegKFPAoQg~glzKgii
z>Bw^?b>#TH)vti};~_)Gj(ZYd!shjnwc=f=vbRzFKqIv4k&?NCFd_knT`+^|jEQx`
z(XQ@V<4IQl5JJvLAOJwAXGKCFrqz9G9e8JvpiemCv0XVC12b*95l18dzP^ZSJtXPa
z^#B8lu<e4Tq5%;}I0t8E9-UqQyTjgoOZMB4w;zdool%%ceC!ArKm2=F_go)MscGMy
z9QW@tt!@CRXahtkR0kpC)|y}ifUG=*<Dz|w$gnRgvu7ha+m1nBCkL*Nxm+$tspm*>
z9IoxpDeHta6-Y<B)ZFBRN?fI)lnt!e!<T_R;@SEkAU$L)!T@UiIsh=2?c-C#YG#~|
z^a!`00JCt{2m|yNFK=Jm9$&qBQLAJsB(+p2)=V9GH#0BHr7{E6A~y#H({UK;AYn_v
zczK*=TrQ9AU);XrX#ndFk8i$t|IPpXzx}8G@-P3gDZF|6o{(>Dr*<I>M++eWAPdlW
z?tM|WWw|)QFv$J8_pd(s_|w-PABOWX>%ad0{^gf{^Xvcmzxr?f^ndl|pZ)k}FK+La
zb6=JY<`xYAS_V+Ch{y?^ghX4PaT+XT`A&!tU>F8OaQDz~>u!c&3<wYmiC`m$0E{6R
zqlye;8H6JWBGy3|Ma`t(mH?$Q=%yZBM*vy!{zTx+h&jFp%TO^#v;i<9oc){czJ1Fa
z5z|maBrWmX9a;B*lKZOmoVvb!?ar1FMuDlDjeP?L5mNWQm3MM<F9HN@)%>+0kM5yh
zfQZ9T65Zym-?F+78lA6`^y}>E`Z4+2Ddfvpx56SU8X6IV44C%_X-kn2IX!I>pY0kf
zGc)U(?};a*!>dk{*eXAW)Y@_lN>+fm;u}v6H{1!)AyidX$I5VbaKs?WhdBa(T$kFf
zvD**8@b%@mLZi<YWo`9eePv)1tjc=+e+X>xD$7WGx+6qH%(D3Nk!Y4Bsb_tDPMOI*
z;*7%EeDnRB+%+!OYyhuQPVqUS#cDpXkCorZ&9%;+C*-;;wrkaUw{w(I5`wgDy*Ef}
z+tnT^?VX>yp8V<r+q;|cXw8mAfWUR8vS%mwcEPtX+`yZI&NCyi-=@puvL6P!cz7%{
zw@VqMV1d;HUI9`DxaVAJriMsJF%0F3r_O^{tz+*?t#X_ufYr&OjsuZ2voLS1qdQhE
z#I^7^@H9woO~}bxYqN+Pr*YzPxj)@b2k7+f%{Tw*U;c|PzWVl`|I5F4I4{H%!KTAF
zmE*~AS-QK|GODVt_RAQ7T&BZNrfIsrzrTO?-aG(koQ~soczAgDxBups|MZ{zkH7fC
zKl<I@{r%5>{L{}q`Mi5PJw26L_0l{Q@;i=7#7zj`h>}DzqPY7!&xgYZ9^mF`9?pPR
z3ZY<>UBinAEHsuX1&6T=Lm6u}IAL~65M!7jZEjjfNQALD%(|LkGW!{l-J#YpFXvk8
z?d>f=wAO|yd+Kv~eCoYV({!8$AVidI&j!OEq_Oe5XRop`kAT%N|3iIuLSSC)lecVA
zU9UVVcy-&@Oo4VcHNRFd``%^ugW$gNuzLz`X6pdWjW(ps(?iuGcAwm}^WEJ6jEF^6
z1C-qXU^Dz&cj#(+Rx3KHUino=BuaZ$rfdq9=k~TO?D)D7AR-8^FXMH7&Hx|)lu>Vc
z6A2!j8S@z1Q6M5RQ@S~B${uiVaP$ZVLs)@b<jzFS%ez(DF>-V|<TytnVvGGgQ3Uj^
zS&QE_w7Z+p-~KYQK;R-l5#;XXXh_*a9_pPr^#=jwkXbO(wfc0u)3NqY13;PyBm_p{
z=jK_;VJxoNcWX6w(4HqLGOuYxCBAaoOYiuc+#Bu*Dv454v!Pd!m7(5RON05@W@S4G
z5CE9iEb)F;mY%D2n4n_Sbj3EKjaq9W90A&mFi&y>w^Fjtbu&N+U?d?{33c~S1Pq7(
zGq>pW`0##6_YDR_bco(f+ojOpk-ag&f^{fkfx}qHmr4=V)Ppey+`2Pht@Y`0_Va1h
zet$ZD^X{F_^P$#DGuL)`I(doSby=4A-1l-s?(m$TIWO($e3|FDmLbb`%kut-PQx(%
z=Ffi8jK2EvS8v~Z|J%RwyTA8)zZk}YnIldf>d&(Pz+sheMwkMY54XLlE|)nXz|FdX
zD@Ky_FqRqt2u=h;DZ{|iVJL;hp&;h?LW)3l1p;9b0_4s3dF@>y058n0&>>*0)gWMT
zAQ3KJ5=nrYh%gBNeD>p?o=%U`H1*zcAbB7ML^iFa85OU6B^nW99d=lN&+*Q29ms)*
zNI_e(D+!lfii9M@0_fzOR!{qt9!;>ehaOz<@^g0#MaBwwW@btDn*L4(W@tsk>`#6E
zbs`aC&RI#jZ)E-mJta4=f8TfC-clF<dJi)r23^ND)g3MU01KvsJ~y~O_qF3ZUjifh
z9Mbry5EHFo1;f@+P40WWh60~0>-VfVwo3PwAwGA+Gm~1shNagLy7!*e9=kqN)zT>N
z8pFo(yu2Jt<U8wZW@T7~)9#*ACDO`lhpTYauCrg4wL9$UbiMZC^X*4Ov^3pMEr4gu
zP{yND))HB*b)0I7y@z2)Rs7O45%)M5^3Ym)dU`6QOvhu65?Yoe^{4yGU1QrF<!zf8
z5jneP%sc{_(qG3Ts&KtR6RBtjBC_6pfJXDG9*@W5g02@?*X4LTlu~+E5gdmDbLrjo
zo4&bUZIyb$`Fxt^SzFIqcD7(AxOxGvk}WEwbo18Q<=j61^o4hox}duV4TXk5rm^(P
zQ!Qjo0eu>es(N|65D_?>FQ=4NA>zxs7Y|S8ufKc4!vPd#T~q>sRUHCLt>??dBWb%1
z0A`95fi#Ub5z)I7QIRswv#Py(HL9L#so?Wp|MkDoKL75|fB*ICkK23-U_kJ7(v*RN
zXWa3?fGd+4PP&7+5O^4pg}G%nI{~&nBd`=I!qYSyj&+)9smusDYcmTY=ADRyd8+d4
zk{?<5^N6Uz7K(=I>n#Ar2nO(Rtfkb}W^H{OM`pTQF7rGi^3BandM5$^V^V(EHKe{7
z@nty_uDGvj5Os}M>3Qtw2Ox1z`?lO^P4Bk#W@!rvTiN+KD*{_xDd73gLfkBdRW&<n
z_la%*WO_9b12{*X1b`bj0wTHr00gbQEm@`5w?Ja&VJNM&^ZD%V1D8FHg~q0@+Dful
z^yvOEx9oNWXMoRmnHctq6ITO%+&v7un*;El{YSsE8?s%6OWx}w*Wf>m_#-Uc#j_#7
z+`4v=vfCFVjh)W<$zNpP*KnZK$j`!`XMP~8?YBg@(^b#9v$g*+;<>+V4TT866bQTx
ziIP%?sH-AitrZYkZ-6+ABQY<_g8T4_%{z9l-t6=ZY@RfD<pV%O#Ob%#m^uB=hdPeq
zNX+^6YOSH(S`QClf#+UK@>Oe<gbC-|aAp!=Rm(=HJm_*sms<7_m5Dk5FapNu5P)hq
z9z5sTcx=OdlK|d&0n%|UT5AzdN`*kx)f_t3k{3icGYvyUgk@P+IKtJG84&RC;r;39
zR76bebiRD`^*6u#<*&Z^=DXGuMTBJ>rl*Jdr^ok1`0~Zgs~5LI{`7P&gyHt|__$n_
z<+Lo9#mpZbo=)>TtCAF;a+&Azyv&z=I?tEW>_Lbng2Oq0y2oW{K*Ul#uys{)79ke3
zAY=d{7DO@+7Aa-$Py`E9)%I}z?#-KT=jD9&;_fFu{mFDZw%(Vv<W%Mz1-NOgV(T!d
z0oG1O4mSvg2qCUT#yX5uib$1OgleIo$~4yFVLTqkX<LS$EA{mqY9k84&^yYAJ1*
zLv<{L0fth*3?PJ=i9)rvh7rRc(_!#XR|BvdU?ZvF6^ii7JYVLSiH2d!iR#O|toS-7
z{(9ccVVReG4_+^IMl4)}g>l~olDSlC4Uxxj3c~Yz>FRYD>mYfh(lsVMi1R$#39B6D
zkdpZ#l5U<kxD=67^e$XBpO*vy>!irbW$FF7X>c6JVHk3X%+3Z}@fB#Q8Q-!B-CApH
z8HT}3Pp4Bv9FIpLOh8klYSU>Nr)fH$PY)0G<2Z`QH{X17bCb}gpH5GiL|-nKr>Cdm
z?Ts+?-dbA<6GHT^v8fsm$;`E>sUZ+E6B0zKueNqB+)U)IvEGM}^V!{cM>MdNynhgh
zb|m#IjoKzz0>EBo*=XRkgoW4sp;s@x%Q@q!)<i^_^`Dhsiq-twU5KA=Kzu;{UIXxm
z)xhbRLfT*V`nNFW-LFqb#DK`xejo7RS8SE8JuTg3B|BPVlC(+Bj2<HU?UEbPAC%N^
zvjW)FRIt*W?b?s^@BCUn3#>%V`s$2`<Q^Hv*Tl03Gpn}K>BKpsv^{?D#hX_zKL+B*
z`v=Qe@S3(`aXO!=NF9gP=Euj!7suf+kchOlXkVD*<;xeB%lysPZ$xN39EWk5=Xo)J
zrD4;{(l4`y;aHD7D1d_mse}WAd2|o7ZUD|w1I!}4XStGB26Cgz4T21il-G{D)|Tb*
z{`-gf@0R(qQjcRT+U>F|c3GsBQcC*o!LH3%r8W=-QUu%>qZS#86kf^nHn%d!G!Dn(
zG)-e2#9doAB4FO9$0kvPjC7jM!!T4LC`>`)AliCpo97uL5QCA5fB-YIR7zvFT7*Pg
z12G3r%#V+cxoC%B7;8-vhE$9s8U=u|ie7YCmc!wos;$kfHMsJJ7o@!mo!_CtKS)M%
zxu&UOzRJcS@*XR;L1fSCe18c<gvgP)k^mDC*U6yhTjjuFZIgGAnkuP)P-{q0Dns9W
z48UwPSr7NrK3~^1lFJ^)ls8!KT?%C^&T)Y(csiZt<$Qa4D}_!^=Q@a)&C5AE!igwr
zeR(%i)4fJUW~L~m#Ff?m^9SE31&Od7;`ugFHskKzoP8Bl$s!UydN`~W8;nG;;vj&n
z12V@EuJAseD36x_w=EQ|MUG9!8{uxd+zhTbot-50t0^NyB;d_<1~UU@4lxBylj&qf
zQw>E4)#CcJ*u9aSzjOV+z~KQzZs3r@YK{m`$joUSzlZ5`ncw@n)+dauNnsDT`)A2z
znsE(*+#NB8-{SSh+z%B^^Ro2*LU(rzLBQDN@Z>FiW;`4*FalF`m!}{SVmJn;Pmr6N
z=kyUEB49|lShz*ld^&&o)z_z|*#h3bdsvn(ToGLr)V-M=j}uEgyq)K^ID`x}yk3_1
z>#r{_?)Z=Y_)ms9{pDZ&Pw(E{8^U;VYs}isN!;Nw>#}IAHy)_XF0Cmjh!K~xBhTxT
z9(okqb<Q(2TfVYuCbwpUv-wz&1>K$4E|>Y6Z~x|Re*N*Qk3PP+`Di-c-P|5|X%WaG
zS+`VG_|RM&11RS{s9G38RN<T)5CnIx@5)$i4%6W<mcjw1+O0P!M3Q{>^BK=fhgym-
zhm#ut2tp|m5`_Z+h#;q#g*g%+)444HEJ(nZjAw*l_+cDiE7YWp#oZ5wsm(1JFxWgb
zmPLE-H;3bH8iLP5w|Je)8QD*TVWF6u2@^>Wb~gx0PHD?tbz8Y>AxLCPQnM^_?WX3>
z`q1@zkn<l2F~@UeJTec<;}1zS3)Gd}o0`^I0~+AU$pV_ks*_ji8%3sDX1|)9Gp`i4
zX&^8YBrUltm)09IvS9CvTB}vmnl7z%O)<5p5<}r)eF>x3T-+l9!c8Nq!5FxWC0wQG
z8g5{6ZPs$lHSD1J12hUAU~3&|ixKHYc%2ttBiS9XK7aG-wXP?yZ`kmMj-}U6_=7M6
z5mH2B6Uq|lW}g268ANE|7*{@n+rgX9y1(<CLqNn>0psqmhMO}}s*BPQ3K7xV6Hc00
zPIFy9I6j9|?dx#Cd{57aSbZN2fI$0@8Iih67p|{H7Qt2-3OrLWf5&xRWq~PUdLHY9
zY)H(40p{V?$im%v??E9Vx3{;}mK;iMW?z2!Wo!C$S}sqg2y`HGgTTwYkgzSw+>FVe
zE;EH)PWP9`hw}yg-rxV^AN;{Dn94VA-Wy5)G=z`}p}`UX4#grUXldFlEXV__cTjiC
zZZ{NUVn}O4z#8U2;cDrWju@+@G7w-F4gf{Oq3|qlIX}Gl{}J}5KawO_o*?!v5mhsH
zkBGb~tGcS|nCWABrn_h70(WLOyUPy*u>=7E{J?*i00Dj(vd`&b>dY%LBf{OyR8>UY
zd;IW3)HEV{Nk^i}!w+*cRgov}_#NMT_3bxbw+bQ?@|1{)B*rdr8)I@}W~CG&no^Fg
zohw0eFxOfYJWna->F)lV63=sR@zI?C0y=d=iTEKqJ54j7vD++6L=4VCL?Cw$04@X}
z<mK+FRoy5NEuhs}Ew!o$iDbl`wcJxh9L$dOx<*qDNBR=q3L~S4xjSwY&E29`5Kv7V
z{YuSw77++$-R?SJ6$i3A!omkdDjZhksEq=dOM71xVZSFaerf>V5F;Q<iB)SUnzPLF
z3)M(0T(!Da_tZO_t;E(*)o2Us?4wA`BVGm7Wk>$yoWa`D)4QDK^ZD*_xo+E%^Ni@V
zZmpHj<uhwx9B@c-`=2ngkdDlGjxf3ptd4<5)EZh3`VmBelhM?X`gz~M$p8Tp8}^GM
z`A2h5fMd(!J#6MJoDGx>5j9g9<-A8bbx;z~-z%<<A@3MdA|>R+)I0b6zy5cJ77t>F
z73{=2IGBl!LgT{&U^FlyXLMC_qZ+1C0=*9n5KIg}V3JP4^IO#n_#rUO4<GRr9wWHE
zM$sYqq<z#LL78r<!@_&4>;ok}qSFrKT{Hw@N;_juwZ;XzD|1L~#mH!m^37D6HttgM
zWK5y*rK*o_-#%a0=gYPg9R@$_2&eN&tycBvG@sA2IXz$2<yuVfqmSX|zxd}r{n;<f
z?8m?V6HIw4_3O89t=8hcZKYOQRM%#gx*{^NOeZqOqOF;NI}zSZ=_qzN=Y;OnnpN$9
zB|;z!Ed@X*<=I_<P$b{q-(N3VYi(JUpa0^cySuyROD#=<;Fhx>1emH35};d)nOg`K
z2~Sf#F_TjlPNdU3Z_Cvb!L!?xCLsnSV8mK2g4@3S9oZe46$S^9hx>C%skamv(3A*R
zP!f;;5Oed^6aZQ)rD<~oR|F77Caz$6Q>eBUkm{IahyBqWOo?co=b(FbI_6E=*F^->
z2uP5fg1qdA<b;NRhNgh*KnMT<28Y3P3U<&~w{b?(zS_f9e)!KHWi8+9k~y?UFvl*|
z@OgGXv*w^?%{;yis$kx<xp~_KHNE>_w<uC`&M-zPh}|D{7prqHKno^|S*vYB#FSaJ
z0*3vU)@m%s%&pbXvFla10&_Pabu~aVzXdchvOola$)Wvx+uQ$SuPt7z=eY+f@Y{&(
z_G55-!98r_ff;o?xA&eScEh@V;$yGn-)mwzXzliGLBZUg7Vvu%onE!QhuIw8eNRvC
z#=ZxPwhoypAsTiuy-5AiJnesum_i5I&E5PMM)$w6!vo@A-<!O<V(B4AKBWKOCz5s3
zu^bhHs`^1H@%U2x^nk!I1`a<Cc_j+#Cq2|(KqySEw(%@%5S*EZhlkVYbiJ;nlx10#
zOWB$=BOh)u&ERrbt!$@^t=YG)-=I~n_Tp~(>F@vK5B}(1eENeQZrk?a<Bxv*#h1VS
z@^_#9@bl+wS+}h!)anilIhUnPr{qqmwzbk)0}AgjVX&#sScBriZic4wJdOI%VvIxX
z0Olm<XyD8|QCb(>wr#mwgwmX+b<qaKNCu4<lM{f1#BE?Oa?UBSs%f=EBqFm=tDDxX
zZl%qMCBz4S*n+=gU2j;U?sIoUVrD>eH!?>GC^(3)q;NKLEj3=s$%DS+P*od?Bw`bC
z7jMz+3Hyr9n)ETSb$1aKn#^*ovTd97F)TAPdMF6j_sSH+(`hctI+R4Z(p^f)hsp5h
ztwjeDw6#4=i{W<s?u6amaX-T2y$2c8qhsLFVBN`=7zz+^HSv2fu+5nf`dkPR!D-KY
z(HT+Ed9ax9D7+7YO&)f8t%YP4$2hk&1FNUgye#X}Q<>(eHd(i;q&q-^n2Q*wH*!Wo
z2W`z&d%o`)NFFvb?+^OJf;jf45JCKRoKeR;jGMpjVnhn%(-BWG*h)RqKDZel1Hqm=
z;!rf{VeX&}x`$CB3=Q^UxU>TS6c0gg|1R(T0qFZ!9|=Xo0YdF6M)|c?9KF$7@ij8J
zIB$<<DG?D0kq?c%x@QDOZW*D4J9;fX^BnD9cXxw;bo4ht-PtKnqPvZ)neAh)P~_S3
z;yBfI<8MR^N!=Z!Rcom3_<JWG?!=XlSC5y9lfF4(i+*1e0Ol>)g_P!LD(j}&h4Ww_
zw4&+^3vX@SLRrH>%_fTe15T4@+pgF3l<AX~FaFKH`Lloa^PfGueDz=d>My?h^2^`+
z?zicjfA))?J+JGxZ{ECp`#8;afK#5PEVJ>-l1nLTDOww%=aiCQA`=9JMo2lK8>yRV
z1J|5b)dIc(V^Hi6%7@uZ-AL7I)#bWfo|j+!>Q{NXH#0N`Y+&wcrB%rjYIkxZl$>)C
ziX%B%9PFg6*}%uVe03&{`rV=Pxov-5ecVEfoT6{f%=46YK=|oA(P@IR(p`p7{q+W}
z;N3?4l;)h+l+*ywz}%W^Yo)D36z0rj+gdHmoMh7Gp}7?3p(qv+k$ZIOhG}EV;~{zU
zy{Ab;j_d}06f%eRfGd&A?!CJsRA>l=M>Q4#Z--LOA@Iu`P69Qu(NIS<1B`yL`?ghP
zPALfccu<nN6?2H#v@kO<sD{{PHETh6b%)k8aNMTQT6No)0TEgY0ajopcO}AYD@4MK
zW@r{`fNL?;8pAQIjhO*Lw1s_0Tc9G^p)VKGBnr;Rz@D5HoB$1bUCaO$<D?*YkQ0)D
zgM(vm5&_KBEwgle5Ck{(VX-#Ug9On-8v+c}n{WmQi#J7MBnKxXw`x9GKl}4G)1yq`
zF`dMb<+WD(;5Fb@=7MAht=oODBY^Gg4>0Re|BSbT4v`K9e}ITAh{d~J#KC|sexx;P
zO&JK$RCQZxewYyrfHW*L#(Ih)G(KnQg5>TjLL+y?k(>g?fEI|zj_>ynF5jyIi1)9L
z<aWsJSnK~VaPt;LC4icy&~G-gqRkCYCz+=+tk3IZ&B8*d)b{**tyLc$UVQo0cZ7nW
z3pE&}rdGD*fRZOff4;8QCr>Zzbbh#h_~?B9l2ev6|M(|Ad-?IFZ{NQC&F_Bq%P+q9
z)o<TjF7Vms?KGb-<(yAR-J2ugl(L-W)0ByzmUUaNuRi(++<9m$T(_;dWyu1n=BP1<
z0wfLvno_njPv8*vpVnFyK*a0QMTljduD%(9Af_o-H}#&~2eSn*5TpKZ|4^2zwz4%9
zFcHcpnNFP;t{UW82t5~I^4KZh4xZRqfXKX>>UNr51Xqg1NdVBEFHh4nrOZGfQD{T}
zf}8<oPKCA&T-90wKmr8wvTk{v&MC{3r)gT(&YFAs_H9>Rw#F=Rn3!oD>|`0swYBCB
zt+g5lk1!F%;ZU?q6NjMZ*mqrBl9`7k8~`Bmp;-sEBOD@jBVuVWpb2)kx_8uP->i&?
zDGK)8<02p*?rw@XWkOk&MMQuRDRip5wGaks(=>%(Gf~*88346rW+k3uh!2Df7c?lX
z`<t1i$Hzw^y1Tn;tsz2dCSp0yW>BlSyNGbdsiC`D+w&(dICS~YoVqeY$R6|m^l$&b
z5zV}+meMT1csWCOM`DbS5E+rs5m-3Xv(=-m;)qd32y`wZ5(+XS5D>IlIYO;gS3?AE
zx~|JKWf;<!yHacTyXHLS9OT8}hXWc`dLr!JHM_c!HnKKFKqiWmA%bEEu%Lqw6OdI0
zb-|P*?<Atm-*GTCLdL^HD4HyRdretb7{Gx*t*P2HO<Qf(%bHR?&F9*jD9!VoJ2rR2
z@F#I1L_#Dm*B$UcL~5Ys#3G4nD{7(jgJ2GZuC7&?7@QKPoHC-QnmG{h$bx;pc<ib?
zV(Mnmh!A%IU?Kq~$tfiUwCnPGy*vrStCug%)1+2gGa$^<iDe21k-DBvCos5PmdAI`
zzxmA<|M>U6`u5v5ufKVFy;cALlx;IN7ffnSDQ%@#YpvC7T?zfg{ps%h{Ij3_><|C&
zk5WE8KQEW(_05~dU;XlT|BwIY|Ld>*;aBs+`Tpf;I^BKxgCD(o@#=b6E>BOFr)RX5
zh=hS$*)<cNPxH(B2Lw}VDa+m686Cmx#oe8&rchXRH}_`ROslt|6$w>!E9E?&66f_=
z1m!>e$N%!#r=P!lygV<f12%$mIyG~1P_-m1B4u66wk4*NxYa`B_jjk1XxpwVc=s?%
zX7DzpNm5EF<#`5THQ*$9&XPhBawGC7gRr3&v6ckqIXsyH)~%AW+}#0SQ*&@)Msh$$
zLPEMeKR-P_)><U7ka%~U0}+|>ERuleG~Y?e%W|#tf>v5xnS9C#!A+Y8fxEVf;B!ih
zT(-@crj$e&5Krf`q_nQ9s-`3nD}1Pdgc+lw0ho}4QaiJhQlq;XqN~i3Bnu}5GLOyY
zgc7o$NaSGV4O|@>k^v}!cK&>{OdVtL5+3q|;^wU?A-Mq|m9lN?iU6inTazSa&_#31
z$q@m;0hwD<2Mo41xYt@+*;LiR9KEU5rbz67wKX-*(?rb6x^AVgBnQ|^ap2`r2DX}+
za{#b&o|<Z@RfGXySr<uiI-Rz<m0D}9;uwa5h~As27O6Yk+H4LUvyZ`0WG6%GT}<<U
zJKn_S4Hdk*7Ee=_UZKm*)y-3iQa)ap#_KzH&T|ahYpw3#KMt95K)`nRz}_*4K2e;R
zs!AcGVU<D$W!J=yp`pVEZQtS08Ix`rjHg>uGHPUW-c5U)+`^l-SIy96yNnHbU%((L
zpu=#<@CJPyeD>B_*bB!$wOVUcm{0TEs+sBr8zOS*3(tm-8XhFL;>uIXp)a}DLD80Q
zw^E7-rIb#2S`gb-%6gqhCP`Dyj#w&GYeeYOgtH)C*UL9wfBX8IZ@&8KtM9&h`~0-5
z>(&~mc{~C)R8Rm~%Qj6Dp=W|q;y16qee-Vl^i#Zl`D&U^cXtmjUVi-g_3MB5<?sIf
zAAkGn-+Tipy?FTvBfoq1?#nN~d^kUpQfgU0e)Y1|t(9uUdCI5xbT^+wXj@i9PlVQL
zDM)PdEa1kWGKZ){3<ijbMC6i~8J##v!q$`k&*%H~dM%~R^W2;px_MnoLrzm7=E5X_
zv}3_(N+~5$Ck7&l2ZxO6ttn+r1`evh-)yaxR;$AEYKf2;g<Z%2D>w-m3W#vd!kK~4
z3Ee>5m=IVflxNuhoKW376fI+r(u$gypyZU?kq}#J&D0Dy8K;zUzFrMUW38JPwPtP<
zz)Ux^_mBgzBml@9vAZ;y6B9zj0q&UFPP8#|Cf*51yU;}R9}nFEClpRjL|aie3w;|v
z3;QSl@b2grn-}+KYt&C&3p$EJM0eO*XTd#j*QO;Xm<C9p)DvWL1jE1!LZCaMw~K0B
zRq4R`j!Cn-U$1MVV*55B5|Qi)-NG{CraTvks+l3h=J%!=G4ymgsj5Iwv%4h+f`h9W
zYG57Sn_RnkA3YN~^^WA;Y_+zJzk6338JSJ73@ic-dC+(;?}e)IS7^9G#jFcQha{y`
zN-?#g;?`Iq20N&t!w&4G<Zm6c>h4JWiopk#hycOEInLZ%Z_Cci$Dv68y3fjX{L?XY
z{UGupKzJ~P6t1ZP5bl&P1YtJ!S_5N0dR6bsNtl^dV`d=1P+%D!`?O)dZ*fHJP2|0G
z#V8`k2)b_D^J1F<!ScLjoFyk=Q$#e*EJ(SQBFPQC)b-uto7b;jfBWsXZyz78*Y&!s
zfT>k)+TVCJb?PM7(#oba3H;!PpZ&qlfB#?q>7ShM9)A71FJ6E17jGZmeeuOt|M1`c
z`?74)>0I5qqM_QhF1A$wKv!+?8kL1vXc87eLT|cCPE$_RRJESZXSqMur6QQJ19?;M
zW-Zt)V5idr=7=;&Vk830Io;piuS<FR_MPN21DV@)t;@BXAMSYShD(4hBGa6h(X91#
z=tSgs66Q|r^+8&91R0Gb0H0GvbYYwlG82U8YR(C9KA$*eU;;D@^dxloER2z-1Gt;I
zH{aH!tQE{TEa26gotde0-ZwI-wpwd5t+gN`QmiI-M^z90VP62SQ%LsiEryInA1fk*
zQ_!-<eHb>MW3dHPBc?ae9GK^MC|KUwP5V+*Rqw}nl>Z%m1ONnl=)<9R2009kbqCNu
zr-m)@ja$)K{2o#@?0xpoyHycJ_YqlB3yo4RBviXunT9uss>P{56v3qHA@@-j+&YT;
zuHUJidre8*xU8C)9LFhpTToS}c{-e6BaAv~H6SNvU}vQ0hg!gC(FrKz<b9Z0Bu+*9
zv$TUebFfGDnb-cm;XW9q#LPF%=8y#o5)KjXlvrkT=Z+PH-8nY0OLWIDXhB2(8ZGeX
za04K^6JSI<*zZxy3c(>{|K5v_x3vf#M9(8LDh3`lGz?XBN7tDd5))A<A52qXX06TL
zCz(V<TU*yPxF5u~a7oxnx_-bv?C6F4D|;U*KC!0f^EolTy*{qj#nsIG@w+$B^nCx~
zd}dW&Tb<^U<P7GmY^&ARuU~)h#TQ?G`PJLEZ{NLpysn!Xu%M$WIEetbX$#@QWm!&h
zGRJrC-aVW?OKJM=zxvJZzWfpZ-oAaiZT0c#`RREfNixr^tlxh9O`wtPk*`nJTI*?=
z*Xtz<-9Oyl-JkE~i5cB=+hQ)EhNRx=T8UxKr?st72$LYHVIxx70&iFwm?3ae2dK-k
zXybQp9^HLemODPDH02~9Y1!7(>AYR9c_Ji7Bo<1E&8%((QW8RIl@d+UB*{fYLQZzb
z#H5r`W^P1`IcKc}y+$k3-8kiWo~NAhGy$WVnl%(A$->ZTF>`caLSh4JT5Buy`SG$|
zx4?u*l0Y@NI}tE(VnL>g+El%@+Ezhw^y9+Vxjp-m9!nzrO~KA|^bnK*077YA`!+N*
z??DF<T|JtxabBuwgqLVv=A8B#D{PG&__i#`TWhtHZQJhd?jSfjy|RLRz;)YMw=}|;
zxzsfbvjQiL<UC;i`w+Y5e(`>X))cCl8JQax6Mk?v4)yDY-zr-R*h_qI58wN}#RDv|
z&$|LLf#zr)^z;}v#|Sx81#dIB0UE8<fWlF0CmSguqA3_7I=G^1_Zo3@zv*<uJQNN}
z+W+K7ya#4JPU!a45DNK3r0T7;IJI_G7X1JDaN+}G0l)_uKWN2)&%nqS;;6gD&pu9%
zLg2l-Ninq^uFD5}l9^(sct%~r?hdX4F6XK`O%r-opCh8?zHQq)otZh$Q_fi(cbdws
zZ*t@>#xB|=2=*%`K-E&0E6qG7In9%|WnC`s-n}W7P>%orfB;EEK~!6=&!2s&bDGuc
z`n0X<I!~o)dEOqMp5Oepzxmt0{_DT}?#;VW%Cc;wwE1)oEN;ymoXO3A5SS3uT}4iL
z&fd1?%ksDX?eCZC^Z7h8^RjGJn*rsV1@U=Vt*u+BAHAGjy?6=gm&YeCO+sFMO8M^o
ze9FnymTjwBX;vlkvR%1x(RRHo@1CBfl(e>ohnKOOa!P_}3QbT|K>~9#Sg%{zRETTS
zw{PEm`Q_K=`%e(5lrnL8`S2>G#Z(c1dyfTDVi5*4Bu8}O&<n>YXGtbZL^d)h00x#Q
zLV<`{*{l^r=Pv9-iMdN6F#~zHQ;<82?5jh@qE}|_YM>sS05d_%zDaiw?1QgTT5x0l
z+#$3ml)zXx@w}Dh07ibquH6>EVKIa*t-JRYR=|_h59|yaHWPqI0i|5G6#&lXvxq!D
zKbzS+=Y56m>Cp`yJ_Phsl@6D&$E-+(cJNSy*AYhJH+-Lo1&$>?AqJ$;O6$MUV^ik@
z1B7rpS-&;|6O@}&zJoioYOUEkoolTD)Fq-_q0QT^)Z1YRd-&SpX5cP@;fmq;@%;dV
zh(o{fJ#r)fArKls(6oY3hD@&Jh-w-gRO_%PQvlz)bv+2)qS)b+9^?$tlv-=nb+9|)
z42QWZ4hs+(=FF{i*)Af~<^VcE4EKQO;W6CDsBox3VuIzn+^p{!`1>sWpa4BSj(IB#
zd}vQIU7e1R^!*S%{CR!Y97Y!yckKN*0C(y=4c6x|vpC+meVHDcBz<)1?g;1e{P^xo
zSs^E4aX?iq1p3|Uub!Wu-n@I8raN=W)9Ky2ci(*b^%r0N_UZEY+h70Yt8ZRw>vf_7
z8jz`~qk*Y5MF%DWl}RR?uh(bG`Q@vR%eGwB?W0#8FUuk+-@Ux+=xvd;)aA{aQtHe5
z>7$Q7VU{<KZ?<h?Br|(>c*v5_{BpUh>sreS0LVbjrL~xLszWKYHA}?Lmy1N4N(q=8
z4c!><G-oi3%FY|iIU!7^(`mgf=ks}*rpvp>s@D^es=j@E^U23Ab0$CoP-YPVM4IxQ
z0H(xDAOh2rSR6qm@tm><x2`PVW~$l<I58q8W=z6~P#6=Ft2I>uM<PxFia6AiMY8px
z-T?t9B~l=JxVulB*UQz0bpikl;})Qlr)io}ZWiimXr9zS2cn}Je~phFIJhr~eF?|<
zvVr76#6isn8nTaMr6*$DWu!wgJyab=RUR}DV&>XxPv6KPSiI2|*dstxnL}grLzp-s
z0$OcbtpyQs&LPbg75$Nl0z0t;_s`u2!f%9>+qOMsV?Jbyao9vhh}<LQaSmbOCi%WJ
z^WM!vL_sGo1nb}&1Rx+r#$A*!AaebKOal{(VCWug9tS`I2J33H=!C#%<PMw?_n7Lf
zi^6HG_5S`IdQ^#1d9ZYPVii<NI0j!4*$r6sFUD03Uu+CB5BH$!69SFn5kuMAv@^>`
zk{$P$`+WTdbVYYC3o~cK&~l^*g3%V(TjL#Q5PEJs*^K*ujNY3Y+zr$K$;~~$?TMwC
z*IKpqU>dEK)9DnpPN60lGp1lG0(HcG`1F~YnYscAhXNZ(@BIhNNfJ*pq3KqhAD_N0
z+m+ay>ScZR<u||k)o*^8=R1~pKHXo|?N`74^;fUIYOO6>F|(ZK(iDkAq-razIIsbh
zRso49E0~ocB35wQw!~c>ajngeo|etA8F*<5Bu(vFG!b#04C&qD^PBJ9wPy4Aguo9E
z5ANP-DcY(jATu*&dR`YL0COTtl97x6Ip<|r1S=6qB4$SEM^3q3S~VitmSwq=b<^qe
z>eEj@{^LLX!%sf>q$r%vXLY_@E@_sR4=-?V@>oa+%oH8+lr!=)B|^=@r#Z0zK+BWl
zoJ2yRw+Ufj*qLmeX95Rw2G1$YNhI~y<_Jg(?z{69bo-Dvq!C6aAV6e(INv4W>-8EV
zfiRJdye#-H%otQ}vnrCI0a4GYLM#!1iL}cpVFyPeKumtHQ;)p+cebXAB-~>t`IzdM
zDoj&Xy^20Ve12@f4`_3T?Aef&0)U>>BLZ4r(UAy&!^=KCwyhjO=omve?2(ITpr_+I
zZU)eMqp{6A@Xs*5*%Q?e1yNOVK;#`9z>Gwq>WG|@Kp!M@K=&RN%-o_i?qKG%ws`wy
zKDN9^4$HlgJ<Lh=b8Ke~`A&u%$6ZiIdUWq|??Gb+?bT$zCcHdfW3Cr9Y0lZ*yWGn^
z_0da%UcBR=h;&tHxBi?Ek(tblDLM5<Od#k(H8~(bh=dq*bPv`sB#85iNDw-q?TGKi
zgM>_2Iqnjvw<9ppMDHPaTy|9M0s!P6dX@x8KRn+REDm-OETyd1WuE5{%ZM9ADC@e`
z(#$N+F$7RE%kxABT<u=VpH3$qngGX)`|0}p;>F#R<cr__>hbv<p$gG;y*6uWS(fd2
z`TCo8j~6F);BVi&3HZM$kg!9$uBFzNr_)w-D-|d?@>VJ(No=OJESHCe`}usjJUzdC
zeD~_b%lU44zFy~?*Ro3Hluw&&TT=v{?_VU+wYG0wzXkJc)12}&orLMKY_8!0(Eu5Q
z6~G!)Cz8~vx|%z=d26jHf@1?mQ!)^dIpujuBGRfAs)(r5biEdLzdxNn|NQfx|Fd7z
zx_$Ze+mAl|!93+}-oAb{ee|Or{pfdJ{MsFbF_92at*fbK0i0%G6k<t{jRG;x^F#zG
zvni+{18OrS$il5`j9}KPJG;qg&Qk`23Ssi<rl6*Q$RQE0EhKFML;~8Zx+z$#^Z9%_
zpJQ*Qln{-X@9yrd>#C~TwpDHJ&XkC#tI3R_B(N~}{>NT9#VU+u4<Zr+pgB|rBx36l
z=0FsxH)z)G&vyWHy<STxA;N#XUJpg?4Hm88`v%0!DQ9AE*VbBV#fFQbnVALAw_ndR
z&EJmzvBASRQMH>1Ng`rsO$~a26@u_l%YT3?-{1Sr+upyvH*;mk)2!<nAzM{JeW!};
zg3G;CJs3CpcjIx02>;Lj`VU&uj^+t87WJ`sZwL|*g~~qyfFOg1eYAz;l#qmd3IQ=@
zp)8aM#1+FLoSBX}aL5}EyAj*<X(GH%^Qn{)cze~hu4`*`mr6nC40I78V(`Gq(jGc{
zYD{5nI`9tG+rAbAFcd-oi09g)t!fB;3K54NVVtiboO4&DBTi->R<YfT1Srr<z0um+
zK8B(Ak3Qr;;ksPsc?waQX3exs^VC`egi^{pO*!Y~vb5IbX)?3xWpVfUG!s#&O+@C?
z3;;-I2i@6m-q4OpIqn=u!VJrLMWKh6_pO%S{_fXbee-p#buHWD_44-Z<5yq5e%`jN
zwYP5{)!}@;kHp9f*V<|`M{yD$21ypyPNPeV48)WYql23#Ny4ILEhPF;uIqMPt4t?J
zxfuYUX=6@hYnNqV5=3-^l%{z;BXLt-w<z4T)OuOBrCOTL>)IY4pAl14Th|hhl5Hy-
z2O-0hQX+b|yZ`LdPd@*_=a28+)~!5Wu4?|{-}~vm{}2D8q)DC9G%vN3Rv%tIq%4=q
zlQ4@=Yo(M$TS0`BaGvG<?!*kIIkP~mMFj6olW8SEBA6s4p|HBoiG^sMCUDIuee~kt
zbUIm6SK}%1l$t7uU`mKcEFcUTx+;#~rZG7-a1i7)O`rfQIc0^Y`MtE_fRYn2d6y9F
zboT4AAd--Te*_Un01A~-?CwF~dAAcZfH{~K711S$2;DuLFPG<9>)rh+=XAY3mr|xF
zm$mE-#NiotleyWp6`*IVO>53M)NGmKAU6OI?x^@NNOwXO3A|R`i6nu{8Fjav&!^oA
z(?M%1?w)ckrCOLrgGbdFcv~}da7PCW4xWOkqnE9E_oRcU_F8MxG+nRP4<>TGwD<4F
z^e*qehc6of{=2A<bYm>^V^`J8=6Q|@$!?{2l=B#e+pXyk5$bpzjNNDe@6F@(ZVL@T
z+4#f<uwYNMLUsYEo68fCX}pbS)+B)NzmA+b)CoDDpfG?<-VsaCnUS1EUlj<GS!-3@
zV4A1F*sJ~4h=@qoYVJ-i`(?LI1C^XJP?zIQiEDT_1?990@gXAK-`|S}f*C?Wgw)+W
zb51Fxe)^B+)Zh5%nfgKEWKZOMcp~l(rF&M7u5O(CclUFt>#~;o;_lVQpR&wv-u@QA
z)@3PGi4#eJ=17SX0CH1oicP_Q9LS)#ldBn$8W<pe2V&Sj(Xq8s2)HXH5(yKaHs4B<
zob!BkBt+h7-L@L$8N^u)1H6bVoF-1`bUL?I&0wp=009h1kQ)MC*Q#nPr`j9<4S3!3
zd^$O(IhAI<xV5JX;CkJD_=6vv&*%I5`|rMe*IIjccy;&Uq0|+b=QL%^*}OL2tZh%%
zb-jN4(W{|t7-&IY3_!CHamp+rZY57b4CXFE%oy-WLnLH!L$I8A%4Y@?5k`W{MC4{M
z{c%;?%_;)_ix9>-;dkr-9x{Yx>c&pMy#!(AyNCN))WBg3Pxe_*EYw}i2N9=f5|J=L
zLAXiN+sGQsYj6ysOJG3eez`uGH$X3?gef=jzNq-vTQu7XwLV&i)@^Oo-Sc#!9zz2o
zs1C4$r3^jj&Nie>h;CVA{8rTUPft(L_+n<juHm$<>pzjYzOQlo!LUa}U`S2x`=Yx9
z9p2O)`gYHy{nhpn$lhh%BVpuo%q*pKiw+D(oLMt$>hqjqWVd%OLs7Kp=spmI^NI$*
z)^-lQclZ$kn5C45iQEphG9p>m?I1x<?ifA-aVG3tQ4v8p&ZBxbjv*4ld+qbR1+mw*
z$03go)Mt3gn`zD&Kw2w@W`Yl4S~qL8hTep$-f#kavF2%AR{&!{2Uyq5-HB#$fU&51
zUkD8W6HCNLZH-wZrM)*FfG0Ccl=k=-QmpZLr1JsPkeq<1&oRy7=xeQE?VgCygd&l^
z8CONlcVNw2?q7cT(WgKB`+xl9x8HtS*KH})oQx*5>PQNikhf~3xGEBpAp(LLS_8*!
zt$Dkp=7t8*6jsJ=3Wlzzs?7{rw5j8I`;$_`s_2exWbTl<8$q{`Kuj_*rCxQIZp-y@
zSp+GiDJ097rdl^Z*%}zAkhzPym36yZmcRJ_{N<}xufF{Ht8ZVwA<jSl`Op94U;WF^
zfB1Wbw6$7Vs}9I9_K@>=)>c_ahyXZAWQ~+E*Sd*JJt0NTIi-v#ArV9-2jGN;WMIw+
zu2n>Y2*6N?at0LeHiT~w9LNDJdOiI-3I$>y#6XD<wAyu2fQ3Q`P55p)ughWxXg!9;
z(XQ$<%|wwy;TTsE5!E@j*1YLn>Zw*$-2$kK&?BnrV8Cl^`N2<Tbl<j`&~ZprzyV6R
z`-r$7QJJn*$r2)j=W~qIS}Q$IGK64lb#*9?RQK41ir%2A0)m;fQhL=z$r0R}kCdn@
zX^oiY?iRRFy8)_*A)GuTdJut`o3&^O9!#bB$RrZ7NTmZ~8{Z#Zu5k|Tas(0DNMHcO
zs8bjF@wKk&Xti*R$D`^82>-G^hk?#dAm7K{?z<C9)E7Yxr(MT$<kH99O_%l?&{p?d
zm7`As;{XxP;blKEVI;zk;0$pAq##Q6UxeGRB_@N|G@2m6IF5}C1033c%6sZ+W;~LD
z)|w1s6;;irc}E@Sp)`m=6YY9cBMp!K&UBiswHTn)S~(@H4XBR@^OQxz&6v4WLqv$&
zeE7~AbTQ}skc<o1Cye`P5zo%d-aS5k^2sOc?YdkO(NBK*i`QSje)HX9Y3t+D6(QB8
z+HkF{Rp&(7ptgWBA+k7dv#RD!AE<xFvNRHm=0&(<tGlVz+V1XOwAR*jQ@1?B$Y@Zt
zu4@;+jZvG~gox3}3Bf8=tEFwBxJjs58B>~xC66&6UrT*jHeozXGEIqdA|r5ndS00?
z+p0zV<5w?!`tv{d$&Y`U=QGOP^QEkHE!B8}^OUCPOazz5M+uEX3e7;unNL&J+Okj*
z5~0M*0@wxCnyV=~f)N;acR+Fnvn~l^W~2&;21+T*z|Rp8AciujTZ4fZM?e4p@2kcM
zn;V%TQ=-fwAj~=O(2z8<+%&4o-kWNQh(j_CAf5(d8DVr^D$|rk?2BAMYzSB~C+K>K
zfZ@J}A-?xsQWncRs-l>=+pvU#A++WYEJS5yur@9g&}k1i$K<9DMFVi_ZGXYNh>m2U
z^}fV=l194{Ux(zILGRLn_gw>fB%!V=2>WRSLt!~eY8zdPL+bXPto!kc(QGs`u~B}z
zJ0TGgpzV4O*hgSvq>cdQh)NhzwcZmH_fQrYrqb3;UcFl`?U%AY)Onuw{B%#jV&~%^
znT<>DZHxHD$W^_|)r23Jn%3IZoHJA4_;!Z_1L(7!U=OkYQX`JkDx8hYtce6wLz@=p
z4u!&$Rb3>TK}<{I1a7UBQsO8prFc9EK}mGIHpH&M5W6P43~Sx&)>3JuY^p8IS(}Cd
z_pST!J||=^?ZG|Nz;K|WXt*rw1%6!HAsKgfB$7nw&6_vRWqbMR)gS-yzk2)j@t42+
z<=c0cS{rm%iJ+6XDOF{27hptgU}{*+7%9wo0WCH&BidNF=)j|@h>)67isPd%R#Md(
zPrPhJ2(n1PBgjFBb57bEyh}MmFM$)4)`Vv^nuX{2RJOL1nx{$KWWFPUhWfO%O-;9w
znLeHG=jnyWwp=0q@ci*7KS=rX_3Lk6e3StBeD^Q|2i^I)u8e+ve?Mn3-^?i`BJLJu
zIq^JCdok2n1xG>_VhArXFaqy#j9}3m1BXEAE$bTT#3?602+2DjbW^}?a1coMF+d)$
z72%8$3rtc<Q#SBg3y=dN0fv1sn23ryGDz84qb;gbGi$B3)=sArB3kY9{XIdEGy>m2
z<rxuc)mFPYPXtFMOeyQ8xAD}$O>&p|#sQ@a-Ch#jhrqGFquYiD4~P!qca0@H^3Z`Q
zbqfeKb7DpjQbi(a)#~tb+&|3B5xVE=2pS_Zbs!AxWoUM&b<kC85Z^^65ySd-l%(%P
z%su|@nfNhY1rTkQJ-5B<=b&bGKA$7g+NT!BjB@Po7_A^;%w!@vYXPbN0Du;BD;mN`
z$AfEcN%#;zV&+z(=<xm4$FJv{TWj8VT?cfOZ2)A}TC3BPS%Q!YwN{5c8;uu1L`=e}
z%Hjafbd9v%U29w7^F(Q9eVN(r=f2l3M>;^i{{G2Lt!|uIJEpDou=<<o#u&FVd55hr
zb6^p3nu!RyQ(pjIQIbHYrXJ93KJXR$Gu|H)5#8V4w^AM56)u+xBb-jBKmOxCUf1&O
z-P7f|HG@`*G*xl{P{1(JbQE`P2I>q*fE-BsIM;A^zPHw#P@EA0jpp&N9v>gO^N%DU
zZf+r|003GGBTbSBG!af&2!TVu#Tq&!CXsyR8JVxk6A^hc!juz(dC}%X?kMvt!mX^2
z>w@N>?bYf0+uyyuKCN#b-(4zv^6?LT@$-NF>1RLL+E;JBdz{X%?(Xj~=XKkz+iLD4
ze0O&@XEK-Ch_DeDn47hUQ!EVko=OnWJWp;7jm#T*fUH7%;@})f1N*~_f~JZP4J#vI
zcQbFyqd7A6Jw>kJK$IXnjH@vrGPPPuDf1~KVu)Iz1270PI0B~ZguRf8;;+FN`=ELB
z_xDmMHg*4N@kIm#CX%SHlT3)Bsxgb&eI)Eglj~c!)@pX^&UgDo4#bX&gs2<1qliRX
z6a9u2-KQ&KE7`b0J%)%FW9-w^y+;8sG?#|lgd_MNk&OBfyX7tIX!%GXPp8wK!@)qj
zv}z1D@Y1pT+D8r_B&tL0G*5_V)*$RqQtHP`m)P(ir*}=f!$*I`_%Z?l5Tm<+Dxg7l
zy+Lm;?nOZa<$=JmJr)cOC{Z^8iC7RLwws@wHV@(CUQKI71Qwv?NQ$J0*jjbpiLKq2
z9ElKt*a5Za5|4b_s)&R)^0Hi~X$sO?Yt+jSw3vVgJc3ASRkId977Ht-WT4mUHB`NG
z7I$~uvvR_Nm1!v@r4+UYDd)H$1TGZTT^hMTYt6;?(gRzIihdRrkv3MtUQ<L#a;#AH
zFq#otE9#muOX9D;{?e_@SzbNdfBNai^JRPY^!)U^GE)LjgCMXV0Ah*|9m3CqqJ6Pf
z^xjXS_m&oznSwG9BNeS9)gfYF55%syn#3T=mB8j{&Pm#~u5H`4rL`9N9Tum((2Mir
zpbWD+ma19k?le7bZCRGJX_~|xQRc+VZqw=XqZhC0^(uV&=@0M!<)8fz^XdNecaM+H
z>oh+gb5WySMT9O{h&&K8BV|GY^AIQ8=bwl`45|izNyMr-ni~Y&jiUqutJ{i*j#P>=
zOUjv3HZ+RB7aE{Q2JV5LbPs*JE?Gn!w73VC`0LTmLMG|ieWWb`v(uQJ67!T#?jGVD
zF=g7eO;wpOXK4*Ic4ZgkWPmo%JQ$~N$`gXRhuyCbNuY@c#h~r@P#CQ+5m}Z+6?O|E
zL`*5ETdfs){DM-7YmH3}0D<rA+W`f3=+Ztkzm=idnhtVJ<Zdh?+qU#+%~*Ku?g-{K
zx|*SOX+FG%hnJ7FR^qAxybiD{rADk!KzG~KQv8E>x~FupZI2yc*|u$GR-_d2mxSo+
zcD?mR$7IUG3G0Y6?F0fGS!&dn80}FQG>nKHFdC*2M|Pynt-44;1ZEwJ4ghAw-I;J*
z%CK9>f%dAks@gQ=NK|)~fjD!bPjoy?kQ^wWEhVOzW{pTrr&FypJOX_T^4wiSauzqN
zb!*LX7G_@8YlP10wqCDS5xKj&6Ql(Z%mX2-s@1B7tOPJ3GjY>KPRmvw9v(Oex#gUz
zX{j3-^K>Gj)(RkTN=>n8ag@MMX(%#8XM?bnLPR`GiP_`un<fHSONq;-A(2HyyN1m)
zP4jg6;_26q@7}z6^$M8I_jk_uX<3?8V<CjKD3Ex-gvnK1%{&Cam{Hxqz{On^JbVn9
z6ApnF3;zdXB6{`eRa3oQR~x{La0kkggaFV=Qw4n?GcqifCjx|U%{|R2rEqH?b`mSK
zO{bF^FY7a=`E)v6>f`A=m&>!ZN(A#MO_FL^ixzkP?eD%S4gSTy`tv{h!+&jl`sTaW
zz-hX>zixH8JhSAK(ws682>G&Hl1x(~VM@$yiO`eC!^6Y*G>H(S0km4Hwk=OQF{w7y
zs_2~uhz<bimeZ_ewU(mooW#A=Qco`)KqPFoFbNxx0w#p!U<hHu7_<=taxiOTfasD4
z(QB!#wfTI)lmNm#3rsDBzwXYUKmbf=rp>BWLY(Hbu9}Ex3NItAwOUIxgpNm}&=e4r
z9TC~hf?LE$c}gPUj%E#9tzv6f0S&tl9x#aHWm%&5=&x@az58w3(4!mf%d%OE)L{aE
za4HK@fAa=FVcM~WQNWI?xn3_3e{!B9MQGjUf@o+<@18)tC5oLo5aN3VQ6M%FVd7Au
zkC4NRwW=Sa18zxipS;27)!w?1dm$fl6pKL?k(%*;`SV}2TJO&1ySuq;i<{;wZaS1a
zAQb)FaCnAljNw86u{A42Q<}_Bn}bu%Gf^r<RY4>HQ<{>2sVOl5fx0^STGnQ*S*xu!
zYoW%Z+ENn3hD2&sY9UI~d~#p_&Uqr1(#lpgBuEpdEUoEvS!+|4gd~WZ(wy?CH3t+T
z0p!q>41C^{Pa$#`$W8}b*K)aBQ=XUw5Y!Y9Qcf%!MybRkNsyeG=Q$JM<??LW&htE_
zRJToQ%Q<J3ZQC?x`ot`WM1ZJ)7gNfKa>{eATB}wTR?||phll%ZTU%=^j7-hc+=%IP
znox*Epx<pn1XZ<W=#)}6^=;jfq@40{U0P{Vp0z3?Gx4@=1Vk*v^5*fWl=krAMN0DK
z-MjDJzPl{To2RFDPfwevv%FiEx7X)}ZUii>R#mHkTJT290dd>57Ksxv5xaw`)#gmx
zNoWI<%fg)G>G82>&C?_~U)NRD=hJzbW=U*d4xTgTMA|mfZJtxp^78(CcXyhTobrSQ
zS}M3rlT>S8fA!7l@4n?}%F_hQ4=?WDJ$|=s7x0?1d0QN|k6)cX{piKt{pH_U#eel@
z|KUIV=l|n$_nFc;-Mv`U-&`-#`6QWJUBN9gC3FIP_2Tr=tB2DhS~ql?a=x2Sr#vTQ
z)0SAyck}5yoz7`GF`<{bx@(>?3$C>kZH8FQIOo#Lk*3p$nAf@?;_3b#(7-g%nyxL(
zR-u_THFFI33vw4+^hVYIS_~;PTze%%Z|6{?MP!tW4r(ZA0wxd!aMc3nDJOTkEYB=-
zI!$@XK+cKh^9%@E-9)&yYHm5n>2%5x^e;b6X<L?@ISDx^F*r0Kn3%n`+A0w;iJNI{
zW?r^Rh$Q0OHOyH!rA)|annaR2I8aJc&S#bhopU~c;kp*9DlBe(y<FF_jm~}|B2!Rx
zQ)5a=CQ}G))6ir>L}4yl>HbmZoCF!xbzzpyacHp;0U$97a~966C_0|!dso<&k~nuM
z;68<EZi?Ut7VTq^5Z;U<2Z#{BRa?N2TC2-)bvKz(sjX>~-fln(+-wjS9MoJ9kU-oG
zKma^+@nJ{@!ay2~w3GoAAwci8!`+wl8j!Jl`Vo|X-n)5UNddqWnwb&a2ofQqY26ni
zAV;>hSw$q?EkJl)+#0}Rcy=t6$U+35yWrB^wAC?%-y5=Vsit`7A?Pjw5_GJ6Vg_mu
zy&Ff1UdYa6CL%-wk2zzsZ>okW{VsptI|iAV0ln&bLrKJrti~t^%mIddjB0eS;C(5Y
zoHOV2?RW1Wl$O@ZM=$T({psn6nAfGOTisN*8hX$PMNq>Oz<|I*bvGRL5P<}D6^IxF
zQ6}#;vDEckZv`6X)LPqW8TT38uxY8SAt|}7=F|Q3aDT_Hm*x8DtCxUY>Pmp?bz7b<
zi2UNC7tha6kJrn)r=?Wb^gDUFrqlVwtB*eW<YQ}_Y9;W}YM!9g<sZNN`rQWq?oa;s
z&;RYe|MZ7Hk?BRXRJ1zhSNG?XrEVo9xj&uel(iLWrPiet4mX@R%jq;{NpqGd3p3^<
zruzK2to7MpOTy=Qs-{-W-M3Og<4Ks+pt&+2BLEY7Oa;~7ci6>9Kp`L)c!TV?yBmOZ
zcS%<VARt8(WJB=Q5K+|;jgY&_Eh4lA<YsE%0XV=@1_o;-`Y|kmAwL?f3J8)DD+7RS
zwbl*P6A@@5XoMM2-OSC^4T-@;80VDTy{KXXB4OqV&5Ye!;B8aNBAj#HYOS?Gr%`&?
z_N0`w8F&MCW)bX3=;;Jot1vt`#|S4{NiY;lZb8P~nG<trt*C0q424kaxWUvT6@UX8
zVl=9J_dvqvT9Db^88CoA>U2Bn(JRos3%W<DVFT5X?5)*KO6nxbQTgM|Bf<B5PIMcU
zgeCY;66_(sT>%Lpe5*q;Htr5h)70%50OFIKoC}A+{jI@9-J5Wq>X<dvW(Gkq+PU^Y
z3{_~yi~j&faR|^u8oBG3yhkP2(V&PQLV4pa?pggULJdhrIw+?wb5rvH5TQd?)CasS
zE~YC@3`vm>7|L{z8aWR4;%6lFSBv`@hl&rg+4$j@kGIy&r@U?Y?ee@`%FLhTBxwHa
z>#r~C^5(lYwLvj2Yr}@%XxcS)h{y+V`FM-Kcbr{BM-G%&c;3dW*@i$@t+mx~6=!C)
z02`(R=z(X{X03*yay0~RZmlv>;`#h=FDNOc`{|Xl5KpRJn_rf#wdcU5-=81cl?8Ja
zVYpl_s_@VM;K%>NfBfJ5(Vzb5eEt-0zO2p4c7L98W(PI&Jf*w4)10LhQllxkq-X~7
zG^Lz{3Eeg4vj|Q}oT|Hnc}jVnQxL{u0py%TWSUL@u(M)(ph|)bu6;Cr`{>=xUOD1G
zx;VI#0|M_`Z;UsYh+6BZ10qt)a-q|XkLo%5l52%T5~sv8fw|RHSf_jn08luXA{vo6
z`M~+7Boh#t)!i;kQAu!;WC~hJqlQS57`00}>`R?lAn?(pMgz*#s+ze+7fx02d)qL2
zdPiZMy(xK+8IAsBGliUIW)4k0?q=f_4)w=vJK{iOgl&J-NG)&kSnR@e5lr2k=!OnD
zzTn<HP*oxftu?I;P{3R;gacFu&?-#WTi@7jL}b>2+ka43jjSXX^pO~b^IC`lINo?e
zqw8@96T6J-_djl!(4mUrpxwY3ZMa<?fA}`z*uy9u>;sSAis{+jioKl{!{+|j7!8P-
z8|}Zl!whaZ_U}*0naG>^hwrG<0pelo<24_8h44PlWIQ%IhUq;#xjLj9+Rn_>ZA`|R
zyYFdow1Yo-`Qo>~{jQel_4&!lnkC(z@BZ=c|6wiV@^sybnUie}D&P#Q8OJL#5{32{
z4%|v4<YSq}sDb*%CWL;b_e<}f8IEJ`2FwtVQcGa<ODS*4`f$!KUc6ea+sCh7oaALK
zg;Azy(&m@tiZf67F6DbfT$fGt&Exa6Zr?t<c=4kj{ph+pmr`Dw?!Wu)_1kaX{ou17
z{$KxZ|M$;6`x)lRh35HOaW!fWFVAYtte_hcWg!3~_LTFKAPXaT0-5JLWkGWUYps}q
z=|=3PVPHc^^156Bj`Ht4lRB1G$9CJ;FNcJ53`RaUv-{bPgm4hDKxSqj+8t;2^upc2
z4XCr90l>BG8C|RmHUmyT;KqZN(Y@)3h?7h}4N9y}$@4tVp{mWyV9bmJ&H+9L6Jhrp
z)}9@GS<TEGZ|a=8t5u{s2mK(3Fp7w38YZC3EK}b1;30Fe{a5ys$lcA=4gyOtVhtFg
zyLY6BM>0nP?ixDo4v1>Ec(rG8qZEjvOG5!*?9lh1**G*tR1b_M2XK%`Wn-)yztgIl
z0uy)ljlK>P3Ed6)#r16;$7Og%vru;x0Vj%^g3Z*7_J|NC4+Kf;{lM23<<Lwb3JfXq
z{}_fYS=c1^Q+H%!N1($fjlU<uh2Q(wxBdTC4yyy~>7!&0lIZte`S$uF@b>%J8UW1m
zy#K(yV)oE{+#92+InwWJe{<wy-psqRf(2L+1i;pHYo>V;M0C(;p65BYx)5kB%NM`>
zjkfaY;l+AgiP)N>v8$V*U?$<_0LbQ5cVE3I10BW*I!F!QyPy3n944EwQ6*&}+G@N7
zWaedA05uUJVl_nqmV9@2SC(te`8=Pm0N3YbD+Lj^TFYiem{JlE=Je6aSEuQ`ZQINH
zyOZ!{#6|=>=evLLM?d^e|I`2Sr~mfffA?;EUfS7A+~#?nX3i7md{*0*WkI);$%Du4
zE-4cmAtc80Da|>#8UoDo<gLc0NGT;i5oDs%=@fEps;=6_koM<z%mCuq4X$Iz7TvJo
z1Qzx^Be41~;fZEcG))On02zpcx;OZEG-LUBNbN+$BVkL^+kI%@Du&=*YfQcUbedYT
z(UuF-cQnV8^29Jrr)FB!0|y=GJhP_eW<W$K=P(L%Ql}1bGVlB)Rh8a*LhsTZ2<BP~
zQa1*5x8`27qID(Ay;*lei+3n~Ov6AOZh_SY(&$(wMhv~x%xLa_<U}EhMPaBBY|o|*
z`!F01a;q^2uz}OMt@OyQV&g~P?x{4hRX_(BnDATt_JKY8UY@vTqrFNtQ$j{MO0V}a
zpSVLdr!<N5NEZowWb%83dt7#ih`<nipJRkV8*h8KMH>PV9&YPi(R@Ep9^XRz>D}oC
zhVDRA**vg~;|ckGobEuj_(KQRqgw*faqo2d)BA@V!Z8e-#QuUGyw0A&?0KknflCPW
zNfNnb({y`}fll3z(^jhL_Q@w7ef#zOUtOMFfAh`noXiY~x3y~XT2##e*bz}N_;Mb7
zXb8YvcVRi)#+yXeu@1QXZ?6V==1xTJVInQeT(wL&38U7H3D4(KO6l=(xtpfne(@Em
zO~TQAODvQGRkdns8^Fd$_viB`FJHxxc6s|~t)8Y?oPYY`pZ(dN{n@|y_y6&CZyv7&
zGv7JjvaRRyd7kE0*F0s{q_w!iJZBLqmEG#y{gj!}s}N2}gfWzg<|K^_07aO^os<Pc
z$h?WPfB;8P6`w>kb0{Z!uODw@KmXslWANS=8GtYvot^d6SH^8u9)7pAhQY{ZMmw~U
zIPlsMjYi=RoZ{a30dB3;bt|Q)X&{^&4VggWz>}`)XT5FTOc9w_u)BD6RgT;BV<(B?
z`@F=M)N~MDpGm|*rJQpe3D$A59B<d2zKmU?(cjoB!oFYL-{#OMMTUe9T?9f^i9ERA
zU2?-IernG~;l}ItfjjE0s(2SWw<;vVttvT4ST@I4euPfjBmJ#$0|33Uj<v#W;0C~<
zL|3pQ-EQs9xGYnRyfQ*e+}vZ!<Gme-%))U#1e<|~%p3H%Iv&Go03*t_Mek_`X2mD*
zyYE#%{hBb$SeW?$t;Zgn$Kx2;uH#Tw*?T&BDR<*$jP>1Ag`|5|?|^DRK-4<=BttI;
z5ZxT<y#wPAf8Wbep--6z9aS}m(>*)p4jIWglXNg?+<|xRo|*NNS1&*N?6Xfl{q(CZ
zzW(x?FU|aPy4$u;d$8IR360bgW7rgl0QA1Fo5wKGhK1t?SM?qMZa>dD8Kn<KZ2$T^
z&&&v}hLAZiCj;_U3gYY6-<1_!KFGtv!#SOi$=n^N)S|7pnzd4w>!%-md^(+ks3E9h
zTes)ZPN(~KZyx{Rzy8I-({%r8die^NRIOP}fF$^IdCCc$)T|-tH0NnPgV$3QVRtoQ
zVhNLXC&J712@w+$2%7<fXr=I0HU|?yB98c|YTH)s?#>^8!~2qU>$(&e?amObg+7~$
z`-Zm-6AJ-|kVhf5YgX)c7<_yu_G~0j!(WL+L;w(&!Q4x6b4eLN0HBouhGEESK#mNA
zK&<A?y)-SY<7&adK&>?-1M=3)%~2f?fq{u{u`fa@60&G5rZpN|h+bQb?A|r_ZJ@oK
z3X}*1b!mI9Fgg-JKkXpJ2wy(vHi#IG^N6U;-H<6^sJz^w@IkhD^i_J1HyE5D(AV2d
zHrg-9%laJI+VRZuf$M_Nr-Jushq6b{{S)tSsP`Px4oN9?XVjr`ipbG0BxE9VueW4a
z0r^&|?o*nb+4{ZL->d8%*#H}Q+(aE>%s6D~J3aX}{Mw1_X2;h*e)QmRBYus!&2Y-w
zo0ZXUT&|lQ4&L}Y{zM!$M-;B9C83zh?RzPHac?*8e69GL{;4o(W~R4eVE--=ftsqz
zppn3V2g1yNxGYO4g_-AhZe{!K+t;P6IZdB`{-eMC>%VPgrttMQ-`<^H0uwS}hg?e|
zOit<*fZPB%6n4X<att8>4#p~Q$dO@u_Xem4I3WP24yh`DobzS9cr7^*h4cnZFJFH0
z^ya(!7Z3CT8GS9Ax|Nh`GoDUO3lp)>wXDyVr&CHy7@CUPw!M4zcz1rGwSE27>!-E-
z@E3nfir$pOIe}_zYUjJ@+i$;>bT669R+qAhV4g&T)GDHr8zKrZGbYI*QkFHPH0MbY
zS1qm8U<lvezX+j?cy7!LA}J*xVlq5PL)?<h!xQ}A^ACOu(fa`E_#Xhct94rkBD!T>
z=#&Li$4`#%O=Mdk0B^c13n)g%Jk-(3*0yb<ArID?x_c;{)T;XiiKkk$3H4mK)=H#=
ziJ4Q%@rVPVJaFtTLfhu(AR?~TN_Bt`-ozdKGSWI6Lo*mm6EoZ0_ux>C?OQ3*nmv{A
zG0@WwM-qK;nwhFII{>-2JzEb!bm*2zdkU-rihm4E2mm4y{oEbfvtO7Y@c;f_|Lj;-
z9?Ridudf%&0Dz1FT^bq!KWGZXU5zw}0KmEy1WJ<3OfB@HF&4od&O_#XAI6P?sEf0>
zdw}o<tg44R>MV$ulB2sZ6ViLqC$T<0h}|#>%%&Pltq?$rj`-0+Hn>I+Olz%fAHFyq
z5K;RB?tg+=)xbQAAwmlc%)wlUd(%V>+=V#IygLlVJr+dZv;udwv!{mTC+D17Z8;|(
zXsr@s&It(v(bhHly(8V+El;_%^5)Ik>vg$Yub1oc_;mU9ySI5hSM_FI4V!y4sAdih
z1kFR-8`Zs4H4kQqHERG)IFJL}TNkPgaSZ<4_F&rQ9zkY?-kA3gMq(lWt;)>zr_*^p
z5&D#pyCKot-Tmo&QnPJa4Um`sJqZIif}T(LH0Q7gefRX(n&o*erER6&-#>ix@u#1C
z`lHW2`TR#e_&s-j^Y$$XobU2luk&d_1Y$}OjadaS)CS%Fd`jtjo)QxhgkqMpHqUd;
zDWry`DFOPjTvJYIn!%x#no<U&vTSM%53{Dx8Va2ngI#$b#Ni@Xcpr0*>5!T#0fHi!
zgQ=OKn|Y|dJ4?8OxCldde1&|XoAuv?F0tbf=+0JaYl?{AeXIoNggCl{P*t~5nl?Zb
znNrGIDXlf8ba}om*Hwh(IVrT-v?I}pQktfD5~f;<nFf?HB|*e(Ss0NS+P1CRB8Vhp
zrZ|Y5?uG;`#6mF=JDtv<fQN{u(*)3sA=Ii`8yl^~@2WOcO<62>D_vYw0Yc*$a-N7d
zY9K)0w$=KODzYwYO>0qb3>2nn2vEd~)XfwE{sXbLy*t*49MM?EjUQNQ{?C8@v-i`$
z8|%wI{D@A+-X0{T6nG#+@&W62GgAw-P9ipkqv^^XuOnm}^+x0WM>P#dK!nsWo<WKr
z=!J6c+eG_mZ$E#~Soz@a?}^?pXQ2bl|GndGRPKGGuD6#u22(#ktZoMn4(i$WzjeUA
z?SBZM8?PLH>?i`ZU*z6-n5Q|V6b>SBVC+e&juUy$sZ&ZXU%oW3-~8rx|LyPp;mx~u
zTWMQq?x+UMz#J67k-Wpd!J=CaXyD*z-3Y9!{f{KUMw=^i5$OncqTZK?eG~gS9$}bf
zs<~Nfrb-A|k_e&uG|fyjrD-}%l7@9LN90ivPQu_yh<A6V`}-G7_4)at;HUF_HGT8$
z@$uc$<GZJ~Z=Qej`Hz42+2?^OSFeEW)vNnjR@GK(Yqb$#mc#_$HcyjqAhBJ9g&DzA
z+uivtpv|RLwcSY4LQ*yM6cM{y2xtQO2gr($#fcy}3jAA!MZGzOkzMv277+Vz5rG_$
zfPs*^A<j^5LO(2+(PlwJYgTKGQ63XX&XO_$)LNQW3eSvz0I@O8NhwX!gh0U`jnhy>
z&gXNUq*{qJ>+Xn@Bm}Yv2G2bjSTPIHR+)hT%`B93(8108P_i61g1fcWBC!qV-o9bC
zvhGD*h^=@>w&<S2iX<G^TO0!O`{Iu?o`4XUP@)IAZ?(w8i3TeZT8yO3G*nFhAQ0;?
z+*#fq4~#JeARx%tq6eFSE^>Ud#{3{*w(h3VVNKxfOsTf5R%Px{CfHdbHxIkLfIR{Z
z-cR5M&I3Y9WPBGfP#_}+(*DEd`X1K(d!Kxe>Jv)1kEbM~5#D_}96V5agaQELrrZ7^
ze!yhxosi>)|5JbQxPXrT97og5%X7au0N@6@dH@XXmRjrGd`CpPCYYJg=;(jItataz
z<#Km-_v+(M=hK&KZI74hyQhmfa!OlS)X{>?ZJ;*#N7i%bA)^I>7a3O)rTy_H@6Y1B
z5_RuVjpGF!D8wTI(GR1hYgNVZ`T5yF(R|sKuDdht5V!&u5E+80DpESn4L2ivUY2XK
zZLOs$@%HxZ+poX+uTSqTfA=?k_lJM{FMjW*KhB6-yIwC(^PHo;L*OJrB#6$0gu>(@
z_hV*6Y42df)>Ty&1SVo+v>-9Z)s2>g#-Z0*BZ>pkHGDp#dlA9782}CzHxL03V^$YE
zXA6<>z~}&k`Z$KDF913TfupH{12PA-9y)D2Qq;Ob4?#^pkR+10ZCe30E|et^Q8;%I
zS(?%`%^@Xo-7X=|sI|@WeBx7UExNRX2I@pCISGlXO5!jtM>4g&vaHa|&05`5wSwsg
zYB^_c(+&rU$l|6@x9#JPXOUFOTC0l)@hx}_6lXk|pzU+W?+(UI2#!Q{xqIqpB$y%s
z8n7Y^H|gE=sMIy0xpp1D20#O{*)gQybswF98wS)YR6h1=FaZ8P{JTHciSwgj@m_iu
z7exI76L(YiTWm3i>Nq?A;x$Z7P2F9FAN@EkXpgEN<d6NN>Zdonzd1u6tS8k6H2Oa|
zr}{9Ey}!Nt#mE?T@8E&sNb1-hIKlw;-2RXx9!5jhaV!77Bk3{sJZ7Wg$0C?^DC^MG
zPjS);Nw1C$NU6B0X_{!vmrkdXnLRx{0n;a+d@3oK*_*eIUwrvhYep$AYjGrVFoUW#
zLLRC1y0C{#=r^5$p>RkjXdLEyQQyz{j?IrxL!wHEf|-gUOiV%~EJ;K}vLs^EP(o^T
zS=L&cBtD%_^J#9~k<n_crB(ytl#u!B*WYcWHiuH0A)W8<N#ybE6FPnO&9|55r|WWk
z{ram~*Zcb^31;D#(oHf6aVyno6;5uNa+1V|j^s%Mk+ikYqmE;Rg;^;4V`5*qdu!TS
z&s;{ysfcm-b?gf9EepLZ%aN1D{oL18e35%E&VT^PA?EebGh+c9VN?WqlQb69*f2vI
z-*(L+(~#EOw&l89ge3BifXazTgwb)9BM~K$d7g914$euK8M?)HbSJU3cDX#48VUYZ
zYl*tMwbg3>(|t$#ElKZfyB+oi9%B2a`3wNjWTP-E9mt10iNc}K7UgdYFcHFKUH9$j
zU4^ghDofThSc_u=_UGVmbK)8OP}_s%_p{O1RwEIHUDwKh0D%AJfBSR9K&Xx60yu0n
zVYH1$G%`RJmYqZu=}Fk+A?@^)o`GspcSt$!mF)4|9s|em6Ypa(KPGVQKqw>G#zEx-
zI279N*To+KiEghyijgCLiHD)_er+EFyJMi=|L#AL_9Bk{$%h|!7-YZqen+?Q@bw<<
zcOymsn5L<FrP!{Z>O>f=;qDwo5MKfCT1#t{2=C8lSG}%lt@Z0~UjODdzkObo>vdty
z0AvoT-a6Noh^W=!lGx>LMuqb|XioR7j!SlfaNi#9q{9b8ca;+}M;HwgAx7Y600S^$
zl;6Z)uC+CDOL>wcOr))a*L*1zk*4|V%v){mp0CZ(K_cET=WW}*`|j<}e)_Xzxqk8G
z7r*?~f4^KFfB1t>e)Pl7gg_9zscsJHXt-Y2ZP^I1X`6BmG?2T6VwpQg5=68vf~n0~
zDP=9IFoT1eHx2w?;LOdu({cj;IARBmZbvjtV9!GdXlI0h#bE`#z6(R47#cAk;P?uH
zo12Eta^L6!FaQ8Z$b_xcbzPV-Jf75Ampd|bH$u!gabh!7b0Px9W=h1861X|oX`Wcf
zLgtgvqER011Yu(bkVI0J(>#kXU=yLtgy2>inDudUPYIa`)mqpkAwu-$5FuE^%mH^*
z76j-z&C`_3G`KL#$V{U?2oz^f#yi+%nkF}l8)#+`MwwC7T<tgo^}%b{t7IZdDW{YN
zGcy8f7t{_}&cX7!;h%Q6Rpfor(fMOD0~o?>bOmU)x*iPxnui?<0T7}QN{HH(vi4q$
zD^ZRi58@G0dPq6PsQQB#3IJ6r-aJZ!+8w3!m~aeFk?~vaRmA(NeK3pPKlZloPKVfY
z<o)Z%2z$h(zE{5=-qbBb?hU7ZDiz&38~a(ZKacOfqn)1)hisaNLfJb6@MF{Nfp}fl
zl=I!)-Q{xm`s=R&;FC{2X{|j!KR-P^T`rgK=keyP*_7FQ*kfxjvK^ev6o)4Jz=Zb>
z0vv%Pu%AX?7TC8iO6%EZKa-+38c8Z(56yuu53=A2;I6HfsqxSn)63<uu2*!QQqB@o
zKblYHd^*);Ps@6~fAw^EZdH+3)paWX`0}Gy|L_lg_wwaOFJ9cQ>-rCW`!}z@`t{de
z{Kx;(|N6h?`IM$pBWi{Mk~nWoYgGm)t<IW}+*P;Y%8KS;w`EP$jR?eO$K(#^o~bEO
z@<DN7p#kaJO&mPDm-f_bf2O|oLkDdE$NuTc6+qF#Bx-I5zyviK(dePC2R>%j<9NHh
zas(h%ZLL^S2Swz0&Y_dPx8|cYp{h(0+}7PAvzC@7(Fy?vB4o!<;3j6$rbw<(Yu&Eb
zi&_P>ZCNv>eP`*ADppk+ea}5<h&44$)9nWCUNVEXQc58rBH5Wc^PCY8K*vPmw#}It
z=|;{DjX`qSr=EKl1%NPNiAx<g>zhT&k!i9=iM^!W`%U{^;Q##RzmJF`8;um<fU`kA
zWTOsX2nLalheHcdD0Z1?&M8vj=$gjKV+V5QtsWfR!0#obZlLewf<0c-K(_XoT7>w1
zpuM-dKiK5-!JlYqJH{U1JqpTR;~ypEk1*K%h91M{2eA_H!|eDNc|Z8|=u#cS=w7z;
zdHo^K$A~FfEsi(U1{n7|+IG`4Ez9z|-~I0EufKlx?%nHezEW$1{QA4^zW(}~r{~MI
zmics!^b<kc+%)WJkdSNB-lFTfb3ljD91Qzm4gijD6fM`i%pY0m4LoO^R2O-cnrn!4
z#x4hULKkL0;21G7I(XC8w0KcO1Y}8RzPodv$Ln%g%T~0MCTX6gGa#9Tf(p*3NmW~|
zA`I5PdHeczzxw4jUwwHuonPF)xH~_zs^Cn-@dl^UL=0fyt^{D#Z0HfFs`bZ&$S5hL
zB&{~H-gNSA$nM*=GIPoj0;b_>%YvhG4LG{OBP~U6Fmte|#wmz-EC?RzBp!?>>mbHJ
zfJeqk0AvGM1;Zm=Bl5Kl`_xuitF;!@iWuEhP;0elpgU?UW)=pg&04&>6rHZ7?#_gO
zShO`WB4){MzOI|Liipc~ac_j(@tO#e5FuJo*KX@pOVQTMt!pWaLXvo&sX&q}oMO^B
zW-5`##N48{n_+aW=6MQ$kh>E~JS)>4*ogaZFZzD1wWuz3mgzpl+SU?w2H`<pwi>F{
zv6y48$6$?yINmW0+Cy;E8^V-vK-QUs0rB8z0f2^lfC@T#MF=t88#mkyQc5}J0G+8S
zF`5Rz*qlj_ENBh{3<!i)n-h|Q4Q(h2b!g(Q7KDVs=s*mIQReug1_)+~Kx6p%J!10r
zMmopuMpQatm3FApF<*v}H6I(edw{<ESiGy4M0pJFVr=l<|3Zgf5(q~Mhz{;3D2kz4
z;ycL|fe_yV4~(XdQX&Ai)?EqQ9gW-rT0ksV+oo0>^sBGGc>VhIdcFSHpZ(d7e)M~9
zzkTgmv!vy61+3@u9Uyxk0Z71_0(#e=(vT@P002Wr2Lp8{Jf2vQd86Mj9>BNLvEMWs
z*ir`qHaE&7)_Yz?WKsGcMJO!h0EB&V!pyQ<t|6i}Pnjt_E$h?cb*rtkWtt|Q=u*~g
z+2WbjvSmqbmJ+wJs@0!-_W60vfAL@c-*3Ko^MC%ov_Jh<|8}ivNcnsR<PG4(JgL{U
zY!eV=CWmI`)+R|poN{93kPQmU0@Z-oaj?}0$=zzzoNq`zcMZ_-VddZuzX;`dgJHh%
z-dc4I+K}}mHF`H->I|r^gvb(z!;uuXmWhGL)z-DRD<fu+>aMx~K+gFz&xo)r%jL4w
zVzpKvR&@;fCJs2WZQGVv(Bb*{ImB~It2|{uAd-|)E47pohA65^%mCxabYMmopiIpx
z40#Im$QY4OG-LspdXekq>L3{Izw5g0NhJ}Pwc&K@vFn-BG-0iEP_w#95dt9cx~|NO
z7}y~e3C}dw64fnyKZWc9>TPS+*0c~&lDuuz2O2s6EKx@hVQV^uG(F`HSQ`NGfB2K1
z6ERaVgR*XAEpClMV#KY7DklVXBmf3PNi%V7YPAL05Y?gM%7`7Xs+t=~qBv%KfR`NI
z932VC)d>j<T2ohN79k0fdFF)3)+Ng08MiUl3hQ}u0|X)x-1RUHsV)tjn>_~IN@hoJ
zx6pZqKI;@_HzOn_b~9}%%sJ&4pvZxFN!>M1Yb(U)V6_%C?HyqRPND#&W(b6WA_$}a
zZq7Noc~uRxw!5d45J{V6NmI%Qm?TYka<kf6N=b4GOm=9VN@74FCKi^IBoQ$&Q_d;p
z1mJ|2L;&=9eSY)Zw~vo+zkB`NU;Wizef`zfNc8yjak;E_r#r1Cl3MLb-z5-<gj=nM
z*5ww!J*Ml}GfRSQ`U()3R~kl(Ee_F;&tn!fE8B*MQ<5pCiG=|OjNC0qYSwW=1gP$%
zwA1Nanm#=}*Vd-_L@e$!O{YZp#fy*b?_ap%W!cu!YO`f6FJ8VxmSro;y2ag5fa+eo
zrjwYqDW{KKy?lIp_x0=7r}OF4&wlXfC!f81_2To-e^{)3^WE#y!^4YDUcGyI>tuI#
zcP#00y{x5>v#GmTo~9|!0Jtu7U5YjYm#tJ{5zfS^sa>y2Z7qdyC{o*2Q$5WS0%)zm
z3{f(L$)h2JOFJ<kN#{vB7zhg?X)`oNoDh>4A&AJ#m<ghH&!*t!#L%=gZBw4f0Sy7!
zt3JMaT&`CHG~Ktb6Gk1Qt*I$EkeUT{l8{Wzs)D*V1vL)bmMSBj=6RlH2YbFeZ_BE!
zwXG6jO3BQHlSpDtDW@sTgj8CyYB6G}!C{dUj6ozZL?mX;oF?WOIUyw!(yCioYptE>
zg$Rh|zHSAOhy@AFz}yg-gf+AqF|i~724JF$$dWP=Blf{%YprS(0Qx`$zh*RGVkSWV
zx2{`2MAMwMZGFC8npGq+P&IAVc(_qU3pIQ`-HjNBA$AlJiUi!d4a)!JU;hz{FbN_E
z5;IOIB@s76fG}7_Cr1q8l&K>PxCW9)N-0OrXlG%%ca1Mc0PQ9`k;YI5%7KUoON<$q
zIj1BdNEGE8bL7ZLgoy;ei6p3=?uIBSC8A_zIJ6o*sJnNn!?B`Ayya7SZ|GQ1AG-k&
zi?7Ra>|^GfQ|f%`DED@Fe1LL@r8oZ$U@=4_5|ISmR&2uVP9|vJ=FGw*QDqRZsc&^-
z=CBAn;(mj3GBWF6ZK;`+QfjTlkdm}kzWeUm@4owXU6)oHB9X(}w{O1q_3xgZu1WGV
zP1{yVtLCU?O>OY!gS%?sMh=lS(-^_y@CFNGGB@{@hyyX^?yep4003?#ND`}0)lJdV
z+zj1d?->LDIJ&7^YHL*yDdh}^0K_7UA}p=h^L1I)wW;?tNz!*6A+ZpX0yfwABmkC$
zU3GbWPDx%oyl{Ybk57{2$G`XEk3RVXm>q$q^y<@Bc}{??4z<-<N_f&CpaW@bp(^K&
zW=<q2O*zk@TxsrgtEE&oBc>^3b8odU(>$L<I5L;mjD6t^Y6BucHwuHXhWmsboe`5e
zfkh3>Kpf<z7}<nmka_F1kRy5k@xj%Yc>L*@cJ`IinwC;)ts=RFH!XuZ)V6tZ5k#QY
zHmlm|)@lnKzpa$(x^R-5a`4b&{Jm{kPML)w>BFd(qoX@iLJ`qB6On*PI6I&^y7d~n
znQ1d(M8}<nJsK5V`J7o0LL=PGT$`FHIQ5^mU0bBTSqKQEs%kY;Q%#(~py{m@V;<<G
zz$!%f6+6}9!5?eaQAv6S=fkb79OZjp24vT=Lkt>hm!~^&{(90j#Ci8HM8jpo4}i*J
zgo?ely9P!61pq<pk0LrQYgbeYCrbo!3Vb2CL3{-f!4Z)u)Wdo?S)+yM{vrN(|L1#C
zo&7%T{53z^Gl#C5i{_y2uoDFKZnU|DAlOdI@<FppnfC^0bgN^)7w=+k5x_`M+}*78
z@f{j*@a&s|5=pF&;fqZ}%U1C=7V9@$)uM&86Hj}q-h56OXD@4ce10zLmZw<~^+uwD
zMQLa5Y|t^YYzQ|?oQ}1}K5H8A8Xs5I3E2Gv_i>PWI_k8J&V96TVOPMRFd-uVYh7v_
z47^5K<W5Zmc&Sy@pO>}PN|F!}flH|@0t2&QW?%-|S|iX#$kYtXL?p0ZZ{EE7;)^eS
z^PAsHr~6Mn|KVq!efCtAr>Cd;7w7AGS(YUU2}CN?@daBg%{M1z5(5lBKjyTqL2@%|
zrIalv$(dEXl(lJ@=Ui)p>M^UyDMd-w=h7YKxgX~il=?mW0idq#6rYUH5~iA*$Q@cM
zNS?A-Yb+-y)oW8#M*|9agQ=T(*JF=yN>ft@A>ZoihA0!EY-JHj`E&;ebuF#Lsp^QX
zMK9~3;HP{?jMmLxU0WpvNfZeLa};%IW{g3-S2_%MMHo0V0y;RdGpaRA-jZYU?m*|`
zkj5A*A>zR8gu5DA7+1fCYjglli4n!!)e5*VGdj3htnQsP<O8!9T&d`;0tWFqnFUCB
z|M)<`W0yQ&8j&={iDKcuibM=ZEQIb5PzOUGCj;-A2Z#Wc^Uc9(zoz%vVc(+<eP6=E
z52`H@o_b&00Z81y!L%K2mWKl>5TS66q?ib&X<C*N)0ksvzyB3K0Il}O{!g}0cU_6&
zTSLT9$Lig{K;(IAt=-?>$1^^XO%bt_ieXRmey3GU_onKA@{()C1Agn+1C6n144{s$
zANO-t>f7JZ-t?%o0?^&v-K$rx*6U(LnW(MRnx60GyYquNJzdr*<<i`nh1fR^0vZv4
z6S$jqKyoag08x8j_lBek0hVoH>{D!H-%Xwq@dwL*h@634^`?Q)<3p!5M^gx4t4az0
zA%EKXL1k`$Zs2Z3n>i=~IjI}CcSB0|Qc7l8*L5a&`S4IndHeS5t5>i7@DKm+n{U4P
z%fI}~AN}|z|Lo<15o)cb?aiBakC!I`yFZ_DP7ZE>fGl~UBt+!Q4cr)!*ua;qT%NC`
z6iLkB!%LVWjEBBNDNVJ;37R-L?W-=bQj8%jxPnJA8A=?ZezKr4v3C+(K-?&jaPX>H
zGiOQyrjS^d^?JRA<M)khgEvG<-=y9Rfjf)Il4Bj~x{FbShiDLd&8)SO=98J3Z6aBa
zuGed8`tWcco|DATwFLyl$uaR{rmdEct%x5I&Z$)k8>9$nV?L9}K^?(yXJd_t5O|oh
znwfd1Ed!Bi4Tjxb5CZ`^F?V}*E#R)iNKUP(Y9->tsg1EA5Qs=^+pdXW2T6_Nbbde&
z-wPD`SoOFiB}C7BFz_8f!FxCd7>=kt=ErP#2WspIAne*42RXP8LfC$Bdwu#rS#4(K
zkP-t0v9uQnM8vqOH*(5SYb|9<DV_3pSv~}BelVK<-~(~LBky5EpljvA``CUA;K&Yl
z*j+b6e-LrVEQtU_Wo^kxQVLeCxicUGsvEj79W7D83<)vda>E%VK;1q~5yF6ox{y~i
z==nzB-{}cNRLUkIssLyyr62zA_lRW9r*Eb&t+uZ*E!TBfwsl<rgwc^PF}ja_IidHi
zG)3<ckip5(0LZ~Q$uk<tVY;?I(m;a-aFvk;!ECRIy3;5kFg109n?-gUG~Uh05Ln!_
zHVyDlQ)3I@kE=QWSy!zDX2v**!cPSdi8yCOU;;1@<XBWy>t%VqZx8qP_wOFx{N3OE
z?dk6P@X4pAhr8?by0u!g36d(72G(jJz|$#Bc$)80>f4V+n3E#ZrIe=4oE%t$2}u}`
z%#kH0nMKI7nNpIRCyApO`@O^W^xO_uKtOW<#57nBH^f_nYT_{Rar9`E0)%2gS(dUq
zU7u7Hk#{=D9=O$_&W=iw)oPlPyEkv(fQ$}yS)N72(Kt~Tb$39-G>Igl=$DqwiQF}d
zoaS7%hUDlLQ^daA5W0&v6SzfP7e_3(8Mr!#q)g)OrPgSPIs{~)_agVUTL9_bM;tm*
zheCEVqzBHyYun7(%xc}t8X3BKt2Jl&09F&>!bbM%?%)Be3<W?KT^Agd#v!}I9%OgK
zXd3{ad!K_vs$~>3c67ke*E5Tn>w~W1e&X$dQTtBb)6&B}he#8SU*7}y@z)2&$cTC>
zP2+!qtPyYo2%TA1vu1|w`oT5qn{&VHBh~Vl^nLKZJ74JdI?!!VdfcZ$?<b;VS<dHk
z&It!zs<pP3%9KC2fIZvYkrUBJ&N;VMO)H`}#Nbu-<EK9Y2)nSG?sY7qkvJP3umpPx
zH3^;1^QWKuz||h+dq(`hr=QQK^FRLMFW){sGee%{%M!#vB4i?iXwQqQTf9StIJyu3
z+%TtknAN!Y4(_wK10KxC&@&fi=4i@wa?Q@925^eu{vJzuYofN=-wUIu0wPgzua4AQ
zwYj<xFcA=QBBIodV95-LLXO_Nxto>kluxMb>FMd^%a<R2^2yt`Z@>Na+dus0fAHzY
zpS^r>U&?B2ozlze<pKtY1Rb`uT2rkXkN72=Sy;`~2$>wHYFle@3~EnM`~(>TYa~Jv
zdhDh2ra7frO840g56~S|((hpm^m?ymd~P1VK7`P7K?Dlbv!;N~%%Eo1rPjJFHB579
zsHPo(&yj{kW6=k;H|1nz%d(hRD0Hmr8u-m)m6LPMIj^PWoa5&KV49{W&F<<@%}9NC
z6RWmXL5+r?d^{Z;t+1T)S~f6q>YcsXTB{o;F$-_{U~Tp!T12dybn0Fvj{R<kQ8t7n
zT~7ofl_uIbAw~qms8#Fmybuv}9r}%GBP>J*E~EfHsG`1~jgBC8OA3Y1M+@AV8)^sf
zFrazYc^!T6DAV2(`i@VIG|K(!dvd3pqJc=%?XnQ!zaE_jnFkb_u7nH-7<C<jdAMwc
zK~UX7nQ0;-zb?;6jt7;8V;DU~>cfR~tE>3xNVOrvRUjG!3}%r@v4}9q-hYTr${shP
zl-^GlBFb5i5ilrt@ke!FFMFf9wHEX{B5Jj{ci294LvskuMwCSnhQh7eU14Oh$D3?s
zA|VXuh|ro|o|jtN>2!CO@67DQ!^`RJL8kd1{{Fu|Kd-@Zi@!KPo$-Dtq+Q2-qX9^6
z6rSdw0Kh)_O^4G_Rihta#Ni{>XZ>U4sTmLkVf_f4>SqQLAd(~lwPpka$mR`@T-5-b
zm?#0?7-Q}b)O8xLIEcQrsv(o1Auw~wjDk;3@BZ%Z{*M2M{^U>o<l~QCl(K&DyWgbw
z<RF;D)f7C_L?~vqt!la&@LamIWh-V@wUoLQ78GJvRnSQU&DUaJ%^jIQb<<kU=M#pC
zm|2wkh(4fjL%zVH42UeVL!S&yAsj;m#^4SZBet3vB_f{6dbwOKtu<>NC_@nm`}H`a
zOKF1@dOKeMfFy3L*Jkc6i5$^@O6x(^(W5>}X(FO!TSMPdgsdqeFr#X9ZD#1?pn&G8
z%~ZSQjP-DAj-`~=%xds-$lcLx+ZHoxwE=+Y=2l`_<U=Cb-4T*$16KrPx~Y*0%D!ja
zVpD({qPwXfViIwu0Q?URsMfUZ#c|I_P+DsW8rv|ELo=X0ga|R1@E?nb=$<AcMw$Uc
zLH$tY|MX`+gPwiHZ4dp{J@y_`Dg=OCT>U7Vu}Abhr0y{^i5y2gdp3I8KjXKe&<HuN
zQQ5>n*GefO!6DI7Hbgv~W&poluPJ4G|Kk|JkASCJcL8tLynpPy(f7dlo#K4EY$6JX
z@5n1VhOX9%2veT&G>5Wv44p=B#9F)ROs%z)8kjZJ)>>gk4R-*JP#8!$c6UGujl~E(
zL>NAZ(Fr<|3up-PhrIvwy3|?|rzF#|Zsst}X9QYHy<D!3&sPu0U=k-RwV9flx7vUa
z$(az5f>IM3aPO4tiU)Cos5SuDtw|FLIjrl-bi2HL52%@uk68i?pQ{*bGIQ_|v1yG4
zY^f~{J0ucG0Vx@P{|=M4Apz;`wH9Vc#MUYS&QmU}K0ZCVd$Yzwt=3=v@|Sr^|L))X
z+mAkad0m#L%Yx2mCdhZ^b51z`+Ga7S>oOv>wCi<QuGeK<gWTCdV~q&`RqK47MJV9+
z;C4QrrfDu^0}F~KBOyVY_W+1)wj1{1z6+S#`p*z!P!-&b;+GM@0GUBjxvX#BzTMUm
zkGl@B<!#%{e43_ZS!=DW-h86MPA#+wTeDI&cT7oyGZD6C?nc0XuFZ*Y$}=;S+SYX;
zqSNUVA~?|!ZMDE~Ff?tQpRU?Ub#o%gc_L<2-9nHQh>26qW_Gz=mt`^2EbLYsv}=I{
z*Hv3<HRS)yEf}SNI&!zcTEsD_k8|E?ZM9bOw%10g4FPItft3joRBH_m62NMG0vu}z
z_J(VpSKJEOBZ-`b&tUYLRh9qKpZ<)Qqp5tlJ4s3g#v*D_STPGT@%}=ARNrY^`$g<w
z%f}=x{$5$Pj({1meK8}O=Xn?1*d>-FiMz9OwYp=M;5hKvOOO4Xbc?PrG~fG}d#bp9
zB?_qcdMU+**3{@%zULSkN^x;g9y0Emv0Yr%JkJqOL{d}JR>47-L&K1WQ%cN~l4vtG
zKg~0^mu*7~T7`F6P5==`z*6co&mnvlD*bV&5D^RE0hED=M1n}IsYqfLL`o@7(`@F?
zmrHGC0NV7`$De-u@yG9;E^pqx+iG2w_3gXIJWV8dT}yDn0bI3;(3BH%I5jCFCrNIg
zS_26O7+x$*L_%yYCCNEO%Z3PIBokzvokQ*9hR!)5QRggotVO&LvYT7kLHW?!0W8cA
zJn*=qNzL3laptZ@fJt~tSwd8C2rC&_)Asv6`TdmSt1rHor|IRxL#gHA;eMKDG}6)n
z>E3F~lFp~Is}T@75hpXRYt`0jsgLiTOI@9S5c8By^Hj@rU9QZ4;LGK@EDH(F^Xv$%
zQ~=B=_bnq-wyo9z;M$r<KL;JmZkDlV2CdfUWz|+wl5{>Z(dFrRnol^*P;0p?=s2Yr
zNm^|?;mtiLa8hfhQARs&p3eZdEK6%OB$t-!R$GmXtW_nVQd%hmoe0Td!2_Ec6D3Ju
z+B2W>G-uPcE{llNS{Oja`OVC=v{uvsnG*nRTdB3BDc|4UQ;>RGYb~aBKFz0js&xae
z#I&m;#mBHOZm~mmB&Dhnu{-uU4{qo&M2LR+p}PgvY?=~uG**C~(Y!-h5Rq5_y4H5|
zLxm)e6>x)L1$orMOFJZK!b!e0Wv12||BwIj_c7EVahF%=HE%R@5Qir3*t~S0obR6>
z8war_I-t_*NCet5+5Oh<M*$*A%2n$~A;CS&*$DtblrU~?^mpUG9c~qWZok5#ccb4v
zx~NL*Kq86;&^~b+U7lM(l&6X4_Bwk~6#%-J3-uA9HX_8JSPV%l00?qtl>9sFDPE0*
zLRAF%snDTOW=bNadogDHaiR?~p5yck_oQ#<0>)p-X>QHt(>bmu<%~$*zWMfV{^oD)
z@9(!#0kLdlD_hPvNg_ss3a$i@MUsfBYwPO2fsQa!^JpDZ?7f8!l?(A9L2|!==ZHEm
zG`a@J<fF0~B(J?n0uez5S3`0kL5OKDh@@`9j=eOC=Nqrj<8CvHX>(Qdpp<o`9b#IS
zrL616AANLrdM;)A#m|0vx|<2foy@>mYqcSOFq?a=O;xL@JJi~?Woy-H)unDRh^?yO
zDj0K^ySuxm$H%6P2&Oy<cWE9~6%I%>F-f?42I<mT2Y!W0URS-psb_WsriZU^$O{43
zP{4}0oT(9_gQKCEd(&p>&D0I!_^D0J7^s<gQwKLSVg>-=lu{ZVIWhJKs&OO-lq3nK
zt!!o*svn_>6grcknUuQc`zQ`-b6_E9%>ev-zDI<0+uZ%({za`-O=(DccEC<+(dYAV
zRL183XyyP&eVPOTb%|=a7ngAGA3h9`cC;+GGgF|k_7Jp3#@IR^v_5w#H{4cf|IwY3
z8hR6>%yKgoQ!uuOaJAM5!2}$<R~xfb0O$*t-n-;IXukJ84)roH8G<3GnYM1uj>6lv
zrIbY20E)KO+QgI*!NrY{D9k7kn2-R?v^Q#n#obLoo2yowyI*`Hq5D~c2d4a9-6LXa
z)fG(v0o+jCO<V11Y;omXRx560Yb{_tw>LGuyLVgmlHa}e<}j2zDb%!d^!R&Qc5jA^
z^1&TwOl3pW-&<=D^W)l>Qw$tvSWWKtd4H+anj4C+8@6g9az4)h;sCX3Y4!Pfxh&6&
zkTS6Vu?5K^u_tt5IOlx-@apOExGbC34Jb`anPxy-Ym0t|S=$RA0Lb%<u8D;Z8IS-c
z7BjP^4BZqwR$~Yi-!MOjh=A1bu#9McLI?!T=!imyfPwEOlJGJMn!7u+E#%SI--n9`
zqxcY@avgV=1PQ@jzI?FSzWCj5|N5`~az0I;|ClM=Pf5U9X+{WUwyvwHdlzV_hFZ7M
zvBL^g+g1wzY}?ja%R*V$)i0Mt2+31PMqo(JfJCq?OW178b3+fKCrZezX{VFK-s%*3
zueyn3wH~chwOU2QoMu(+rK_2{YxCN+lmr6osG!x%4Xo2mO|6w`;G4N4n6|Eu*CG=z
zS04j0dhz0gp@M-mYo!4|0U~O9ajEL2T?{a#v|WptDUrLEZL77KdMWLEdO?!5x;4}3
z#6aSPgpwz*r)FAn&TbGM9*F2IM7~Bi8}W{a5=p3Fp#|v~$(203ltTb(<ZupsjNak+
zfy3^hx_2q}a2em;bsi2lB^X)|BQ?2c?1E#Do?VW%Z+8GdVE#{k`f~(wKsOI=XAE0M
z{?+TE*aiS_6jVBd?OTd;>nt45mv}%&?d9+e-QQDGrc`Q+3^cf<!I1s_KcO3$gm?CP
zaNJw>{(u78FDW`}d-}F_QsTQJGQ52IY|ZR&Qqf-bzXv%OS+)~Vz)D9GfJOpqLsTO2
z^gi7lGAsQL^m}go`RuQZ*bzmo)ji`r#?t+4WR_`~h$vb%L{ghRJw2`KN`&8h^VP3^
z^^Xqvqt8D5?#;JC_~|E~eDvz&-D$o%Pp|IpKl}8RX$3G)XQad|EC`_H!W^Q#YKnxx
zJw>KzPS`uCNQgOf*NHvsE5^a&BOwLCJsXXJET}n5jO3Cy6M~y`sSC(SQqEI~FsMz<
zn}T(qh{z!)Wfo#VWa1PwAqVs3VPXO<L{{4mKK+Os-o1VE`R70Q=;KeW%Zh|*=4R78
zNlM|oOhg7AwMA{QX2czuTT`=OQkt*pwp`ce=cnK(GBTiJIJSwTluUJ9mr{y%_<GO2
zTWviVk8HFHYT;J4QQYX5cL$!NZ*q5U)wZ=<uh(V0x`Q_DN_aNnqj_sxU?sjXzHX{&
zV5QXBid$DbkNsZC7U;3Coy6|?gTZ=2L^m&WYpts4ZiWztL}aOm#54u-6##23rBr5l
zc(~un8nb>PC}rEWt66h*)9^-yfR64H9R%8oYcn?;-7n&UNdB$XJfQdYjZY8|=uzdv
zsDSp`+TXYDg)rv3;dyT5wU0Qk7qxpoA-WLRUA>P4jhK-cSu89;I-ju%Q0@-S@ct-i
zkEe%db?Zp_pepTM%e^Sx=f%5YZI9ZB{a#TF^&v?%J7V%NNR7-caMKArHb?eb9R2V3
z=QK@-U19){qSKmEKBUz*kv(^pG##UJXUjmBg9>T5y@>84rKsfr2yEywgS(P*=die9
zKw_N@(F}WyGSEMWXs&TIhJ<Kv*Y>FTei(HR#eOG5W=?|=;XAZ|P|eM)Fxn}x+@+81
zrs?AsuU>w#Y;~O_PbYUWfEN!RZ`<9QcbCU^Pg^kyib|`TCplOo5D_pTgaW*Q8k#3!
z08~Im0t_chh@H@xOSl^=99}9E8xhPvu>0&`Fhv{@oY9340G%)~*+^ReG4f4D@?GKE
zB3D5Ku#kNml3+xjT62~k|LBLMl(JqQ-@c*gF3)qQ<@TC^kdTbn6x0#I7&Ck_0a>PA
z&T}$#Qw3GGrWxo&mJnRPg)qev$%(dYD`i#H=;e(q5Zej+w8Sk$3jk<9V!W4_2H?2W
z^>jKV5o=9bDcjO&(bhH(Ne=cf%&NVsGi>R6M8nSCHE?kPa|X}CM2t>(lFReb+D1H4
zA|Zk<77t}BrEF#fCMhuywV=R8Q!DgGnyFf>JvFauo2JBq&rk2%?Zt~1MD+Cb2>_-k
znKf%0bv-8?`fdA4wviL;-qgLn*QXU8e#p1{VX#P}9K=Bnjdm{d(<2l*@WT}3y%^eE
zha+RV#n3=)w=Vj3d<7)J$iRe%S_{Z&IJ$E9IQP;xCiS=941r2LUdJ(v`unIWA6j$K
zh}_e+9k8}z*Sq{j3$Su;2twEtIL4IBToH(cFaY7+Q!pGS&VD@+KK3klzrsBq+}ohX
zpRr-FxAy^dSi+tv(l8<&6Sf;&DnhDAKh5?wLQJ#+#=mRB?3da>MSfG~8|ia5^FwkZ
zcL+W&4WS@E;9+}u7w;%!o&i84i)4r8qn9tXvS=+o{mGAi@AHqp`{woE{Pkb{$shgV
zd_IHAZ+`PT5P$VBFU$7rcW;04^Iv>xN>*E0%4UG<z`|&)Iua@d-E5pRhS2pFp&tbp
zdhj~|!@$wd5e&gy!FXqy_G2F~kbs2I$#fwAa3Mf9RS#D^L}0;WWC#GXuG{`x{P2v(
z9KahQ;ZRB>1afrS%98T@%YXRCAAbJ%AN|1}YAcU#-~7>^|NiOzl{-FNuK!=U{`AR~
zB)bp9&f@M7cgf`~_3G8$T~*y^^a2nI31Ucs1Ub}z8esHI8p&q<v@w0w2k8%>(MW1$
z#6>c3MgY<1Mt4_t*Y@_@^WF$|Kj-Mf@rWCl)st5CEGu8Wd*ep9A3w`)Q6!9*C>1eL
z5K%Qjz}jN78Xzc^N{oQ0phf_Jy1-%B4_%1JU5tH-Ju^$yoQEzohtzQ#Bk{c2eY={m
znSdf#001NloEnh~>TFmtsqP~H<eZ0L?=xW{67kuiifGO?=g}w56FKKF0S167*${lL
z0;pzEYL%k7;A*wOQ6h5)R6#{VtJPYEv6NEh%!w!vRcA~Qkte(pk^~SU5)b<^aO(QV
z6rD=!*sQLLG4hy;nS?+ggq-UlL4+l1W4>l<iIvSI*P_atLhm8(nYD6p+FVuVRw>+%
zPBZlEUO>B>Ihh?w&*e185XsN1AfmNa_cw1GcC+lE*MKKqCa<H-43Rufy%$F3PP0we
zrupljjWorwI-z0b;MIud;KXHDLJ<IRWdk!&P%{Z3g+KsQYn66;gu?{?UZ_&fO@lc_
zZ`q=vPrSiEYE`LHt<8VDdkO4PPfScmxr}fq=e>Ho<5G>2Dc&@=XKYMpJw$3cpqiIq
zbbgRCWO}}tz~m*_l=TZDhe)-!*$yq9_n}0X-jN-mZYEj_t)kW<C9hZUXuVBf<NkeA
zsa3~)K3a!}z*<Sh&5GZ=`1;xF*Jp1o6{w5-SfrM!z(#Cz_y|+t4~WP_PU;UKuz_gx
zM+{yxO`0@rZRI7b57E8AA#jaB1Muz=pedrEDb2a0J5ZW(tA}LM_eA85aV|IMNt~5z
z4fK2H+N;QBvo3q<y3Uh`&1U`fJ5L`zd4dQbQor8DRlm!%>$jBpG1uE+1koz$C?h~b
z4s1}Xf-w?;vD9h+9LNwn14Rf35iy!VDK(cm4!5FN6~?h>xv4d;*X!fs<JQ+x@P3+4
z+X(?6*P@7IidBTVz}%E%LkMV6#(m8L0+{Hy-v{nMKv8SWWgMk8Yci|i&Qk!OHP1T~
z8BD4}Jhh5Qk)q6awAoe!R539vB9g0ODW%qfYQ!*TN<mdcG`WPJ0!0oXsj3!5X8#<n
zlEX2XNzSF#>}VV*rH<L$rHV|onxVl#_}ri&pG3<yvkCx^+GGX*fM&Kr3!v^e53^2l
z%U&IX0^p3zyMv>~VzNmb?@;?sY45b)d6~JY8lsvJGuJ9%Mk^CV(CSd(GUga3i8g5D
ziupiTrkwNlbAAUCq_l-FM49LaHVtI~vAPAD|6GJbcyTICWCro$+RReoT1}+n>|z`~
z=qHcQw%}{}^-Q`6%_;D3UTJGGEIO4zC(EjNygvV{7~@0}XhCX{@;zW4r+e*LbZzaB
z3E0RKU9^0Xo3yDXi@p+25qw;41mI;328vm;R5O+-yQC0;lstEjz`c(AK{Q2YbT+1%
znP?gFgVW=2++Uo%xw<^RxOn~Q#d8MRZr5b+`t@rQ0H9LK`Nb=#_V~%${n3N-n;U`i
z5L4>93Yk??*X81JiQci`5CT*%lbVY%N&y8GHZ>4YGtr4bY@mh=rmecCLk#t}>3W4N
zhJrQ;%T~@oOvyk^0o59%rB)H^QZTcYF^UI_!hk6yQ&Op5-c1F8s#>q)O7m!A`PO?M
zlv4ldum5_r*`)RQ?DqEY)BQW|eGt2T6?n7Vr1fS$6uGdR2ZN@MgNTWp_U8}?j?BCL
zl~zC#QB5f^M*u2fSt_Gds97^=4lb#Qm}?#L*sWKwPi>s*Mb|Wg1A<ywR^gv(-c2C{
z3<2t4;+*qvd3kwye5xScF_W5YB9fKt_sdjU%3|bw4p#!rB26PTh1hl7?d|n`KL(_f
zl9!vr7%WuPuIp80x2r?Vs!E_D=4gS*H<!&UOGUwcMP1j|TE?LunW{;V5CbBYI*wz`
zWmFMhwpvRm0PIaE0G%!4{jwKzBuy1PPE+`%SC4mPFb!mqcAa49U}}rbGPbe^pqXlU
z44vbSO!QJ|Y!d@j0Sgq03IiA+h*lFes-`I=0pUOX!M8V?4Iz%hsG>QKpmwr7E<<LZ
z?Pf&?S67#ev|9DUum{x5W`l_1I1-VY(86RHGy{oRR8>U|rB**~tEi{}5+J!UDH0I}
z4#7#6YOq@O!?+g}4y>l4f&`*6<`D@+rPSieVQNZ<A%xmobE)rEUFw-!a|RH|)T9a_
z_gx=DL_n#gVzpG49Id66T)n-GfKp}H4<%OwWD4NNpsFA8gv8{tWF#Ool&Yo*>I#~Q
zM5-3MRTUk^OdMkBkOFbw7`tvg=CU8gm^vh`qJg*zNvj5A0+gzOLrR^Ri8R?g*Nj18
z0Mx39XT)KPHB1<ow2DdvQzl|U1Y@EY==SR3$>T>y+oQ|N3lS+f|IJT+^7CK(ysAEW
z^5ofz=YRR1f3{wyPd@!5B!2$-^_$C^U6x$sb{KZ!P|Xx^SF)m3&`J0eeQFMBpcp9i
zVTDFMS~J9=W=usji)0fqRD?!{uR0DRAw>#O3#i8EfO%nW&Q$SNMnfh-4oJupo6Uim
zikeDFNlGbsRJ9aiO3`7uBHE-@2z44_B?=52F_^&R<z+54c73k(X1Alrmp50}SJ%7U
zuIpAYg<SJyvzD6QyncCmbDa_grdsl_A8&7OA3b{b@X_gm)8np(h}G&48BR~OolBRQ
z00Sh02$m#tRK{FtK_G9>J$QI}d~$SidmTbtZF)eeQiur<L<PYB#X+xuxl4(O5iz9{
zV?=-|8e;1D)owowV?I7Q(p<oV303O2yU|*-mg~!loQJOK`YsuWPB)a8ic}7vORh_4
zAu@9)wbmjrb}1$z_R*8KR`<92{ce}Xk%<BYP($FpTN6eV1Z3hUqNPb1hjA=(f7XwC
zG0ml@T1*`PmRig_QT21BRIOrapiUif;8WMHLX06r4xvcRwE%LrN>a0E>H64pT^{o|
zj-HW-h<8iODx&*(m0{SIQW1H+LaAE4#6Sci6`TAAS{KiS$jrxtllm4i`2Z2X#6&$Z
z8<bji`<(&uAAa}!#)tJF$bku+Ou$4TI891o3LMBgGIRPi=X7(SdT(5=W=Nc+A`=Ck
zTN>W#R<rp}^K-+;NpLu1cruQk`={+>_LP&kmNFkE4eU9U%yXH%%rU_ZB>H6${TqMZ
z)aLg0Jy?R9dJ|C$$%#h(O0HPsEwHXz&D5`w#Y<f?>pF+)3nSH1YANKvNdo{B({UJy
z$u+SX+_I_SW6c@VV77jrM&t-hrWZW_5HVF(vE1+Xu}kaC_VmGnAN=TtKls599=-Ks
zHx5@fH^VT#{mxq-fAYzrx86EFJ$d`-J72v#yT0A;#v#N+p>u#_=sIVL&g~qp<(U~P
z1&R&Q0ES2kq+o6(q!Ts@oAVk5AX5#*%xuoTa0r))_mRxZ$>)p&NN%PkRcftL>I{tS
zLh`bJnK(o@P(wsTYYDkG1HfhffRPZ;Ohr`1M6K4c+wXt<`RC7{eSLm$na6Rn*`A)B
zGE*QFl`e%YaUSxxAJ_fr(donWdi~{>Up#(%8rUw*UaAh8RU$+c>0-(vA%)HH)`Fg2
zy*a-=D`kAJJ=t#7Cl5}Kj*t3v*RT7oPe@cs1^|&#q<B*9ut_9a)||_M?IB|laibxr
zb-%mOTAgF8Qc?_k-^CO!uP(tf*SsHwp=5CeHkit^Mr!f#w@WK9MQ>-dR-iPKKHt_0
z+ajAZSYftV@gL508cdQzQygfUv6NEXAubSrRS^S=A-b2UV_=+a;ZRnm)y#Dyx>Vid
zBR}`X94|aIwHhwLOw}qPpjS>V?(3+21pv%r5fNEnNWC?O6REhtYaF>sR7Gsggr~|L
zut^#<wt!PDr<elsNPVX3&H!?ly4SF1_s)&E`J1_EH>(cM;dObr^Pls5&sn;doa_`r
zV3$x5ty=uUnc1wLr9o)nN#_xNiNl{?c8;yM05mLrXKwi|os(O)bn(A)oLw|Z?)0ri
z#4-6Pr4T6RR-5E9gh<otw+@MjV6)s&H1T$xio5mJ3FO<H;C!H2T*G48ZPUogQtaI=
zl9>U>8Bl5%`qj<NO{j*P#&Wwhe($4?PanVigCG6QFbv~<0Dvb?p1k+odtZO?^}qce
z|L2?A{V<GDjl#?XV`Nsbxe4nmA!a0^JeEbD>5jeNT#-$PYnc1yaJQLz_{p8Njssy3
z4O}w9kdQ+lHnZXf#U!e>Y*iz=35#lTHr3YfnFL}8shaM`LBS|e3ej@CKEHVW<yXv+
zLr8sxA>^D>?B9LzR@uvLw;yk>IL3G1d3169au{zOJvjd0y>H)KU7WwUc=+J435Ft`
zHV&okZgZ(4_lQTx;HYVpTF|sf=Q1KFfl+9(hf>fy)0w+x)5G<h$jaVgGKAQr)OVNX
z`y#?<P_))Mjw9D9ssOOv9)}RbOte`NxVl)3jg!vI=4cS)5E2=SXe};dY^qJhFr_qm
zz2QWuoRC;L-}WhOQbcjNR-61t=an#yqnh-6Vh&^8J3bGmDZ+%9#u;7UgS8L>VW3H2
zGEnQiA|g}g-493Ox_8sOr~nV#P5<GH1)95&c;A%wFukxly}JY2;a-Si4yBX^kX)^L
zW_HmR<}kxDoQ2wToqs<!K<(~8d^sVRZ|n4~F37~*qfxDhaRJ$MYNK14FoUV61)HZ*
ze(zxFb<XcK&&_#(QC-H(W#F3u`M)uM&I#!^vrZys8MW7+Nwombb)8?B-<F2%1phU=
z+mnUa<a*(k-8TQK?*yxuiU<($M8T>qDNhIhGy{eJVvIAiZ4Tn|^P(p6(@wi;db&9o
zvYuVutk?ZpPv05G@#`0_Qi^ZC`yn$2X7>lbydD1X$3OX(|N4L2?TZ1M*?vD#fYh%{
zd6%=QD%?5q%-p)^?w1juV|Ngd(TwQML1m0fJnY<0r<u}YM$<&K)%Xk9M`ZHWaH+LQ
zomc6+F^pToS`myC6c7=Js+2$+C<KB)t@Q)|>)1U$J$d->fdF2ey-6Ha+s*OGN$C1o
z$|iJ=j*e`LUwxU+&dwF|!IOs<7q3P0=G`X`9~}qMaU79pKa9*#!7eYZ_hp9|w%gOA
zE=CSuT5I-Q-Qcc_!=PoDAn5+5fNGtMZ||+=8I0_kF2>k(9iWCt<Y&b~X8;IuuDMoZ
zGQt%5Zq>ITu=uVsMDHZpq`?6qX0@@5{M-USA0K%E+Qvi&>gt`8nI<ON)Xj8X23!0x
zfoYrdQguz)l80F|&gm+Cmr7~F)rCO2SJ>=6PXG`jsG^t1Ue~*so$p5jVT$+C%=xai
zOzRucMa#VKn^AT7SMv)ZVweNOyt0>ZWDY>k(A~VOFZ}wJvz_~K3Z_x4iiufOL?z=%
zZL--XAlPJ`28dW2bex!|l%gUrMpJE)c@t;|CXmg&qr)bPy7`mqLUTkKf1yc?&)+xQ
z-$@S^rfJv=rdi(BWl#Fv85N>WT-nsb-CzROTKkwHvH6~NfnS8C22W_!k?CY+z7X#v
zxsEV2a0gAars>@-5{a@@ziHLfbtlb?j4y6(jH3VxhSlao;dUrB^{dx!E=nCAK6rd`
za`KB`{PJJ^%YXTw{?q?@eLH%U%nT%l^I27ERYQh@BbGmb`kRu_$qmnF9+*2I%a#3r
z$;1Jgtz1P!Vuz|6n4*4H$DtUxv?v&YOcwCWK|$3tVmn-IN=p<34$KH+bc|g);mlCA
zh^a`4%rXoCu#UPLa)|w_7caY2e|&O+$QYObLrCk@X0<wsp+lx0|K<Pp)9-%z-uoY7
zz~|4O9~~WSj*mY3#phBfgvM6}$z30|tMz)lCJLy<R6?MX5;K{qhz2Cp0uFs~Q*lML
zI-!iGHD-rViK#&KHf9YWgcM_!>acIs3`6Xahzn^^Ejdu|mVCcncdOpahFr(p*hFVc
zrY4Y?Rsya?o0r}MA((-BFkxW)!hCf#RPq!D+6_M#XIK-Qo;FjAQCo#YF?Om@%IFpf
zv$i~9^U5T0FX`Z!xK5H9u!zgJfGzq|3L7B7t2#hXL~16R2bv7bW*jm#4d(E5Acst=
z-{ptMW0oD};2zv^t;`(!Jxa;T(e`|I=F@U12kY0gj9=dj((TWQw9+PMAnr;54u`~c
z?+gS14FnBbE@95V=b~Wt-Ch=h{#SG3X71JAYZ@#Qw+SwG=ZDKru`D^gSh)8A{q;SG
zn>)5M4L|nH<-&i$-0<)-Eozxio0&Trnwdu^RULB%fY_ybsqvgyFMimL?hxE@q#2aE
zj(P}zQ@R~W>{jceW7YcAv*!TXbzLrUd~zH@K;$pKe)%^){n@X-c(xnz_T+>#<XlZ^
zh`ksNrAif|pqhb<@R0jAaNBQkw}y$^YGA5JG_4KbcILb2>O$KeCh+Mpi~>L-)FJ|6
zZF(jk09}ejDu7|&6q1T)sfuc7E`r(abs#XEAFG(M5B~k`nFzqy>o;ew&v*MVb?a9z
z*JG|kP*mP}>#g_Rd++VH-zkK*SJ$T4ZB`$D>%(`RKK|gn_YL*U#rgTg)$Q#*tE$od
zW*0)(t~bPSzuyPOqps(k44{-!tC?vaFq0T4rKDn$Zkd`H1w^G>iz1+!`&_$ku2Hj!
zueA;(qgu75i8J2ZfYhlA=Q39nh`RMEb}4p!>briu;@H(%SujQoA%IFQ15Cm<+Is2g
zhA}g88ySaTXgLk@Fbuw`eV*)ZI+x@#i3ZRdw}b@qlb=%B=9T1PULw->SS!`4^G;vZ
zSWE|)kw;b0aT$ozs#kbRw&eWJMT8meg?mpv+HIfMO>;tR@|)A9W&OAOg$5b={ZHS;
zNmFM6$+z(2XN$kV+ywEh-YCX;5au}KO?NpqNKi#+Qf+~$u}I(0H1SWx6hIUK2v9``
zF>-J;Pa|$4buqbSZVEA%iKl<Jzv+eEjJsM~s;Ek{!)dGu7r1r;960S#8~e;}f~w2P
z60{MYd3V`}kb`?_S2aNdVlJilFZ)mY_Rf+M{>rZYY-R>R>}R-zzyeyOAVLTY6o3eX
z6KAkdhZ`x~spFpN5wp1^USLO1A|i3<`b`!QlfLVGmQ8@y*O$k~C$-Awzy9(+{>T6L
z;~)QI9J2vjo?mTNo0j_`tGRZ%)5^#vMf2g;@b>0+3=fAcwjQ)Mv900UoCoRrSEwq6
z5CS`di2@VhVNrXC0|2uaI%WoMhB)%nTb~5`aj&&@DfTJ4m=>UMWCQgF<ZLJ~P?5j{
z4kaTBtw9Qizy?yQQ;pZFb&9c!BcMGzJxw71m`c66IDh%#1)9D4?$bZ{lYc;rh`8Mz
zDdO|zFV8P;)|(R%aB27TdL3dg5hhB3PPVHsDRBfM6CuRyW_@*ene(0rLtv3AwWwN=
zT1|bJFpm`cKgTGRT1&0&CsJx9gn&qlMI6BzMSUbqF(x8L4sIk%A^LhF#IEZQU>Np3
z_VD?P38*R~hv<NRk5=e1OCA|KjLrn^`B}|*ObCJ8fW}-q!mTwA5c(+$xxKqPwJ&2<
z;}D7n7>P7Gj5lh%ZJ<(JC<hVUV=9IeW2m*TTQ|27zJ-^0jNv(ADW!@Y<{y)&jRy)M
z0&C#qNmEQ4Nx$W8(+{;V&qUPB0swSf*9e7Eo7VNNRn=F_460w|Zuh=s^3S~-%3BRM
z^?H{)%VoTW2}?MKTEClp--i(PlRf8LJJ<nz*-}F9Mf&|pDP3J%9fZ_ouct*ad+)Q%
z5c>HX^Y;poRPG#E{%`xf_mkP*w22iW=A4IN@YYpJTEiVg?Y+aJ>pEt3K`_OGHq|8E
zfy-mbtU(N?D`|4kwN}LT*+U3mR7%M?LoU3sA(xs<WCGRO>zlV8J^0~ofA8l%|M`!9
z{F7h(>Q~p-w^!$v*Sj48KYaLjcfCugBf{P7z8Zus5yoME8)K&c3OIWmwuA8Q>3#1s
zy?3`8MHb|nOX#o$?tR|IA(5<7opp_9sAg13u_{%vSx?}&GYJ&LWe;t7lqw=ZDF6W2
zG|d3fqNpMUeMsBwx;?&e6sfDO+udB@W_6ZtpMU*T->;uOednVO-~G-f-+un}v+aYE
zGL$dB{CX5c2nOMHmv3$dW;Udpa~I=wd)!ANfb;W<qg4!%V(bDyt_8hPoOC2y10mOf
zh*mY{HXw#Zxo?nhHDhQ}^X}m)su=j_^rY;gr;{nAzFVg_QsATQv5^~O1I6T8KODTO
zlPY<?-_43VrIbJs5q)gv+Rtjj>Rh9|)W&pqw&jRo-jyLZzw=I$PZg0&ntR1Wh?v6e
zu;0t{W!8eAs`5b>VrIv>j6ck31D+JeK86s6VeoQ(7Vw;PEa!@CE>&lBQCJB5v?oG5
z>DlTxcm4AGK(~cKthMq#{GCsIC(dh~2<O3(;|Z|oXpq}s&b9M$)B|@b=tH;!qlvA_
zL<p!NwUof@c%4bzw+R8^1gr6A;w(CtMocyl@Mmgih|#MIU1**7lz;Y@_ecj*Juj{W
z%Z!ALf9)c2L~4%100)r~Q{y}>T;%2;GT&cV0%pNt2u$plq}iCLi^=&o=uWwQ_!87w
zfyohSb3Zr6sAl6h)?64Vh9)xVr)EmYmx$RxWEzqD@GGUb3Y4mbn0CA2^ug(N-QQka
zqSnWcPB-f==kfpdzx*#>e*SAje0cgm#jY-|YN_Zl5bCW<sG_A-qR_8b6Z&Juig{`*
z=vGLPT}UlN4lx|^kx56=6-%7VswRQi``xMzl})DNMO>rXdeB98g2b-xi&Q}E*F6PF
zU5AJ%g%rXnhFS`m_FcEz-)1Qyl@R>lff)f2Q7uj4Q&m+e2TCcW7**=gW(z=L&f0u<
zOlmdIi;J`CtIMP9`knXQIXON?!eJO=*Mp%U@Au=`n~Sq^cPuqCOsSKq2GFOtyS?7s
z-kuz-ADpZKe1cd_#I<qqushmrH>*`-s#=?9u_+P{In(0!pV#f2>^p33YFS!fN+E5J
zj@Rq0s)<V1_ea~~5E6%&Qs1xEeZS!lChQ%9X^LUH-G)fJ-EA&o*Y$*0CKxZXOFAeK
zc3tlp@}(3{4t&}Bc9;{r7$Xstl4A@8?suVZXeC;R5hv-y5E2o?4ADby1Qj$OU5p`7
z6S3@LOiL(E3>;%ZBzFKoM6WMPIcNw>X%?74j0XZ?+ov(j|EmiDjTYs-W?=$!8QW%q
z;f$do72MuEC2HEwqN-sTai>>5O!V(X#`zRl<_@+Pg5Rs_y{4Mmlye&e7QKvR2%a+S
zLwLdo7<;FKb{Bgzzt{3IyoWHuts2_Y8xh}NgDum^J82Zi41%+}U+pyeMglc`mOGtU
zILze^Fbg6A!m*Y)7oJ~pK0@bysF~@sBIkuNzY8<V-ISRo@9Vxpt)<q|r*M3<VX|jm
zeDVDG*PA|m{NaZRaC5zTu7Y4DwY0&vR59kT?Ro(lhVk}h2qF2Qh|P6|pv{-7bG}ry
zR&kr|xnh{<^DeLkpv-6vD8@;)X!?NQ=IG!ekc}i57;33N7#I=5xF61Mu0*U>c=z4Y
z^=5^p22x8IOao&vSNV1KO(P;?Ml%c{rQ{d@L*RfR5CO*ZI;Kv<sv1o2WFpuNw_TsQ
zuIo1aet)~)?{9B!tEgdoE87FbQFOP<Iai}V9NaB~0LF1V&qJT+!RblrJ2fQpv&I07
zP?^Aym>vj>oGD<n)*`ar9NDCeFc-`7@|$;JJII|CZNM!=rmh2~5V|xBnSc!;OVug@
zhCmLrLoz~)DXR6QjI}DDc4=j1R!yY%BZx7^$bOM?!n6$Ni*<O|2y@xK*rZ~HwPsH?
z5op0al2S?|O&#pGm;3Cn?^;t%<{C_vvlFIh3pF+0M&8`>z;&oQ;XW*HdHwSX>H-MA
zEQMhj%uFdQ0YEs6*bbrdAf|cmZDvi+WzY3q==_ZrHz)t|GgyvFmJtvUWqMwSXs*G=
zEFuEtQOyy={wFOClivtXozL)go$k4W=w6HlVvQQM{54Z^_Xx+*-#0O}W>k3(U$y8?
z;Ni2kCFOc9ZH4(E;qT>wx~{;~o`qNiG-_F<iI#?YbqR41*ZTuQn~rf%Fi~tejMMB1
zAq5(4E{9>a>Jw=<?r+atK6~~2%j3<-I1I1PF2DNn>ld%itwIc;R24fIz;Fm)?mCs3
zo1_Rfy+rT8fU%dTK5eKXih<quyG?<uk^H<HK*atd^W}`F;6lR+0BxUpy9NN&V%HDD
zb=hZ%A=fgN;la`N?RTDt$eUNMp1ru(tZ=hhcU?>&-rNj~)`W<Pf|?7fw`P$VqJj8X
z?h;YdcRi;lxgxWd1wep|wbp*M={IXcyuP{0r2^q2d9vH>&d$zuL#}{EA@wWZP$pUe
zGY@$;<o&uo-5jlvxvHSE5!DQ;D@hxxA1#W&$nO8{8P_lj%ZhT2Uo#YX*3&^mLM+)p
zO&qcjV#k4qV(geYcj7b`IYlI7B#6jb9f(F<*KN1kaV);yyRM@|0Imu)$0=IA`<%Ps
zG|^q|vNoI2$xn!(E%o-{z!j2k;*<bDDP=PIM8aSo6M>3c*spDxiN@hgWKjo5!5mdW
z2sUMD(_Z%3uS^@Zok>7pnFuZ;nAx2e4giLSDbs`j12LB(tfiC``xZu*J&rl*O>c7t
zQMH_a9~uOUcb$K7IJ?XsC{r|0=d&ZYuo(e1&r1YGa<CyF9X<#yz_D`{eD7<bogLo&
zUg^E0TGdiG5#H^-&F9Sgq2{B79Ab5En!Lz5=UX?w)V(Zz4x<yhf#&6?S`0x!Z9-q_
z0^z*;Ec2abGD2QTc2D|UNEGG`c7S)Z=1gS*COkiT{l%|;@#|mya@g%Z-~FnTa&tZ0
z+ztT)cRc25qNc#ihM-o*U2*N`zV9c*5~x)$B6B4taa=SKARuvLlDKrhB9)l$o7y6u
znm?e3(EXd%zDljNR$?a5VRvh2zxO*o`iuYO&!0bk{;&V_zq&X%fAZF&7hgX+KY#P~
zlPAX~+nbx4E-(`fqN+fEkpm)Xspt&(Rth-in8h6?Ii?;0ML-lOBD!9$V~kqz)vz1K
zQbkfqx5KSnyfGq0z|e;-5MU7*_G2DLG_^>g6#$CL&HlDzz-=Eud|0RkYzClYR&o_E
zW_Hg}v5L$ort7O)n6SgMy^RA!{f77xZ@?ALybRRLL6*K<)U02x_Tx~-VhEg~%g2<G
zk5=8NwdQOfh?G*#98FQHGDmLeq5?o}G!X(X7yP^{XVITIG4u**8HfN6StmgB)WOZP
z0X!zDh~P{h<>|^}004jhNkl<Zyi0FiZY7;`@aDbXI1^ZS72gSei<saW87BxmEQU18
ztl2-Bh<o)ll8L`-RrQWOy37ZnOaaQ@C@hokWjI)VfF+cF9+E86-Fty-xf9IHgw<J<
zZG6WLDhE(^^Yyd^%#f@s)Q|jT0U|7BmoPQjoe{=&cintY>%<6HUS~Vc{eJmNEr4zF
z8_%bOvzu)ZN#{>@kNj}x1vehW!s;F!YEx;VyiLh+6;)*fu(>1d?@~%3K$m^@3nFwk
z1vE1hoj#QhoxHee*djzQ6^E_}Lbpom)rxTy8D2g6`q#hw)mLA9x$5G@#nq6D3Z*WU
zYUh_%`yo^4kdou0Ysur7i%H-VQjn@(>I5=y>1zNpVT=Ik_9v=s9FORpo#4Pk0GcD@
zTrVuoZ!>e<tOnznPeH^|M<Pg(Lu63n2%miGTYvhG{?T9l<zGJk>hrU+*N-1OM3tNC
zi*XzfF{Ky-2V@N(Y6QT5Obp3yyQB~R712T<X3j&Ys%S_Qm;;F9Qq6=I_IpvS)v8Zx
zce~ryuU|fXE1bfEt_u}(zq{V&v0ojnS6#^i6A;*Dvs$fA`$V}GP}`5tF{BWYm~85{
zp^mlS)D15=kF`+Xl<4T_2&c{O%ea&x6Pg&OV;P+<r$88*SgIPjsXBVtBBvmlyQwrU
z#k@|@wE1%|lk4UfLKmYcN-3pC&Q-*%-{PEa&WnFJ7x`vMT5EOIlTG7Lm;i!cuFhk2
zKx;P)qHA<bv&X|8@$SE0z;8;J4qLv~;<;iggA7#wP-a-sJSkantL{YxGb<w6<a7wE
zWus#1iutChVCtgMh!ldK8e!VfOElskj?58cp0iJEoI7x(<(DlQrT~Dzrl>AC2~9cG
zt7K13;h@N3CScg+@5}UadD_fJ(=s)_N06t<W()B^2lgqDOv*9$zUKE@CQ3RL-oG)D
zE`NUiIJujfLvv#$<~tNvW)>5hwA`2Uu!)0ufJq=C8q|e*;JmCu2=1f1%tn2*>K8EP
zJW5v8r%&I0`uOqV#}A)AefL+t{PnY!uWoL~7tdesN0ADYQmKakVnLn0yto1V%%oOA
zH>q>%jZH$y-W3r5p639ttWoYBZ*VYVr$ce`&Cc?CpAGuHXM|d79t$CyY}QAsz7G4p
z_!ocn_T$rk^Kbt3%a<?TdHQxO!`a!{Znrz$Zkdsgx)@8d=`)_P4=)Una5{^PnaxnD
zswykaZQGp37>S5hsbh`;7DFg?JUQKV>zG#DaTi7tB}QO`<SNsItJUiGWDOv>42n1w
zA)pX2AObOJBPPVy0Vo9~4gjXrR5bvk>CP-0XaL}oXk37}{g_82Gy>3CYa?zTh=>d7
z#~3R%SuzC+Aq@L$q6kccZo6bAQjG(Om|OKQM-fq}NJa}C^kunlZ%5$W;eqEuO*4Pm
z!ib8%ld`fQ5Y8rDcTzE&moXmZMY>cKfX2F(d0;a|10N`n7x&h*;}81rX00KxWE0Hm
zQ~|_e5zUkb^JcApSu?jZ0Rw4QDW;}+XN)yHr-m3<W`#4@bIy?GaJEcNzgd@gFKiie
zbs`e{#@J*t;SUT5ff^3cRZE)vd6QCy>GAvqDyJ^AqUUph7Up`(YrfY9SiZ<NZ3gCN
z40p?c<p;+`x>*)P-a)Ts;$54TEECD><Fx2g-#aSj>p^o1zvdF{t`CjlqzXh1xn(5h
zp69Wu$?fg!xW8Ga_`UCa?_{&xZr7jx>Wg6*N-4uI+}`dTaW(9A>&=O{sf8ar1S+78
znYES-5fPFD?-fK<t0<B+VTk6eEPjZ3Tg#k|;}<;VSqer7I<<`E9p#u&R2L*Q3OwH4
ziq@l}^{3zd_;|DZ;@7`^aB}qiJMVn=lTXKSPXuFrj0~Io3Z!)kyBN`G9;=&%A_h?>
zVte~f6~t6$zM#!#CIBHGZMIz>yicuWOuSyN9~>V)e0<XNL}aUV>Q~|BcD%m59<R!F
zyREe#ajp5{YGkGmXspsxr%Gm~hHQkuguuaxG*WBj7-H<yP{0uR_V(7nZZIY0<o;t-
zU<Naapjjj);*t%C(GWl#R|^1*&54MljZNh3Q3`b|<mzQ+Qe6?7++aE9f@&eO473z;
zbE-KTU9QQyr)1mLIys4XEX64cvSvcXgdRqnkjh9<RiM!t@09a%F6C=uhA~Z7;(^t5
zYGlrEaq$Xs{^tXsMSwa)fcamvpZGU^(E1W>W%ATjK+t6<FhC<yoneePO~}!V%;fMr
z$Q(PINYJWFkoiyoP@?E^!uP_cYecCyRf!Em71SzXXCO|&_HHR519>uvhb{~QqNzwT
zrSKOyJSZD;vm2X(pqGug6k?7ckeQmfG!P)VA(f9ZW*QnI5<oR`cZ<kuIISSOuR>yN
zf@EfQkYz3YLU2;~y>lgmxHvg$1K|=ekv0_$GXZ2EU;~}7a?NM~0L)NCQw&qqIios^
z$iPSq4G1ZKiA!n`!7z^N^}6qSDLJKX)o*vh`26LoFTecy`eq>RO1*t`esQ}SyVYhB
zB2z%Oqo_qh42?NZpovM{Oiwu=0g^$HY=&B`f@(Dd2nK|#=pJK>lEn`j?{^qDs{z!I
z8A081e9CkboPGy-es$T$C|Vid>63@w{mv(k9v;7b`QktP`>XfgfA`xTe{}lb_}PmW
zpMCZjGk^a1=L}S8MSu{{m<p&`0qDA}_iQFaHj}Zah(ZhBhOVp~2&y%#GXfy1={Sz1
z>T0z*Jw5*5gAd+*>q%D2<9@f>?{4dE7&-K-&GzjlkFIZSx~?OJ>)mBo^(ULHl}x5&
z0BT;&Dnba68HTa!_d8%)qxGv55jnmU0NfCan^$?8F0R+T7x<-!3rRBp2Og&^buLZ(
z`&^5v7A-b8z5r0Q5?djujW|RYC^55CkfGFEV?;nz!qBCZ!p+S!d?SYH-Ok$_@}}yi
zO;Al0&;x5zp`DTvCuJE;IAX^=F0e-kPI?jX@re^M5wWO*iT?qu`iw-BbDkXNT=Css
z08$9m00aaiU@!y*y_ZcNk|6+4Bx1&9Der1(2xtvo)uvjaJ_*w<c4iO|STuW<>z{&|
zQ|iZY48ft`5diWy)xstK9%PLgNZeyi^>{@@%<j{IYPHmAAb`$ERRd7~1pzWda3%w~
zr2!~-D@0sYfSAdj51M%{7uhY(1py)l1tafyO(bqZ5L2yXz1<+<SQ?$STdmEkl#vhu
zApw|FF+bK!YXJ_8Re@k4KuCZ@EY(datvR|lH{Vlix{o~f^9Z1U&ivK=ugcV90ECt}
z5E79oFb1s#sF9+fp<<*6Kp+YT0RsSmxB^0urt2EXpc<MY2Ii2M<ITkdPzZ^uXLtnT
zkeTE4)zym^F9O1&2XA%#_Wa`Zm%n~~b2FSieEa(P_T`(;FRlmUgrOr2L~-1YqNV~l
zS773VZjXjUWL#?nGA0tUQfe1hD6FbzVU^fxA2cK&Kp;3Y$b9{DY28rV7%2J-52sj5
z3hGHk!#sfzS%@G4#PEB+^TXf&z27Ni+^kO?K6>!__3I~3-~Pvc`lnxg_3Zicm&0Bn
zcC`+Xxz-vm83AYxv6H$J_rx^K1&AXMQwpdS7)=y|d(kO(82YuD^f6T_!!YdkyBNC%
z4<3B`!;e1v@WbcNUx(P0QqIoKcelgl_~hO9K79D-^wrm2ht#1cCw{Ox?pKK`Mhv^F
zb0b_odaz!tav42%p~-sFAqR?N3cKAdgpeYYQivd}l9qaNbK7-Yh*bAw97l&jBbsS-
zZ+Fv@$C6?)RpMYqwPp`2IS+`OLJSZ}DJmL}5J<EVH--{3Q(!R^H6<L2K<Gq3LAn$S
zalaczAPP{%I(w-hA_uOyPC)YoDlx{`bvHLR<{2FsVsLhpsUol`7%CAt3Aol;vjH)2
zaGz%t^}#v-sbQ(=L@d=pAu_X?P-yb*rfP<&?#ZD9>>54*C}4{2q=iMKs)8aijYW!7
zAK#f-nXFLe;*v0|LddyRs4+%1E@Kh1lu|&dwHhiDBeN+WGsl>71xTSCk$7i7G%*+N
zP@bnuVKF{ZM4n^$%&(s)Kt_O8>o_NiO;Ls*U~rQFkI3_%06-39b>6*u5rY_*J6wYX
zZ*W`71&tHw467nk1R?~)p=2U*^dY$7HMIJ2Lir;gka_LBfUmm9r?eBzjA#G9`MC4y
z*;DmpLOR`<1DN4(ukHfBd>)D*vFjPwz&wE^*AYFKzS`6+#2L@K=tH#>+ziDq#z=u3
zKP06pcNBPkbF)g_cRv24?-Lq*_58*2XRkt9cPqZW8Qz>-7O{}JTm%tUtJUqzn5$OR
z+Kk(nnVZJaBHwY#MMR!C9c1nkjQ~i1a<C+uvluWlmEw9BtuQn6by7+pLLxwNQ7B>r
z06jTAy}7*DXL#^9y#4lDr^nmtYZ>$Y!RhhQ$u_0_#fukj-n=<JK6!Nd==HM~>-D;f
zdnv#Kl(_E_GsO^GY6aDR7|8(9fb4J(s=8tal7Rri&3>12E;V=k>g~sGz5Vt(DW%(+
zoB#Zu|9Z1MCcx|K>so7IWRpJ76=)!oQg3dqa-X{JC~&A_-mcbQ#hWL@7-M8cVklBE
zaEu|wU}#7Uinv{Gd?3>IJ(8&^Gp<%0Gdgk$K`U@;l87jXDFIY~!`#A~+K7m11PJC9
zE`|rRIRcOZc?m=U$b?`(sAk!uS`{)TiyVCvy6p11gy6l>-V;&^Yz<rHt{H65{KkC+
zAmW5FuC;22D^oCN4S{(YiO4it?<kt0f`eL|u11HcmzkN>ssL)>^EGp<mYK!4LIiV{
z1=6|Lbv)@3qT^wQF`^nwAp?!bjEtlT2&mh@wf?B*O$0_^IZ>HkZXR>nVyZPqf$7Hi
zFvL4qIE{2@@q&slh53cRhfhEJWV;uprz+5Vi?u)T0NS6!Yb)tpY#ji77}-pt5CO}W
z7p8KII>}z#9V{-ZA@~h_A8(}~P7DlH7jXx~aBmsS6QOT5i07Zr&4+0yKVd%ShcX%P
zP8Nx12f@?1^Mi1JIje_d0C3+IkzyvbiV?0-JUZG~se$qK=IZ?Q`PW~6d2w;|@ZrPV
z_08+^i|5Z@UYwnw>3Y>M!7vO?WUf+W!Up+UGP5jBg8A_9Q`i8+kE=E{a`CPOOrkMb
zTm(;<>5$7%8`pYEnZfDz?bx`!zLr{3fR8@<=;Mz+{_w*OZ*H!xZf{ab3|2~g{`~p*
z`DIFRyIs2#H-I7o1q>8w?Nrr3UG&$9{s4ePV6O3cNBq<~Hp^Ns#u#JV@Asd5_F0yn
zpIzU+c==LAQixBUJUKZ&0;y-OUw-`Yr*F<LFD|bmht+E37JloaZN~^QipW@U&m9LQ
z#+Yy%YuEK0(9oE@*`@A>IF6&A>!mhna3T&NIirN#L)05bV4|eZeAy9gT3Nyznl&mK
z@w{N1u@7$dFiXIQ3X&UElPJ`hMXKX`Yn58_f-J)T6hh$O0GmV0Ywql;Hbwbm7gD4i
z7Wc%3bMmMzP~H<`$bZM5h4>iLz*LnO9XC49Aw6Pv55!u{tG;lT`SRT~@j%R(+plJ3
zAV{d_;_jXyse8|h7WGc@;lmypZU^Vfd+E|r8FT(CJh*00A;1oEw#7eh;c^bmOU$qz
zXurvC{Sb_rfU&n=KwzQMB_h}aQw|Q#aCcrbH*1!fPxs>Wy+}9jqI<tNop#Gn5`Od7
zmPgL=$=&Oa!d<YGpUf~}=l}@Oh=Pll-P2=jO~pxc($Jb8lQ(fK6OqqGLkMP4%9sM6
z!mC#=#&Nv5x{^|At;7E2)r<Vr+fT2qu5up6VIMghA0LU>>o@1do%oa!ftZP?nyRVY
zmFYcv7Nn)vf-bZc4>5FF9z;w8#O%FbUwTWH8iB)65I~TC+Gz@12M-=R*lxF{r>74e
zp1wXmJHNO<rr52V^nH1GIgaD;@o~w!n79oVRAXc_GQ%R(8g8`BT)k;W)E@A?W#DAQ
zj#AfkB64+gHIDn;m@jT_3}CZfpFVx(@#)F&Y8A*(<>K}0VJKY+>+PoNB7gx|w@QhC
zkX*4C7!*}i6Lu-3e&syo0Wlx}5yaSZ7y`D!({D~GO|u-4eMmN~D|NZ$`MJ#4Am+GO
zhldB@8ujg{XdO&Y758Tifk4RRHeBVy>YZ`9?}&wC?l*vvc=+DW1}$y|WpDt#&8+~e
zGKWytt8Obtq$~<AnUrc|+Gs7K#_6qTl9FpqOVcWy)lqE$_?g+^%g|?LYSr9z7|<Cd
zX5u$udC=bZ$O-@&bfPEflyc+L*IU+OlktyD_2$GGoo>)<W?>Uw#T&^nM%RA!mIO{x
z(93!B@=F>Z=I|4m)LYHWRYJVjcNC_!)~{#u^H3PL=@AhlK?5xu>>2KLDxl#f4%y|L
z06Gk9F<|jCnX2UZ`*uGk9n59WT)y4>J5x*{L{zJ0cE~TtObp4OnMk|Z3^=tB=A^>V
zZRHWkj6{ln5m8kMA@p%&KxG_D!C^mMoV~ujz8=SM-LH<f+f|pCBbb#siWJ|IY88=~
z`F0#d!OYO1c1#XY%BA>PKL{!KQzvwyI+5>TKQEyHv=);Gr>7b!Ahq0ZS~&n19JwuR
zNKXW0M2t-E`fNNsp&$I<2OoU!!G0Wb&ci-$j<zAi(}xcY;o{<|*1F&C0if1QjHr5j
zb19{E-OA<DRjW-hw}1#PmnRw)NRsL4o0$cFj%c;ktE(#!$$1z`-j{lOeEj(I_;}r4
zzIk<Z_U7?h@4Wr)2WRJ(pZwPM-g)o6n_+)*a}8`__07fE$)?|~yKdEq7IMLP1O*Ui
z<%UiJEdnIK>R>(u0pr-Elu#{?72JMZK^0_L>2BQ8yb@H2u~reS28!sa$zBUKV3XNI
z!~rxzu(>8Sm1aIlY<0}cp4nE{^aFsL^Ei&<I1stz5qbx#-Os7<MCi-u(8lrjwOVy^
zF!8JPDxNr+xi5%U3Er;&k*YcmSAG2eA`0lNIqSk`t{R*t19O+ivI(MudSKu99>;|m
z*)k!R4x#FyMB6oaNHs-8LQ>CQ2zf>!C;)^hRJU-uWPRNW2kk7HB7NJ<4JoKI<Ko^w
zL8H5C6y~jUFRr(56x$$}8m!EHALbXB7y38j)Zrq(!7mamrpV!5x9*T-+v01P*jghF
zdckr?ikAUpnT;~TZ~j~pAau^@8g|SzH(iMp1PlQM3<1O^Z?O2&>*C2_RE?03096$o
z(Wd4yOzMH6l#$W4C&zu?N<t#qu8&rm_5bv5|6gB!{dLay`1B-?a(#Vmiik9hBZLSD
zOvEv`xje!_@@mdamgmjATXAo7F8|kKG&spm8wAQ|TH=lR!bIrGFjv=CrNWPX^rQdk
z&;IP&pM3n2AOFqO)z!&^Q)If??J5`%^?m>T`|m&d^6SsP_+{6nz(5H^>S*AAN&x3R
zD<df=VlY#@%icaT$iM*L_V(7h0YsE0KL{fF_DAnMfByWZfAd#oj~;*U-iN2B53jGz
z_WS)m{Kx<F!GjZKih)xX3^nH=k2``4yj^uYg`kLxOvFIAyWJyNWFJW@F`40hKQ89o
z7Gv~mPQ(JW6kaO0&L^m;3bKQf3II4(X(~q!8o`SN-=0a^DG1DrWS|G6Fak5PK|-=J
zsHnsc5O`|2DgcHMN)ek9uX$BW5p`OW)_`j;b6D@vN&P|=g*;9f35tk;0-^(=nc0Oz
z?u3z6!2l5{s_&oW5FY?s3=kKZZTFV$GSFFbB=vWp2CtmjA2?y0&F;$(&tdcc=bRJZ
zdm=_{^TYg;rO@0RO6XM0RdbBPWN<VGSua@bWopy^9zs$}cwufz!Ys6YSS5>F0NxyG
zXO~;TQ8OE^g^1C3S>P;h-@QmWA<0d(aljDKXKtQ9PM=Yie6p#>_ZvRf994*LdMa=a
zdwwtI9AF)bUvN;dkGTLtJ9<o<4Cc|Sl<bmMMp#YXdiyaWrIhyj{cgAGQh#xMHI|&E
zGV^M+syd7}w>j5RRSi=JG)bG(T1qLpV6eD!N0WiPOCX+M#UX@o9B1{ZISp4;1Sfu=
zXA|hnOaT)>*AXRG0|hV>(VX?;k5B)}Klvw5pFTZ1yC|Z^rzejdJsN7UJPt!f#LZ^&
zTfg;Nl1qsAAOFMuoby0{wN?g33Iw!Tt;Vq^y4)CogIr1PJ*H_@fSGN#TL7n78aDYg
zWU#Y0uTD=k-Gh^1zyIv#fBV+sxBu`D|Naku_xHc`(TA_EF3-L^<1Y2<6%eUmirZZF
zx5J)@oarB8AjTqP97h9*Oa>B=R?s8jkjM6<o6ro6<E@s;96XZ*H5HKBI_aXy2x_%T
zCL+Y>DGD>UcAhFyXf;lAUZN&+>!K8ZM4)7-hrJ9yAw)LRQgf|A#7qsLTlE}+h=mw!
z;v?DQZ{}Y$XAgunJDaH?V$OpD&gUr6XfmeO8bNadt--Z@H-lFWF!g=m5Mh?*dIPpE
zH!lJJj3(q#VbBoD9)ERW_sl~JQ7u|#ao={G=n2YXqTc@ZkQI4M2zMj#LQ3xt74IZd
z4yT`56$XZGG6O)fBldDUCDkpw8^poP92R#EzJ7=}c(~gx-&f_(W~D{q(;OmGTBd$;
zHnBML4xIGaH03uYr1M`bjs%-ZE?Y7eT`h2V9No*pe$(;Ls7m*k0@I0if9iFw3%NL)
z8b;Va{pOpInW97b1388+=fMyVW9;MR=;-R|>gMWFYwfyKTCLuE@#VheVH_{7_vhEU
zVXSJXW;eTizdea55fKm?VUfBYM>BIL?G{}p!j*YacQ-Bd+HkkqExR%8m(^klsvy;f
z77Xxq@*xv48=#`97FDbJJ$(DqPk#8rAKvVDZ(hDSJw5HZ`1<Tkw^^r@V!yh)ynOZQ
zRT*<B<=uDR{j)#&v(G>O)vFh;&(6-q-F_G{sKwYhjb2?(notcv6+qBHe^X_%-|u6L
zsfz%hr5&6xMvQiQef8?<CLn$Mt&jiskN^1Z{=NU=y$?RhMyDso+@(=#jJ!GCAX*;x
zS64-<j<o<&u!im4=e+`qL#YI2LIBL%b)5>NE+C?bdJZ*?BPwjSM^{%@W`^qdMAM@t
zG#{1COHn6523OL$SG0knC_Iycw)CKNt2`NUQ#oRafXqCmBt%UFJ;n}^MTU}PN_hP(
z4i$;JLM$frFlSDlAk3trHa!cBhz%|dbBZUE6C!#x)`Ce>pSpvY_mx*`5ik**C{6cM
zlR0blpU)}XoQ?V=MGD?VYfkkpQUumisbC&19pL={z<=jE?;;@wa(T^(^lR>Bn9FEj
zAqF*5(=Mfw^E5=BpPY&M*u53t*oX&JL{itO>Tb6a5#Nfln#OEcLX(&v5rq(;Asb*~
z!Zu1$*L4Ww&#CWwcR=wS?s3`cAZ9l)#SnNFRv?BLLkK+PGLB;iq3`=yhPGt@?)MvG
z*L72m!nG_Wln<&yfMSf}IL!IDfdCpaaUdekUA#0<14RN3#Ew=46LCefYM=&MrOr~}
zbD;MBmOA{-QXhu>>?KP?fUbgLX2y}7<yK0mlDn>pDc$aGRBXN7rqq4)_1CXozv))}
z`Q_D*|K=xOeED@29gFVAQ85^@A%|`SL>wX#8li~X?sj9&DJ6~}m%Lf8iD(=K0AQrP
z>xyJz5*0uTF;uC;I2ah9sY#VmrKtOQfXg6o3>^{GTA85h5}NIHH!At$^vJZJRj|rv
zYWeix@sp<~Kl;%R{)<2Q<Mn!7a^4;tsoGFV6*+nMaI@LeTCXp!N-poe_s)-g@WbE#
zgFooH?w6na`o)WvUFs0ImfCeI=0M0C0#PtSHJEAN{@j_l*@>Dma~?-kMTDI5{&t6m
zeczeset$iV`*q*{@Q2_3@Bh31{?GsX&yo07pZ|J$a(Z!fb$NRwCL9S-%qlZ=UDvPr
z;C}EiI-n$_SjNJE9bFe=;t*=7IgjMcL0~TsnK^`5YDEgf0f0o!U4xx}Rq6<66INfB
zFqru;_MMV*W+tSTnGzud0&EONZ9d6D#9iMrb17A8?NY}fsDT;~M*}p#kUDoPW{ype
z1`#R5z_pY`J>?<M+n`!&rPdK@4FnMZ#D%tqhZ)Z~XdWdnH-kJx<j7T}iYi!OM#5TU
z7)OpV#wgN^OVx9o7}QWyt5i`H)#_16m6$y1^r4Tlm6)mKjD!t=g@{aGSW2m4{c43s
zBEli!M7geFrPeT&&xhzfZDk7~xCF}_>Bf@N6m;fbPecF{Ce~(@gH4sS`p|O;ok=N;
z<2d(v?==K!tp+Yc52X~qW=vR0X(~|D3_GRd6@k0UPKRDgT^$-W`>dMlA<;n(-^1v^
z$92*T@M~+Q4YTRw`nS+tny;3KVBt+POYSd`WK$wf_lW02G|wjQCFV}C_vPi+Hg^(;
z$h#;=jqKr3$r18%&WntF-@kctKGu?R-tG7OW_@ve_1VvV^*4X}Gbvg`fjO-=wZLv1
z!6>8zhSk)nI5oRYjsSkIyu;P{Ty|&3ZqoqNfB&1D<>^zKS_J@NXMYwXO&!-#Z*MNT
z5UP&nXT$sNA3c5ab}8lL^uhb@y!-Is!x-Z^;@R0*HH}^36vuJ&v-!ghKiu8iUYx!D
ztH1iI)W@9bcfb4H{eJ(|7hi+wdc7^BNL3<24rZbP;?EOw8kx3L>wvae>uR;~C>CR6
zz?}2>`T5PwH4yxr-}$Zo%YXZS{%3#sr-b3BKmFTZ{Nk5c@a+1wJ33k&ZDW^AYZ;aL
zL=34*qJ{=BhLjSS)-vXtA3S)l+uw})eTseGMP>%klzMCk-DQd7wO5NX2fTzG{Dj*N
z4dyy*R<`%izXSM*s1d|H^;CaGXzD6U>}O2QRkfN@NNa?`1Thj~B?<r<0y1;Sb(w_v
zB^41047Fi(U~Xd}=3GRCrv9F<QZuW180}6w<zR>IXur7>E-EaGpfQbhb&?=(K?Ea2
zn@Hpfyym<nVd2Ypr(^_2ku`A`ueQt-kyUHXS;R^yuJ7bJO+?Wa(j;@KkJI*cUK1^)
znoB9EpI`ls(X%O919di3=^V?NE5?-1(`0r(C9SfIN`8F?UNxwQAlWRx3f2Igr4%M$
z=BgkHF1~<>1|X(YrCW8S6oU!?9N23dQCDkkUHSQ~{Tq)~<2X(pHSFo_93m%{Tbsps
zehLc@C?dMOz3uy++|zUsgKTnxp@q_|-@aw^TrMe{<QVRRY=>}4Yh<f}pY7@zccJy0
zN-2R-->=u(A;!p&j*d1Vq%Xhx^78s>wcYG*_E`%Os@gt}`(fz1Rq8tg9!geKaaA6G
zloAjgT24y=1Tzjil<X>}RjOy3>fTUxuyLKfRYg%1M&v+*rdkjzCS#^yf4%NEBBfUN
z=!18@_uJq7^%q|}e(Rm@eeZk6$J?u`s}>^wR{dHL)F77<nEO64!nnV^jW_?{Km5Nx
z|NQe|w+|tlo<8)Vc)#BVA~RzHL!6k>wrthuq1EfcTeQ6Y6YeU#^Yrm|zx%y+-+lKN
zzx?ID`d9z@Z~o>dAARfNKlr1+|M1B>o8#lO>i5I2+uxcANEV}Y*H;2EU<9(mmR_&d
zqJ<Irz7NdfI0{JYI?>{wOQHsSX~(KBJZvJHhz1CRtOd<zn#tQVBOowj3QTdHXoirO
z<B<1=NbGZ0U)2moFwJsRbsUR<Fk?&|C=x+{<~|Ro=!gs832SM96ARq&nq&&?zRio)
z$NkHCyd}sn%vp}}yd4iS%aG3z&Fw>cBIgr{#l|!@jMB;36bQZByPU8sn`8eQBW?m9
zaiSq0wB82-VUzu5jFjB4(vvpND8iI3+460?;d-xC>Q5sVXQABJoDU(GHZ-`uq*Fyr
z>>j*{h<3Z3uhF?tGXHIhKH&}=N*6ZHezS7Ugl?QoIcG$hJFuk`aj!&}aT1;#w^Wxf
z%xJQ?e+Sb5$K$mpbj~%J@66PqT>|v#+(-7)!mrTPmF7gUHMtg|uJf&<#chN|vvrQ_
z{<qSMycc5Q?)wLa3D2b5P9@izhlH?RuiecYF^I^U7tcQX?6c>uUgWU=H=~hKsvjGx
z)hfnl$X2r<sDT1-3=UaC#FWzfM&Nv~R(a_>LZnGqYT1~ZH;<>E-eG4>2vTcBmB194
zASP3}xe-Qq^5n^b2M=Dqe*OM?@4fr(yEivCpMU;28Lf}DrAjqLA`vMio7t*QC+qEZ
zzVn?=KmC*fUtC?idi83vTE`g2aa7e9qfL@L2w-HPc{N$BdCuCFOWF$*L@cG0oDuQp
z=qSe1M~_aguCD%v|Kb1o;~)Pxr1<Cm^<VsxfBMhX$0zI4(_D4Pqnh-6ih&4ftyO9!
z3QVACc`S$+Bd=E5DmkUN?)%h*GG@;!eKfRyRUVMh942-jvT2w&3$WMPknIbC1`(;<
z2^>E3_gv47z5rnI$bhDXI<+7@>m?!;BM4x?6nw;hlh|cST%6%A;s&~YbB)>Q=c+n!
zBM|^X2({KZQ-HY_*`;|0nJ%vXj%nL8wwY*W=oF8|P+nDXEnsMbOD|Yns1bd$_Wcc!
z)W~Idz>N|8Seg<qLodHtlt4s8&qiJG8^E&#Ctw1TDvYIwRt}7TtB8PgAxbSi7eHqO
z0+@MS>3MhyqeP8<<MsFqzxNxo+wI)(O&7u1|170=(&iu42_CH;F$)b&Z)R4d5>ZIO
zH+k1}%vfs`6=b@)xn@SsB}EiOmnXd0A)_=qXbyQ~_fl@zE0}iIK>}8-&e#TPumRUL
zITTsTi0P-<^2zy2l{%d|E^IQ<+f*&a;9|YC)>7(xgs8R!r|LNfsvf#y*5naFt(tQd
zEwvUj-0%0#zy9*#>~-GnuCH&qv@W$&K~+g9tky?ew;FO8@-XHRrm?0U2}LTX`BcFs
z-MQ&-6_=zz1Vra?nrfX-#wm53SDBb8Ai93ONU<s=%!KRp_V)Vfb_XB4v-<G;Z*ThJ
zw;sRq>8GDQe0aLw?@K8UA3ok}HoN^GV5Jm8K&D9SG2-g#;`a9T>C-2F_AmZ-pMUSW
zU;O&>XJ0+fdD!QD&N+nypv{8-n}rD>+2nKSd9G825V7Qf=;i|E&rY=t!|+#s_17`-
zcDwzZ-~BuP)xY?&zw-yb->){eV>ZNG$FYtvaF+ssmeJ5m%AR9~-u2RoM1d#;tY!35
zPoxyd$iT$NK<eUPXhhtOI%%V8FhirruGC2eL{z3GJ|ayuA^<`y#Z|jp<ANxt)?vs*
zVWNyFOblZ{1@I=)G($&ca1^3|ibP;WRmBWuu(ksEFn%J}0_b59JLd#0dE}4}oFJ9H
z_+yMS9ch-X2cVg8?zYdKD?k$%GtV?VJgd98A-Jglm^1jzXQTk2<q$gWhGtk^<RWMD
zju|*o%V+V-tRSW>jjIkP6%sH66R<F4lLveExnx_y8<*+ZJT9NamKH`aGc4cX8LHkp
zm|xa+yH|_zXV8Vb>Ak$nBg>&51g?UE%&b!|vS~o63XY18G3GoVM&cPo0nEr8kb?@$
za4yd`J&&9H0%=ibFKwV^m^~tTtZ|8Qn~<=6IOm+_&TIo7EsS25$A*W?<vpL5;4<K9
z<E41e*PJt9APObVPP3I`6p>sDGp{!55Q4WvSA7S43?YD)T8nD!`j~TEtvV5@rJ7W<
z7y~2d?d|o=Zcsq-B$_8kikZ~f5()rponI6?+^%`?%pHljj=B4}rsq4EHiDUm$ynFj
zY8(XtK6vlj@4oX<2%%pczw`7x&*e`}PL7X{Z+5r4-H!XD;07U)r?c5_?A!0Y{rK(2
z+f_dd!+y7OarF>FZS;YRh&Hi1L<Od*a|W5r))b`_6bK;@^KQ30JA1v~!{bN&AO7JV
z{PTbQ&;RLv`KKpO-+un(7hgR8y4!5G>s5k2bglb2>~|=&i?JA>RWOTzDX?SOhq0s(
z5yhpH&8%O=hRU>7f4Bk;BGzilBYBRkHu3Z(!YG;ITs+Ml<FIH84#N;*LWgfkW6eP$
z-<wJ?!+CmMtM@d5Bd8ETs&8@gc{rjmM?`b(zlf+vWY$T8{GP4SysDR_l}s0@lm40G
z5SCE6J1Yml6+p}yzH@qNE**l1=u=lhuUGWmhVo^1PrY>7l9QqcG_6iYf_q4rgCQBD
zl>Bb{g9yu2P78|?j}h*kYm13TAeV@QsY^I%uQvYa;j%nHNX=gGdZ9|w3}o&G+{><=
zdpCzUM~cmvxh|Y9ee(>%089Yx4W~pvh+{3?dW8*6WJu^UN+#9{9`C$F^~ua!^2~A5
zYjCr}TQA#!^8=m^7*(zQI8zFUMuc4#=VxXHuFXEz_0zfMevLRCfD1rx2(^mHFm*F%
z`c23=cd4~6h$y6#$6CbPR>5Ck3JtaEH+jFicysam>t|<gUY(!48iq_5QwVC+q@bCB
zx*%H~_F@*hRV#=>fYu~w>)x>^IE@*ndXxRR%-Q`cDZNZcryQKUju9~=ieUvNs#eQ5
z?6r(UAfR0tL%{xcv#nLn&(CkJZda?-IF9FM7qx0aTyHjtT1pvfO_5L5+eeQcz4g{3
zPW;(tpZ(&qpZ)4rpS^hY?CR=9OO3HZ;Fj7Tu(xHv#K){5Oet71Jyq59dX3nq=)2wS
z;^Ly~x{p43`se@q|N5W&>7RV}d*3m$=U;wNRUg0g*5&Q){PJQ7PX)%2%+@J%U6NtX
z#DNV-K@G_WjhRXvkP;veyDd`mfEXy4BB0Oc8;M@k2^PReA$TI9YJ$dIhaxbdgDcFM
zRxC}nBcS3WSVADCFe$*Bww`9g$sB-F4%;LkBNeC>Oo0eh2no%g7V$2v2Y~}hv;k{O
zt5`F2cSPJo+gl>OU0c2BkI>?%rAD#>ANNejgsC;*MQg-DH2_%3v$j#hWTRbcwFMz^
znRD7iTAiJtJaKMDCWweM*@z(`=Uhq=z+z@aWtyWDp9%(WDV|0|bYQm`0ee9wmZgFy
zF}Y6*$6$8Qe?wf7c?hftM+2BC8o+)(GIIlGWC0^gOc)RtfxrZe=1waZb^U6$yQxJ}
zN3-GyPg1hAO06=%Ccw;w{q6c_+l4rkjH<{HRCdGg_`$=mj#5TN?Lq_ysFoq4rkwL6
zJ9co0_2}%VSZ}R*(J_vLkFMM+YL5OfbmKUdEQq5YZYia%>vp>Vr#*m(KHr}5W}f5A
ze0r67KLPizln&P!I1wXZ03#5Ttj2%=wPpy3098sYvN}2GVj4@4v3M&!#;{5KtLM*t
z@;85dc6KIWo6RbP?&#?Fi!WYYUR)!_etiTOnWKm*;A+*cwi{F&OY!tmN>!0S963}f
zG%Z#%1z<6a6m!j5G+-bDGYo-r!4_M769Nl>R1+zTlsEzgtwKR%%pHeBj<&L+qt)?)
zEkgqfGcyCOSF4y3Fy)%TC5>YwgO@K~{?)T*FJ3&m+3yTht37@CZVKJy#l`M==T_CV
zYONKJA_rs=F@;*k5vRd%6Vy?xRY9feVi%)`?DE*f@b~`iAN<8%{Kap7|98Ir`s;uH
z@BTke-+OwqyM6xp)!XmA|K7JgytuqJgj#c{z!+1)qPn}@ITe*d5|LU85^c7t&1UuW
z*IzR8dcE$tXlBev1Ox$*yoc%8C;$`|Q$-A_l_<o>AZk^L+~FVMME&sfQ)~4CTtvn^
zRw)QnrS#N;n$+UyBocX>-NZXHPPs0KNQ@zblA--3^87BUkWvI}+R0`{1SzF1MySQu
zTwNCc$co3&VaT=CKz`675_5=v(W5^ZR8uVNdtj1W#5vGR{<kpsPMVU5nt&=Wg83lM
z5DWtnFj1`lU}{<=hM<l4>lCB*Jv!vwrtiTfZ%CfyyU`9cahgWWr53A3G4vrxuz<lx
z_`mqU$5N{lA>zo)M2r+;3`7713QP>DU>1mD2xf%H#7rER15KhjrBt;^f6P#gL{Sy{
zeoYjd=@&vmbSq#KF%c_85V`ACM4?u#RmU*{5OXvG!jNJ@pkW+pttoY2B%;jGX*|p!
zFh{Sun9)o{7_slW+v^(<pTaN!o2pi=MMU6evt=R`jgd_yj|B_@2QUHysVcP+Vu~>&
z7L}sPOh!14*#Kfn-r|lir4R|p!OJQ-><8u;LJA=fvMHDXArpldQV0nQMa=VK5gUfQ
zS+B=oAjDPQo0^J7PBA1<VB{21puiLe34vY6yi2_)pxL@#A()iB-L6+%s(B2=o7Cx8
zN%VAc^k94Z?A7yU&z_y1oxgc=c5(h@wOXgtKY#X$LkAE`4QfF!j8$`y)UOb=<XpyF
zYsq6)k$@p_bmdx=3TmEIRLR5$#!?jl0|zjaDpIZFT#FF0f6^EO0MuFmbh}xLWT};j
zBC|;~5jI6FWcBuD_xM5g5C75M`>o&luv;TQdGh2j0w9=FK{Es#_j}ESiBQ#QO+YC`
zQ;Q)!dGhpke)so(@Pprb`^nQjt+hfa8bYk1UFuzxLxD<GF$APiYLnn;x?reEfE*}F
zsd*SoRcqe#-Jkq}zyHtv@jp5~I=a3YL_h?dy?hl?|M92aJvx49$Q=AA0##JR+kM>^
z?KUS4@B>SIfBfL&Ntd>&OxX2(UrHr}Rli~)H+9!qwHld4W)scBfCgRa7^&}iFfg%N
z>aZKeVU(%}6gfByIWQrZ)817oB2ZJ45Cj8LLhAZhb*NTMtC<)mArMla5IKreH0b({
zDei}H$fZRXtq7)4Ysrj2h-J*HZq;{*i4iDpG{st!jG$WN(8o?|9fvUx2M&2GF~q=;
zLf{aIQV}cFkOCm>hjAS9ei(^qwOQvp?8kkGVJLe<j472;hMWz6IYKopz!YQX2qFQ4
zg>lHWNZ+jkhg!0fieQnsPpM5q%*+%_Cp|KYf%n4>!MZ*nSd}t`Q6z(Q-^@ve*nkk`
zQi2>fAfQ%diUe4T1Vm&cW8@apz5CwOFub$a*rd~>v-vsQb$f3K=|Od+<<KfN^%_9M
z?q~x6IS53mnwd(|3<aAzYwE|N`zT9wv3GPv!Gw~7GG^u01c(%zBfMIzW}N0Ug%mTC
ztT|_0@O*v3UaLBya6)fbDWzymU8m?a-x#}&nF)ic)>08Yf+8Xi215ZOgQkr*r3uab
zN5yGu<TVhO=Ku$flezzO7sl%cqxV1s5lvd_TN;3@dRNxxY*O;=Fa!+S?NLJB-P}I=
z^4Tvw`{l*in|{?DAHAolH`fD&czM375Mu0rlR@xS+3eA%252~`{DY}Zt%rNPByT~q
zI)(w10{WB}G=$LH1c=QnAQ{;>j=6Z#h6RL>$VAop6mPC>4B+uw55D`IZ+-jQAB=Sz
z@_2Q16}vtVGoy%<s#2?(t-Up5P-_hoQc5YL)OTrp1V-!C@uRoidHwqA*|QfOJ<r~p
zl~RC02no~d;38VpO?SN2;D8+<E2X4Bh`5T~W}R-XE<XGD&)<Fj{fk?<xg9?E=)-qE
z`rzo~WV1Qq7<a?oz=$b?V1xi2P^h(vQP)LhAxp(!v{F3iDF-ABgpD53Y8L<%^`clr
z%9u^mMBSVYTe7TXz#K#*=aRxCjn~i-2TvXMaGm$2JF^iZp@E|LBW_iB6{SE7NTn1t
z3?ZNfQ41g;P^(MCW+IG;u&^n5Kfw{q0LUE8$^?b78B^%<E<o?pfrx>T5R{VDG{oRI
z#c>>qQ~+nynSe5gO(K{8fXL{&pg`z0od5_S1T@1^M5{G6v0AR#N#Qz))x*TZ2Zq^p
zTU9}u$&HJR&I_Btr&)(7zh47b>(r{6sRm~XnaNbs+!5x(1)_5~a-BiKbCYyJ?i|$4
zeYWESC!8St2l^JdzC5UE6?cnuhUH9VpGkVn_;m7pokvdxB<;laaNwJF*=_DF`BdF!
zV&01O%kx=~x5Js!JYNbS5Shzvswx>wV1S;8YN;?yB#exZCS|Us9HMS8bKn{Q5|*5U
zQ&C+x(bS-c^}?d>K8MkJE#t!>rdY6bOtRK$V(4|gGI1>xk=L6JBE7yidvkvF>cvX}
zeEQ_cg9i@);Khp<x3_1z-7e<}fe6i10WE|8W<^RV4mm(XbmIe)iGVzJln@L+%@BwJ
zyEj%l@cnf2AD~+>n2YXIQ#2a0<Z7Tu3hd1&GgGNxW0k&xci(&e?WgZk=<Aq~k{TDW
z6e9+%V-|pzIsr343IPqqS|Ar-2pFnD-R;EC30;?$m!E(B`Ni4!ZnxX6*D(@PB%)fi
zikO0ms3YO-++;wc7-I~O^Qc)=!ugw*zxw6RzxC};cy;pL`yYM$@wdMH=_f-T$NkO*
zs9?av98%-}#LTNM=A1z_1r9`D$ZW(K5d(+RF<>TMb%_ww&Ffmi-saLa4~uYuReGqM
zNdY1<j-wlDEzw#&_8f+xO)w9zc9mL9wVGHJ5i#*+Rf(J;lMHaoqXBV>NSJeWSZK@R
zQ2|k{0&0~?GNFN(8PK7k$XG@(Z4-D=anG(v+|OO3)IkskFb+cq6jBnTl1CGjQi&Li
z%w1lpfSSu+wGk5{Gz`U|+vx*3pBS?f1WFmlF~yZONWT}=Fe7D}-nrN${6x*mXX=wI
zBjHTlywhE6p2Zd>Y}%a}@p3HSoEf+~D7ZIMo__7{xAO{^hedPpG9Riq!BOW#tTih^
zO--aYK6-v-okW!m5egiQ%!`BCT#>$%>_;dz6*vsR*`Z-pjLta|QQ%Z-C5qSx7l&Ae
zh~qGD2(>zjQ$(a>S&mRtbs}7dnK7k%_hH6$FCNK(xv*U2-)tt{qePn-8aso{Ts8#_
z5VA>#K>#2?*LU29Hy5wJ`tqxb>#LN~Z@>4wzDwtqXV1QVadCdNyB+qsvFo<gLaACy
zNnPL=SS{B)41>d!LI^P)fUC=ESbl}TVw3ok`cZFcfTo~AO}dJ*)LJWW2%H?mQI*Ib
z01|?jRh2Q@b`u^vdaK`T#w`1xhOX=TzKZ2)XqvNd3^8>KCPh<7OdW*W#hxQ+HA4s~
zoo=_FdV7043`4FZ#_0H2Gn=NXN&rM0*6ZDHI{~)Zqfs+N+a9e0!tS=3*4U+f6<1xP
zNZ<bU2Ood(ovsfTmv2rVKG^o#i>pg8pnyPr-e8PGUFZ_mJO-qIL@stf5+Vl*Awm^O
zi2_rt*=8JNHLK#-G7pHW)hhNqOvdKEbmx5(LeMG>GQkNP;%4s4@%Z7Rsj7+L1O`9I
z=wK^)CxS!tItmTZ<}f{jTO4RS<7d3H>^oYdxZ1R;2&idABqR%y%(;k}3W%CXZGtHc
zDWL+0>S%%a#b>TIA~N7T0fgnUJbbU{8K{aWgBn?zuqn(?B4w~(22xRlOaa<>R_9^w
zQojl(%*mk+(?g;Y0F;>k!u)KSuThIriU^2zB$k&k^xph>{^1<^X7=R0kF875=|#?^
zDsFyhjb-nDp-5&R4$*L}8e(=9a0ukwc~@>Hc2G!il!o^N5GinS)@_mM1nR2d?zmz)
zHVjrXa{v@(=75eg3dE`^rTW8;9ExYz?aEso2>>7m2f*byvAkFJpb;~+qXkwy;DlzX
z;`|G(^k8yrJU{>@F)^{e?;-L~$D6a8^YinYvQK^d=!5rTjIUq5{Mk=`{^b{6xm-<3
zD?$bcfaJ!X+N`E*0(i-Myv-rz-Xr$CS48|m6$~f)P(r9#38<R;iJ=+_AQ}=UhER1B
zQ&FHW)oX}ZK}5Q4wcecctD{jM^_{BbI@CG>5vW2y1<Y0Y)EiQ*bto0ATD5UE4rMq!
zJv~0zj^p_G=b!)L7r!_=d%a4XnuM?dwQ5>L%`t`qfdeDW!(3|`R0;rRSC=UulWx}C
z)2DBL=hJUJedn#!YP~*s^zkPjJbrR=b$j#b^^Rjirqjod%xo;VY8ACwatMJC0x7lp
zNmQ$fF(aoa3Q`A%y{d|q&}wj^K)c}vCpJA1#grf=sMYmm<_y5oE&y0<);>ipr6^dD
zD%G;%tf%Us4WkjDbq@d|nVA*`bp#@E*D`HTLK7|Oe(@%-z}U<Q(1g1>ENlQ!uv~I3
zqpF%Y|HTb~wC3#pb}Zu9L;$dgeM|sgwb`8pWF%%_6KgDPBUEjMmJUoX@uR}E+@O(V
z#j8)}uWQi;qip7q&c31ff_*Q-0WMEdEq^F;-N6A46?9XCZW4hmPLE8kb1|oK(=XFv
z!_zWo!ky~=jyN72Bth?(E#Jd7-A%P@8Chmof14DfT=IRkCOteYRaGT2ky6Ttn3il=
zpRiAP>mfh)rI5!44)yyrvzWB$NX^<sx+MQ1@l3dKix|&j-N<{^pYlsy(zKU%X--R*
zHvuN(*31R6MJ9VE4{c0=0}``}Pyj+QwIT1<+m))mxp;Mbc@txN{Px2>_3ys>?k|4!
zv!DL-r!T&GISiRNA`k-PBC%WbF_Ge!>u$dnFaTVyx3%U{iY-JHzY#;*dJsc#DT?Wf
zs3{i;3p%L)ygy7X3j)L_2*ii-iV12dq5u%P6k{w|a;}KnckA0>A42ky*4eaTZpQ;A
zR#X6pVhAC`*d5dH=6Jo`u3x`+{`u#>dh_O`)S@AvYRMy$i#H3R)han>mVi7p7UmKd
z6iomWI368sA3ZvH^3IcQfAXylKYC9U9zK5i<*QdO-@FVdot&J!_28uIdnQDr-M*BZ
z0idduS=tIoi5&1}Rs)3)8PHe(usS4&fkmViH<WIBwKc42<#DVzdwUcBT%KYa$8j9Z
z%(=@msV0Qb+{fFV#pSN_mKXCRyiKSJ{<nuwe}c7Eg$C{P-2{z%tcbW;t?V0_nuye@
zCGU%5R8y-8LS!!fBH|1hM0593nylU?4N*4<LUwA8ufX|ICsgmD@pZ_`C%_grylR;6
zr$`jkBk8nq3BCRU)8>DUz-=G|WO}fWxu4;FBMENrPKa(ObhsCw-Yd4oY@LJP@->zP
zz6+Jk@49R~fcG?~@>eI^7*4?mCrQBuKr@qC8)smOBX_P?L|kFrOKijz5Y=j_<~jgK
zXl65Cewk%7W~a`~zgAOEg!fiEcog;yvWWDl(<-eyBI+lLKVt_WwlWaBQwlM}={)c|
zFlXOV>m;f|WbFv8h!Z?^0wm8W(SFL@&qk-S$FJO3%+4SfhFz9A){!F}pB^0@9myy!
zo;~~QXTQ8WyE-{}5WCI!<z*g=7y*zd7@;8)m0=ixL)S%QV(bjr8!bNkYbi5=0=gZY
z8j3p`IbO!oWU~3T&zslGX1^Fjs##3kFU-&^pj$Lll@b{GJ|W_MzelF3HjWvQ`hMj?
zg&vsdL<Arr7ug-h{WwAhVY6KwAFZ!%E`IXUzy9T~el9w89TTf+-S2NxN>&ZTA_oG_
zXdEa@JwOOu?niCvc}a-Wb<sdxpT7w`cHQb1zx;f&J^uD5A3u2f$a9}kM~-xJb9;Sp
zUTd9!&(7&++Ah!|nn($;M+j!Z!Bnf33WmU3YaPcLh+~W<2Xd{)M;G>A&I26jTuQmU
zy<K)uV~m8$zUqOP;6ZjbjsO9b&7epX5yve0B6Uj8Bq3M5zP?i`-4#`sQw<O0rDV10
z?PeAAC}V0l4}pou@uv_P7ly@fzaLx^g<PSziYXwGRzsse9Eh`J6(K}uod-bx1eA6L
zn1cC$U7_Jk37jF~<;5ZMTgH=nNgm9kbAU;truow%fU8(cV=h`Ij(5W7H}cKpX>$l?
z%O2<)cjjDaK{+^Nqw{Mn`K`0xod3?8ipI!OugahazaJ>i^H7qAh_u$)_sKw(yod$e
zb(X)3Q*!6h>W3bMs;U%lDFb&km?Z99ac;9(mthpEh$y1YE*-~l(n(xOiU<JoX|?QB
z%+G0gXXcycU5ojEohJ3m!}jpV+fT5`_k!!)sz=^>ygog@Jj*$6SL@Zo)q1_IS+1_G
ze)ZFzfBoy{u}cpgJuWX_4f|Y``qjDuma5}8h(Rt=R01&~=bV=~Wm_m${ib6XBS*gl
z>hoT=p9C|Hr#^>5b9pF4m0S!6Ob```kQ@Rg>n`46k(xzH-^JtY(aml*?DiZ(SaqmS
zY6a0O8B|l>mvMv``;?4~46@WN@^-ua;)`E?`PJwD_W${>{^~FPlSu)!JQ}Dze)twM
zm%U_niLk0BF48`G%iu!fe2P1?IofWIH%{h$@aW+OAAIuU={sij<+HB=F?0zLpFDm0
z;_~wR{G5n_vr9`gKqStkxKoRnjCoh;PHHbAo6QOUw5TKG2m_JE7~L*-=~Si@ml^;>
zWEcjoUK`J9F%_8fgQ~Mj=F{4jkn>!bA~P|vs^UVZw5>^3bYAFpgb>`;)CcsgxiiDA
zsl6yW12E@-Sdfem#YDAY2wpQ%jED|VYZHI3`bx<ub^ba!DX7^bmNbV5yZbf&z?bBl
zb-8m0bM!}SlR_gJBN;R+Uo;T2=B4NbCDJ!%NK?QCfC<$Da4=Gv$^``g{-f`I$boAu
zW;*GCX69xXU?#5n0stYBgYRZu`F!_hnjn0m4LXOj<(`~_!VEd`|MkX=+1#p+USHJe
zq$4P`s7l}Wecu6qNKva@m;A*&#+lh_wer4r*L7Xjl~Ttsw=9pS0d1SwV8d>WV~HuM
zK`x_1dqgELky|EmVCEPT5g8ye6SIgQp{HrC15j(NxjKwrn#>{qpiKG2l)~F`-TMvn
zwWzAh!PoA*P7do8DN>M9O@x_<DVNby*P9g~U0+`@(aG`gdbL*37tdb&<gfqcv!8zU
z+u!@`4?g_p*T4Sa#mlqx=2(n&!>CAOk+GDqRG(Zs)S#5?$nB-|f<MIhB8OoR5pVu9
zMp^SVL4ej0N*swe1x6$jRfRwdfGI>oT=y{qB+!zFI^H~fc$yery&0aIuKwg7{ewUH
zqd$r%ou8c_A0HhZAKl(w)trxyx9e3eQnXfP1l1T3K?$LjF-AT)KFWFj>tFxu|M7qS
zzy0{H|LWvq`{=>x)zt-<9&a}YP{zSqT{pw7s&*+Em=SV_UK%^_E)d<^UXR26^ufvZ
ze(Tfk{?>QieedZ9AH4t3w?2IE@KFd|tu~HX)b_)0bGysATwGi+F&L_-5A7YLbF|r1
z#|fjY*8S0T#RR1kmui+;MHG=zNd0P!1~)f1rza=r_!vc86?ebiUtL|fHEGj=Q*~{m
zHoRr(`Yv^y0Sx0fi~}O2E~%-gR8b@hF%q+=4CA=&`^eElA#nsi0gGL#;<zH$)on;1
zFslt+@6*?2PjYi})AxOhF~%Sw<2WEf-}kFk&jCvrOD;@Ei2MC64`bIS1laF)rIysi
z5JIiR%(||RsRMxheosVw-{+i5sWB$Ppeo~-b1u|$htbTcRAvBkL5#j<Lb@ayyNB3J
zdIWUOM`<GQvGdczKY}%FFGU2GF%_w<O{^-V=B1Lq52U6_9XT|T>rhIm)c}wQiPS7C
z)7@oeI`yy*Vx6;Q%-kAV=EL{&CGYh;zZvG|cFdd@FIz2>(19EH84(S`kWzB3<tg7}
zp8|P(hlt}idbr6s&z*sWfnaVjvEMjt{OVFlF-Gs8PK}<bXhX9)oVkJo=yb+b23m7K
zf~MiU=n)@M$ivAw)#i&_W9HqrG*%C-)n#HhCkQ4AjGn2w{GV0Jbs)rb>QMCS&%b)}
z=FM)mGu02j^-)#(>g#8(&o9POEgHwP?p9YfyGA^Az=M(VCIATFjym76wY_{so>kW|
zBce=6+$=R}?!D3O46;9QKr=y85j3bVKqOQQU<JUAI_NqkQz<!i{qfPJOX1DS7Z^Ck
zn1_9(k<d~XL~=|)Y7vq3x<5MF5JN7zH*a1&fA%GlJ~%nLzP{XDT|Rzv^5J_QnrPzi
z>eZXCzIyiT#kEv;^5isiF_)^PGPN@UjXXk)<CtRX`~Km>$De-s>3i?J(``~99ZNlX
zd7k?9YPF7CI${oaC{@gK7)EA7!<=(K$F$;pKe}j^YTfN_0;6N{0LbwkL_rmXA&07J
zno`Qc7)AXMZQ_ssrIa~ESmq)kvLA=p{<gs?fM*emZ|=CJYOGporRhX>D<^BfX$P>)
z0}q|sDXKavX8EG^W#H#4A{yB3uDB*vpr%w3x~}U}9kZF$DzI=Q+YN&^zUOrnV{|<A
zYLz_mbqW3Uk#R2My(T6@-!Dtwc|->0*!RIZu3qM;Ha{*zB=T0|v~3a0q_yBs9r<I6
zx%@Y8<Kb@&>>FWJ>@abvlfkEnkMw{5fXSWwmNB%AgWw?KGv#}&H@pm6^JvUMAXO@*
zOr6svWiq`Ex&oLl5mz&r_Oq8c0HA&B_xqhwTx%`fkQ&Fa?|Tn_rBtcbbt!O^Ixeon
zCe5LPxaT2u5P9dzyCGocFfsE*N>u!mHbB=>H=W754jOgo4KVWdF&-?NrcUCl%xbpG
z<!u34p2KJh#{jdApIL+GqFF7)OzKz*)W`{qKrv7}+8&odp1pec=FP>$<+W0jp^U|h
zSq+2;)h&{pV`nC6KnA9U1_Y=snc#irmc<hSvboZZk!x{HrN$xt&b=ScqG!52sDg<p
z8dL%fjHVcgW5D$qLZp-epbWz;U{$UA;dXO$lu}TuRcdn~Koco|ilhc*%$1opo6UoV
z$9dQ>z|m$M2_8Ot^rP>8|H+fLfBv^W`*;7-zq`J^?N*zA@DIMTS)W|pT)%m9UdHO~
z9jm@4qMBv5+o|bxyCtyq-uvLgZ+-msJMW!5d_cj*;r8nKYIAgg%m$=ph8$CuIwpdf
zn_bt%K*^-^X|-B)s93a^2#~2r8FC1;-t@_Z1d)kS<TN)xV~p#~YP{JyQhn~`&x_v{
zIK25Jo6Ci{az|JUJ?TyogNUjQ4`d&9&(-uKn_F$lk~}RV<f(FM`_9am(M)nKh}d;q
zj0dMR1n@*-W~QoIEs}GoRis+Asz^p`<}e<zhPVbm4zV)`3WyvydV-9q)%=x-)MfYp
z00@klD4iLn2qHMq%83r5MWv21RwpA6gLmT0%ppnMQ*})xoa2_GN5pV3@&&idBV=Ho
z7>FtX-3g-}o?ucjQAIzZ0l?spEyA5v3(eO$$KQMD=RLraEv(F!8R8t{eQrR+fU3pC
z4I=<J?$4)_gdv0`1h?6)XfnK`NuOs%W0*EW>bdji!Yy<5z39BSDD30~-(dMoRK*nM
zgb_jKW9r`PcrGvloXFjG4(4AnDTJaEv=Gg8J?1-ri2h#pve85H+u+d4LquQz1yN*<
zoXjwf!a%Fk%c#5E^^o=Y_V#8NL%-qBjiOSEDOd>31`|W@hLK+-p&892h~=Z1!B5ku
zfq>eS5LBxwnpRWCiUtJ%V?YetIUahtS0WWq5KKTcXEyD+?!ocV&E-`H!F^0$pPlEN
zIfU);aY&H^2I{2NTr-+-45pPhf{B8aVb3ufA8$`iPEL-t<8J@@)yq}to;-T=_|c=1
z$Jei4yP*C1AAb0w-~HVb*FX8&pTB&4CZ_#reS3R5?Du`&A8$`mO4qyF{eJ)UlgFQY
z^2v9<``wcV4-5#vQn!lzejJ4iW3&*WiO6WB?9Ht2`@Ub3m}=_#zU%rrX01wrksuMp
z7(>7=b&N=)c@(KYHo-Ybi69c1={OdDzRlNYQjeUGbMsm2!FLY0ZJgbjEltF7-kz<;
zJ?SSgv!U-4a<P)dqJlXl#FTcsosacA+ntqgoxKucOey(@sY<T3l2PEq1SZu=t#z!m
z;$#IX&|IyQpsM9s2oFLNu0&pI9fo0=12-6HO90#D;c}3^tYzn<ga|~WUnLY*WprgI
z1Q#sAX)ZN|N&_JxwdJb;+^x~4?J!}>wK+)#x8L*1&YAyH-e5#T-01vs68pdPb#LZ%
zuduzB72o^)`4(_v#v?A;{6wTyW8zwC$<@qKLL?>vK&`dJ#HExfweQy67D*|JXwI1_
z#u&}8RyC`xS?eKc1`GPtaf;|Id7~=ggE`0W`|;Lp8bDz5L5edg$g$^YZgy;D&X@28
zzc!36Hs6QCgP;Br2dy9K8V{q>O}jho@qx{J(>&Iji2+nSK04`Q9QHZuxb8Nnp;mbD
z=8Ih}e*TZ5V^QL09K0)})f7}rwGAYlYB3!cbm&FQVcj2-h!a)OvvO$vo?6=jpyaG(
ziaI&dBM<{v>!czQlSs|OkeDc>_2y{3-uB(P$r>@o$Uv~#^hT@(p59XoAhnwIDOJ;&
zD|75tJqErVZZDsmJ$Ue_3n}kM%TjZ_cyoSzeVzAN6;etsUc7wyul@~DstUtctLQKc
zZmS6Z!!TT3UF~jmeTs+(hC?pnP(mcDx>|Lc?I|Cpagdzze#jzX23^1Ix-O7|7R6iT
zd6&mws9L+&mzn`ICMKi2&rO)FViu`15>X%pgEH==jD&F>vv`xr`_W$J&mqG@XRWng
zue|d22V-XL0TW|HMN_azMORczgo#B=0f>Tl(+nHr=w1?pD*BtGj_1+HG`|gpNqx?e
zYa1Rp<&qgfvI&n|YbEg^k5_q8RS_+Oh=c-$MnFM9RT>eIBAYp<zqpX7zxc9I1^_PD
z=DT$m_EU*Dc$T(=?k$-<uo$@e_bT%aZ9QUaNTWqbz1WrtreI;t0b%kd@u5NE@Y12i
zocNT7^KkCbm|0kOH0ku@Y%$rt7lr2pXU2Az**t4Pa@SVyA)0Hi`fX~aLx_YSr6eLL
zggL#P&ouXbaq{1xU?-%h7G4(h(4cK{5SnYPTk^*1v~Cb5k@-A~_YV@A&wszw4ZVce
z>{RE5X9FRC0az(@c5H6dnWASI_rmCu#Ty_><K&Z(8|j!ord^in>)YMU?Kqap%gfhq
z&dx3_-BJz_hFo(|N}be#!BLF>1_+F(-mY*ot#dg{T2E%aJZKhMtXgf7<rY(uCNAmS
zD~Hn~p~Gma3W#Gw5CC1*&Ct}WDiCN9J-@uFrroN)+1*}TT~Z7YQ!&+|VHHGl7{)-{
zuRGJQzr8|4L(Nj7Q0OAZu-osye*WTr{SW{C=YRXN{q1n_<ni(57>v%|T)cYqrWDx?
z*Sq~#)Hdsr)q2A*ot*U7*Vi$|*e3ueW7%Eblrg{c=<)CW-XA`G{CFISDsYTdYwB0q
zlZS6!Uv#UuJwEbu?CR>ud#U}=F@Worg&3oj8bat|;x5RjwdPt>q0QU_r!IE2iV84s
z;DDr}Qfp;s18ZCGLCtI!hN(`cc`E_oZnyL7!xxOImLdzv+?+P4I-^{*jv1KTYpbZZ
zkH9?yj!gjbaTstK0(<kpGg)t^&g1oY$kF$G8L{M{l!_`g4OhHVVP<M*2GuGUO-N65
zl%Z5qQ`g(`uuB9nvMP(nBqi0h6|{AFCvTfeWB~B<xReoa){WGAfSEbTTi&txhYJbN
zJC*BvvLK?LYhgJ$u*IkcP>Ep<vN##6FALaZEkEnq!!q0chECcXba0vi`^Waf);~E+
z$f|kK_@kPpKoeUjgczeibsq?t$nr2dk$B}|jknIsKJmEsd6xxLjGbR2kz-1NxN{s6
z0+<{=SZfjyn1Pgvh+fkoscCDYnn43L;IdAiB}ToM->kRicE=nR?}gE+J!+1!5;IZ*
zG6hsK5#3!~gJK`k$;pHBvx_{Iu@(x9YK%;w>%fePaop{8tWYPRVrEcPG+y4Kg*_K6
zfEh-U_<~<xh#i<36{!_Kt15w-VQ@z#Q$?sEf}pA#2wN8ls#NCC^(!m+>gM+P@=Ei#
zJw8qSS_}h6tvf@kN+9N1J3!cM&55c?>_X7!t=34S0OL4*_0_Y0;UE6-Km4P=`-k8E
z{ts_&Z_8M}{PKAWX~=t3+N`(h&GDFP-QV_`^=h@cxw+Zh>=BVMAR=>Euh-xI{`bH2
z?GO8PH;!c}!&n9Y=+~8qvQ#O86^CKC9c}@j?|TIyCv$=N-s!p+yCkGt*D<r1Fko~o
zASA>v`LC$ALqxNgmC}Sr<~88k#J!B>TD~QTlP2YIfBD1m_38F-%WMk)Ypn<zyCfEB
ztq4j)j(x%=DI#7oIJ%b?m<?Zwv)DNz`YAGJDuLLD6|haDCy&e4=S5~FhdmL7*rjNx
z)*4cbT{6&83KPbVd^@{;D<C2h1=qenGeB{=Cm@jnBKP~jFN26~Z+Ar0bt&hp>SXju
zs7bvLqFU?Z3Q7P?ewBy;Dol*8Wf|RK1^Ey~=aAhh)O%5R{)U|z!pWy8b4V>&fRF$c
z%tRH843VjfBQgcz<~|-EU@(wc6i~tZUre~IMZa>+M(4wAS-d#5Yko)$FmfTq=>Xtb
zOG<$$I&31wm~(c>&TL`Q&bK->fSj+e_+rMXQ}66%M3hn-Eannh=7UoqV{Vm;gacX@
z5mk-Qb27AM{ilEc?0u1G*@I2eI|r)R;S5~l1-9r|wUiJVGJpgC6b->#TtQ12`?NZK
za9l_I{L3$%zj?JEa_susoBhph7dx$$vIrWC<H)hq&LIR2pvvg2r-M!?`pD6H5r~uT
zQ}bN}G({tI5TL1xIi(N~mz{JiDk{z`R5c%!8XAjO<j}ABz24m3j2!|fJ$(4q2k(CH
z=+RrHjJw@#weGP(t-{Qk&5@bx_j?2Bx>byk6YmjKHLm)!T3uY<ygt9Wxg8+%-}$ZY
z|K8vI<JD^Q<@5ji^~=}KUcA1(x$XKjCm$Wh)n@IxZWzY(dVPA*Ute9le);C&YJC66
z!{7bAzq8(MKKk~z*6aRycXe@jwjamcZoeN#2Vtj_Qc59&lu|%i^($|tSJ9laR#U4e
z$Wm^GJp}{+Q(?xG5`amrG?^Zj!b32F>T%Yj)}pmGC&v~>!F`9x3|s*U5JHT&uw^YZ
zw<Z{J2s{h}8G+L%)yRO55GZiSh=`a%RInn#gy?)GZ3&9M4!h86U{|*<0)P}k5Y;^9
z5CR7FFgkZ3L?n-ciHIRE1?~{hOseT|>c?8VB`}U-zEMOB#1N8+MNTPnlE<P(j4?)W
za%wGRF)$)xpy2#aLxEQC>6B^Edc7hdFYTRn<?zkjPUfvN2ORo_0Lb0;qY|(o03Of|
zG^r2S-BFO&luh^BZ^Q%@^fpVBYAV&EgcFB|D0Y1{2c#i0F;g2UbgTesqAKM3yD?l`
zh0FkK>Kqy%2vlGT#O~_Oi4b_mV{E9&jELLqc0b(icDwbuXWrzTMG8?!X)?Gs3Xuq7
z$tqN0O!HCctfbkC&DC6Dj0T07z(iD-V@k=)a?WCg2qFcMIR-;4RRTxHub5e_U`k8`
zMztycQn0EOR1Fo3id5zxra)xSJY;}CpzO1oo+G=e7%;Tp3`NEeLX1tkM^(+L7f{Vr
z0>C{{0ARB@s#$8SF$D&!V-Ar*U{D}NTqPvDy1BTy+27WkMjMAxcNoLE>u5h@F&M^N
z#a8PTGD)>s>o^L5Qxenw%2+~3BA}unC8ySbkqQt76#>u~BL=HkB9nokX;mN~g{mSH
zLYJD+R+Wm5dLfD-Amdo~#7JJ9RV-B~^ROQz(2u_Ny{8Y~lZ<s=!JtEiVvkN9+zjK(
zmoLvRFSgt5(|4Yvt{d|{S4n}ZAakn5ug<Qnclqu2KKy%s@=s6J+i!jATh?zchw;tL
zuq)7QPj;hZshjmt-}klVvo|l_yt%9jz*tJNqI`IA{NMc_{+s{y|M-9U?ce_GU;pZ}
z-7vg-^ODFOJ${Jzpp<d7USHncbgQ`T*N6zBeTW2zYLTO4S$FFY!frQ6sft+lL(#hG
zx?1Zv3?Wig@eo$E0E=1$297Cb%{iygb#aAI6^5LL{WzE@A^}m(HO7vZE9g)KP`iL#
z2wg~?kyObw7m;dKw4#*S^{c+$jzhV;yf!n&Fpi@@*=)8~S646o|7`t9lWbd-9)_)E
z?|m9~508l3zW46yGb=MIvkKK@bx4!|5`YK-A`F5kqnT(jlSv{+(tu+PG*a^`G>~yX
z6HR8IM2a#PMG_<k0VtpdvI>Q4UjN>0qxEq2bIxwoS{m%*e(y^t2G8!j8R_A1{G7Gd
z`qtNMU#-_Ct@GRcj=i6zsqK63S_RQ!&Ux<}0EjUv2pSm%Ff9cQj9r5SqBYyDWzIRJ
zl%wW(x-Y7TWZuP;Qp)6A5=C?|Ml@LVi?&&e<EU9mDh$5FvQK*=T67)OUALAtc=Rrn
zV#SCU%%)tJ;lKl}gfK7=oCSdp<5Y`j&UwEdTrI#jr|$sJA*N6cQdEmESI_mzs%(O<
zk{mlsj3Sy#F~dNi3iSwxT}}K|GX(}$>xjLv&O0`Shn;NQIeaUp5V*QJ16C;@py&*Q
z0YJ4pQZPFlC2t%EaI{c*v(-9&!vT%<c%Y*m@Zg!!IQOW>p;r-siQjMo6H!&?-h54}
zbb~5Ig}KRsnnGcRIFQ5l>tRogb})~cEm5F;BmjUp7Y3VYzg$UL1i(@Rz>KUqHsfn9
z2g1Q4!j#O)ft*2lh%$!Pdp16@n%=~=a?Z0ZrA`5LwPp2^BM`<k4pX|@?)Gt1LULi)
zP2^}A%YK@?_ifu|DW#O)8fGGzGd@M?%Az`r%(%7)Rr8lO*PsCNZp|S%1Vu8?*<3?O
zXHXQ?tl~y|kg?6p^+Df^z-ZO4)e*V<e!PGG;cxuLZ+`E)-z9>Z+s!l%=&-2l_IuR)
z_Jgy2v9y$~?rz3uQn1CzD#oa0UFuvD?%#iSescEXKlkHh)79Paix)2nU=-WO^z!n$
zX~Na@-8h1C@ZiD8Z~xA3J$n2W`u6PJgWv!CKlsT{escQwF&L!V+poU(vgsFH*Kp&v
z+uI_xUawO2`*By#=KX%Js#XN6;4+sfO1J1m?DG0D#@H_x%&?y#GsY~Au<d&yG!rRl
zl<XV<fPsvu<cj<iK!9=BqFOOAP^>QMKmgEnK4nSM1OQ#rgy4t`5vFlp=ei=P#=0RA
zF<TkG`1~75vRJGfdjKHcE}CYy9}&9;5ALTt<(y-Q!7&n?EPI6+B=xPg*-be%AynYU
z&{Rv&+6<d_1fT?po;?R@&><C0(D=$`6%j)M=NwVn_H&DXjttl}Qi>-JM1(WN$e@ai
zXTIc2wmFQhWMs&mnB2EgBM$}`M|`$+YOkS>BU9*bOV7mBW3t|{>{P1wA-A!j8#DCD
zM0T*mXF$U_>dp>=Z6}hC!y~@Vr-Z}EX$PFO{*^?P$<?Hg`qSt7C9mV~<`QRsfE9{<
zvq~Ox;%_eM=U%$n7$135X29fusiq!+RR%mGqRPQ#RbQu=d<z3QRMq3ps<=qKW9I@5
zGt7aA<oJ!ZdH5}`8eA!&%-ThIL+o#K&^(Y?m73LFUaN2g-jLPLB%z}R*8$QxjL%2>
zWxh#>NTg=9U|szKkcg?7%=~Dp?lxkoNc-J>b#l^li&(DrL)vV|{eIl<vnqOaL|n3%
zLg!m1oKkf1Mux4Zh~=D1RwDO$BT*NOrf5p`E$bN~f;qafp0(9^h<*u_AasWu^ZBOo
z>_jA&?9id}j9kY^0U%Eg9^HHE$)jh_zy9p2pI=|RBF5#(iF2;$+TGs1_{Gib?X7Rx
zllA)K>>PvZoOixK#JC@gbJw)bzxw86wW`g*Zo3`#V@}e9{`<fBqwjwAyW==Mefl&N
z`QG=w`?vr0zxi7~{@wGppG^C47>3L1>z{r0kAicJ55q9sTwOkS_pOujdj)JCN7xUG
zuIU!5&Gxo3^%2c^@12uerfG6GTYR#^j=D<Y_uhNYC8xqrxqbC{sn3510gZCb^@CQ0
zSTfXnb(~LLQIV2L7UzN$L9-A-8$2V%X+KTFX0tiiRMd?w1n-@5&%XZV<%^4)(sHq?
z3H4_uXRFof`OAy1zZPaD$IiLc>8f9>iWVP&f`v-N%~Q@oM9XEUIGBm3=AudtLkQ0M
zlH)9;E=WkGvl(;F8F22y3`iA9(U`>(n_A7#RHY)Q;GJ{i>UtIgjH=1|yg#UuS-myt
zqhZWwP&dZ&U=4;fPSm-;e0b6Y2#bgy*%%E7XM-!6Yl4C?AyjjF1W;6{`4}~EdR_wQ
z9F$CEhUCn!hFKt5sl%zS%_O-uS66Ssqi?Q>j%6DWK@jM57$iU~>IY9&n>qXyO+%_;
z!C#6S0ywbGj`a=>%R!klT3My201_eEA*|`JsRXX+YFLf+4s}i6a6g=%_<E>7z41W}
z)bzM<I-X9))z+cLz1CJ&S`~l+3Q{;!{TkX{kwmK&wPprTH=gxSwKrbPju;kL^*yZD
z(<-_Bcq-OlQB`f*R^Je_&p(z-WVRE88ro}C>QY_Rx2<z-O8MgA>eZ`@F{Y9Mp*2P4
z8|OkPnzAsn;{brFR<erJcTWg>ybcvje-p7ie(4+Z2CE(fZ`?m`@-be&?c)n51Rth6
z<s`^Vfsh#xh4jJ0^*7JI`uG2X|LcGB|7<s#E0uJ%UUj`^n_0k{?cMF|rt6na-v40P
zx`s~kuywv+rkv#Z^1=-7ot<}~fl>^yX__uHlCo$%Jw5%`|HfbcwO{*lgpPw>EEc{A
zCnqPH?e1s);Q#BJZrS%KrI_b@!^LWO@7`HT({{i2ZL?Um%$OxlX(Dp237)v5Ohz<^
zq(WAa>O05mn;_FvRNByb?_!KKfm}q)wDxhT>YPKK1Kp|zlBxodf~plfJo~C@Qjobu
z<q$v_#_hNrhh2=LZ#<#_)np+=GDqgfK6>w+ci(zw0x6{!v*XaUt%@vK7={?fs9+%k
z$2rICnBsDA!rrxQ?|ow^MWP{xfYX?nJTn(0uw0U)l1n7-eKA8TCIU6VtY|4}hXBcH
zPN{|p&beTsGeMl40U|i(UDGtvG$5nRF%QUd7pRhscTt@VXP8nBUpDVYp>nYg>*cwO
z&MHJOrg=d^Z&=#^K!tSc<X0a+=UmO*KtwQ7Q3Yl8ShFpFR0Rx~nGTCzMk>{?stMuE
zvGK^lotxWZ(+IEY6dp(hWK@*^1Vq5IZMS0WOshR%l<D|1zJ8$tx$0m3dcB3LpzO@S
zta*+$4}-|n(c=*Diifl7Tf{oETHtJsj|KxYW;#%e(G=&HU*J;ob=5f917fNB60pkk
zF=7M&D^>#<RjaDvXeUT@R;U=bf*mi~ymJ=>Py#$e0oKKgRgGHxbNwrTisbq}50G}%
z&JuD>B2lQCHdP`zKfjk^dG_?xr=NWJ^2Ozp3Q_QmhRMoqP%uPBKvi&#y=R?mSh3zk
zh)jTRP&X@BwEz@-ZJ}`Z9bOy6F!Ri6`j><Z$A3XYfWsyPM6!Y+vqz>}CofXpIBxy(
zix*!%{d^pz`)A=de)C7<SDV|bmtTK9?zV`$I$b|}@c7A-$LD7!n#LDjetvVey}Y;{
zrqP9FwLW?B<h@6y%XPnOf(PWbalx&B@cr*D7Cnb>vOYUKJ$0e=O~^&=w%e(cVT>V!
z{kW4HSF6>d2lv&ALvoI$VF0wyI5QdcyPV_6YVqK~gIBL!F*6vXl1s{s_l`V!H%-%O
zv6{wob93XpuNl|lI3o7*g#xZ0SIH_WZD{HiQpCs%4H-zlkjP9y%s>H6>-Yg$7t*9f
zN-8l)9vqqLLf<uqPp6`2^KeF>*my8XDVb{DEmZa9=H}7)a`nMuW*(<$9LL=_#CR9L
zF1~pM#C^9sIXmyWMMs(?mR;0{#6i771drwevk%_;VHm7BD<Kg%W;XKP``v!4YEvp^
z#vaTtuy1{1&IknnTm`JqnAv%n(r9?RdBDKbidFYp$!ZD&4ArDuXANXkEgTe+hSk-6
zegM@>L2K`6qV;iBQ&Dq{0Za`5$p@zffT#wdHV5ATs8p@}fe>@BE3NH5Vx^WN0^>}Q
zCOU5F=dJj^#2q{GC+60}=62)A4@aP5Ku`4wv^Q8ph$y8xF1}``;<xGd-|mI$Dy(9W
zRbP=SB_4?p<?uh%cZ-PV998=H0YaT&jyIu$*9F>Mx4?Fov2oUf=xd1K$aRGSYuApb
z?`y}YW5uW0b@a7;7Q)d(d)9^>+PAr&9)6Hf-OC9=Wo|MMc^}xZE0PchP*uP{K%L}B
zt|b7irt*NQ09uT>Yx-x;Uw-}d(_uHP*Jn$^VVJhN(Yt0GV-c$-orsJv6_o>3pdQ7p
z-atp9A{^NMZ#JHA#H8RglFq<yeu6U?{3b>ATWvnYSfwuk5mPBzN^sOHn$3O-lFm<8
zzxjiY-hc0%W#_MMuC89boNl*l@aU}vj~+c5$MGNk!#}#bzPh}=RfWfIKYZuychByf
zzy0W)Cr_Su@3*%Xm(RXhuTI%J1q>l{t^4lB@B6kpJH4ltZ?EsV<-+-f*y1?cTwmY6
zfB(tDa|GJ$w^K|ZxFWjUZco-rNpYJdW?U`%<)WGPyDvVw>X+4OlbmxVssQz*>AJ3t
zIDOw&T1*WhEu|o`D#Vzf7DOUK2T+ZeQ;gA}tM`U;u4W&jnn9`7wPf{kQjn4*gBB+1
zTCa+r1|?Uk2QveeqEhd-(70R*07xm*KJIRA%q&hr*Ld@q&4&GM7>042N-4exXMGrB
z95)yHn+wOjTlDMo*<yL>4FT0O#*(KPW2t&4>X(a(O9D~g={WyM0aep%M(Dw*iHM|F
z+O`ExulJ~AWHiJH9ouXRY+|ZXM6!wE{DcV+0a~@)1DKtFj?mMwIdyI}MXdtUgWO4D
zRx`^vSIw1u+Yaf?LI(f}Skw-id@|K)Mrt)^;`Oj~fDLV49l3+2sa5;9V<kx`9R%=H
zlf7plA|e>bA(s7E3RTO|XJy78K+Uk;UcWrNA9$A)MtPHM;9S7j?I|4iq(J0|9Af2d
z&JG%cNL+RI3ivvCsXpn4LRsISGqa)<V+QA#ur}>h9b#0W#wXXpYj8a3#38`}Nv^+W
zy<5y)iyw|<y8ipI54CxgujSPpCX|CSo)t1OteN4}9I3XzW>y``6c7+yjnzUjQ)M(q
zR7wT8$yBu%15EpAyV>O__3g^Q?e;^7`;x3*G^Hpx1wzYGR8%CFOz0{COg5Y0&QcfE
zO3bcMvZ{&}0GJJ8kBhHr8A`|wMS%_?`h#ib>uUl42Lz)sILOq*Y*r*76flP*h&kJK
z9QQH3y1e|^)z#JID+ktMkeD{Rum9vvKY8^ky8!RMfA;am-ywpBj~_jH^vHYfNUkoP
z-Q3*7aawf!dU*m&DU0`hb$-4+IrF(=$VS}vOUvW)m(PYcot>RMJYQ^HJ;kA)#`NOl
zGemsrt+)EVcQ(BG=GB9H_fHo=wUA~h6M~$rmt%@)8r3-@nAfu+RY5mR6A`V?PDE@N
z2Gv4DC1qFbL{lUNW<&$$Ip>@+NXlRU4lBDH5%=32&2x`ZeZtrgkz<T0j?-WzGXa2>
zoHUo-HP!1`RZS#|5GVlbu47e>7)YG5nS~G>=y-c|@y+LVcXyl3W*kRyo|$7x-Z!iD
z+1c5d4?(q*?dIz4?gG9sY<#y^E|=}1U!E<IeNEmHgPORcP&sf2Kw#+ERKas#=bEO8
z602~arXmuWXelK*=M;6?4=y;Zf%KKZg!6WqD(F8~2~*W-vLpxJ^a{nQ8ln+FkzC>X
zoU;@KG!>gOR|o~Hn0kaNU2)7~ic?NAN6O8PIxLW;JU40wwIj@Cqx718rmua1sx6Ug
z+g?FTK&+V5HU||HkqrfvfB=zeM4p(^x6RWI4XhqKKr6eDk5f6a1E?DkInIN2G_^ad
zosI(_6Pp5}9q3(TRuh#0k*k6Kp>`u8PSZpLT#@gYuvPWNwer<MUl-q|bLQxworFV%
zqUxJLDQ~_dU_4kU9i!K0lJgsH+f<8)s1@%TI0A@ofQobot9i4nt0T!#I9$J{TGdsn
zJvzkYRXKo^S%ivKL%jfM5f&{eYbhp>r+j;NdvST4leK*>BIMZnMgfWrN-j9()FY8d
zB}Ho`C)77tIRmrE`i(L=dy9zB8{WOgdw>q(#Q~Uq&Be2WgtRts-ZfJka$UbPftU?6
zWf8;my)(<xKl{^90)cnH28?jJXmdmuv#6}^cfb0p-~aCSzC(;(eDT?{=P!T$i%++^
z4Kpnk-D<UZ_sNrG+udz$#Z-y{ld3M-=JaGaY;VUYmD4i-xOo0z9LMd&bLZ&US6}_}
zKl#(IzWVCn!-qfm(U11GubQTD&VBsx$HBw6yNxA>5Mqou=f!FX&JV*-@Akl<8tRzY
ze!s6*W3$<mqJ7_c?>9HMQ<l|g&CF)(oCDO7lZeb{m_Z03gl3wioKi`-`fU&%=Gaoq
z1VPi7_xrouc2n}?9QADo!F9n;cXzC02h33COnJ;XkK?|Sf&^XHot&JQ+1=*$;_26$
zo6Ax(=e*nPLfeJVZf<UJ(F^yK$b}HjAKZWU$@>o<K5W{><z_#m>FU)@EJEy?zFRC;
zuI-!)1|W5d08B*8j>t8kk5kT3B#AJR8rN0q!6^zv!Fk^{h&WALN-;t`;(m0n=&Xl#
zjR!?EQ%0)C5<5C7YmN)|`bdhHNCroUrleH}P<@Mz#j5sON5c?iu493!YF1FLC?8_^
zR_8bS4^(d;d;Mor0Kos#|K{J)%CMLVsi2~wf`EW{^5`&6*~lEaBKcSds)x!Eg-j`h
z;F!7EK^<K-hAA@p8rykn=~cD*In~TgI0*g`3DwnO4ZgkHIF{+-27|a>7e$=a0f(-;
z9wSf*j{u-bB0|Wa@hMHm8l8$%<J%BImN%?MUjJP4sA|P=K*W^hXuOJ8JLgJCs_Fx)
zO7*fOVpA;jJsfuQ$BV{VD>EU^GKE|U9sEY|5P+(xi^XCbM>DG|;(DZa-6Ex8qLsYq
z10$lOoTNN|_HvwZOu8N7_08QFvnotE7cgUoO!b_Pq9RhnfY9c+#5yijDLj;-08kG8
z?Hs&Fo~8*@yRHk4MFd5e+4CH9`r10ts`_|_ZYsm&^{{VfCX5tgtUJ?GGI?s-)=EYK
zE!oOMI)~?0l*?0?rqqV;`0=CDvt`b4x4lbgavr8(*EC_V=%ge7T`rf4u020F8+ZGh
zbKCY^*M+WKuh*xir^7JBREVg?+hr*i7Z=Z;e)GvMe(o9GefPbe{NyLU{X4&N@4@}H
zZ5OLm2;sl~(?9*$&wim`eczke^5pdW4?oC7x5FM0Pfkvnrin31QSZHH9)<yp`o34y
z-EOC<eYf22M?|j7PD1pa%_ODN27jCY969Hlh{ZTI-Z4TcDdh<b8c$82;ApqK{ql=X
z&`KNpe!E%p-TnLLITno4IA6UyDnwvrZQF>5Xs&wvlhc)mY&JK~zWVaz)2|nOTLs5m
zw{XshC@~Milv3*ZWz#gNl=JiZZ@>LE`*8Z;(fZ!~ta5pEHB2$9r~&!_Kt6<6q-1Hj
z-Z@uk9)wNTEvj0yvUIXY&beDGE3pp|+oluK{eGWSiWUK>3_nSkh)~LYzc*1NtM?>`
z8YorI2H#F8)&(5^y!Ks1j4{?_)G$o-0THn*!0aopv1-TbqeMh?4NyhB^9zcWXnfFi
zRwCLwSIs4xN+|+%1Q6<T?N;m4iuct#NRdjvD7CILdo!^>0P0*|b)^(Fse~>7Kqg-^
zutdl)AsI2KArk>AVF>Nv9KbhCi0e`X5B=c0(Rsa;_~kY65j{9e>xu{MU3H>+1Cy;)
zo{z1PDjk8&H#@;Mp77ZdU~Ztkh3KIv8&&=0>#u`{uBnQ~TsMgo>jon`$SjV7?Js!?
z99m#R^Z+PQO-yQkPG%URRK{CMwTERyDn%VJvO^O@bV$y*F_%2WQdC3;scqZ!3Yw5(
z5tt@HC}0XWLkDO`#AK?oTjK%vR<m#I+=)oQpep>F(}T*p%0qn(I3ufo$-Lc=3RbAS
z;jwW1;A)F60LXQxqR5^QRRD<76ama(>l$JLvRYLQ+a*)V0Izn#)qY5MDlr<!a?wl^
zv?>|0N-9OJ?jj1L;c4TcYp_}$)x)3-PDJ{?Z`-zSJ0iNdx!G**yo1xe`Q6|Bt-t-Z
z|IP1y|9ck~7q2c}6oXXqfBj$mHxC{?eDdD=@4o-RYPGt)y}P-&dGY+!`Tcuc*EP<E
zrin4`_xs?RuIoxlL}UWBe8h1Q5iLgOYOi1>Kp^w>^_O$YRkak!IWqz{N+rh_+t9Ra
zYk9i5xw10cTP{pf6Zrn>A*kpyc(s}-041ZuhQasVv+EZ9cDo&?$q_c5JnC-P4EsAI
zZQC%Xj>`d+I&?zQH03PI<#MrFEfyW3<s85K?31(Y&1$_~wA{4|WSUam><8a;E}&x)
zXY4hl-R;%wem`DcZJMTAtyZhms%bjsT-)@ERkz!1)G);iMg(YpCFPhR1~xPhEh$aY
z<elq+Un~{`SW3~^$h=Z2vmD$8s=?@S&I5q`eh&cN`<zRRW8HLukqA{h?U)95?8%O$
z;Mkd=k!n7ssvMz6L`*p!S~Pt_R5*W*F0_4JZWxFZE0Ri9wc?G6r26j)8BiSuwbCxA
zs@1Yc9dyl1(R>p)c!vbWWPpyzK(&g|XLrB(t<DvvuE6<N_-geeq}j9(;9%=NyINFi
zvEGFT5yBz)2ae>j*Tt8J2&*)Hel<j7Ml}OeV)7NK0$@HG70!t2Q5jI7h+mpv&8i7r
zmF;7Zh={c}OtAo<)weg}9RL92XNJ@3Qf^|(?7S(<w`c~0h|?&QOqR8h*8&)pY)r;X
z)wZX;v6Rwow_B}NO<T-xNRm?-r&Nt3imBl2LsNTC5mPW`UsR32KtTZN+NuHuHrqHA
z)0{IhxZtb%Y*7I<#|%u!gg8gm&+!{%Fkd_S_TbNTpQj>-K<rgPLA-bMlwtP1aiB$2
zlPC(1DVQ^~oN|3`hH-L)%*5@&p(!y2PNtgCVNbpaBB!w6Mb~$2Fta?3hGGCIg9(m9
z*<4?s88hv6WwmhM{myrO=l6f}*MI#-AAkJu-QC?!fBMs3eDcY&m#?0`eDUzX<Fk9`
z!!UgF%{Tq>#D~`Trsf0`Nom;Qj=XOg=Mn7g_67h&1k^x96#_d&qUtRxsznS00aGdj
zK!l~*2G4ywsY=b25>(M51jZz$DJ8PZ1VqFRL5xc>EomI5anziyudhQ0b)Ch`M(B`y
z+f>jj_#Vv0VRLoybhFtE!=Q{~ZI9TpWQWG=O3`d!?6Sd_OMl=acU`yHZC^fny1U!-
z%LO{_R!iqRTlVC+-p{O_)VIz*ILW8o#mg_AU4EIT)OFozweFWE_wPNr|L{@Vr^RCB
znlS9A?agf!>ICm^?lw&qy2XNtq!cTX08P}hD@kUj3uZ(t#bPcl)QI|7pjiDEMWnj%
zJLjfps@1?brvkD|3}{FOSOs;SxTtwzb>7SnPyv~kk${O=362CrJ$8OIITR79jT;hz
z8lrVw0{{+@fgH|DFa=^lskXW(&Jl|#SX3}aT#LAKBuL~AH0-&+mx@6+RXBvnNU_@S
zn3-y+yK+@Nls`S}#9vb^8Jr#dFNb8Y1Dn?b0C47gSM+UWJ{_%9j~o0_UUP2XV0$$i
z$<)c3nb;pyQuz?f_hv5)RmpTPGJVrOrc&gb3y30`5$D{*Z#B92`n?@7(s|1SQn!-~
z9RPrlSpg#;LtsENMdt~DMYAcAoBs@;$o0iBt7uNel)O7XJBzubtm$Su#_4u@D}ss`
zB?A+1RsGg3xmZPHk*e(};5^scfip`)Mu??aaFO?Zjx7>-Bi!6(wHnNuym_#A0~|P>
zJ;wuI!RmPoHltvrl*;rKV=yRUHd}pjB?Kd}RgWs~Lfe8`j8iF!=*`L$m07#c5RrHa
zE=;1+J_9NWF=F+3V27ooBHVY)TMr+dovlCm@WWsK^&j4Qc;Z|4AOFAp-+%N+f3zF+
z>+`b@Km717|JA>;Iyr5cW|-o3KZpqCoMIfu5lp&8U(wPr4Nce9wwH)qrAV7G5FdJB
z1XVHvsj<MKMRTbDmzmAT{lWXt1+NHMO2e*ME~jC*ySqDGHE%zDcz5;u`Nee}?<`Fh
zFJ9&}b>2<Wv>W$L+twn^%tdUPCRKRw_|ba3TCKXehBTF2QZ8wTv51AxRv3ZJoMB4I
z6vCoobW@C%H@B1Id(-&dd+$AdaR0@N7yHd^oQABjT%WA(-FJ*}+=UPnAg7dU7eeUT
zcD?L>^83H}v!DI!7eD>Q<;#of3m1I*yjyk4_38TF{RfYlZk0vV$Pk?io;VP)0Ru8|
zU{}P@K+Q_2fqD*+Tn$fSR$u^RLNF;R^V$YcM2MUjrc`pCiLMnxs2h3j{UMxnex8rs
zsj73p8W9mN20S2vdbC>CgNe^!F;i_y3}@$QaLzZ1vzrSs@ZryCoY05B&IrAW)sDB6
z0;sB`N=FX)LI>^(bN$R<Cbz4WxznkgqsXi|R6WR+<`hCZY$VVMR5Sc)ug*lZCndtV
zxjMR69XIC3_H&-$se0VKCZE=#Jnup((o!{Am2ad5Fgv#&AN$uWEg&L0M@Uv#UbWxP
zIf9{MWrx)`pvuvzX%-M5l2xfJ!C_xttCdyZTdmi1Mj)oyUjINH^?|)-M9x_N$hm4u
zp}q;k=;&}VSqZH_ZO)N-8pq9cf4#lE8+TEn<2E#nN-zX56r0z8&Jh`8t;#v9OD?OM
z$s=iu4$6pwcC%U(ioAw;MFi0t*Q2I_DzD2ZRys&EFty5dC<>;A^EhC0%p<CyT3vIa
zW9RDaE~+)!L6HH4N+~G|U^LZn97FJJ+ma6@rJ`D*nn{ry9ZHUj)V9F^X(^tpB`VWc
zQuM^&+XS4HUtDZ<|M-vZ_LsZe-P5OEFPF<d_zQpjhd=z`y?giWKYXy=?*PCv_ie|_
zqUMlR{X(S-yS?{5w2f;W0GMdyLe4mj8G$+?F*1`WMs!@&IF14+7A-}<voqCPRmhcz
zjm$_>j;SOU(2=7`?IA|fo2$#qSI?&Hji&MH<wcIus_TIPQNg$h;SiY#R5ix<^4Zhd
zt7gC7-+yp^a(Y6JQ<`GVMJ0=}DI=(vN)dyU%A#Ak;Dc)v!9<5K65XEd&p&wUy)<P*
z@NKi*-{mQ8Z?1vx_U>-6S}s?8<49Fdr#z)Jnn^ibg!i629M9LDyZ}yP-tVrj;*h3&
z+b<WZ)!DsAK7<(aIE=yj7^j;!0YJ{;h+WeWbBvLQ=M?*j!kJ@YbZmr*5$p9vSBKt`
z3p0pFE&#x)R*I;CV+V@Pxq8~Alo)}?K#|b_qFJGO&l(sQGan6qs{!^L_Hi%<A%dCC
zQyJe?zoRqxyGlW^${VS&zRlXEL89b?s1jn%Syk{5+E?!YJ805tXL&56swGo40S2t!
zR;3!wl>;5B63=9&jhO*JDyb3<>Y5%A4;rYt1(pNg`#P~20FH7)JGcRUyBb#Q6A@97
z*M5DkRgd3B@!tG1Gu0JV9a@jeCuXJ^xdY^Vqjq5J6T`fuQZR>ysP@{5&XF&0>_JFv
zhFXXY!eXcw5Dxy?71IDSC5L)UI3-g=RV1R|+<re^USB+adAZ#WF(<C;K7<fLDw0#4
zQY@uNrKyptIpi~N0acQ4;G7(|pUC9ERq2~&X9shz8rxe;5v>UgAXW;*Y>qX10lI^O
z!0Q>mdXDGAEp&vpM5Ma%7|lOgiIEYJEG37i1ORYwQ>4%|%<MyBW=ch&-YFc~kV_Hu
z#whHImLl2!H!g&Qrw~DHm-7DU^RJ)1&?3XQ+wS4f1NiZefAdGb_Nz_ffANb?KKtx5
z@>tt~%B4jlAY68<dk-G&r}5_Y)_ecXd+(l|olPl9v6@(8s;KqcrGi@BT4Rh2H<ii)
zV9rr4^RshQG0ZDda_BI}v4|uEP0<0JoGj7u*I$0|#b=*N8e<$Wr~BvYVNaU%WU<^%
zgPEn2MXJ|zSS%LaH{0#@>5I*?m#=>CgYTWJ*I-zENJG<503ruO=t#<J=DQz<e3wIL
z0btp8z6s+vzIyS}D|_O8b<*~Y_kO#-OEDQ?;~7k_6!Z>DiIS%Mu-R->b<y=7zWbyJ
zT^j-z-EMccH(MkJ>_ow_pzc!|axMrYNlKQ$E_7`lYE~!bTmTS(37wgV%syfY6q-iB
z2+eUNXhUVqI7hWmGS|?j;+<Qze!m@#G|%IfqH3Iu0aI_Z1vQ!ZxWulr<4l)4))TDy
zLnKv2G5~T_gHu7AO6xZTLt_^ZjM$T7r@#n|#IB?%8d)9NkNahS*YQDBdqZ=mRzj!M
z#89me5i=T8cBfR5kZ9e^9H6wOa)oBq2Ee@kodG*~eLmE>R*}aeVgB_VzXGUK$)tRI
z9cHfnSI*TSrCBx$ulFnS51bKOs7FO*HO-!?s?@eEldJFCxlmJEYt&aQ^DwuafcUNV
z1_$K_6EV9fW}Fezc`iPba#a%qoYSCD0gM=m3K3~Jd<4O(>R8h4ZhLWieQ|S@imI_P
zCCfQxwNSE7Ij5XOM6e>pkc-s5zS_uQji^B|F+7w%nyuIKY~Uio2+T}?l@Z0igjl=@
zUL2BL=28Ce3mQ<)!bpsmOC};ms6|5S%}i8^N-+gQavaEc=THn37#)%DAtF3Uv1u$N
zXDJ~BU@$@op4(t4sg}VCnt><BG@(Kf=e^}(MVhwp&O4;l`N=z+_q)x{e)03qzx-?(
z_s;RjdI_NKyz|c4+1aw|>v1k3SNZu@Uw(e?{zKpQ>yr}@y|}oDF}7{rgiu|D%(RXh
zl1s_Ch#*1;0bmY;tFhuDqJ$L;JwC&#>cBCQnqW}{RU|AfrRn<eD(AfH`<6xX6o~po
z821x9w{F&k46skBc;7DiRnuBZsavjM`Fa?p+s!^D?Yh-sb&A6vAkI(~(9DxFC~DUD
z_Uh{9`Z_vy=RHg(ebcsgo15E<oAG9N=bd-5z;;jFV$n9e!2nFd?QWW;H0<k?<s0XS
z`nFlL%f9cMrc>3r{cRnudQa?QmLZQr+3tp`F+~GtmuDxdcRg|ALmL`UEGl(C=|Xo%
z(;;SG*F*|v3PnT}nL_20nkgXysuUHeB*yCT2qCls#>V^LL(aLRTr;AFVNes#4h>8W
z$!5n$XHpe`H!Vj|5As5*SRE3WDq>ZWi$khbwOnx;Rh3ExCsx&L#7b(6V91V~Ef$Lk
z`WOhpF>4;ZXFxQSW5|Uep_l_v)#{3Brc70yRF4-2s8;ZR$^jyVE|^)pg7Xn{(BK~$
zKu|zL&kl(wPX)2Y*&mffuh&fnPCnKc4@C1mh{6oa9r%ny<O~#Gw%D{cK!X~JS`|+w
zrevU6#05sM%JKBU0a!5&uMK1B!BDEdMBStv1^xzx;Ho_Yq<APrRm3&3i*wGR)f24x
zvCekf&JnY(6MgV)+qNl{aeH@tv)gROaWWuh%yprZ)Q0^4#)#-#aE_#I)q$*JK!J*~
zztM(UB`g`5iNin+&1N4(RYg~G&d5|u4H&YNH(*~N<O2~Of!JpHboF)uQv?GMA!h<8
zQXG&YFQ!+wH_kcs4tVy(Qq^Lm#3(U~srSBZ139ko8KQ!S3eYsoVzDTuF~*dV_d(Sp
zDX2Eydl!n9o7)|No-S5J1PwdiX3$}p`p)mSBMMw>_R|QBhkjA=7=3`gX&n*>bY1uO
z;r-Lo^E}1PZu`!YCl4MyY}@{JdkZo4>lGN?Twa{rzgJ>1!!{upSHJ)OfB;EEK~yyC
zh!BX;141rc*QpjYDJ3Dz#}b0fPWa^Cy#9UDkGl8l99SB6o7<hk5<K2JKk=0P%1^t^
zc5~~4Uou}`-#&csxSA^iP9X#ryk#+@lhyL^qw@0N)$Q%(;?*^I=R;q%V?}8y+u!>-
zWN~P_^*tQY3o^*rZZ`wp4ZAy-+TA-3ZLwGg==JsODL`ne4Ad5jMJdHVQqH*~_RH0J
zu~?m0VKKbf?5AmBz)HgH7c24(#t|9L`>tE`F{de|&@69v(|$KzP1C{5rCF_3P18CK
zIp>rLA_qTj%)|hFuv$B+A-^e@5&;K4<}u~TdtY<gs`|hYc3l&ki*Z!drtu+!lqNF@
z!4ZL>GW$x-tIHOdcS9BRI!xQZRbnDwWI{Sma;|9rfdAUR@)y-0<}}4*hTb;{Zj7br
zR&9F{Cy7y(s}moZVH!<TN<>vAq`J<Nl1k1cPjON(cI>=2z+6f$MNQi-0H}eILp6zM
zh-oUCRC1AgbP1^#uyd~DVxlD{Lg>4W5X_|O8Xp`Hu&1_bLf0BX5-CMPV9|m^29RPz
z#I|jZgj+BzC2LhF5g<Y?$vN+RKqM)GfWe2hX-m$-uqVL9VnGNh1;I>Ja;_>hN8E;v
zi6rKd(&^dhu;1pKyG0uUXDwNhs4}}M!G%idF(I?yy-H!iHZ)9R25s8`^6l-dsGY1=
z#FR_!yUqtrV^k6EoMWzJ6eQQQz4P9P7Tr=sn8>>Zj0wUx$n&SyUwr;zvxz{>e$s5<
zn*M6L9aCxBlbAGS>D$GkU*?pDVGOQOQSXCyPR(*PcQOUioTHSaBBn(}ie%I3?2Dyj
zsVk<c@p8<b=YIh<Kv57uRWw5bo^7Q7UE`E&n1*DTnU6_d$fTOH7GOj|14!~Zj-up}
zQgY-F2^o<H35#hiIp(xjED+IDRUpM&vM>fVhnX}ggKN3bY}0-qpwsnPnR3oj!=v`Y
zh)hOwadEZ1nc5H@K0IG9NF{j!CKz_G+wX>9dh4C{{?cFitKa|L54)~kELP6D{WKs!
z-}jB@lA=l>RME_YZ5xO&=1J=@q*9Fx$2f@;?;SuXCDo}yrBv+4X2G_JXenCM5I`iV
zq~Nu2qGgLZ?Y9?b38bi`lFKwr25_=Il_Dx8TBB)DU^d_J&O7G}$T?5Wv-5yHblvsM
zP05*=g9~XYDn_mmfbA5+qR&9UwCtBnXe~|KTX^ro2koLgJzIyaNhzw8#bVKQogs#{
z?YgdAEc(TgozDtIaLkr~kUcjohDO;LIdGxrmq5;i7SY8iB2W|BQZ$w9Tk4nGFL-^@
ztX977sckK$&F1dK)z#De{$h9c>YHzVvAuiQ_Y^#trc$P9+@-ij5br58JPaGNf}o~F
zO+)Z5_>z*8)HNYZQ6w+=UL|k$Tklyc4bx66BV*3R4A_MtB1K_NIIZav)v1n#{aA{i
zVRf5xT$6^)`5*wUZI{(kx;7D_V1RAsk-REou^iKWHwFh}Km?9_t<Xf|yhC(FD`T7x
zp_F8~#;sHw4aaFx$!0=~%oy4RRM=4*_V_J1Db)maW<F$4BchQ*Z%ht7yHfCVxT@op
zTST14%(_H7qyxRy3+Z8wo_+to%<5Hh&ec;(M8<LKx~@_vBo`GSKz0tCABMeiu5Y_i
z%COsc?@v}M5qb6e*?PTRuUDz$m?N<T^is;%dR=KThF}G<lxoDi-IU|#PUNbCY}+q#
zj&ukGGqX~}K&q))-3ZngZdEm86&R<zDF)~IrVqZoyBl6UeRXqrx7&_)n|(3p)~l%L
z<;4|{0Xjf#+8$%vPq8}Gdh#iyzVC~O<T8KqYNA<^21Z1G6nB{!@a%a$1K)_1o`sGX
zk$8?^o|k6`XrPAGZWRctbA*7ItN2K%0Jj0ubQS;rrmky6#Ov#LhIy}Apg_`sVv5S-
z(78bD_xq8Za}*TK1m?tUAIcaV`P#yhDIyaE14<$QAi#)342ncVzU!uGyV;FD{_WrT
z8-Em?cRbXOAII%c!Wogs9w+NKagi-DGecI!S=pR<RwaAyO`H|V=FD$d8PVA~WM*E7
zi!*+opU3^<zk7Vfecqq<`~7-855%o{F1Hjf<Zkc{J&R9**;`eEuR}@0F9of_k5`wk
zUa?+0Y9GY9<5%R74}N~n9^D*qZLtuoawA2vGp-S{sWZ(mG_lf$6uQf75bed}PCGs!
zswUx1uO*HVuBqU|FljD)Fu!*eAj9(g@lczLOj@+biocZ;T-vQX4JAxo5mNz8J?ZhD
zkRp<A53tc0@KV$<ch@@q`}Z~L*@K+nQgEqT-d*G;A@r339JZ6y|E_jhoc})!&cfoN
zqUcpJGNoVi_Zr?u&ZSU;=2K{>KwT-^jo>&qh{#xDHDxzAJ~eiHEZ_W@WX1ejfz>ha
zQ^}&4(CO&2>kEU>(7dLvIi3x#+Lo-kFV{9gad|y%cWV`hQmS+@Sh!UEoZA_|1JNF*
z5mSe<;3@Fw&W}=+ng_~!AAIC_FA$y7U(MS2=F5-!-Zey@%tXdB7IIy{YcaWn7rQN#
zmvcAAHel3#*KOr-yEqiRN)?@%7kj};!rPiW?V|Y(p0o<~S(6eAtyt)7o+d2{BNcm+
zdWv8&<6;?!T3?PRdpkI87`D|Jkj0}O8^dv5$^XBa*?UUAEvvG8#`a?#w*I#2zE5X9
znK_>9S%ux}NsO&Ay19??Z6Q~1{m=DT;i;>HKBlD;c7|Na=0P9K!rClF?}${)``6hQ
zt(EZ0^ar>z7M$#BPdKl3Q_k?*19jD&TLyY@^errAYL>UJ#>G@q;Bq;5-%n0czA5yb
zki$(ureB+ZN7d*4%|f!vY(mdAd;hV7BfO8k1>q;s13JZCBid}jPJPhvp1r;|`}?5*
zZFn&*6)o=sP;8fHqvjF<#$r+plNOFDDe53WnTX1)AIdvPv4eFrtjQTougtIl9321A
zC>hu2R&%i`O<C6U+T8DYu)5EixId0Qi!e;TT}q(`<{}}LDwR?(Qr(Uz;HgnEm2Tll
zTQk18;|n$_in~Q5?A$%Hdu==xXMrUytT)ZihXf*VS8e&L);*!X?RiJEk(ac)XW`}&
z=#~MWoiNr1@_~Q<9R#FUt~A^QLgc}%3NW{&dY8`Aoem+1khRITJ#JaH<<vwAwEc`H
z@aeB`Ur{*X{UI^!GOdN0jynHImpYh$URoOWzaLug)Oc_4(LeLW)xw5o_5IwOxU3vW
zl1HWY0#vhne0&-on-kkPUtWdaCvaHO2qz$B73|GBun3>R3%dFR`ODEh`>F$C!UqtR
zYW+I*!>;DS4vx|_u3Ud1iIjNe9&yM~YD$Wmu%?y_CUTMfC~%@85};b;XmQ8jttJfI
z#5X@hmk{MKdH0o2@Nl^rLbn*~A5=zLv8dPzwDe8C7m#4=Q#fp-;ZGLMeTMYnZeP9n
zv=STV5DOWqj)<&$)J~zZ00XPj6w*cTS%m0U`Ztx%P>_sJ(Zs|ATDOq?chsx9^htFa
zd4~j1G!K*FhpT!G(<&dNSX;56mI<$25ZT0{u*b>$AADrThFjD!5^VVepCwgArKydP
zC6J-)wvb=GxvIBR<$~`s(cj@V8{vUlz(1KVz1}JyEsb>q>lEb}GaD22pUBtQ&x~)2
z{9XL%kQMi!aXyJTz30mR=fDecv!zz6Ig_}BBlV;Sh%Sa_;$9H5SPsf1FB;g|_6Z0;
zFJXgm*@E4<)o`LEODnx<KV8f(m2yq7K1(Z+acj3>_(K>9g)`>fris|^<`s@0qE{i}
zk&rCd%tQ=xI4_xg75o36N6+<f{=r#&)$`c~g`0(e@vW(JjqnrC%U|@EZ5!nIfS{s=
z^DFZHHYcY&5!bjLmq7MPrY0sez86=119EL<eoI$+wBIT&RJFk{rw~!a+D1F_w|o>a
z(LR2BpGe~h)L3b#n05F@?{ohcvIr$3d&sycjawVekhoR)>Ug(B0QvGW$;jAZD`RTT
zUNndr7OxxR7k#Sso&O;#fy)`~ZFY8>R1}_2P6Zac>zY$!V_8_xzPS_Z8=xVGUBb!t
z^aP);4Fn>-i*pu%SFwl!luORwN4C7P_q`V&qJ%Fc7PGaC+b(h5y__8H%km5jk{!eb
z+2iR!V+PF*rd|&k$EJmGW+v+y&pVcbE11Y_dC2N5)SmuP@H<$$*sa0kBRZbP61*kB
zz@~gr<lgGtis`#$aREyLfh!`5NnQEQTIw_oQ{o^%02ZC`E#gBSV|m6gylKQ0;`%dE
zCXnz7U%Nt>`k;|K*1Svvd1_a`^v8vDSk7dC=fC$f4HqsoLXsS&@h6D3v|lDiDaNKl
z<Z5KUZhg<s6~4thE^PQsVn4dHCWp#uuj&bGL@=!on@GSS@=*s8&APwy5j#j{5{bD$
z9yN`zp88ilgO<?yJ0E+MNf|~`Hh)J?yp4JAF)UnRIZ~rKZ1eqOf?bGIZRdT5Kg*Hy
zH+45ty`?1`8<vJ3Vq=35SS4$2HE!`yAPyFI{Fca0IH?~ZdC!cPp3JfS)tq$jC{e9v
zNmc(P5r>d;OTL<zCyjI?+cT?H<L$AmGwrjhr|!$Z#>VOCT0)WTS6+;S%9jrXVT
zvIX3lI<m#0r-9r`d|MZ1DKQ*!xOoVK8MOUG?!^bm)aS;=<?c(Xp$P_R7Xwi_+DQ{2
zx%tCGrO~SsOw%cK<fd%N?#!uf97J}mRrmA}O}`wR`IP`4m&)p5J2*o0#X|>4a-P2}
znD3iPcJxLPMA9jSE{72xbs13^y%)!O4Lz5x1y6DEskC3<tO1<BT21c>?z-W+I~*4t
zg1cVe1okJE-GPhSX$(3zMPxV<@TDqdSRvlQK+UTkM3N(EkAZe%bXLl#h`9>zoYN0_
ziTtK05kPgYspUnwJo!SOswHf9i|UrC{vD+n0aL&Es`>lN(We6s@#{)AL}Y2Z{wmKy
z$VeXo&~3{Pt?DxwIdmt~7Xq?d7jX*ht!^MlCYg?TV;l*w=`xos<K-vL+&XHHj$Qq^
z_*K}z6%@;}h($md5n<?Laciu{p$DGu@AuI<aA-DtV7lv{I1THqzyCPvt{TjE=#I{?
zb6pOR{`7{piQ9rXgE&rz%he$Do7^kust_p^awF1L6au5*q%VgTyZ?b6m!<jYnd@?d
z46$4OS>`r0ASToJSb~AJl)C3d#F#f$>3~tJxiIJfyy+fd$&jzIpy?|ZI8sZ6^5O6=
zv{|<Uw~uzeUoF!0-W1w+N8;BxU>~=C?o-A{(5O1+3kPCgwccS=Qz=zi$?95JY1(=)
zb)tuxDI*CHYQto%{M7dXc{KK^I2fd42cuz0Z#LMwc;7%1dG0M7Dq7xmAaU<<dMleq
zxO$|^i`if7qgs}GpJTL$!$19~c4D2$ni6LQa$n5KiDmbt>hWifVQ*qgw;+yL2s-YE
z;Z)Y$o*YHGbx<V+6pi;0l$0)IZcclPw7)@OsijP{xifzRV9(DNx<j`2PF<0W&TKM-
zR=4U!6-=2hQPfOx$6bY%GIg~ktvbdU+u?|k5-QCkVe!Hkr<Z;_-`Qzx1frY1#?VCM
zjL30`lp&m7Y6+tTGnMF`*Jadhn;?(7@uB}ncu=bQSKOHujU=@ZAA8_St?o-}+~Cfn
zvxs?_Zanw49SXSuB8@8g2w<@rx;~^kt^_1zK@S7?X@y(6mvVssr>?V>*x3A|I^yz-
z0$-_@dAS@WPV5ebCIUVaZ(OvhE%sjEJk(USbLAyr+xaMEx>9$awA#J=@dL4n=9LvI
zOH27+zcb44KTCiKxtAi#!?Qu*{QUb({>?>i=(&pB&&u|d*Z2v0%o#ZQW0pyNJ+qOj
z@7O-P<*oDJ8yh>5VA<^&Piyj|<SSlKb*^(RGkPZVRFi>px{R_xFiqrC!1Qx)b2m(^
z&n+a<lbqOC39=bF{J6mpsh3mrhYDoU_0l9YCC81%II9f4L6vK)rL#au_k8G?N?G2t
zJyB)l=qp9bo<)}hg&@Mz%Vf@S@Ame<^V7Lt<ZWHvgE9jy>F$L?g{%Ge+S*Z+`%3WM
zt3R*uq6>hN{n8JjZU8nMn}+a`q;{;@ixCYqRZ`dxv3H4<3|;{XU`{^Jm}iig!6qlR
zXzanM$+}gZosJPz4=%euL<KSS=%hrspB;^IPZ=(cF#mI>gxeO=s`K`(E=E2yuy=!f
z-HeZyK4mklGUGj!{ad<~_q~78SFW$|J-&?=DK0vyQ^R2b5>mcYr2<F)1jeY!gdWiN
z?U7m1X{qoPeAy=A8Z`6d=Bas<#=}sVVXszuxlmx3;G*M_#y;+c?j8qot4w$ooKdVj
z@fgBF6B62Yvyp9HUv)NeD_`08e1p|Eke!S<*PvF}(=-Geh9>Nh5yXp=5<y1B(tJ)4
zGwoPPo7)B$sQVIB*Y_jML<fqxr4_0Rgc820tNA3QfRJ+{`gcbiac^o{33P`mo_X*^
zI-qmq`f1MZV5GAc@oEv*ibfmS>1tFbE6;Z9@O^+;=Mmkx(?4@QR+3}b;xEoGt3Z;<
z#lI~Ai`86b1HbG0Y_If?|9&KQIYXhZ<(E7fw;w*(Sl&-HRpY0NOcAW!dc*Z;W#1AD
z@p{I_nT4un!$~O|jh>4r7n(|AcyB;!F3~<UaDhU3?2Z$7(%w{}y!+Ro9(bUDIk>Af
zB3;`fbsS$$Jk8dpOO|#U6pZ`YJP7}ck2YtvOHk*Qy_IC5L|kCM@>ZCS-*4jy$wSsA
z-^8{uBe56x=mS}*dBCgH-9a32`YfQ8mPH)Uf_yK!8T7pTHw5J4lCSYM=<mIui}kZF
z^0DDZ`0M^{8$}~+g%Y=yKDrRENwZQmAx9-MiHc#dY0Y6a`oaAiqL1_)uH{w%#4*E~
zl!KCz^dy|s))8AVz6KPgs!#_tr;Ksq9!HTsD1qJanqZN}1nG8)J~ATe8M!~JP6ni@
z50EuAT1gL8>vD4Wf#}mSW=DvxBqJjQMPE*Q4B3C1JI9AUc#OW-O7K4?&nMUMy@Zfn
z{KMYk!s44tCz<@0{P;CH-<F`ykDuHb|G#K1`TAdR!WZo6%n99ch~o6yUtM#F2ZQdv
z<vzmU4nW-Et2|hiR0XQ^u7g=Z%I)EIrpX{DGRRXYTU3D*#P}R8{5v=G4V_h+<^JS1
zC|5hmg<TpZFyh#|1Ohb$=u&ZW8BvXw9YnbamlejtMZfmNd}+5rU3cSGcIEJZ2rvA6
zA%675b27`@xSpj@{EG`*=-;FFoMAC#GA!9ZFIUI8>e-LiP{wuHBtNfh9pEYFx>azp
zI|Zvk+ocHSdVlr$G+k8ygNOuA-idMqadru6sHqzo#DZg=s-UsUdYEA)b3+rSPjoe%
z*q@+~Z50tlnA<#Ixmt-up66Bx6aTlwboD)!*<~8j7wxB)JY|-@$hL`<d`9A=j~H_1
z3H8)NkIEE|H4gNjXx6MaW2>jj!9=UQXW7>h14zcpD@rFiPI+1LhC{`6;LS}C_y^bl
z{{mgMT+#7nM?nT+b63JHvm*5%cSR@At<*6k!svs-C`pi9{q=>fUBxY4hFewiIkmZr
zhI~V5>E&iWWbb_O@J0F}{X_iyJIyL&xmiDt!uUrhs!$lF*qC9++|J547wXmzcESt$
zoup@3(a&q^PLjGk^H$#oqP~&C^4g)gMun3#{MgG}lb~WDVvb*Ae5XYfUzhUTQZrE8
zLsWUvDA^<dhETJ@<-N`UyAFqPFlrUK<ZnLk*^{8x?=#_Nxtb%p9nU0jvdn1et0<?E
z&fKf0*2P9oivb3biiE%MfQ^vjY#n>x&-HHx*L(Ae(o^)MSWx)QKAG0}B}=dEyMX23
zOThXI^cCcRWkkT?^vPE&a65F2ry_+H#}3My9yA{3Vxi`q##%5Zn?_2>g)w3_a`S|j
zAs|Lr&P=gMn*7o(y%a+=34@dzqfz=j)!JCh`}3>elqaoa{y9}f3MPFoZ*e`Yaj+ao
z6TMCES9;XX7?C3(34sYH?0=*$JuTg0%`)ukBlPLiXvJWlANBR9PCP0N0fx}P&d$h)
z>*vSjRa$LkG!W$Z=}cIj<x-pO5?P#gK{VDQgz$GqM!)xB?d%W{_k~H2GZYiZ5;{k*
z{fvLx(A8&;hN*^~Su)8|tXlGE-zT;nh*7HXJKqXEDD?z{hj9xUw9Rh#gf*uS4mb<0
z5ZS&@w>x`0J7-}mDoti0yJgHEU%fA3N~n7Gcp%b^IV;`Et9Qq(C?W}k=>aQpH~-{3
z0Z-Zo&db#h;LDDWJF=ZEGv+Zp>kD<@znkjKKGXboqJp)O)px@8*lr+bnlC%Yr`{*o
z&`t|77&i5y*8d56?$-xnT3QhlWa`>uM#3QF;i<5BnNk<Dsj;D64|S4r+tQm-{2ivn
zgJ`Iuid{KRF170VeO!Sm1y{6^noikoRp%&QnxtXK<EJFI6(mZTAejQto}>Qv1C35R
za0kR#V1mnI;ga3v;G8it+A;3yx$8f8j$hq`ZO)#Xje|DM)A;CIYWL5Uaf=?k@emLE
z5^Lpv>&OK0%sUpAOkq0pPZ&%(<}}u+{vHXS>}o#}lRYLHou$-I9O^kTwPT}vG?m7t
zkq~Vm|7wLy$Z>u-)n!lR4{h_sOne^0uM8dtag^zCg1v)S1(*F&E7k|Jh*F5#Fw-Td
z>rcRN`K<>RKyXMGBa5R3(IcrQ<m_D0v+wDR{FX_}PQ;+P1B~+>lhD1HJbL?rv5m`6
zWLVhaM1qrkZ%^oHm)Kux`S3@t1Ck#shyMkV`a3QROnpK8GpEZT2E<<rZZkC6OXb^X
zfr(9i6Xj~g(_73zZ3SRbAjTmkkPyJh>e)lLy2t;<!cQ(2PV!&Kc;`hgiDq3+g?QfV
z;(JcM*qpB(p79*uG`}@3VF3cKLio`*kTtv*5oh(D@)x)13cR>{=bJRIYh;}3*i`Zq
zUgE>_wtEZ4ewp8mS1)JCKU%GYQ^6zD2(S1Y>b7S4ytPVqfbYYi^1`^=Q^gqt7S1`b
zloEMJ6Kv_!z4HQL3CW!)VXwR6s=lnNuBA*0GB5z!8Tt~-26A>uO%4Wq*HdQ)Qip&j
zFQOFee3#j=e3gWlK0PDDZlA=`a&i3h1!wr*e&C1ht5A*k>G8$I?iR&7^`rz1cglvE
zt?=>Lk|*A()^L7meJHt8eNMEq-h~{htxUAt9XZ-jC2W}ah>PT_EXcPa*!1-;sv$<B
z1f!AIdrv+)zxr>+r`ixW+Mj_?P+4&_a;^o5iJJ)7%K4G8mf<^t58N(yP!m!w!0(;L
zmbteDkZkVn`=OT-z62s#t?ROpb69jh@6LZ`9#XXE^qK!4TCp(wwz=$ms@V9uO12uV
zX@*edAwOU(9vr;&=xrJX(bi&^*II~@rQywiZCS>}d^%CvpWn88@mGjhiPF@B#HiM?
z_P6{@GuUTeRU$p(Lu9nTbir*X*~zjr7g@wIxk>(D^@c;)IyB)+Sl&~BFOh*_9hw3~
zQMsK}(Z199s3su|_GUM(aPOi^qVM{!Iv;Yli1I|Ej!bOQQB0LpBsvpJ<(iIZrr(>>
zq@p?$Z$f$nO|wR?r(V*j&h1BE$=(6K8mo4|9vsf2f%^k0tstwm<n(Nvsq(*itB)@P
zk&Hut`R-(V#?jwaxMIJN{_!?DQDL1v=5TPVG2_*IZth8jI=!e98QAv6#bn^z)JW&A
zy*+e0<<yw2S5m4bHL>?XK!x*2Yz#H`Gnd%Awbzq>LU2f`$Zp0|;E{e3(^4ZTC26uY
zQf9uRoX*Rmi($`>*4XzH8&ZqO@nL$X%M!JRt_QoYoxL1MC3=E>)ZTNTWK53Ak@HyU
z8GW?J)&IOdt~!TgJX*hnT<)3*p6u+ynvo|^at~A;7aPa_u%Gf#%lOt7VDD>Rq07et
z0o#stA6vjw`n!85SuXl}*aap7VY(KE)_sOXbSOOW)m^F6^R({zckX0E+t$Wm^x&!X
z?76~y6CRMt9ev)XLo`)(l%}f*D<E#3hwtg(MTvM5(XA+%0fhHjfj&4kqu%Xel8uO<
zG(qZ}3!L}9@>|$4lU&;N?Y*+|QTfXCVNdBBV-W1mevC7`-e<b2Y2o*6U9K$=o{3cM
zlD5a16x(!&>36jvZPo}so!4Xp<o;s4r`)JFJ0e@=tjQ+yvzcG=gM#|+dKx1Ye8dtd
zixOv7BN*}G0A0cx%Kx)>aNQ^W3?|Nxw|0-@l2bH^)J+^(@lVeNntlGusZFA#Hg74E
zYxES{GsaVFu)T`^Or;DW^PlvqJsok$5`ksXtkdT+_F6Yox&)tHo+Ek{y90V8mk#i{
zn1aHhtem@6E3I`W)_q)2zDcCX>s1!#$&ZrO;l6WzPttD=H8?v2n%xNlm4LkSnqA3P
zX8;PlMFjIrupj5(Da#NrsasV|Ew8b3`d*+We4d%~%<*|#F1Oc6P!fcNUMi))h>Y>S
z8rEThlHrU&ur7TRBWOh3By+<HRR-twG8AzFIZ=HyjS$jOljO=HeyjO5X?PS-Ksp8*
z31W%zwD758`&&v(MC|pt)GfE8N*1m*;`k9`xYG8+Ov`0ne`a;e_2*k-0@e-=6U6`P
zzxvqWg8ZY$x6NKFq@b_PlrkbC2G`=>W>|o2!M{z4n#P|oIV>J{08DZgMZ)&Y{wAg}
z`9V=HVdJ1r%)KpU44K>~^F`O{+VpOlCkZ3b3`O}gjf?=VcF|W+i)ZGExl=F(HKmit
z&_DKLJ$Z}7a@)f4PH&MIM%Zz^`%*n_&u8#mbw-rVM2B!2%O_y~fS$oN@iFe>Fl|hV
zlT&XerP5OYN}_~EnNymi1of52lmTdNUDCWWtCx125AC9z@P|OL6H66{v$}nD@qj@h
zZC8-gmq^;Mf|Nc)Z8}YrN)wu-%0_{hSt-#oG}Y?p>A9QA7wp^J5qNGGzwv6(%6iCM
zzPtD0A2wh)WDm6H7tp5sFtKve?%+F1?PfJyJom`i#o=~w_|b`eZ;qYyqxjFyO@Bvm
z8XagjJpkoGU`l^=Up^y|7U>_0%e<8{J(=oy+)!iwwvcpN%~6=->jw3F_0HB=t9vk!
z5ZG~CcP@S1I{~5(%|9NWA5H!B_ogi&DlNAx*Oy)8O$=C<$8g7FIfPHF!h_SzjcWon
zxC<js_!{A`F<C9lFr)s6C(1OO^;<^_>$|7qq4NhC|8@jz<U{>DkqDpQn+Gz#(#3mR
z^D5E(V=q}c<6p?YlqW9!=Cc%EuHDwZzPt?mEL;7w)ZBGT9=2^oHSzA%Pc~D2lJUE-
znqLcy1b7OK!d+>tuySA!vDEDI=MX+Wtwgtp3C^r`9BF3rxAg}^^C1q)uiIAS)497t
z=g9p+ecO;nYcriTV%ehub|96UaXb*75DQ&Lx#)m-+gAw#B&t-dlh8W6LgLZx+V0xS
zrcX=NeA`$gi=h^e54WsT>}Mi+p{fl#+vp^EWuqds=SuYLIaRT_%6k6Q4|$f^co`sE
z#x1hCqZ74knqU{n^aA^ldmvV2pD9D*8QW#=T(g99djZ<zCSPJI^+|f8RMkHAJXY37
zCyk%&aTQ}}J`A71g4oY)GXo?!T4Fr))U`8Z2j~K$rPk&1f))lBYDi$Yx=|d;*w~e(
zA~Mp+iK=G6%E}7t>ije8r&Dh0dPK}Y8Qu7QYP-45Wok8n9s4b~lYo_P<NlXXr-tkO
zUc&l!#q;g_QI>7N+fFb~Ppdi6`_>|No&AtV(Ob1M&&0B{9Fo6;N$DCb`GYG~v1JFL
z_jR;%azQH2`g*47nK_Apa(dO8Z=OUe3C9l@*5+re(_2UxL2y@7ug%naCT7+Yn{}}a
zvkA(^bqgHP4e2jemmn2G%tQA@*!?5b4NT(TnugV<R!eE-1t=!_6;Zv}%BztP*{8Hu
zd|bA{!-2f&c3e5>8k=0U4SIucQy-5mqf9J9DrvoJFMHI{|L@Dc?s|<&Rx3Y$GJQ5|
zzN5fm^u}bau;H$!Vi$h(H3!K6cL+{<YElef8PEK_@CXk%SwqNKy>89NLiH9BIAlcS
zM)M3+*0tKJU>TVolGMP1JU%)avh`bTt!qbXV{8%;e0e?;pL!0ArGelk#9r+4-edS9
zsFG+$1oiCGy<v&Mfrn-s|Akc-J#YlU;&b5!B%`im5&I`hkqP~cY-}mMk;B5ywKJdT
z4cxyOb^l!Mm^&t(k_=C-n{z|3H*HmWIaj(|Y@F=1tz2(ifABrt-pBfMeAI-b@afih
zKKO}4L2mw57R$He|9!zL2rXF5X-AQm(o8@9d|1dVk(K7=S5-4D#=QLLll=9J5|Qv;
z({vEkJ!PttsP#vGP8xdI17su*ISU$;4E2oWq~XA5jj;LwM-}#&V{P;F;EHm4nK1qd
zGUbwYcz7uLk1b?IltuX~PsHa8sH@sW{Q<gu)Et<^+y})%tZi&~%j}b9_=_H<xlc$j
z%6%si7CxOc5v5QX-VYq~T_|Ns<uQGE<QgYr`s4E9LoEoLLJB<c7UiOtM7XFPfJ#Qt
zaSxe|>+X_NDeR+mbBDP}Vwgct{@UE^34j*$Ez{20nA(bq);a4(Mtbh&08NjvM$QjH
zam2C>RQYK1tDl8M4J$!-Y;y0(m8GB7d9W|Kd!cll;DrBv_~efoshSqK($rTPc2G#~
z(#mE5Ha=c^yK3(V9s3Erv}m?A4*3n^A!mGje&MhXP@2Ke<q7b?MH+j%+k;O3Zp}#D
zYfYZe&#I$)%P@rgHNkXZ_p6}zOm$ZH{vFu%=wAMd?CgBt9o$4CHpFSW){%}!xN(2+
zba5a}8wgXe#%w^gNq{!>DKa^4YLb`?LGx5ccV%+{rf;Ox!2}n;CEYLo2B~Xj19ilq
zrN#?{%N8E7V!a{i?};w7uIdcgpI1xLJX`<;l*VF)$3_7zP2<@(&n>?GETr%~IO)wd
zn#WXApU#jo(~M)2aokl-b|lKYN>6vAJlVBJtbmc6P3TC_=EA*{-0I<LL|aGa>j&8I
zy{W5ue}Qw4@Y`7|dyHIuJsr7g+cu$BGcw|5s$g=ammYV27CZ$RX+=B}*^IT6;FI%W
z(`7DijX93?zs~{I8y)aLV@+=v-?==RICx)5R7wnbHen$dBJkeo58+C|;@LVG#bj$e
zHPiE!vGQ0MCdQ%6t9(blYw=$hb`vDR#*&O|5dj-Hp-U<D(6Zc6K?|+1qtKwN+Yx!b
zdNDsFa$M*9g<W}!(aiZS?q64@vJG|A;`|SORQk#6VzOBvI}!u+ZZG!IHyc-I12!xt
zqBS)m?^Mcq)VF0fcw8V_EX0j;v?zyB7ZRlR@?s|0q47%2CW-GfQYxb#R=qm)A|0<0
zmTlsu8YX7oN~dFa(UuK>uXeRH*HQj|3zJuXe*DrQfaJM-wOf1>uZTRe12&P<(-|e$
z?DGWMM8M2?L0X$0=<l%N;^OUswxxV5Lfj5etdy<G9=4&`swZ2K92y1NrfMzp9jK#a
z8Rm$7w$4gB349q@v~8JI(eT3{K(MS%BuOSj6;XmR|EdNIiTI#FN5>28OC(BjGBtUX
zRd1I&yxECMzM<U&-Z2?H)CtRrPUGHMo1eS1rB%q5)HQ;f_8jS|mKlD`v6#I=g!_hc
zb5a~nycdW)d{3rnBy4UBYOKP0h2509d$pn2*P;7^2Octas8dFvI^Mm`FK#)zI+N=t
z>1J+gLUDz3iN2Xew-S0FG*<W7+RzI>J?f3L;s@6D_Y<haJnIo{GC7Vj@4V4K;Wu-A
zSo7uhkKaOYCm;bfy$$ROk(Q+WI6U-FM0o^VV2ZCoW%MF+62oy<bm5oVid=|H{CbYh
z1Y!I@g62Q#6#MFY4I1{vR&QM)yL|MWC>|vYB7UH8=fXR|FwW+pZ1dDdMNLh<^mb2u
zE4j|Tw4wpcSOncd){x|d0PpemRdmf=W>x>9oM-k4E@S)*CCr~c9=L=ff*TI9Z<QFl
z&mcCZ-h2AP!IapPqnpFRKssZApDm^;!>(*%ss?v=bOLmT;J)Gy(*<X(I-jogu>M?L
z#wLC^Q6dxEJDifE<4a~~@Gu^=n`)^|hYV)REa~@NUSPgk9|%&3vXax*l7*!eFewYY
zc}jH59e)pOOr`vb9%?K0DV$eka)0=K?ZRG#H562Rr-rUBC(?}l{iA=g@6b#6^31@>
z;8yudmQ0s~M|X5Fj`Zb3IvV{y^1G&FsLzM!qTZaiuh)EOb#ApZd=QW?2CeDq`#s;p
zA`!tLvBBW<E@$<K7rvF@L(ch7|4_+j00=hWx_Og-esar0<YKU!2WN=35Zu)e{sFKs
z+F>mshxFd&5WBlKx}E*tYKe|BWwEk2Ov`qe(0W63?_t*Siust~1hdLALt57t{g1Cr
zzYGSCDAOi}CoY8Dx%(kE*3^H+=d<flk9+Vl^sAgIe+)Et;WR!zgpLzxMK}!M<U;y}
zpqGAPb5x#r1vetSaMLo}gE?B&6Kj}^2Z~|N(SS340VF^Dv+@;dOqDw++w^`1{eRFq
z@T~$_jR_N6GmN4x`0I>~8W}w^mE&N&ru(CfhJNjt+OC?>k2y{fa42Cb-_s{aa8$vM
zSb1E8Wr0q$0QDyA&Q#TZBsIJDN&n+9yVHj%up4td+ZbUa=7zAav+6+(5vt(e0Ayvy
zSJwDvxTVcChhO<&R%+Ek3Etn*Oa-wo^_Ro`tbTO4Iz8PC>*X9uT_`L%C4wdf*o1~%
z0a3|KA8dg3_Tredz&EWC6p_y1{$)=jmvFGX7c<q;Ap)ksLzRSq_Jk_XqS4<KZ!XVf
zYO%F1_6E6~V_zo!km<p7Weq=HgVGS{=njIBk907AX}&>*@Nwm5$X}o}{xiAf=7S9q
z|0OvT1H=>Zv8{Q-79-#aludDNOTT~J(6&t$G!O?`pnpvJ%%K<iOlOZUnvO9#OT1k~
z^!`;0X7b-ahLbDpgU6EvzTY~s45~ss1x%h#F3ZTK^CZU9^r|w?-TWxC7eiHjos6D*
z+{S?qXv_C*!*$`sG;>v`dJZCn6Z)k)geaQxR$l0~_I(O2<9aco$P=Z4eH2KU^&u}U
zm$&MbLQ?gS4zSaF6=tlemIU)`%g1_X*TfB&4R+-Z9+Vrc;KOEc{NcyrnD0H87c(<Z
zHmI9tX)e#>xvjAfX655j@U5tUuF>;8j4|n;YbYHBWN`gr@A(`Nk%y<JuNIe~mdjGB
z=?%)|dCAwGcz1zgxFf5dkpA-Hn}^}&Hs^-{y&<^e?(aY_Me#iO22*@}86ROZ*GxV|
z8?=%c6VSEQ+Z>#CzB@3VUZuP4T((a=X51K&kD`t{@7Y@-2fdq=(+323Cy6iKd9x??
zbbWzRtYjG0sPxUyIbUZiqzY~;LzwA#?E=q*uh-JW!~T82&E9cXYUTN~a(I8PxS+r}
z4;!wZH45aoPLajF5AeKl8j1F}lw6MYld?nRX%Va3PhS_MXdM-qC?CI`_W65OuOnAy
zP8B0%VY2%7@BS5?LZDY`XGbWa-vV_7Tmg%ZgwC@Y#3m*t02NE~<0r_o{hiIx7v6F4
zAy)s-EwuQGJ+e1o#sEL~)6F#YW9C!~I?WCwqu#IOfgRMA7%qFvqaJU5M>yG}3!Bz6
zlV4@7!v)$TL~Bp)Xq&!Q>(AC&sI^ivAl)90zbo?)3Y7X~)T{t91=c*e>3VMwwZYnH
zT3(*9TW#lG%iDB`9SbG3vxpnW8L-X!0r!>C`Lp_~8=M5*YRr6<<Kclr0lRbcuqVjB
zXA9?@IKpOdP;l^Kb2r-|BBW-PjBM0#Pp+pk>=Zcr3tIO}?jEjwa(_ut5PgO4ooRFT
z5`;&@^#_^U=jH0K+Z}{%rP0^nmJn0HjfPs!g4pa<5Xk$FWab*I<$D89*R}>^9`CPM
z$Z36c$-Nk8N5AVLrL-7q{gr;|ny_<mcDOkXSL8#CQ?3wZRxS$_|Fx|A^HxT8ED7v~
z9i2C^uw-*0{~l#frWV*i969eM(&?l~*WnaJyq)0dVL7N$_nFk&v`c+J|JydGv8QLj
zc|;I7gd%WD-_G_GGo-J94mXzz8M^B5(?5pmlhH(#HJafC*tkiE(w!vjX#mV+lzGkc
z`SYjS`zW4e!r=Lm<)i%jxu}_Lf>r!PM^jT1%B9}3%?RS4-=7^PH5(%|%@(LO!*{B=
zM=lL8f5$2|1|g*bBLm)AE|1O6_PkKHXkwVO#{gi4CHs%7lcobiQ%SvfI{^DS%6j83
zSh)A!!T8|<(2~oKUGfU{w3<$YIQ}Q3w9MUXdkdJNgTZvF7-%%v`;}Q%<w%;$t!|x`
zH8K8blDzu7=+3P}4@y+LfDSlu3EjE}1-tb0Du`19*hr(dgxmj$Z}hJ(b}lZb7HT}d
z=q?r2U4*!;_{Uerko3RG4=C6?oh%4LM@QvKCmFc2w`FOesW^M^z-nO^#(&(&Cd}X4
z+Z!2TAM{h(fP4+*zBJidS?dUy$KjJy`I#f`;^4P~)r^eQO-$%XxFABGi6V^dh<WwS
zV-ICyUK(bj%GH;{{{9*GGFtf^k4B>h{hgdDogdQ>=$6Be&(hn*Hg<Q{E-!!jb2leK
zsB)sV3e;lQKNyZb&3B8;0$?K)CerjKj!HGRxbo>NNIs^Ssn(GUy<)A|9FR@=BC+3!
zmjCY@rT|1@u@Y9+R#ne1i0!>5|6W%W=RDNc@){m>P-kCsAHYyV@3TzkV^}LQFd2l?
z-TnRjlkbW)q9HsvsAnyHy11_I&lXYD=a4TF8zN&xF>1GXGCmT~%hxD@Z;>tAkCZ+4
zy=rDs=k*id8FJEUsmgOzhNfQ5zVr;jE%ks>``<pvuZkf;FXY<zf<#a>RWUM4{X_t3
zH&3!dNo|3u@cN751*WWzru0N7DgUrgV|yFF+=2i7=6!NeK~cSLEKoXExC{e5s!m7u
z(j0dgJ;LaCwhi(c@RU8k+B^yM3JXI34+fLwm<%R+vI=%1z0VF0)w}UJ%TjFial0NK
zHV|Jgk4ed-P}Z>9LYoYN<N15>;nyqIAI4{DHSiO2+q&rpb-Xucyt%4FRT|2&OxdCk
z;dFr94e8Q$!U8tCE8rFIY8TB3c!R}z7wJF+E7sO!FS|}2>I-nW$*oQ!1_grHQIg)D
z(@u6Spv_mC@s+4n1;vLhY7dh+i)p|7+ufW?`sf)d#s$lC;Y)2^YV2=xbM>@?14b%W
z<lw%qDa2ifjHaA6g5E!%$uSBxrkAh)`kYfuB|+R6mDbNBDD_g5rA>yAcATM2AygqB
z_{SCqakux#+7$DyL3Ixd(H_cWx4Jl<o-WH|s4I)UwN>Y1IsOQPfQa*AVm}Gj+#RVq
zv1J=lHnjHBoqG!&vg8A{K3uciyr#w`UI?PcvA}TTdcjE%z}{VU<Cnw#tet1WJP%iT
zS6Z4EJbJ<|E*ENF@@i_i6cb}-{6*rdaMTjnd_(q6wrAxiREZporNO2jSlNlWKg7Ce
zs{Lr@#AAT+>hhi94du<m&007X@e2T!|5Lod-dy&+l@C_YM>JY|#ZCuY(e)CpIj=W{
z#Cxy*F31$$TqlPU4k(iquKu3vA8gI8bOm?1Vt0ar&`b9Toeg(Q4AdR?D2X=Uj_Dj}
zR>Gys<Ir20{l*rQisz@e8@lU10H04jXs=GA$K}TJ=2!T?n}7N@=@1rmMVdwY=#0<i
zte{QU+0O3Y{Si5w)ync#0ilO8`iU%;vQPa5DOC5%KFZ3@AK9ko0u{wim=eZ;IL~!+
zWW1-?_21&_5gP!$-rsxiKK$3#+U~`9*o>F+MN?DASl8?OBbX)@{odf<p2s^qCxyxC
zzG4_C-wN4ZkqXutUs3J#TQ2Soxzmlx24R#XV>x9}&KN|MY+`z@Kl01WoV*kH)8~v}
z!z`p(VZF?pxF_zA=(GF1IGPW-UwYg~h=&eLE2jhE;VoKVbHnFMp9|uvGQjEU^?RSJ
z$XN0aS2Kq@P21Tx<lkSO*AuupeSOX@LjRmi_&IP)<HLd)_mwldWx!O>{ii1Gs@wS`
zHD6eX`ywK8Vwh5BV%ZtrK=NNenEfWsZMlR&Y=_!4w%Xi0J~_T>GyuqmfJRa&8|&O=
z*hhpgT8X___h64cI`m+veA`q{SINXo6G2uO$cic$$caVb-`EhYM@FjcJvIB=dZ?FW
z>doQ1EjGABe0oAUn}qP7q2+4Y2YZ3HNAP^q<)4kIg#eZW)d%m##YmnDBcxyZ-u-@u
z&8nv}_;l?DQ#SSo%&Cl3CBR46Rtze(&E7<;bPog7eL8!Zm<wQMUV6`8j$j(rt`Cp8
zPoIq*9ZKRF3T|=3&Ss`XrIe=L;e03ZcLc!lfqMs(`hZ9EpX$Ee^-l4%WuZ3pI%|hH
z19}wg07tIeex*%Tm6DP2a;WHq>-tPB%UnJhBUY8gF8Dp>w-0-3z>9{M8Lzx!C~AD%
z>MjJ~*?m=R_18ixDQ=>nQ{hg?_I+|bTV3yO|Lrfe9uUqhb~EXIzNKBF$fY;e9goW?
zwaAKc-9TcX6#!)ZO9)>3!ILPhAKqQe1~UV8slEc+4>KjVEvLJDbumov?ff+Ru~eRE
z5m7k&&-0Ue+SSiXoVE*AJReOkRvoi{B!|P_+84~X)Zec2<@=pOe8`urzT(j)GnZY)
zfS%3We8q~e2kzEP;m0fPXD*8F`Oy)1eatD+IJdVo8?sz>d-Ah^s%pv%RnJ9<SntJt
z(+QDgj9fkHUvOEGsJ@=?yt<IF3BPvg{paJq*nRqM3P2AwYu|l^JpK^CS={A&J%v}a
zRFt=pLgBh@vZ_`RD|9eG1YcatQ^@xBqIcYWWX`?kEitCZ4PtdzOg8-CgEvH7z1^k}
zZHIM0!=1bQSMlXlZ$OCeX?pJ;7KPAI+{*P*`1%K%^Zqw&3jfeI#l1HH*Apwqi-pRF
z^N^LBYvYaDh8|af0u+mAJ4vc^IW8gyWEdjQR%sj6-gW6yX9T4Gb986uGUd&m@|B-=
zf)a!_x7OA!%Wsy4fH}Ft>CX1clqVlw0Q3QQs|FprB$u{c!h)cpIRDKb4aH9h=07B8
z;*^rCsFLLKDJi34${k*(fLh#_G6d8R>@;tOK`QGn)pP)O(*A8?y*j3uvfPf7JH^X#
zR>ciAG;_bbgOYXr&TI}WT=;!9OEIt&gjiu;r@DMLn~8XIY!$EMFTmT`y&R*$m=~~e
z^ZWV({_Y;e!@KdZqT)z;cVKJ2z-K$Eij2Yc3W376W`;&<-ifS7u73nJ;Z-56!hFiS
zPDQLFlsI!Wl;l9c7()$x>h1cADnPDNGt1Ag5Q@l3dn6OkU~OITS(8|8#m~*BKphyC
z+7Y;^Bksu#4%nUk*<TJuvgI94eQ4|Sc%@||93!N}e@|17Nf7P0#Z;Ll8JQLnr-y+i
z@>X-1vr|s3#k}+|WV^?jtMja%wV5a?RhTB|Q<?5>W1rcz6pNL32Y#>9*RKZ4TpfDs
zw`Ixj*OWLQ1#=;IgPjAqMU6Uy>(>hs-hb{CreqoO4Tw~`4(3*Si@k1Lhb!Ka#^${k
zm6q!5Y;T@K!=F7Up;Dsfn@bBwv`74eCK#fO`_uri<DLt;BjogWpuPLa0jHV4$O7XV
z?z}DU`L#suZ4nGBf3kBsc6sC~WLg@@czA|}me1@2E9%~I)f{`E{`Gn0(%pjFf_wZ@
z!7HC`_mxvPRK<C>-R^HwkQhf<!x*co97v>1NKTtr(h%GU>t<kdO^pS;l@$+tsy%db
zorFzUy^*=P>{^Cdt|Fs;uRt)J#7y{Jd<?7Y&*YpthGOR5n1-(YT;^8-(ZLaX&&?|@
zKfvLq8{qzDOjoP5JHK8GPk8dL=<byZhTMd5Di8IHf7ba___-HN1(T6MdQF5FrEc&Y
zTR5MwAjm}dmW0a6-(|whz9IpQKg8a4Cmg=Vg<t=5q3UlodzSdV_uTVxBm6?~+O6n#
zOR~6Fyuni((MD=SNWLB^zKpjCJ>P}5cahHZm)Qt_NC7?dq!Pdh*7_npoxbpqza_7=
z&I`?9ns}QQfC@A@eFtV|5zpApZhqsgSb%rm4Q$&31<QBID++}EUV`V%CNL?#IbR`A
z-fXViP+}yKItm)}JKTx-nnz#|shF({niiKQkKxC8(iNH_U|JaMo;o4>X3gdT(CT3G
zvu#$a!>)b-Z-@2b*3GQLhsDL0f1Q@{bvpxEZTx@Ly{FUboEYo#V;{;#j~`&g0Q>{p
z+goNI{Co^o<m`-Rf;2p-)F#lDw}iOlq?pLbB@n}t=d`aW4kIVO@;_R8{`~95m*QF5
zf&}rwf(^feK{@_Nc$^q?q<JSR5wC<<Sa>{`;Lt=W{_2zwlsaHX91RncwiXMSI=&oe
zD(`Rs(9N{oy(=G-sc5Ho?M4<rpzkj!x7i_A4B&%PtyU)bS3G{U<mz!c>Cd=%RJqhN
zzQ&yQRn<ECKN+gMZ^MuXPPU)bF;#suy!jdpsj#e~*7Xu}s@&e*7Tm)C1%P0!5xlq&
zu<mU$m?$$9oMdL-`UpZn^oWRr$s$l>ai}lXh<R+qt74;q=xz(@{dx1H6kdBy_&aVn
zx+ai+LM~NdrJ-TM=iB3U$TUN;p$X|ympu7_7un*vn^PYslUF*!8((|Y+gx9Mzuw`z
zSr7lWw!k9#-)N<c|Ng{_I}FkEF{MI-#?e@45&`=uAd<OHHezVEaoN96wi$6XKC10A
ze(dl>UAYgnqdkQlufLP@22*y6HFRC|%SS-G#EK|N1!-v|&=;_bJom{kj57_B%V1(1
z@n&}q37Mgw4HJbW*{col<XTBQpHU%87<MlCT>k6&if{`aM*>$$_)QJ+W<6U5No6zP
z^RW_uhB-UU_h*P23H95&^zw|#DXsdjaDOWQ2^b=R3qpL6F*z1>LQ_@KLh7jWLD;F#
zh}&d(th3c%1S6{l;dul4<nl-k2IHuNZt`>h3Bl19K=CU>Hc8RD&$7{&HIKh?4LaLj
zI0e|{5a5Z^moo`NtP7=`aOFNBHr1hb&0&&4rG0vw8^>Xn<#gbsM-4I&-4-z?2ox07
zu^>+l(fW((Hvsn*-iG}1XBn#dy|+i!ywB$RMfm#4#mk$;^tSKUe|v8#(+~y+PKtzu
zQI@&zV?mpqQ1W}WpIr|X|GaZf@bPW4`ItRpcJf=@kcIlWuI{c~{jmd$QYp3WT)=t`
zLiPGwT;YkL6>=K@+yrkI0=3~GbyRt+cyA!U0Ksztd1T6!E1T=@*R!6N7s=P+H`n2R
zMk<Sop9IQoxx{tg2&?QLGSkZWOvw9c5_!u2p8vWAT^xu@zBByh3Rr<ul#Q&uYPvaN
zq-z6Khgvm|{>by+*B73bEmD1^WDk}VZJHxX8{X<bx&v_5pwkEn5%ah_d{LKuNq&Al
zYNvpg?@v++z=<5%hY4NX<Xkk_XgB>;U<_H24#Pb7t^iaaC(m;;rCA097I^p#Ny$6F
zT9Ov7GH*TZ&n8|r%-<pW_dB10&3QDMO?1RKT_t|a*df(qOxV;^FEbZ1l#BnH=oW_j
z%&V>NBGUIWDAJ5Tm<^u8;pKIn-R%?Pp>1Ch)q1=7(f3iB##ff{K(PoZM!T#R8f}O2
z=)eb;UhDr#upjk%1AAO3Gns>|srda3{NS2YeKs*&kP6Kdo_DK;T86ugRTN8S@SI&0
zt$R^Th+*FjGm$g8vmyoLZb5FsUG*#j8X5yI_2oeLf*9_cM>ArWJljwh94qvW^=AY%
z7*(8&VMv)2o_mK6Yr70c^XIYC(VTew3H(k8V#ro-Kv<3zYUg3<SN=nv9>DG2oo%5j
zNWfcnD;AD_YfMO0(VXSSp<87Pw}$yDG-Gre(4o&%GH4QgAx~RIl~5^mYY7>)*0v6;
zTwJ_f+)7HT#H?CL1t5N0dcc$*3C{#S58%O~xw6eey!=hV7q1g*8L!(t;g4!J+sB!x
zTRW^>9G~mo?CuPlpHwFIR%K_eTe>~{0^d_jDdoDuQL+55wQ2C3CX<TSgdQB@D*sJ`
zH(Qq9qwag-YoAZQpIN!*E&qGPs=_BGMMTxl>?jbh@3+yk;9%(tZr{mTnz48Wd-ycU
zm(d>OFJOYhwzHXYcEu|Z^C<hV$E0SA;ZIxSEj9Im1pJFAmFVyJ5TjdlZh;LFN;0{=
z8QlUc+%}L}0)^kRm%aA_{Pp+#r1UAm9$<emzQGt$^&7<$?!ox^9ZgIMlvi>&rW1WL
zB0$_<Qw*8prDlmE=t;QGZ3AkxgnI6GR%ZMmhjW6=6Q)@0$5IT(G8Q9+?fk&}_6d+A
zNKd>EvwBZ&K*O*PSdHiVbFN|5l7lO_9FdBN?oz*KLp=kRg!u-bhuiIWsPREEbD4m0
zp^!<4V~|}RRv{@<d;4#VPn5iogPS_nmIm#?NPIU0BiBZYKdaRbJ6pitT!sL2z|t0l
z$Mi(FZf{)gg+{od{h>zq_0aO^`qA%SUo;d6`@hzQ@=xy?Q|DGO?B+~rkW7a(#cD(5
zn`<9X_qT6k82a(05UWPB-#bi7q$&U%e`QD+_Tm0x=W>I^U7x>fkiR?&!F7ca^u%7F
z%`YVOIdO!oH7CUm%YvVZW(hslEiw)D-^C}2jnjjQT(nBrOj>b1g^|Xy7WO(atlSy1
z7t4i!Uj;MzkcSGsO0*I3bjvF|VPvs>xt?qO>|pNjfaB+_RQJ|s?Fy6Gm+MF-L*MGS
zvKT62$h!^Xd~Ca#U4+{5n>33}L+=4{9@uw8x1o*>Byvripri$c0n}u^4Ki+t!Q7wb
zZYO1vR=woaNgllydMXY_6$E_LP7nV7hU_=u@}E@x#BfPk=?JgoFh~$_Z4}^iL{sBa
z%IM34;>d<g#%h1ct{_Cy_b0ITC+OCX{;3n^s3t&y#oI4o{SwG~5d_$e6kbA5_Tz)H
zh8&e+;9{_&BEF{@N#;E#K0o3BYF`ug2s7F(;I*r2ndZj7nn9#0>u}pKWN6+R$jwTN
z>&hF)zZ+vbYV}2~yiaM*(9xu~*y1NvO-P_`kI9hVhdT2-wNo-AB0XNNWQC|Z-BBNf
zZFY!Arm93INLE|Vdr>ETR#o)F+IGc9Hc!|mL=h9o+ShSJ`F9@}FrQa3<ezGZ+->t<
z=XfBZV-tQkMX4BkBMyvgO2`5+n{nED{br)-1`aXwj8OL`OBr3cuU`@EaUz^UeDq9F
z<rz^Y*w%WPe07D#3JUTaK|k(zv@Cn%wH^d>MoTi9Wa6#1qiKaqbH{vg%Vb*j-nV{>
zKWcxwA-k%Vob>fu&9KTYB|2mPv~B23#7b7?;F#%{OTz7FP=_wv;m`s{@Rrfd&PPhI
zgGL)gh)LF?s4peE+wYs2s&{mCnu#|Q-s{?n3`Iq-GA2N{?BAdI>|D@-sgls&$dKpI
zpWw@woLLK}j?;th8j62OGRDE(eGhJPTWgXByqGDF8qD~{s{J^9c)@mma>*TODq}@e
zULkokIr}n6;@)>udhEeo|8xwKeP_?|>)FJ#j&H-P7<1o~S#JZT;_&P9nSseW4_R`3
zDM0>3E~1fdzQs-AQ$Le=JGH`T5I@SP_?UyY-x;HAlC@5MXv<g!ZO-oOG$~%Lhu>`M
ztY5tu*)F!0im<u7(7xF(zC8QY+}RZ<0*0F(EmRgGZwQL=Xs^9HRqUb9{kKU|hrh-A
zw$~Jq5aWJIMF!@U6d*(K2@w$saQ!qt3}`i=_-aPNx5krY5-D=#fB6qHdU}5INc>bh
z^aN;V1-<#Of>@gL*owazFt$1SwOqHJ{$*!ifLX2bZGD@2w{>EzfddVrB$K+r-Je0(
z!=O1kU;pt4j>E*>)0qaW9L#lYw31GN!|nW=wv0{C4x)r>HAqf&uFfC!$^jf{S}`$*
zwGAzMTiqlu>cbgDpFj;Js+hLWoPfAMQ9H<d!`&s?6oGXY1199$dwM|cr~`U_gdG7r
z_lnIM+1Jh-6&o&*g3W(&i8iQ?KcZG%b=BV+Nkoem7u$F&X0_Ajf(?hik;L%4!`@YV
z#jvmbCSHBZ-nny@eE7uD?Ma|`#n_3Z*7<+SNjee_LZg1iiM+=ODRPI6EM3FmvmmXi
zwf{1#m6|eBsC2k)M{4xTH}&6ls;-NqR{qLx^|Sw(gIz*`U~$<uV+dRP$N6cj>w?_v
z3=&E`CCylGl?lW$bM#MGF++O_5v!9t-yg`dE-AYAkrUgocx;A_0FzPz$S|&dXqAh?
zj>$4PMOOQN9G!<hmH+$4k*vfq%CX|uN5Y}(&~dC2iIT`(C)s-*n~Y=ctjt0vvK=~~
zI984%gp90XAA67A{r#Ok;5_cfIrn>9*Y$cmUvMoPjIs-X+)QKxSJ%%Nuba{1fK&+#
zpn>Jzq+IYXP}4CRpD5?-;eEouR#HjRc(Nj_r+mJe1h^jfNv9KEF*7<<03OA-(11%%
zD6PG8rSKv8_x<mdEJoKgnfTcsD|f}-h8C~p>#_3YEBiN3y9`V?wTA?GogL21KZPv+
zkXwTa#=bF05a3-dOYJqdZ(nbA&uE+&Q<@I9g@vcnkwxS97Iep@S!d3`Q1v84c&t|J
zjYTAQ3Y7*Ww)@Tq-%fFS2nVS6q8bo-ii)8BY{U3$^4x8|nPY@uf(WOn)3voXXzxdT
z-Il!mxMcF)_BT^SRZVCtcWWlUZA+XonU$OJ%MW|-4b?yNa%rhI?%B?ZP(F6>?Tmy9
zqG*_+Y*TL}I<dJVKvd}?L-SZt50u~i;hf^U=JX-@$xNUP73sp|{6Cu3@&qUsm)LGy
zKyXKU>&$Om9@WM%ejKOk-@uclzy;di^PM4@`F}eX@#~wTqqpiRp6BqU8@R8cOSM>m
zSIb(ASD#LG<`k4?*XT=dXRx?BeKmW$#;H0zF@YNUM0UE8XTN<|6+e60)_GX%J9|8A
z5hNke74-FJXGr;Cm{Ga8)y?2r!c@IWXn9ggI<FK9U+KpTR`^XBs99)qwh}dSc-VU#
zQNGCpRUhw+X`Yy0ehQ3Z-WMECr#nJiUu1r9%o-}pxA+qRK*Kv*+mE-JIx|tmmdZnv
z!XZI!+dFK9+67<3i)L-@WO83P+kjxLVAJQwBn|$1YPmXe?*1(>HCciNseLD7_IR|@
zeccj>8a_^{sqlsts025+1W|DbrS)A}TiCVy3Q$(m>T=Ri7GU*9eWHz}ecr;Ltf9#3
z(HCWFDw5&&#oSCe<ow%B{Mq*Y>PY(Brf<h7Fi5XY76H)I@){I6+02n<7K*$1V@X<F
zz08~Qrlv9OO>1ziyrikd;A5{U<Cyo4KF&nbr9h_@2SP>4b^7L<=n*hJjlSc=j}I&H
zDWM>_ELbY5iCee4MfD3vWU<I@yAFhk^Jz>_p78y)5qTn4$42S-U!%kM<V!fBH?|1n
zPPCl=mWujexeZgeD~LcY`rK|}d;bp<{+pgGLUTk@4-_jco=i<fXxSD&S&>WjREuo>
zYdVy~;Is|<`6P_R6fsAeOsfN8iI3rXM9+HddNf}%ITX^pn0AzDJx7DwUL7WX>ZZmM
z!Ou4p$P<KFLGP!W27jEwXOq#GtWz$U&WTViV8~0mB2^iF2s7x@LN#)N4p(q&g&}qA
zt(MUAIIB$R*&CEkV5c$ZazyXx8u6@Q#q}TMo79{c;-!mW%mN0z@5Vrq)eS$qaw=w8
z;)zK+yZ2SlryoL&+x+F(hmJ7bOi_e*?(Yp^16f<soxUUn)n;=u)4Y6{sWN7IChQSw
z2{Rw%?1BA#j-0W6Opli0b+D!-MakRtkIXF2B!+sp2e#d$%Bd7@jNxj2ill{9>KCt+
zB{K<LN5VYlG3XQX(Rbv^r}MbA)BZ!Xa(%L{6)+0fJ9;p>>oMVbvkMeK<YM~vG*8DK
z(%eDvHe8h&c-pEO3we|dmlVpLvk-6oeT2@mQ!M#iW7yq+*w-XQfxh|iWg7f3TR`Tw
zf%d{VZCcBt(gjd<H3RJ;b?yK9HQx5J$AKK&g57=w);^v%yxd(o3A8{j@m!V6=IP??
zVA4;n<|IN+dqU2!y3=Mgjnj<;Tl2+*83lY=BpcNWKDuFbJp*^dXaoMR<Hy`)lliR0
zb0E_K*y48Q@|(8Ca|fwaRvC}xI!``yUL@4EpG@e5aQy&E+<@RqED1d;9I%;iwmzA7
z#K5C0U#n|ocrx=Z#l47g5^Uq@qyrn0x@U-yqH1zHlgzY33PhUSIE#|M&O+um)ge~b
zxAFAu?Ps5Tngh?q0$tl@s$UF_b}x1Bp3PqUlepOR-TK?w_NkUf`E+B@bw+NokR*XO
z?88vgDTjj-9@9~#`rje@DUYHeVu#9r7~E&r3G+e~)MD=7XuW134@vKAd3R%;i<e0~
zV@X)nm2kM+n#bXbQy*6Ru;)aYi+oI;-xv4yCK{<NnWG)X`qpLIxrUOeG}v<|nWpTy
z8dgeND@K-q5&Ve61);{7YVo$r^{0%t{!vH#$)c6iqKVaUjW6yuEc;rZqhV?f)1dS{
zBivmd&DhglGF0a9B+q*!UdA0@86<ph;jz~%NWn&zLN2^ed{aY&JxpA@25e)O!NXku
zyneM=cZn1N`!hsj+1#&0#7^=3o&T5ye9Lb_{;OHrg@d>#qVna#9z&p;KjUddqFK>M
zs6#%RdXcvVV)`f3yyf(pw#v6#YXOEw<ScS*RU0bm&DY9`NL_ClOvPIWyGjyX|DFX|
z(JqKl@^xv&UenlyUWbD);j*a^HTvPrI4YAqoyU>c;j(JuM`*7`2M+0dgVnmc=Hy8L
z!9S*HAex4Rg@TxgO3xI^evc-w=Pgn&^^~l7DJ+p@3el(kESzg3koTm?aff}cO2Iag
z=<zY{sjq4%9oJUESL|x_HF151!k@zPa2g04lWhr(PA`7(W?Y!Vu={f6tE*8{B3s67
z3V4OO_?P5QKmYT275imcyz_XXr!Zvq-@&MZhlWRbo-irDft4TRt_n%NQ2=S0At|Zn
zNsG%pr4SktA6K4pBGJ6O{ZdA;z0Y=R^5X!l(Ftz2@87?o-^MTwU3*WUI&b)+vac*h
zY60y{wEq|=yxfma0Ycw_(R~rfAZ0HiBFFb)b?*aei15yNJ<kv>asn5xPQQa$J?r?S
zai*!6H-P)YYQXnVgN65fdb$C87tqu@YAm>Ct~NTd6V(e8QF%>y(#70P%z2)@PqiVD
zVgpQU)>8RP>JFz?;OGh4prD|a8S>qdoEcMtb?ax{myaIg1nsUyB&lHg>B{QP=lk0)
zGTLg}gT~KrM-Se9HWuf(+`zTDc3f1u2Jfw%*G)GD?p+MFmUZRdz|cZ&sol2T#!=FR
zOD6_B$F#c8D4+LB1TVY}iM%hlViCN0Xzzb8F?5Ii)$!)+`SR>}hQ-DU;=%5kn|qM|
zm!R#HiP!h#JG@ac7COs;Q#IJ;4(1lWgM+L@myLA_ws?az$$dv8zQsPIR^bni1Fa$6
z^PW_nRG&QFJ;x}cd{M+0`iQPy;OYG|eIdW%Il6lh52k%Q_f{6i`VxlyO3N}$A{V0;
zM-y+pOi(#rNjsViF<>qJgr9QW4EphW%=emVs%h8UGx|I$I%T6Dxrbx_W>hY#J0H88
z{Y&Zy*?Vn0xo&U+u>O7qPMg4dyRoR&t#goPzL8ybN;k--Be}yt5Y?wh=VEG`3ds7M
z+FG4n5S`KGh~E@O19#*8an2r3zH;rXpLS^r)*=%fdK%Y!c1Qabv>P0`2&Z$@jdM}B
zb1Ua#lOy4M?^2M=Bji+o%_i^lLcN|mO;W=1$$+LwC$G#5L*wxWS#@G}tM~F9#Yz!O
zUkTMogr01l|J(^t0;<FfCz<@g^091yu8XrPShAON(zK4V8t05zRdJB%ucIXE;9RA{
z$?HL6oEO4JbL{E!_uQ!~_~zguMb=uTF~ffEQ2rPg6|*UYBxmpG@#4e;HBSNOdQV!#
zfwo%;pOAIL7YH+-r#R^I$)%NX!Y=~V_h!#v*@~OEYk}lI&{Ljtb$Y7UAM$5f!~6(n
z_9DnevfOv<(7DajTqW>u<8(JQMyfjH3wWWiBB8+qg+wVMh)QHO$Mf@dXxhD@`UOi1
zeYOg(($xi(1Fonsk5U}nzRyuXUZyzWzqmB9`U;9s{-M2}%tG-Df(KcL_A;?7#JUOd
zX%??Uu(yIAx?ymSB;|!xZwfKP>nO#AbnYax<q7!TNmC7--pDtQjCRj3u!Mp_XT9aD
z<6vlqHN-bFSuI{oD$^?K`UlE&C-WkJTrd7jrAB;=shz^W<1A+6194A5f#0u?KnK+r
zCpYx<xv|Sz@~27x`v|`Mw|n{!@gUBiaoKfn$z}{63k{S!O(}BDl$We5J*lDz4^F!k
zPA-Mhuk6@lmO@|%C8}ktC0Dj>e~S#j#CM*!<^~@WeZt?zeHrQBv_8@UA&>1Za%N^{
zRTTdEs*z5`k$8hQ>-a#GT%9No>H}NE!Kjvt0_xfJ9UWI)*IU2pm(-iu3ldR-zb*~;
zdS*`#B`&{ro;B(2)m|R!g(PSH*QKd`iz%;OJm9~42N?}p`ag#CH^m9~vgO?=i!;2>
zLDUzamo8I-?V%PYZ%OC#O`Y!O!|aVYv#UAWHO|*x<UT{1S@lH-ypfjElJ9<i_2|D}
z7BA-Mzgb6m9R!$Qq}acI9;VkE712OKZmW9-``^}8l5h21czw9iS5iLlgqXJa+QZ+!
z##>220qWJ*-s&=z3v7nDPxw|oh3kYpr3FLcl^0v(uu5qd9`29$(m{I`evn4-M`_wv
z>(9`#_TJdfwM_t>uJ|bcot_O|y~Hig>zn)04G!Z<XH4I|&QFu*E$S`%>2GfJOKrr1
zb<}pA<+#YmK)O0=F8=|&WvRaxtyz5IFrBGnXyQ{_cF<5goaqL=p)FL1)S3w$EZv6u
znJY^ttJst=8JM_FnmnD~w=%YUdsYHR<!%PFIhBo-gnK(<9k92lTgqi;{YisOv;K$Y
zJ3zaUDO|L2$8XX_Hge9FRSwQa2bCv!WlB@vZ7FWExK#+ik+{H4lWLHqa{fJu+7wkO
z<M9So8$ln=i03ax{ge)2PEAwO3Gni->8S?HaFMdobkTuy5KP0;v_i)%gBd1N`jhNO
zi{!q&TQm&Td>PPim=Y8tQ;ri_oKtdIhxl<AEz~%Ks&4-cw2;+6`UH77e#m$v?)&C|
z8~M^L#ef2DPU9X5Auk07J%^WChB8aN2bqkh^T>T)37Ty>XnfSQ>ZQz)5$;LE?m)1i
z4gwX1(LpH2>58+)DWS6Gw*G6>#J~TB`{uVrG?=4o^GXmDB;&YLN%`?W;WD^&vLrb<
zjF(r35_2QPZ+<TJOa9g$#X=D}N-6|mCJ@qW(DuzYUDZ;I*`16b4~`+Qu(3;Ri<|tp
zsg{ur(Qv(|t*XUE#w619`FkLO*H%$)v*yzs_<Kr9K<@T?v)gBsl5<(Ohv6p^%aYdX
zn;1b=681Ozb!^@`Uk^>B4x1f^Pq$*?H%5lUnX@%n<<sqm4|-38GwgpHZ2p?EQWBRl
z>J@y7QH2SzwLj3%XfdrJH#SeK-Vu!eg*Q;;B#3w!OHr=h6Czv}4hLUjQo~*E;r^|O
zgn}6%k_2BTlVUS+7N3_xoU$%XO%M1)1>ZKh6KE4LxYGb_#KMl;Kpiows+B#6m+ies
z&$k~Fs|WR(sM^k;{jI6m#o}haeT?9knVALGoteOsYQ?j?qw8vAEidqjWS`YsBZga2
z^EMGYIiDs2*p(89C0V4IHlSJb{okjlW0kY-Dna|({@vSmYdh+|Y{VfwrttK6+{jRQ
zV9&yYmz&Gf!NhA*H}8hOs&G;XbAZB~Yh*^}mhOvz7Q5}{uBNZ_gwyn4yE1=jIFov~
z&b8dvH%ki9lw2-<6<W~ke#dho5(U9uWUI;*o_#4?JUKtqm#vb@@n@lZHr@1L=#H*<
zyeoPyzl8G!=g7~))OGCYBST%2Hbc=N&s#L6^sGv12y$khyk8*eYh+8=%`4;UZ?m!r
z8K%n;x!Pa4X09J(#xy5G{~H};c6)Yv;bi5#Bem-_zC8#NYBbxOFzNk}Gs$3|P4CX3
z?&cKLhMSLn?4*!ZY<AMexG&cO8_byBu!=JC=r9sil<LL1z``Rb21*itW=d_dJC67F
z^i<CK204X0w>MpBz0eou!YY?LX(&Bv5=B{BTCV@$7VdHFL%;pkZ6@~)KS*GAPwP=h
z5;bFiBd~rkKO(>+kiz>;R8ZPR=taWa;24<T=dNTCj;U*Jp73_vkQF4F#^rg6Q*OOZ
z`(N;^={9<{_C?jwFCC3@d;+KHV%`XxBAKVx4Flt2^Y~$y0=vf~2T6lJt|)tokb8M`
zzA?Wy#KU=`Hw+vAM_^+8hvKafI!q&4ViNrqZ-O*G7Jod{OZ3VS)Y_En0%rvLyU8D}
zvziZ0VkVE|W|UP|gg*Gmz{f07&RX15!^mLmA?_vwNXNwQR+qu>EjWcC`616(fNa7H
z(f>OrP9Bm-fJFQ2b8~Uos#{gFE%5mg!jeql;M&D2pW+GEEaMzxd-(Y%1r|k;!J;*h
zAjR)?G!UVlSZzVDV03dl#DfrJ%N4^kfg_WG2t-gq$OSWFz|qNhzR<E#!DabttWYbj
zJZW6YCgOdph#(mit*<kI``z8A#mQvakMs0|*-%5urxlkOoIRR7vNgHl<c4X#<VfvC
zQOl;$bJkr-Lz|Yq+C%BT=02q}w={bm+4a?JwqDKw-BrTI&_Lxor-+L6;1JjTFcRg!
zqnP};Sa<SX>(cVo#@vK4dCdYxT!#5*eq3zFS5fy!Es39=2K_p;aZrWMHr%+$E4Cnd
zajKNAE1vMe#}zTX@;%80nAq^S)}O{`biN%sBr==kPkDu`?mGfXe0##HNZ?`c_PNB>
z?)iM*i3FOs*(RI#QV0Ksx-j_9*x+Uww#fo}#-?%^gDTG(WHEwiM?a!{f=Rt5K(h$(
zWB5nt!_{6LTsi#_PxBoI#HUFG63CPI*~{*<ll$z_oJj>rfu={dBN0$U=A&X&UPGCj
zdx=y3j#uW-cjL%a<eUBdy`#uod1eQUPtuOA>SllU^Z+OInvrY%-{y|iR=J1IkV^_}
z?YDEw0Rtv@xNXO8zq%HCwD?c6kJBx`w0QA-I@eO5x_-Hc<PMQ73s?jrm65VD!41IG
zbs)acnKTo;y2m+`0Gny;Q(|OltuaF0cdjl2%IrLt%@0ZX*uTRmK^F~eH0UXFC)p1d
z%jcK5uBD*CJsEwG%JY@u@}!rtY9l#foPuN-Y`uQ7N3l=s6y%a(*okBNCNUA+Ub<WJ
zt7_6-qH2$asW_SYgOsLoQHHA`rz@0F;$=Ujx?*S+^l|b-9$%(SZ%+H5w^EPP&<(PK
zlsEP61T~wOGciSKc#Qv^I`B~oe)$9M>oPmE>mf4O$S$Mn=tNeINuq!V3gB~|E5>kZ
ziVOP2l7Zy-D9RA&AUQU0c$ShQz_op+^bGTot+i6*8CXfOC<F8#xc=GQA^UnOaJrPD
z*W+1l^z19!nF&kh0+cb}MAp=N;<w)y^>ymRLn!nH!IokY8X-?zA-!;oZ>ZjB#79k<
z#?Wa^H)kn)Pt`%`&TQbSUG-kMBh#=VPxvg(-AB+G@fUJ-$zmb`%!la4K7YI3#fpK^
zKLvV{u8Obh{f%FEG$ka!j(^J7w>bDj8fPp4vp5?XXct?L2N_3F4-DV2S!X)kfeutI
zl#qSJ$9!O4)j-Iw*6Qm9J!E2ST}hZIvjT<Hn^9v}^!b=uf`?Tt5vnGh5BqO<WHO^^
zg=HWf9yArHQhq~Gapdl@)LLZek`xgFyeBJZv|-G|^Xtbn-3%jS5Ce>&{fC>1cV18G
zOM|bqNLQrDzf3o43fk}1D+~%=$M?;@&a|j*v}_Wy!m}g8Xk_>(=x`h;a^5sLuwW#J
zLcO<teyqBUgx;J|Qw%z+FEqDkYI6B;xU88wh>z;!y^c(UKqM<z7vM;y;?3xT0JM9s
zVM2Mya11jZk^Gvd@dUa_DMcGY`vki6SsPX^ah4cqF<C$!s$KM)ip=y4&c<xq&iJ-*
zG$ys)tbXh4#TSD&kDw>4Q$?gR<+9TItakn<`@c-hQOvx!P5yI7i;yF>&V!q=t82S0
z>>Q*`$xkHgVTNnSQT|YY@~5}tZa?37rri7&g(+YvO^<fr-f)u}?cA<za^ZfWe6c7|
zsB*G#I)BoK+u#JE9%gb$E=C8E`>kTJOIX>x@BC(lI>==-nHOa3lidF%P(cTaI};NN
z_2U-7cNd~y8v5StA38yW&s*DDLOjm4-C%cg8?x<#+RR>!Oe?(Ok-+;uU{*Lg|97ps
zyY`}A0=sW<^}X<X^lbKQK_zg1Tf5%0V|S9XY3pyINaNH$4{XOD7w(AApC@w$tR`iw
zDT20&OB^p{Dd&|H21mCzY<oV@!kEce+Fjd|bsRQM8$7)Yk!6T!8RhE;1i>q1Ni^P+
zVyNzu(jOHo({3<}q<DrW;WU}pD)!j%)GYkoqct72RA_uf!!@_CJfo66FZb-Ea&o`8
z6@G}Gfk!dT@NI<;U;@uWz;EH=Z1YaTQo(d%x-~>vz74AYc=3Y3R157I=2~Cq-naa*
z5R0K{>5X^aui-H%sw@USCJzROhV{#RNdF58nxoH|TXf>XFr~z&n|IBz^YeW2R6<+>
zM_O{pk$Iy_C^xbT6ahg{humbK3P*xa$(Jz`H|0A?@^gSLGLhdjgTF|C$tU8dg9pQJ
zYpgGY&r3qu>ClNk@aS-!H?<OQ3Hou1|GygHeBZOcc+<ymVKJunFMje~W7CO?1qqdS
zXr?!fm9v8D<}SqfjwqhsACYU|BV<{_XqX_;Ae)%jy7s3EoCzONcWTxHrsUbskziF~
zs%Kbp+h94ju25NI^V#lc2PtY%Sh%N0_^olxa|w9dIh%zFI6))tvkQmHOI&I4JD5;Z
zy1|AhT^>-9+3I+Re|?H9U$mx!ORA=(>I&QRO%Qy=Gg6UQ(4<FLjIsdamSh3V_Twu>
zJ|r$mwJ#Y4*UAoOj3)n*F1g8kL%BOYGc$WmB79dhH1?XLPI#DfHFK={+L`mzr=#2T
zioULN<VI{n5Wh{f^)A6vJnAV<(}sS5mr_ljjFMc&d*q<JSA&|mhx+X8z`*+6$TNbm
zaVBzg<r%Vzk_Ap76^bCk1tL1yw$;1d-0!awi+ufwAJ62L#c60jp=PV&&@HbP4HF^*
zYKjV8K}YVnnqh>0fwp-25iI4X!-a!%5zr8@yYla3qC)l>MHy(a{Ceb$R~{JvoNb7>
zRx{@9iXAuM;t`(-xL9_*JgvPPo4p$JH4i!2o%aGvz^wr!w|~z*>B<`apy;Zvs)uCL
z(8_@xVPa`wezsb*IY^U-EM#?@PF=NGGz~7Dp6(>gTwVSgubu5Y!(SK;HuAh#;I1CK
zx5`JGA8Bb2Hb-mu+1w45qbr^7J^j>GR&Dm)@?J><nt|ScBP%MB)hVP|C0Dn9Js!n|
zO44aUTDdjafrJ+7#OMUx4H11we@6_=&GV;Q{Q*6hxmt1kNW4}BS3;oU)ozap`YHkl
z7FOh^O7r(|Yt9}LRxpacxbS`!ayY?eq2zCR6dl@}jzqy@rYj%26FE{0M0F~rPaVQ)
z|8`nUWo%{weOBJ`BI$*`=cpEOWImBLhcP9lq+et2I_(xMA`@jdysw6euH%3Z;X9Ol
z%~n|R>f8)(pJ}I0P2bdwbv5@cir>BeIrae;0C|q=q7m`ac|`6~Bd!9B^33YRSaUP|
zQ~L7M>hMQubOq|~)1wLI7WZV=eV#w*IBal5A1QWrA%guI=#}qqaVJ*Aei@S=lFu?F
zn<G?iVQ<XvU&9-RFLwTRJ^}Ly;AxF_XPBaPK6Yi-h)cY!A-0*_c$(<|u|sM*J}d-o
zTyZcTGo$f_Icu3*I}>SqfAOEGsaz7ts08|~lJmzwz|_}jZ!5PjvXuJKH=Y6RHC{do
z_?zp%I#EK=9FaQj=aSe)j}P+$WnHF?xd<+^*n_d$+7rwCb^CgE{Yu>Z$f8fX&h^0j
zo4{_{B}W$vjRxsvLc7DH=fLa;tvd!<P@%Y)K*Uod70+6$P;sAaDj%qb+i8k{K!r%`
z4J#Ux7u*Px-B1<M;kAJZ;^p|v%*?&ffuybJEb~^Q+w56&pOE<EtNvF_V2=?-^f)bE
zo(Myb)c9i3ed_Ia|6}zPkidbZJY0CS)GNv?F;)ern9$hfWTb=mb2ud-gFq%JWMF(d
z3?65o{SA>GIoAucYJ_mANY%LHaLaEZkn37Zw8_kTs2HRpJ_RNamrVg@#>hPmtmm?N
z$_(0AT`g%emareG{IU7-Eui&Dq=<nUzpg;j(1sIkQ3%q7F6K*Pk7OoimRjZH6`%uk
z>yv}_6Zh{)eXL9kjeHLG;GrN}=*{2TTQx7Z1uO61F(A9={eUA$SQ?1wLm)%nf1L*w
zFP@#~g!&FAgM#_gd8~t&sL6}PM)F`p(->%^o5unbvAtsbgWjFm%&fgtKjlJs>HAXw
zQaLY5Dp%X$*VmoLT}?c_xs!);U9qRW!3##62Mx9RgQGkbZ)ef_6PnQ0ixPF23XS@{
z#@eidH|^OUMFWGq$69Cfb+lw63E7A_(@Cc>`nmDorLB;irmMa2EuMmh7aKd@lk^Hh
zU^R8F?R#6zBItEGLv2In09g>Dsk&{KI)*m62Z51>s?#vQo(QQMSDpkZ<r>06)87jS
zjz3*txIOCiNyqo${@uhz(UZ+r)UZEwVnQSCG!;Lp`uxUjK1`b*UJ%wRRGQ7@={Pu4
z^f!JOaJZqVa<MYJS6^?}w8|?W(sNpN=F5<DdnR{*Qxl&%q<pn8LTy1$VEL~4EfV<s
zvV3&WNK7ciJ%+|7`+0Zu0#?fA-H6lkgn^x5T%V;<8pU-~YROzACRvkJsBA2dG1Nc+
zAGof@_uN!#_>ddIH7!@Lq1#q8CF4Eii*Mbr_3>CISYJiP{t(pZVuql?nd(>{u<=*l
zB71pPMC7`9`F&JWa#ZrnyAGFg(8e6LsIhT;{DJ=A<Xuwx*{JK_VPYU^w>bOB2X%eE
zx(?1$7uDkS-Uwer7nqVHa>|`%fl?rcMVm^hT2f@p!`(^u)Kxe#a#F{@sGFq%WuME5
zc`V_cE-1B=-7o(|Tg_n-dTc0HS`*1L7gBV;vPUoZ1O}tg4JM2;)T-;;SyD{q660)a
z-YKXim+56p?RZtm_q3y#v*jRnkO9XKF+M_Ff5|Rqb2Fi7stO#9y$~H}*)z+mf0J$@
zQCpj3gg*>@B>9w?i2}~b1>#TD>r)sHR6)4HJtP7!DL%Hf*~P2|6+h@3*IOI8^O98O
z)aYR_R+_(lC`^0`h+VRPISTZQ4xb&oLad)~tnFwI`Akh8X^TWfe(MYlTtmk|9P+QR
zRq3MLu}%rET-I9G&v5KSv`%a&8O;QNgOo=!c!Foasc(~qX+vx<kujJv&{>D?%(X{C
zo_tRgZb0#@Wz4-$0b$Cn*I3SC9?I`JNF2Kws99Q4GEp%ZV{6K5qj)YLK%u22BLAkk
zff<rB=rh`Q)8>zt^Ym}v*q6Xw_~hIgGZ9*}l`>Qa{3582=}nN*#kE*%<6Ci(_^*WI
zcyH`rT+r1quT_B0>DSG75f^IJ4SP@A2+7xpQi4M2eM~yznf?$k&*_Zuwch?>t^_2s
zG?fd=tPYK0<q8dD)|{uIf8=I~fc;_R1K8Oy%n(DnnmYQ>b){z}7N(|tr0Ybpw#}(c
z9B$?^2-r#ZzwIQju#Eunn({62n#ny+-pJZc->a=^{_gLmr}r6d3MsPRGWarZU_bSh
zk>_FMRO83~?2it)xEAMW<18`(0S4M#u^|DT)8(bM)2s8@^DNhnfFoRw3bw=V^wJ{e
zYHX)3w-y_GwD_XF@;V*y+OyVogIqRy7ZH)P>{O_*7^bHf+{xgZ>p%?s=!{b(rDLO`
zYr>0m*Cr$`Nao#>_;T!4+oo4~LM44zo~LWb()6m6)u%$j?cP83ud+)1YxcP>zNf^a
zhw?Wz7a!*d+1akA)>Fvp-+4*nwC2`sae=SBSOXrQ-MHGixSb<pdssMR7gb0R@kXi+
zFO8S~QZoVfT986z|M;na60|Nl*tNb`9A5Z-F<hO-Lg)&r)8kz$w}Ia+tFP<tPkHVy
z;04hjAj<ot*bIdD$|8UFD-u7An0#Q(^Avp+cy=SB>cGbn-H>;Wf%Mnk?*6p2GCL<f
z4KmNOJLMTBuW0cv1DfvNwp)q_P1rD1jJ^j`5QoWv6Nlbm?CL9D^ApaHb=i=0p7Rom
zi-g%`^pUdFn%NQdf8Dr~G!?PO7l*H0yKM^}26DCMU^MMl;F9zPbcvyq#NHGUg#|c<
zweKw1+PW7M!+(RIS*WqJvYe1>@NsY81~L5UyT@S|MO3ZPK-KzV8w?0eqs);Yo&P}h
znJhPvf^2;1uy3M!$pc$Gg=+<~uu*_cgSB7@J!y4fplb`?<Qde)8}px^6E<HFd>DCx
z?VYMv17;_Ro^*_Jumz5sIMqd@5r`vVL+OM{egCuNgo|#tmWC=lZ0Nuq>p{3qDrUqf
zB5BFwSjMOlrB45hK4jMEk*=;QlAZZeBs(m8?-p63vn+kI$aN$H5z2Nt11|PeKA!tj
z-88lH`uw!2_73;P-HNZN;RB64$?lhj!`U~kV?uTo`+6*tUis*P;ClA&_Xyo~)AyRD
z8&_L#!gD%rvY6A1ji1E$jWdMD>MWJ>L_RfuBJSIN9+QgBVWseM6KG~OAWLPGDQ1hy
z*1Gs?2aZyWri5tllsv`>I$q<|6l&KSqvA`{VgC2?CdQrjD_#|2@EV~^KSnv^{YWPf
z6$sDLow}Rhxd=zey39}#xVl5V%xd{=7>i3|Y9>V98>f`)l!!4xC}}1{hVb%sAFJB)
zUM#G>UU{o>Ho~(th%#{;IY7o~XHGR*L2S7sk1Z1ry<TI!7o**VuAk;!+9?@jJIdc-
zd&mFuN5*zzp>7YwqsKz>HlSP7gyF!wjeV%i^F?`B9IYyyZ5}8A2E`Ng?o?-HQO7$7
z{q)&<Ewh%_;?j8HCF*^$PzW@0A%Eq<o6Hse%~fKY#S4QEcar}5*?zjqO|^~FQ|bTh
z)vzW)rqR)AvN?3PH660L7Ub>Uq45jXTXYcq^ijM2{gdj>Bgd=Jt4kj9{CsmIv`qh=
zPYZ;_^`6U&Vr!ue^S7`Pev2~(X_@?_GDHmIU5A*|J#{aa^sI%tIC0DXl2=bzs#yC$
zrN>Q}R_t5h9?IeDU<L6iK7dZsUVRqmYhf$~;BWAnU*y{VL0#IMUx-@bCk{pr_I8|r
za<<l2`SM@k#dfXovDo`JoJLEAO_hD$YlDySvs?<C2omP#)rN`7>LZoo3C7_45x^+0
zzK&0fgS)#QF79Ro{=bJfE##c>ax6%!Y5aq8{jI-tbg^*y&nDvX&qh{@yt}dw$v-8D
z|Fmu8P1i;B@7UhYH@C>AM$wgtv~I4oK79krx6)FR#Z(z+PainPx!<qZmEuXzu#<1|
zUw1KnBAX9k73DNeG8M&_Ceg|ZQ%(PD1II|)(A&W2)ML{LpJ-8RM#^72TET;i7XEux
zuIP*0w2O-|#=Vl9I~6L&fG;QH3P|5Qy4oEY{CtWZpY6EXbuL?pA5!`I3S)gALf=;0
z$tpJVfb9oIN#riUCLGR|L+Fce$baxfREV`@GvWbcpz?o%^LJpL+!-+2yAC^pAIr~F
z-@H4pY^_;8t!W|%QXu~2Su{<TuTBCkuly#+u|P}z^YWI-T-|u3Bf@fyf|9Z-RZ^ky
zOV_LsfA4kMS^BEcg9=L@sZ0|;k9^KI_g<ElT4G=_g_{YLUp#Rf!p*(ArczYt$v$FN
zD^5QZ*i1cYD915&5Gf+$W%lxjZSi_OS;hc7R7?DkR;Z3g0vR3<zGT{|>$?%AI<9H>
zXR_!|$r!|$_SaO58%>?qo+li2_()FGW0$&$6EH97yCOl@_#{0ZW&asxE?|Z~17Hs4
zErJ#lXRq5rak~L%w6`}JeX=+l!KiXPHylxzuN=_PBr9=^(1YyLk%UC`OP7^#L^H@g
zGmz?fPeHbED3tCu?hR@Alx(n*9qt(hKruH(B0v_+F0id+Y&zcwYs}M1jAu(*q`p){
zI*p|f*VnOtp=@i@TX=@=pclEGq>}nopuvtoQM+RIyt9Yiu2T<`D|TG`8tfAw+oc@o
z^W%NfIN0biZMjVS*4WrG^8uky!sz?hG?1x$&@>}HQ0KV0I<Zu~dPGd?^BQ)k4Z~S~
znHy#_%SDMEv&K@Y8rm8NDS9RG1nZ09-PhDULnE~!>c6qm1t0FaYkd(L*l9LMCB0D_
zYc{CTfeOkO$H1rx;aZT$;n(};t0M;i>}f2;q62(XP396|YUZp!50I3R%%#NN?EO_v
zc_L(g8`Wqwt29GQp9#5oyYL2(VNNf#h8&+r+wSiU_#O%Ep^^&j=ld@#WfiKt$~S8;
zb&M)@8S6T^c=dMnWOAx%<U{V>o@wdl76N(4Swn5YL396Z;|zt3f7$RJP!hQ4@eCd6
zmDgXl5zVreRNL0}BrxaLCx5%2#>;-~b~v#YtS0FH!qywxSCuF2+WM|rvT&%a9C)nN
z!B=mT6t}x-YK_SGJ!rl(0l^moioRPLJlyErZq(HdW5_mO=w3OmL~$iCCcf?9r{3dw
za>zIveBeDbI-WHyToQHLzurY={36J-Ik{DL5FB)nurO}X@@iMoiD2I8>qh#YpY^nl
zTIC#<q;mE5uL9mRcyl_i>4{Jjg=>>p(|6a3PrY%bGzoAFUZMPJM@L?QC?s<I6{PE*
z6Gd_+@q=o6e|^!W95Ij9^}ElMKpo7$SeH@)4oBwk@iVeQVKnJvH1Z2=pV_0*!+nEI
zGSKzj1nS75&FUM0dnXCGzDG%}cHPZQTN}GST3vkPDvPP?KNuF!Hv4;R-<Um}+-Nx4
zNK1+iZj1XKBvZ0T`JPqjC16IvI9AJB7J2e5e#7b|f9|C#d)~B46UrQrH8wTb4PWZ+
ztIq8bv=JMyOVI|1$NpGD-Dw9_kw_3-%SOV~nDfYe{7Fqx?;l$w(E$%wKCAk$uPzcg
zz{>Q%Y;R-3m?n%ik!#J~P%9fy?|uQI+V4>ANfFhR`*-s^*_nA&cOhGormDc*7aqyR
zum`rGOQDe?!f8l0vqxGwj=Hf&YJn4`{zRXSh7~2Y@EE?$m1m#7(`<Oi<$1E2ia6-#
zeIe%E6>o<L3As)?$poCtTxdV2s7$fsV!BR*Xh0uiA(c8z3oLw2D1#TKW{)K<ajxji
z+KXbnjgg_wmmA!19$taL$M`lA?ct__G)=}rW&iE}sgu4BDf|2Qpd|}4<9u}oQVRxq
zhL23>Ady*0l<aV~h%XV<$mv|jf4uwIH*9Go-J=nq=`q&fY-=!`7)os-a!o9fEYx4W
zJbkh;0fr=3jFO%GLjLQ<hry+KJ2O`UWUj6Xds1DUiMh*=UREJ`*R6wVx&9(;s&>5E
zxYi^m%YJ3O!xJsbkzgLMkYHbbalD|Xa=C#@JDI7@+QJ_E8pv%$Z%>pAd|;Dx`Fpx#
zaW=Smz8!K5pe$b3E1PVT{G{chlh1|-Afa6d7&Grc12Y|5CwKI;L{Ay`&_fx%tJ1d>
z33v55alj?<T~;ELEXKFtZet3ZbOm<rUoJvR!LekL6hZ;pCu~F_DuPqPP%!;#U)1Z|
zj$spGa_;8Z{Ho{eb0hQboWe~SQLo30-hCf5+5#YP1IXU0`1qyKgGLwSknN4tdKsn_
z(Kb&~xn7Zrj4SqRYd~T;_;lk;tL1jFqqDe`!rk0W?|P+M9R;jQyXRihUni$OSMDzK
z?F<h$PGoo7n0uVTv~7EFvdaGcN1VrJadnx>@)^wqw6S5Y0E<X$atVn3kISz}ym67Q
z1e1gTZ!s`OISp6E%I7>T8no2s?Vc;Su0ee!Tgvq?(C1=!=#F__?ebm}p?&YU>pDP$
z$6zn}u@Mmwt*gcLE&aFN&$>)j-DryPUzIMZzP11<ksS2vYzaC%anN6O#hx679Bv*Z
z64Mx6L%jAD@og6Vj-{i!yZZrw&XYnfnb03KmYiTrCX(WNI-Eo`n(!U44ZVy+|HSLB
z6HZfuCVd;nE6ad9TU$RpX9vHpEKxW7I(3!ShFuDZfD5q{GsCs6lR--7xG6RJpkeg1
zDTJY+@)G!6fA>=^>wu&DCX2uWUE8&D>szMh6A==ZfUoF@c`w!>_=qql_or$vzT4~c
zSN_>_<ABP=`R+;gOQYUi@39>67T)CH6U&?KHO+1yc{;o?lAKRF5%}YC#;mifzm8GK
z{(*>=m5;c?-cc5o{>M6P`EKX6hnt%hx&dLG!h8DL=lj9IZh#@nqZc%0+jU~XCHnfT
z@mP6cP<=<``sv~#!f`q`%v1i3UOk`dWMhSFmXTw1|AbR{9Frg=0VGdesdG*859GeN
zEj4YJc6Fy%fdQqesw%@b3@qJxTiNeB_y+6*^vTiGHN}z|wljR4?z86}MKjnSlKbs=
z_Z&6}#`}~e*3UBhEL|q|CR2v-<yw_%`^j>y0kZ6QjR)zW&5xspMyc-NndqiFb9ZNh
z7YfhoLk^eQEKUF>{AitqcnyzofsTDzie}gAn+u=iIu3xm&<h|!l6vmP0$?{d>fCd^
znhy-&HOPD3&w%9&h>Uz6H77O1G>nQGa>nStiKd6U#i}C3n-N<01I2(2Y96>irq4&2
z90$S|=fSO8VZG0g{sp8iPe`QIN}Wzp&jM&V0DC9EQCA0=LoUZ@ZJ9Mb#q;*4^DN(D
zGLTrlK6nx#JQ_qU6EHiCUU<;iuAmsg0TqbJUj@MQ78f|4^UEORt6Qf-H?-4s&hOUF
z$Uw}@3fVP%&HY!6F7dPHa~GX{0X_<%b=u`?!J(?^#{Q0AjsLW0gS;RDY`o-<U9Duh
z?!<S}&0#Tdm7m9Cv~m`iQ-Zef2x6Ej9U-hfMzxoj+=>Q@pELWh7o^aKN{ic@(;>FA
z!L_=A+w4Wu;}-H}TRn;RgjWMghU4RV6Sgw!-ny?gHnHcs17;(aGo*{{)myCcG~^aa
za(D3)elo_RRXo@$w%MSg=^B^I{WF!;W}Vr9qp_=<t9^^k!_x~u*<jVwQCa)M?4AzR
zA+u`pU_y>(y2Br(1P$_95196^+AGf189Q+E$4V*RV@PDrQjDo|heYz0dWlO~L)2CA
zWpu0xj*8<+LUvQm#SR0-WGF(@RBKJyZ^ZEABhM66f53>$E3!&FKM96tF?UwESj4^M
z2^l-IlKkoOo-&fG>ldeM=gy{Ui0A93fq~J@DS(#2R*2qbk-A8@{+c08JJ?3qymmYu
zIW*u@Jn`+L1;7>>PGXNUi0Qm)x@v8BA#F5XHTP~6!T4XGW9>LGY*}{eZ?6=$bsgTz
ztm(%6+@kLYvF@UZ;kOYdrJ^4&`b7dBwq#l`b!$ulK5ej7R-AHyR$fXgIaCt+lM6v9
zkeN&Yn3ukH{ccXh?CyxL$gVE|(yWt{y*)rLZsu$jlLGYLbWSg3FU%lc92=VwU0xX8
zqPhyX>b&$NvauZjDHg!wOim8)etm+`GUYwNsTI$CqRme?LH2<Ii@4ZC%PiX-y;h%t
z3Q~|F4hFx;Qws_0@mt1-0nMTGWTd1rN7-h%G@b!l-RAPFDI%)Ux_-h*i5qZ*ecNZ%
zAVn9=HXMW&jh!B^*j{ai($r>-8|wS7gU2zBIS#xSSS!dEV~7;-iK8N;nClHqU2W3>
zp|@dAgZ|w{l%`wL2$hvSNP@`>PJ*+7Ea~OhQg6UB4LpXe;MOZ>%4jIgGJvSW1aSQg
zb_SmM&mNhL_oP2bOtSD_%E;R4ta~Z;sbMBCi_c916Snw`9mYBkZU6RoS&>xm7u)7A
znG}4OGj~eBW@$Bhk9bAoKKTHynD}j`*bLtK0XVczkEuylE7Tz;m-PU-W~8#l4tsNk
z{`*h&iezbVPbe!NBlHkmA3r}eH>?Q})v}}_2C<rigH%~Z7)A!=iOP|<?1A;FO`lh+
zb_GO3U~?04`jA!%g2Heutk~5?@3x8iG+d#Ef~x;nZO6rrpvFm8CyZOu=$3a|4yBbp
zs=8-RH_rbhg?yBDKO@jC8V7psoRkzEF28w>*J&)gTx3+f+#x+q30ZQSZN55H)an3d
z0IGqI^@9)~&F;eq={)zUg_}y}i?B)+Qt$U6cXt;MXhIHQqK#F!n^k4#*oMVoC;YnP
z?cs8$)&maqC5pS%>PR)&mo|~l4PP)l%hRS(Dq{_*Q{KnFl;zqW$tHZYU&peUcBzh;
zFhCj9>L-@{Ta0e4JZzr%efQ4hu(bxLwpP3bZYq&QO--G?jlbCtqIQo#uQa`C6UhcB
z4t~V=cuv<y911I-R!0@jueL2NFMvXG^I+K{#P!V+hQZT~jgxwZ3<-uqClz`Zzw`ZJ
z4>X#zlqFQ}4#8K7G<nZ{G74U)+JPhQl|G@RBIbJ{USr(F-JleLi=ohRRy9nh{t~;F
zL}(ZeMg|Nn<GXRyQ%#YJ&;UL_9_oeGUmVsfi)TIQ?mhrqNq_hMRau~kTi7hJxsfEG
z&R^VV{weFSbt4ukpW$e`y1ye$dF6X`Sc^TJbkzA+$&sLu7Jv;nKKXz&sM#*drKYKH
zm>L*(EEF|u?>q}mOg5-lvTYxC0lvOFpp7X`5oJIZDgu(T;SymnV9j7}4QObWX`CJ-
z_*KWJE#xW;Q4W>xB!3H>ZFJ6LixCs#fj>8(;Opwj{sv~hb}#$+U+R%u1<K^OG|v?q
zGH{j&jZF5|MB0a}tnplD*~(=IF38pWs|u-g6U7sp9&RjlTT|BMO}RD3YP+M}7Q6f(
zBi`p4g<ImV95T%F3GL<_uR9suKfoQ65eu^R5bL5zHz-aIwZ_2IDS^{1IB%(>u3uVE
z+KfT1bJ|=sw|qT%^vyHZDJ^Z9FMsYbBpos)F)jzDS*=9ZB*Bn<+}*|fdv)0aRNI}0
zutigfFB4u8L!N!=+rb}_Xkl_$F{(5<N`hnvaVFoMBi8UeoLuJu_1ko}w}~_ApK0Zp
zZ9w6&XqA2J(VY|)4@3cPH@DHGW}GUG!5f|h7n9^w3i%rlAk@s;4C8*3Bs#ELW@H|G
zHdxz!dAbe*FgsEMW;*!|>iW%ErVh!y@@xd0Z^*x?*^{lNcIm7EM_lra<BbtuAK1JH
zjg+ma9$zSK_a)*lt(7Y)LoQS<k~)uEuMXa-oDA=H{VxyYF%3>8o!N+)sd@)*%qELr
z9ocszBePA{Mm&0cgOWWg2>kVhy1rIo+mtHCHgG_$6w%hj$H)BrxOkj9;y@A60>ihh
zm?02lb?Fo~PWL$s4ehG2ttJJ97RNDm`lacWI$xdFKN%tq#{XGd4ulL+UVXTlzmjV6
zKHrcC-tGqGIt40c7b?e$t{pp*ffgaPT!uVX8^E3YG`aVQs6Wv*c>Q>8WB+79xX?mL
zd?t`oZ8YPDo@%KdK(R|$1T1CLwx7+E45@6&jOYCqX*JzsfPw}jhTmY~J!UOQf-t)e
z`<9DDyBlwF&-`VaIY>5ma3`r!tn78PI6^eeV2M2iqe^&(d%4aJnR;lQCk>&LmUB(u
zc{%0u&ZkN;AyU*klR3pVa0Dr$4ovy5tG}{TJ#0=#Mn+6;b)FA&=II_%=ob)0{@B+m
zJPb5=BR`uPywgVwDYdvNtL-?*sQs&ubG0wgIZLmbqD?s2sa8}-qo)aPfPjA4uMl3W
z^R9eWG3VOI8U-_3X_XO#>e-*gG4BzWiVWxgrRhsjx+NvZT8F^Q#G*75zghkWL9m_j
zYOF3JXfF9l<p2(6YY&$g${B_-f`<CUq1x=oQO8k)%K6M$1b`4busD7dLL~id_GXbg
z+b>DV4R|Hu-z<yvIgO%}Q_ib?0W7Dz?#ttq#n%c0`Fk^?xprCYit>4`V{DsmZZ7sK
z-IWv5P&a>375|LPGUsrH>bpD^tkZdUS~arzRcv579x@Q`ZZ4xc!r+~<G<C4Nd;Xku
z!e#xyBaOH;Ix%rRXZfYmVo=DmDt%tki(IuTC9X?uNa|*+KO6fsQgy#!T#dOmTh@?-
z5o%Pf(|dh+#`bTG4A8y!<x>yH-kheQJ(XT=jOrHJsc%OYkLL{@GV->h|JvO}676(?
zy|F%2U`ugU`5v0D%qG2aSjH6ow7eS-PzpKIBg{--t`@Q^eHjB0iaUl6f+*Yx-UWL)
z!uV%Mv}<%tOMAPixfvt2j7E0^Pg9TW>+9RGhSdt$72M5t59PgnEmU70OY`(@S=79N
zcK$0zcHrWVmm?N`th562GTDelM)vx;A8=dbcornLdy5~hL>wgEh|Rku6|2Jdo`sL$
zJ8#*2{HGTK9X!F8kVvIcElOGujkwQhE&N?8rZfNp^pOrOkc4G4&UC02u3yFBaKIA`
z=E{B;k%zpS@fyQu@Rtjge*20M=Ythpmt<{9+Q}t#c&@+xq7c~F-Z43)0@f`bDl9a6
z7?_M&YUYqQWQ*_H2=KpD0aE^UXD<ky=+ng=YX$$!%Zr8XJmK8Dz9j*n*(2_)uJ%~4
zfKYn+JD5+v@TW%an$b&ZSidKU5BU@c6VO^rn;n&G28E?^Qe}PvtM%5+M>!X-z9r;o
z7kLZC7pp>Y++e5E?9@+ba*SnP^2`(HBwiXma-CZ{ogk8~wDmJW0Ndgz?yZVlc<1G=
z{>nH{`xUXxWvsd+qEF5ft;l0%G;}BAa#-)W5dhU6j5zb<IX~9CTARI`(NjSm_dj;!
z;pXDu=58)hek?N?{F#c~^{qK=BK<RDN@}u!R)Wsgu}IL1ft%$qpR*h$9!#ardnr{^
zrt*8K5wQ|g?hiQBsf3QT7N6~d9u>a`kiA|DxMfa)l#No)iuUZcE4S5-&d=9g!?=?M
zXueiS%E^9OuTJ-H4FPge1EsyxXtevB8k=~_)@llMgnYMVish7!izjM~YNncl<>Xs;
z06~MU{pe_#1bz?OcRBx-bhR|veNsIoyVbcfQ~!Zcukc}XOr9s~&aIY^VE==aKESCC
zG#TCvu^AfMcfAe%d9GgjXx$Wgi+NKCPe#jb0NBp>=D+a^0;Km$^&#_SvQSTGloVDs
z62e4Qk`1;2EYJH3nnSYyt7eJ0<03!J;+PPK8w=Te+evJ1@%OMXv8qXaB-`w)pNV(6
zJf{xX|ITx@GB&L^s$`QZqHk;b#nibL2qOtTl#Z_G&#_K-%vg#mg6A03X+?7V40NP!
z+tqe}6-qS!@_*5qEI?t?%g(8%VS;o#XJDJUpRg<vl|9&_uCE-l?bl#z;%adx3%R_g
z1mO*DQ2U!O-%HK*$vydFjbrtLg^JBwlpar>S)O>};gdwhN_}!dL+*oaCz)I);>cUZ
z&KPCv9%10Erfi{#iXuArHpHKpwb>~4ynxsvEPHs!h*^~#$k<F^wtoI1v`>*5wt=vc
z5KYBsLzy53#j1)ApVKhBT+HjCfeKoN!@{x+B70vVovtje0QVq(kRDu~-|&AW%Zi(L
zAN5Yh{_N~b)`g3-Nz(4C=8W#}%w(3Y_QZo(Ozk*YKyasV?;7t1cWzbaFu`eH3dA4w
z3w+79r8Ht#n{6>A2hn^Rl)VUBY8EI=H4ci<r1yRFA^%<A5eu4*aNlg|zBBTDy0wlZ
zf?x>T*D;C<^6tf~w3Dr|kWEtqbf+$qn}=t%&6hOyx>F>s+Zx7^5D5sdJPG+`dD234
zl{#&DV#stP9UVjxLi330$%mf!iGNPf!w&<01#N$)&UN0K!<9^U?fmapn<fRby*>54
z{C;)ndO3Ktdpu0ED+pQG9Iq<QOShB!J~2^WKBJ0(omfAo5lq=jrinqBzR7ThHvbr7
zLk~<h$EAgn<iyhSS25m%01_<>IK&*Nr*7W1dGij>kmxSnLcvP2qUN-A;HN-a@M3+_
z*7V-t(T5TLn3u8|i!BE=tDNt(Xd*W4sQ9mk9A0!bo8}J^N2->*U)Y}ozSSMUXa-Uu
zC@JJM6T<{^#g1~<%d4gbbEz{5luj2^u1J?WR~J3NMD!y6=mi^bcmg{imsVUEhiA+(
zGD>s51$~nPF~Wmwlx%eFc9*e2AjG!Z{d9XoN=#)Xhps68^Va10XdF!cNtLy!OKVYm
z#7`5poEj-$RKf^RAcAcOEuTb%(%b<Ch@aB_=F;k()rh+pa21eEdcx4@w>`1C>RH??
z?~$lp9_CK6DF^za<2QksiJ$W0K2y`*(1V!!qW9yM)^@GU6J5D}c#?~~bEt{74@CR_
zdmF4Ut0>p*zPGIXe;i$RIGgYLjZtEh1SQ%cVn$Vk*4|R9MjN#D-fHhXipHp2qc%lp
z(GNxKy?3qJ)Rv;P(wM*Z`|~H)<$AB=e%|N4&pG!wOFl!>YO2dK3s{H+y5h;K*Q{5b
z>~|kpXVw*U3enlmZ<;Makz^66;ljOK@Pfy{N*5^FLw?|%W%ePSsb<JOcHmIUmQt^&
z^0r=3hA=}a<_Kl(-Yc=~p7T!Gk_-+ZmE(pfIZ7}MD^YxTrB$0I!X=WW@%hW39(AzL
zjB;N<>{ayC?$IR$r$6qrKK`uq^yp~%mFW*+n{_^Ibyqc{Q~Em(x72q*)CyR2dyw5l
zi6ePMRL4KqdFtw_Stoeji3*A#Rheq4<E`$oaA|6e--(3aPEUO?Ii@aqm0K9N1vvg0
zQDP{04>OmJ5H}O=*?{t7g$8-eoG0eaMUB1Tqk)Eff4|Iu>>;VKkBPlBynlB7h0+0P
zv->P8*^7;UdH4D6zbQZh_lq)@mBtR3une{0cD5xos9^bZ-Kqa$zF34K?j19AV07Wn
zC-<Q3lFv|r9mNd&{o>mepUU~5YTQSK!|s)-912O+fPd{905C-<xxD=xTi0*q;<832
znzye}dJMo}R8HiUQD6wn7A+4h);-8}TzCn#uFycDxaTXA6p-)z4s$%HpPKB{9TK(w
zvx|#fW_p^0brRLcWEv%~7_Y#(2sEtx0m2|5GinMSZ7giPvRZ%EX|gW$`%6ldp3rtH
zVyMLlje?qFxe7HhB0sft+2k40G+@6LAUf_mMP;hf(Bc(i;!qV{3w2|fW3h!Wjb1e*
zZr$R)SF>Ig@M1MNiOGTS%A)Qz{{U{N$m}b&o0G1*>*)lUi+}5Y0n+8(iKo~9TEmc2
z;9MMDUmsqLDzjY{m%ZY-ND(y+D8tYd-TUCQGNm}%msnl?Q&Q@~?}r&b)U9WV>(~Yh
z2V*U2E49X|EY&*XSA3}Lr1-uuEbH4k6}C4()IheqksT6j7AtohTkt6E7^s3;oNBSh
z=*NVz!;4C`x`loBTDQ>$Ifr@oZLN#Hd3MZdNPkyB8_DSpSfmn>wSWJacR0d>Jck8l
z>fV1^d1Qz5?e2HVYn-o4t5}_uz2dpq-%oElm%V8V-uAg3!2=@Z+3WfGkh0xbzo`3m
z5@j@J+u8D1R#2kb_M2m9hLsU_dm<bP!$m@n5e0`IY}T_gM@#xdHP6oQB2GbmEyK#w
zSLr5ceyv7TS*>>(5TwKkoN!7c6vSlFwB+7fj9I>j9U20JnvKqw@BvSMS6`{jkwEpF
zUE@D*?llJQkWZezfvAC@ieGSzmG{cf`gcaX)dbn%_M3!;m{JCo?c9N2_>I+kzUmzd
zPjlGo*~i%5XDtC2<QEEmQr6f1dIB4VbDkREk69BgIs^qij*_oO1;aa4GTw6($FAn2
zc1lWS$g7$!jplNHq(hR~-j>6tx%Kk;j@%;uoi%e>*B>+Yx@ugU>4(8k<o$D2iXnu{
zo<HojMX(%NZs<+RT#h7<ZrS_%o@JHl$AjG#BEOK|vb;PMD>ndWeqXX)Q<Eleg(1_Q
zaLt09a>8}Jxhm><)9P4NDG*g4D)3E%iI^`(_vw4wut6-?h%#rlkpDx;J9PH3n>d|O
z6y*IdDW%$gnB<AE_Uw#j(^9qvO=9hvweSSnn!kaCG5ilaa<+x&XTE_7_=LE=KBq&H
zPO`DFzMdW0_kUlQrO{XPLZ5NYLPl~?7QF1Ekz(<YLAc_ma3^YQ&!0f(dX)Bgb70`z
zTwtA%0DX^}Zci$!jNkl84wX!IV!H-+(Zu(Y4!4dYL@Yy70g075Hj$3~laU%%Y$0fr
zOgO?=A(sLzb5~=?eUIa;<?yYmU&HmUj`gv&e@1E|C&q@f*71>}!o|)j&0gDQOLLxu
z@2QvHnu(KeiLZmP%TE!{)!wFlx!o^DL|o`40Oe9sT#>ZZRx@59E>h_Tu+3rqJ^t+-
zv%j3{=v~WZpRVyNKnWw%oss;5uNR`t5dKWSoP3JbzQ(EED~rxfSILY$oVLu-39G_;
zK6(zT`2y_nym?ePHhMm5(sVj|1L&5|t8PY2&x=g~XThq)29JwBe?S1FCN*TC)(gwQ
z?Y>5QbRXqXK|U>hEToS7aZm@*|C37xo}~p$IlHuE3E%DO*hzD2-(#xp+E*}J#)VQb
zg!53S39ZaJyQcj0O?yXfotmibYMhEG15A0EMHLnLt6z&O<UKq~rtST{IwAR$j90$i
zv7C#oMHT7R+U3UQa#gZlS@m+EV&n<2AkBTTH(wY2@MzctJfjv9WJo4y%mAR@O&h}}
z@21q$^y8lyFIEScie}Z($ecI4^n2+p&{TQ6>`-wmRc~X)E3Tr3^cO<;k}EJw|62tv
zgvXMtfx*VJTg8Sxri}zlyang2KGKfwkKyvV8?ilw_8)LV&!PY?!-!BYlAQ$2Jy>l;
zeZL1%;njNJ-(Z3oXe_|9$J<UiJl4Elu`lgcP@L9Dw&JrSs3(`SODsp4cO<po_qUK1
zF;v6nW&Fxzwnm7y9S~P9%si|3=P6-h<h&Qfv5=GGgK0L0HT$5>NA_Z1sNq4Wbc29<
zbQ2aXV<H+W-!>FDT`9t!y&pWo<2g#~0&s4R?=H0kJu|zU<H?iqJAo@z)iUxj)2DuC
zS?rninz>Cb>VD`?N|u<2p%i&4lNWD<Mdw-!-bq)8f?&Q;KezFVE5NDOm<X%YOsK#;
zMjMv9GmPxKRpFKa1Gl<$HVCIZJ>%Uyo(QODdOB(4hxgoqBl@FB9@A9-xp?UZE-3FU
zn$rRIDw<I@Zcckoi;M`Cmr(c29Z%Yh<wn@y&(7j$XtryvgvL@l;!wnWp-6TPK{7pt
z1`nB6cSAEfP`#-e3cT!Q4Gqp0+zM8hZkah4$W{6I;-)$j710i-Ls7CPdA(tte?lTN
z$Ojk^wwYv>m;fvY!ISv@2a)|cU53J6#2{_8b)b)XvL#Xcv3eM<I60jcd_B-{J@KHb
z?dZ?(qve|ca&))X40X^88^E&0^TYd0w@MbHg7*UMR_b>Ekl6K(LVjxFvI<hVr1g+w
z0=Twx-=j*Lflch+x=jW%KoB$ajKN{Hn+(jdxt1E3+`s!B+f)jJda>cPNUl7DTnx;|
zqKXuTA*Eyogs0>KT7Z5#+e4wB={y_oq+-AIFx0irMlFsVL?uJr^?XYgtLd)G@N|_u
zVzosJ6sMSm+(107p7CD#>eN(FkK0cZ&fG3O-3YRZQ!R@~{p{u8>iYcM)baKhYoHsF
z6d<T_e3t#Tf#;|fHLQ3E7`r3@2`3R7Rn13(R~Pu=RHuczmSFkc-on|o`e7aPNwtb9
zlJN|5Q22gwr^4sOhR|I1_qOZmcGediXK4zYN;16+s;VsuFTb7I1hgDoagM1Sma)b0
zFq-XC09y^WMTp;A1udFd$$Z@0JUy<V0$6h+N~pi%ht?XAQ{$F^MHMz3#>n9qU?NOS
zX)rZ)65po&=bX2xK$%Rp9^~?!A(<))+z%G)wQ9jtRSmuX+WwRH!HOw6iO7t!Ask`Z
zA|yo1ky#N09~C3#BpS`MYnKGGGRMf}Ked6>jb2xU{9%*5nPZYAtdSF28=J~pHfvjh
zNB=>-)J7z36FiM>*?Q)dl2WjL?3UxqhlEq1w39hfFm#)8tt@fUY?bvmAVZA37*fbg
zc5^wU_aHS_v-H$v8t~4mJw@)bW&eK1L-Eh%QzZYl!S@(sX`l|`mv>W(nCy~?vD3ML
z|KX*prN5qLU&O9+OmZ|!yi2_ted6GWr$m{Oey*eCuy-x>vX9r8%Ke9D=>U!6CY=}m
zxtxyA78E%XJNNtVZjoCQgZ=cER7`;N*=bdC@V3?UE>GSqOI+j2>gN(30+m@x2Dl`u
zGM<zHpj{ZuZWqnMF)aE@)GwpLU%WujHx);NiFu)<ha-XvY6sm8GX^+g{kS+`$xaYS
zwoXw8VBQSGTdZBAXGRcSd#|td6IvZ-OPqO%D3d<uwwP2kl|;*k<6d2z>M;=odiKIR
z=ITCA8^mDpu=hk=JiM7exzYjEOW*unBA?K(t1D-wsVZAh7Z;jI6WMdcNYSGF4xg4l
z2o4Qf*$F&F)%=#8*hI`HLo#(&B=f|(Ig=Ofwqi-R|Cve1ajK&lT1`>;sc^kE`JOOf
z`uihl62c5>#(&;CpDXIKWnvoJt~o0{AFVK~afrhryCFZUgzjnCqKf4>-`^!`au(hA
zaca}#tezHKZN|Xi-b?Dz#9f&^TC@9lv7Uv3C|cnodO&zvQ4L7}c;Hljf#};;oQ4^j
z0DeYidk*3!t<Fv6e^MdXCdixm2C{*kjsex&?c-f5)QYx(-g+TkrW?kAaPNV#?`NDF
zxpLFVd3Nl7^Pr%+Rm?yR2jwByQ5~e)#OO&8*^sXXQyh{L_yZ{QeUOQ-V|2g2?1{)D
zs;F^%kTIaSiEYtCy1&1pZz92_5C_r5cDzNCE;zLqIH!F+cqe*r*$Wu%4*XpMR=7+r
zd+=jpS|fsX6_Ec97bb1B9*vE)UhTU8YNHqBUp&;xBF5{Sj9sisjQ^mN<OCwjnqEWc
z!@@QcT)BusQD*mz;_956@z{*AIQSe)8$M~c{kHWG-tq3u+(8dU7r1Z^Uc&-a;$r!!
z5-s9%b?@lTopw2B2e1uVbiTJ5;P@`Yq}~s6!Vc*5iS<Ubi>G`Uj(x#J_m$ua<<Q6N
z0jhWqOL`0{DgBP69Gd+*NYW5Qub!HctjcKl#fd3fdBcFOI0AKj?%?#Us@y?}55T!N
z4~-X`n+jf4ry`gX$gxXijpOmX>+_GtLe4IK%^|f-;9u&;p2ulzUA*DxWw&r==M^s>
zL=@Y_l`XU$l8-iHZYiHxBZ;A;<O0PpPz#kDRK<S^0zOZob6(7em(~FCS*J<Y(c<xd
z*dAbE9nc`v?TR8*KvC$ghGl`Gme$#9OU*<BwTkr3_KgyUfPd+~jVK0$gi9O{8PHgH
z7=SjrA5WVQBV;I0HS-x)xtpT3Joh#S=;NHvHClAl9x`4890wKODs??}9m}XYj4I@9
zFWo$yS6Xjr^IPZb`B^_B⋘EM5G$vaIwc7a}##oLVR71d!3@nmMiNP-j9A~zK@D9
zV+JxUP)bPa$5@n&QT*o#-ZAcJ6?<sW%DpiFI`JPR42*CTPj!v40*MB#_-p05#6Kf0
zOBq_WpEreux|d&*C1N~F$MR%@|G73Tjh5D2;7xPmdYuI`SK|~AvYxlavtrz(<`?ot
zlaFKPJRkexwnped8IR7CrsI-5y3|w|`{{+)eO&@<gAh}9kqWY&iZ0^m%eRVkUTi6R
zo%pWK@Il1BqUK9~HUH4iUtcoy->o<7-y@<?q|_byWRg@&FDT=-i>i5J99o(sq@@Ax
zlr!X+jou?m%2!v{1#DlosvSQ-jB~eRTY}8~0UX120xRA6(--hRxS^p<@6X?eyS)Y3
z#RL+M!%<QF(Y#~|+<-rw(6%^2Q9u|C$~e@>@sQ&W*EgLmElqfZ^ID<BY#579IZ+ak
zzU80PPf931dVkTU%S}VWl=8wFDCq?eE_D?O?=SKKT!<eu7Zm(lAS<K-SfCm7!-H(q
z__AS%l>*e?B$o(7v2j2t3n2Px-5|hPG(R<&NVNBPejzWY9p5rFXn+fRHS1(t-z%vW
z=Z37w1_cOrCxYNmgY`Jn`rnPUuF~u-z=FH&5`VqyvfS)<{3h@6-xWT@*U!&HbYa)G
zx~=Ukw$%3E{AiErAtO+NS)%VTNtoP+O4eoHzjhcNVpRmMH-AgYS;S3f?(rN||5*-j
zX`w>(=Fq~c$|q}LjjccN2@9lJbVv3J>%J`7ky1<oheDv@LQ%t+VUAbCZ>3<uF!t%S
zi5D+4YWP$5Z;8UcD^NtJBWtNrZ1hX4l;R|D<O_PZfOU-8avvmo98u+7;ejl!WdvEo
zNx377M;Sn3wxD)TZn3e9)oczqONqm)Kq35cWhFrKdmAxM?miy!B6WE^>;1$w%A>$j
zK!=R_{pe8AP9wX*E6wqMMS-ksro63bV@F|I>U4!?NtjTE_jK!jeH)CB>rqxM^#eQ|
zoR$g{nHGZVzjf@Q5eUlnBqg6W8IyqJ)^~$*zR8%QnbWNKlPh1T-1xqL^|D{Xw}adT
z(iK2%YEoPRVwMQ`Y>mDYw-*~i{*yB`Kr3s`|2fbgey{ON1VrB-{Vd09XE+q>w*u@v
zyeP4v7KqGHjl`U7yvmvhK$9)g0v>AF*~7GW2Bslg?3=DK`ylRruXT)#jDyeDv@*Nz
zi6&5SJ+XY6cJJOxoY$ZKKE#9UrI7m1CbB*c33s>(Wo{%Bb*a0D{kRZ&yuhL+J==i!
z;rY-knYd)VS|<~b6I83e<0;zrmdr}X_FyNBH*J?D;O1NZ#$0aIw;ofiT%B2<ZaZTK
z+@r96X@hS90Nll(OtSu9)JB-A)@zx1%e{s5j=v6HOmt5_-RbGsfEmfxU5k*$p9?E1
zE73GLEawH8>W|S(NDw{mcZ>t<b&FH<-hihTc<nVD!ESA#Gn@5S?19kI6BSfyksIKk
zw>9k>!<*yLB%KP$rs@y}aNJ|BmcKHZ<*K<%%O5Lut18oGnSiw0^o85+`d$ltP}vdR
zR$Nl1S0Rm7c(7*l^TWQch_rYE;pF#amzGRC1r2RNj@u}C2iGe;QXXAyFJ~jYsu{I`
z^77O{o0?2W3>7nlwnZFOFPc-LZQjJh<jYH7_t(VuVf{iP7)D|%$sP&{BxQm>*c_3>
zn>PAf9E`O12Wc`G{|QUhQB#Ws&AxiT{xLPVARjIHf&(>N{p(ivBX_h)G#!^f1}$q6
zdppfV7Uqvk1SB(&&ab3lM&iZS8F#Bp0RX>?BSIk%u15pHz1}@xbvRt({zYrOKm?$&
zE{p!e=5Ki)POm_Ky>mnLPHOG>EH_*%v|R!G?Wj+sz*xxk%|+Yg29GS@R0?Yh7OJ#K
zc`^ICcE-nfd54=`;oqbzfg{r%ovqGY@4U>c(VH@`v9Wc#=eb>rN1C2v1s+wx@SdTe
zmL_EX)E-L%s#dpWkLHa^#Qc!5jbrCvhjmTiozz9fj^FeImoVIdMRkb3HR6nbsBST9
zOMC=}8sK1-t|o3_;g0NK7}p?bCD#%z_lV~Hp9h2Y&6tw@qKZ>9o;RUhs72T0lx9Uj
zyqWK!8IplfVtd|T;jzY&$Y=wsXq9hBs5q4_#$$QL5LkM|U8IErTk2mZi}iIkNAE>h
zxQg_0>h{)t7~bk_aNe2y?1&xkY_Y%n%r#I<QcBEy^u2Xi%<y>z;8!0XSL3wcb2UDt
z*kWI|Fi)ci*0pJfH5Wa*6$M;AnL63L{<dFEGdBQ*m5WGO%zaRlxhp$jTmPjxcMV|~
zF*a1mGUHWah!6d4`3!FZFRUIewm{9RKZx<JF+ofO3ehXT|2ygA%Mi($PO(i;JV_b&
zWa5l`%2mKi*)wfsxuS&o^=lOXqDLHb-~IDxC7f2ZTudwMR+cR|dw6=nt*`(61(5Dz
zS;NZzMMPJKF8l7&Uhe>ewk!|k=@XLFr@ETlMG#|G6L5jmR=9Hbmwu?9f}9y<Fx5<O
zG~iLhuWWKP1vSJkQjFk81O)i5YSEl|zpO-9qJS;wFSUv*V<oYKYgN$<ATqJ2da45$
z4C#C7mVx|HsrBr74Q2Gx7pQ!`p&=uCRd2g`obFflFiuETofb6**F7UOdth)DYw+`I
zP8ePgd@cI!WqJQI#P6(YLQRdvWQmFa&i!$G>Rw}-gsiy4zrn03J}v<Pf!rJ!t<a?L
zIo{%U3L+4lJ#tXZLka0?HF3W7`<G`;S!`jdk=OqC%#w}p@5kaQ@Zv9n|6%wdAqxHI
zv%Sw%%irA;!CT?B;oC)glxoy$(tc<Ec552#aT*?Hmwb8|nmXcqgF<;@C0*k=(jn!w
zf&0_1XlQA*IW3K5vrg-bo$74BGTb=h$!|`yGYa5DgcUO{g+Ta|#O-{YEk)Oxw({jK
zs>z(Hw39=_iyT6q%M&tl=W^z5f$1RbufW7w46KO2bq>>iv+N2T$*G&fk{P?X5<<d=
z#SwK{nNP|(8fwp;>3Vsmy=}^3%?n;BRZQ0f?0@?X+XAiu=}?HTPZY4pUUhwjZwtCP
zFv_UgKPRj!=X~XNd@nLR!k-A8V4pc<fGR3?o5#{%ag8!<lFHq|3+_u;tQiOqziSz1
zM7Cz$u)9Mb5XM5Tk2jAD9D{;`MW#J@l?%sAmj%)n_PvF{pd&e}0T#x9ycVsEAM--G
zy2j}1o|WtCuH&Y|wi_A5vWcnx;s0b<>ufhzB7T?y_TNR@_2<0c^WD?a)5%h;(o$QH
zZ$q=OKswrZ(M&q;`rz=o@|(dBv3d(&g-H!(%<*h6`WtffiV7p}?NbG3KM_c<an^tt
zGM?EHs5Cq?pItZgp5pbeQNYSf542I!>@MrpbH@k8W{}W?tG!BaI|LF1LF<6iYxgqN
z5AKc|7^W3}o8RU{_^9;RLn+>h^9auxKqrhc{q%nn{FjdL&uhW+Z)Fkysx?Pbq?Ca&
zr>e@dGQGa&uRNrzIQ2AezHYzHh2|rpwLUR6vukyCS0{1CpfX)FCx?0IG*AWzyADls
zp!kJzdQ{Aw$k*Ir6byWTRe7e&fL$k1LDaJtsK1Y(jra6R>o#M!C(_;F^n&(qSz4N$
zc&a?KZ2xMliA@t|!hjiiGUR-Fa<@BMgc8;3>lg5(X4|LKM^?(Ts*2y&U~vEFZ1Z?q
zTk`6>&s6dG;qmDyMs3&Qru2Vd1^Aiys<xZ|;Cnx%bbw!Y&PhnMT>RBylU??HbnE)M
z?E-hRA415x?l}x$((bDZ@e8<G>tm~OSqS+@d$Y!Ny(XK>NT|A=K76(bw7emHEr@TY
zCr0xP52=!uoa>zyWSRqR4wlH_frQJaOAh+Wl}sRq3RLvwH8Ij-bYZ_vDrbb79L)MT
zr{TH2)hKI3>9L=99_1aMzI<zGKs0kSG}aav=;!ArQBQlA*H>q}EW^>0uo85$<in<O
zx}6s?D$GcPKAF^#MMa(tdHXRh+-7mqPoI?hSPr6DzBoHNss<dstAU5OCS3S%!on2d
z<cF#s+lO4PvxQs}(nHS2ZmczZ@df)urUHL1LjHFBPq=y3cAXyL;dgcP_jo9MHXT52
z_8Skg&I;PD_79iaLfWQYg0-kDcf13Z`p(?_2$PRwZ+5k+4j`0>KfrTAcJ?=|jYs3$
z8;m-C69^4o7X@Y?wY|PM0=z+ILyj+w2`9Lf%ae7NkW;`e@8&Pt%}U6X&&~b?TWfvj
zZ2i#b{#l>w<?iV*ju6Od$>w2dXkD<d@Oc-MfIHm>62K>SKwz@K1$7>~cBeN(x92H>
zPd^_W5Z*Y%RhEC<4;mdPE|$z@uqau+*gvXc6x03p$2b7r%s{5HGKyNVw|{WU$rAC$
zT_U<4;1e@-pF3(8<ap2lhfpSaZ2NgYKv2t)^R~5gj%H+WYI#%%YD=cqH3!=tj`ozv
z>)T;w1mKkhqY`h?f0vsYcOKt|#y%EMz-0KbrF_p|b{Egll*@Ju5WL(x?n5a#z5@~E
zPdD<%zVmBoH8xop-9Em+AL`!e`p)R#8yrj)T3;`!d%F{L;@?y(4fhz}DwEU6Ac=IH
zb0)a~KA8HU9}caXv-K0TiTo9)_txTsDU=VCo${ChBqxNYF>hc<1fkI%UR#p=db~f0
zkV6Zl&Gw2&2<K^)7Eg&cjm8rV&5v_*b}kLOPuxSy6tmYzZU|f$FhQfSxKn?bJm}xk
zQ?IzI-QC@{Y^{<xxvhbIEz8a#6%|AF`p~)I#oG785ND53R&!k#YVqpG-wQ7X3=_;H
z+oh!#2YcM)WRsUPNhln6A#EQ|PRZ0!MJfFRcH0Q>-UG|v%S(c%zd_n*puZO9#i@6b
zQ~0K*gn2Pa2|g^ovb;=eUiR?U*H&j;-sTnO$iLsd$mxwf5HuF32afa0G`5g`cZAzo
zO@y2_h)HyV0s?R?kG8G-Odk8MoLSqq5l$0q{=Y_s($i@V+uDqrO<S8~WM$L2WkW6-
z@b5BjmR4?PWv}+$*3XWG{Oe)^GIjGp2;ZFkeqOmg*!K_c3($Xgj=wnoiaq4UMeGtd
zyNg#q>0bYND+`>8go;|hoEq7jdl*oAV>Z!-Kdv6v`YyK#tgX$9C{6_$R;+LE&D#Io
z$)`wp7|3Dh!|lO}LmXklc}<fD1~Na$#ZAo~A9**WVKi~t6}9h=N=;=1wrLq5=IU}p
zP?>X)vxVbheY8x_IVq@(Fyi7|zfh`Wy4(`b7l(+O=wQ&fn1K=qyG`l!Lo?(QLHH$~
z!`v|&?|>%b`h8iz!vxPJBPH8Lbqu_7WOGJ=|6tkz`~>;UDT&tLye}>ZmWJsofMEY}
z>s6Zt_U0tvW<`cP{ru>>aZFXOzCt!9F9hGz<|k9(%y*wO*zdx<p(Uw*T->v+P6$&m
zL^uH`rq}*yR4%3_%O)mTrIUofI`N+VlG>T5(aq-Te>l@yB#%z_y@OhujJFB9`X2#~
zVF`Z)TxI{euDpXDL_Xcv-vmzbseel_;b_ypWybpIv?};wDWQ!re_`3w^bwnE5b%eg
z3;fEJ=*^bt%{1WWbaVu~jxJ5NzIq!}&EAISP6u*F)1m4XxVF6g2zITqIZVBNegPxl
zP+~`8&(2o-{LCQ`LNn9oWGGQt?oe?j5-6<uzq)8wMp|N3R`B8gMz(0+L4^(sYN<Un
z!q)I`7Y+eP@Am(+HEY?YiJ!{_h7?EvuY*=e_ko|p=%H#?BzAGz&T9nu+;B{_$s3Pb
zcqXv2-$M155a?XHHP5PhbuyG^=!o-Q#v7_N>v-iUCVpoW&hm&+G1OeByA@8e5TM*$
z{aF6PfkYW?*UfRrH4B0c4rK`lWkH0$fFy-YCh{R7l1NRfT+ndd;p}_l$2ZmOayN|_
zN}6aMDAyN10|Unqule6Lbpq3;ddLr!VmU!^Yi3y9<OKyP;_V&3g*xv(lVfj^c25og
zFa1ulazy+6J|6PW(rtQ>kw6vn`tpQR;UahlE4WP>TE}1U#0O@%=-h+_SkrIX2g!=v
z+7DNx^ORNs4jVdYBbOAGu$=d|vu)TB6;D9FJ%aI9Z}BTFxR#sC<1vYrRE377PU$Ix
zyF?-M+Eb=203Y!?)U9dB#MHDa(AcnIdWqt{nHW}R7{CTB2SDm-4~n+GZ|&~d>!)Ee
zCWHT7zp7u@A6l@EdtoS<lYYsdAO;BFI4n{kKW6y9GED0kuB@M(88p2);{n}V?iTI+
z`?J>7m%!FHURqjOoHn%S-n0bDuST1Z!d;gyjTns`N4Aq=-4GVy6}U$3>+h#6hr;-t
zQSoA3s;kR$3rnD-$W7<Ly5bdXL2=con3COnZ&j*(FXNF3(9(2iiM2(jrCe}f^KtD<
zL=3ow0)=nYEy2Vr4EOZwf37So72iJfAK73aGqTF!C>A0Vxhp;Hg?ArMP6DRTTIlql
zo+VY^v%iEP<yYGEUdF(&*z|5O#$yIg8-ZHBB?VlK+=UCLx1o8<IRG?j^bE;$2m`@g
zbIonYLca#CaUlZ#HTko)9A4x;TYEF!S;`C+CyvEpGfnFjvQvmYr^e}zjg1wj3O?=T
zC(&1{e4cEeRZ8z6-xqRSDw~sjtQB&)U|lBrzpqC2=C_&sIeo-1b;O0pS&;HZu?TTq
z(Bb;o*^ygQi*(McwxR#w8ijms_RI9MCH%@G#~kO2*6m;1KB8GzJ+(Cjmq%3>t$Cxk
zYR+e(5W?x{lkDL05mO4Fd8GtFfp54MHf*G(8VKCq%uwJ|IoGo&e0*s$I+8$W_Rss_
zAZBx^dT~d0NqMF2UFPxV?2qKIys`7mO|E*w_=56v-diTJ4FTr%IARb545511Qb~2|
zE-6%F+BN-$XE+CCJ_&-f5B2()@*S~U6rAqWCuVi!JTx^a*$&i<HEh+5zq9$#rlk$^
z*EazSDSxH+Qm^+ts1g`EA=@^?{p_KR*syM?q@c&c{hxVU2%{v#%Gb+F<SVRPjVdR<
zwR-JObrKMo52EH&JA>-garJo;mmdVPSAU0csZ~3$)=hA0*?e|<uq2uA^Md;4Gi0$Y
zNGBA)D~X5v#jAh+GKg5Ht~_`iv*ibYQmuZKTfr~DNZQ%eOULXj;|3!$Gbus(f3jr&
zPdumf42+;9gg%04%q(n;KDnLL9H{sGeWwp<#y{da7-@@JhN%I8x22}MV@0vfTJNy#
zJm3^R5a1;v+Y%7GVvyx=a1oDn@c1ou1}N)e!DY;l<+Blp9x0@0UQml~b796Ks*c~w
zcot*8-L|k_B0-ljV!fHU_k+WhO}fQn-aQ6PE=RUHE@P;#RtAHR#r5|yd<u$RR?Y*N
z6^a-;u+xrgQXTY-M2qF+ZD5fz7vCjM_|xn6y_dK>453m}eHg4G^F`&?7Y_G84_*D+
zoUcwiM|afGXg^ADsMM<W0*4I!i-RLBWzhL`6I;4<!&{0s`L($-UQ4-k+s8<4UseMj
z<?^7Yv3L6E#dURvD9P`*g;Q<?bfLt-3JvOnTeSM;_Va0=3AnkIhAf?FI1G^7fvTOw
zkKT=EjeBj$O_^EWGSlcPo|C6@TD^3>AA?<JO~dqWew)HA0I?8<A$n=$5~O!{+eOi~
zoHi87QL3oUj*_;UKV7`1A5WX>#GNZrYoBPdDbAj%WAHLURc%JgI@9}DcKs`mKk{jW
zn!Sf+j`wkq{HXZx?ot!O6XQx?7^6?J)}PUCF%sy$6<X4JDgw%<rA_>Z*Aj&4r@eHv
z7J$~bj;R-8ck=g8+u0X1MBU0WKDWJ|2t)5VOx_P`l7AHor}`c6$Scwn5xy#CX5Sr#
z-NV9ZpfvKs!|?)``c}n6GZ0#gm)IuP6U|AfZmDfyBL~LH_~&sjsUV0+ffk|QEeDpt
z=ZP@wEp3dM4TAj(79HW?oh95EkpvDJw$=v*8;tK+?&%{c)-081EN@Fs1{Fe~GC-S$
zPW#m<*p71u;gBQ}4%#?a3vKUwBCUU%qsf^5_KhV>jP+6tZIxP^)7dWF+iJX0$;?R9
zzXj55eBi@Uked8Ee761p!n(C=NFf}prv}`?&muP8n}LMW74!|?V}!WSZ@N5Zc>Gco
z2zgjuQE-G~b*6A&N^0Vr7*qgTfTM;QhXCWM_S1+=Agu)RkvOI4aAC1BfSWbPJPM6!
zJeAN5S^&gH)%;XH3cdvdT)0a-;_oo3GQ`6<e+nrlK*RWdykt-9#5gF@c|6yy-#xJ0
zX-%M(LkKn!+pX9hE+KGkRn|!_m+ml!sy0Q5v!m!BjeVQ$BVIKgqvk1qbVfZOI9OAU
zqc4v6=xFQVP&lBU4XFI;?US_^v<GugF(2>SnVy;4O*g&%9To`;uxd^?HO#oQ&%)+K
z+EWWsbbDjvL43pT)z4n~@)YKj-tSI8MLe5g1^r+`b^WzmbA*FZGEwQ6pDfPxL)l8C
zr2L%4-(K!<#972feX(T3VrVc<aN@PnM?fE-)4dc8jKA8@6JHtGg$zFr=Q)vvri(hK
z^75dFyI@<<^~t%x(lOJstCx=YGmZRDF0A+8WD-dcYxqpAkyW1WY7dJ?5)U8>$INY@
z;};u0G>00W<7$9ZYUUIym}+r9afBM)Igx`-hTmyuhekTstB3Pe&E5lvC6~;r#xxW$
zR6fLY7_t!xG9nx9^Z9q@FB<UwaL7yhUCv1jLyunGRo$dZu3;qg01X>wdsTE!cfO<H
zP8)+W^t$?-f<QJzh1mW|cdJ_R><uqczncScP$IuV0)`=!*OcUbiGFsYp;p4qgzj`_
zSRy!@RW=^-Ld}Z<bo*U%G>CG1Hqu>|Hwn&>|K?ss1+JmCb|w<c@EB+ItMGtYy}!Y7
z?zW()YmyneEjg%%`U3=v^Jn!aAt*8uf1nR3w9;S~f`TA&Kb)8S?8F)~?fIWc=4guN
z^pDIAr1Vz;mUCiLI@3C(3p;g7WD}9G8&|4#NZ1xiop7SlFL2eBpCONcOt;dR`8ua)
z&QIlL14^)Q_@A&aEA!0*O9KP8cob2-YSQKj=X<P)Y)E;<R3oXm-jV7Q7)%Aq?8&Z_
zpi>eQCL3n5qXt4|hM7|<XK}mD+)~M>EKmb9h}`0Pg3K`Wi;rrR*-xoUh`SjfK!>S4
zsU2ir+9eQ9tO{8_-e#I+uVpVRSMH8sFfU+*Va1j@Nz@cUK5QjWd63Z%#e<`XJI0f-
z%lrq1{l^aU)vkDDvO(HNEI*a+r-IK3yEcj}NrO9C<@ON)Dvny)9>(*nhsCLJafB|m
z=Ps>ubG(Zj-!lpS+ql~L-5#(1%Z+wd?@!jDEh*`Xq*@WP#@5!BR+IKX@w}P&kJGhv
zDvn%WGAmA+@6E03zuXNn34jjZj{y$oUB-sVP`%FqShbMDKa}LwMnLW1#i{?TP~b*!
zCM-TfDrB%8dgOWd<neWewmQu&S6O~3J(jTHk(4>y@fd}MF<4}6r@%uO=TN<mYl3ih
zWsIJpbxG7CG)sBFG|I=834t@rox|M~6^L*cC>&f~Nk&sLiAc<pX}&3_r3<TH*d*+B
zRZod)lxC6>LxgHJP;G2!GTX!P`+rH<T6!ih7epX3GAKn%>W`Tocyb>jlnmu$MX<Rr
z<AXR$cx2Io8ty?A%)USMy)P;?_2jRj+Z*zH<{eTw5R5e*p)g!N-`5;V`4t}u60%j=
zGDFA{cURC-zg6rFWx#^gc32PSrK<<6Y^Y=MOOI=?!{)5>ec5{qW-<+opuvi9<=Z>T
z+3d;K_2ngxV5^qQAarYYNz$Di(UH3)^$&z&zmCFfltk(b_{2_vJ~^btc-#enq4e~K
z^gXe}XU2jFpL<^1Z)keD^Z4+JH{B?SHeMcSJ)hwbUjY5jxDva=T5eD*B`sY$1M2MS
zrC+DXhEjmkX-_~{XAsB^El<`Ny6GAIr;-tz5r;a~`I3Or)h%VRK+?g$c6LUD@9yBx
zM1#FXptU!mdPPQN^;J$7>$;&tMAI9oRupJGu_O&4!je#6*@?MetEZc_@4NmR>Qu<#
zMT>!01n)0)bk?IzPYXqoCK;KwvgzXb<GwKRKS4l3#XnQ3gZnu6rR<~Ua-inusTmzF
zTtHq?YB-jnZKk^JltQ}XUZa|#U><Afu`nZ)f#IyIUZ&bIqXv(%Td4L8A;s-amNv)5
zMG-vpz>Agj^}j6vXCIyF1Y-u~Un6nP>DcrP0N;7+YCZ_`Zg+C3#S!$eiHtrPtb8&d
zT>lPbVq#iqpR9*KfT5@^KeAMyuiYMeGO;FJs-<l1Gj47f=V?4}^FbsB^mFtn8W3Bw
z;wwyhMO+-6*6cv#dwX$maq8gE($i?ZOfOEkIPvY)1fQXpet9D5YL%|u(ApRzGjaF^
zv6Y;1q1-pH98Esf2;pdHK#G{$J^AKj>{W@Y=6BLGOq*=X&3xg7hC`LjoZo4=Yerp2
z{adrMVID=eYPRJ0yOV}K7ZuKOMl-mow`JO|;NvQ6YFzF?nSMohhEhm@+KEub^kC>J
z%|SlR!SV$usGb>Yapon!AeY-D1wwN|i0z4~bFyd<7UfYi?KEalJM3F2p>RYv3X6qC
zlZL|iD>Cpw^{C9UG`g?~R}ucuzEl}oH3rwqaO{rCZi3^pnhDO4VeuL=w|?D^*>e<f
zY)cVXQoYtSbaxzjm{ejb+knz0LlZU=q;+57@0`&ckbD?piTW*O2MzVFdY_h~Uz6!K
z5+*v$K50P#c&g&btD%>o8o3}i6_UM@T%AVlcKdB&79uc&NCh?=7NcTq#pgr;%9=!t
zjvX#Nsisl;M*_ug(cO)2*zwe7^f?S7|2s3tGAe11#hD6bY6ooK?-vLbk$fOSs3uvz
z=j*$Ws9m4JJ{P636>hgoc<D$*_K6Sb22Dz1mju;22@8`tR0tktdn~vZVf{*e_C|Mg
zK<FkUxn-fwP&-g4sh<t2?-lgN(nuV3#;c`ov7f;?%F!4E?*$9=Dc<_})gV3MW%c8L
z789L5KmESnMPp@M53&ELSQoU?);74X2&UE1aS*@f)Ac>PXj!S}#~-ByXRWgF%<)&I
z;{b;LEiD@`riIAl0Eo-x{=<vVx5I$_?S0{F&C<Z>i|pE$kMCMq@q@T+L~2@mK)go0
zLd?ULFKTD9?OIw}ORij53okxv`W0>cMt{p?L`wDM!fl*2X#~*_RS(QT6XI!vhBldk
zeB^Vify&6D;5#qGYxR8zXnFCwx0y{O=a#>I9pD`)Y{=l~$J57zIsUp4*8RJ}pUasK
zE@VnKO;%rn=?DXP`fAAH@A5)gP*m{&!6@EA2b?jY0qnDZI^}dyV$zp}llF-cGgOEv
zh}5>ch9&eoN5P`E-+@k>w~3|<Zpmf#aji+)M0P==ctGJiZ|%!T#O!=sLHA?hp(Df-
z%x^N6-WcbEO0mzhgP?Lg3cLs?s@IAiH(!E8K*%VBSL-J$l-Ip)QY78oTrdcAuTSxE
z*srI7h)%yiIx~46o+v&l=u^F@7dA?+k*bgeSfJ>GVcb0I&GQ4!8+DRU(teC}P;+Fz
znOkVZ7+Y?FO#B2#b%R-l)#pup|A+!?Xuxy=cJ(jVR(|6E{}W{YAWOXp<A?^CN5L%2
zN{Ziu-*mBsVO0{V-N-@(6R_M*x)_sP*2|%LKhzxeGnkqrdAIAxJkSiZ=KKoZ_Osql
zp@dk#k1QTOn|)pRM4I!6L`axp%-m8FT_qQh4>POd=Rq`_O7oOr#Y$1pS;}GxGBiJ2
zMQLMe>n_CW#kWr~wM@JCrTU86Q|qZ0x3h88KrLhovA}&->okxL5kJ@3yXBuDLmT?3
z7BG2(4fs~4d))@uZFSht5)n#>9~h!x;yjt5%*SOf_0tXbw)I&ot$H<7L~ZeYhSfEw
z+bl|<9;2PZShP-taw{1$?x)&-bLv5|JCwP6G7g(&{U4Aiq5US~&dbVac{Hhl@@%#u
zF@i$~rk;gH&=ENP#xKBovQxl96sqqrj%gYtMAQ)I79=bb!pI60v7IdlqG1@c);I`W
za-KV$!NA6+1NTl?<k>pt0CI|NAGCPTV!1_urre;8g?cv`v&u1pQZc<S=D%#2$dnnP
z-(m_7;WW%y5QN2?bQMxci~%D%yE9<aP-r<LOYTktD;m7T^~-bYD&pgTJ~w$p0|^ZA
zA&NttR#@3H0klC9a|=?hxZ$7iH&Qt?$`D391Pv7VqBu=Fe`K|m$tswL%@Bl)kcB>j
z|3`(Qf^X@p=zmQEAn|gOsw`%BXZoYOXPd=!n2c8Y_|~oeIE+IgX^5IrF`rLNOjb<J
zD#&}k=^Mxovm5gRpmaRrm)f-Fa1bY+V>s>Q#J=Z0_cjQ7sh(QIEh0)%mVNVz?c;$b
zSWps?6a<u0_TQ=unHfA8e2bV$<_8A?FseW)J*cg<T0j>hci%<0*P?t#1vE;8!zWlo
zLdJV$yhh&hmG9-Q+befly+IT<G&pdd4JI#ZiWd}$xgU8dDhcB(pCvu@e$1?@o6-{p
z>J!L<OL2=wC%p@UIXdFz4g5s6VJ$0;VQ>XXgS4lyxGS}4mqA)>$DCYVg8YVF+GeBi
z<OzR5O!?==OsAqMV2|MeRI-GBPLL<8QkA6t=wX+m|2crQ{LWAKj0nbGTGs9JQg2Q2
zWX#qIc<s--)Gx^Nz1{X{*NahMS8^D|HTq}MPYK^X)*lN0CL=9fc3T0J_jKN8rESH<
zFsk3mNLpIDnCCfiGf>7>Wh5b_#l&=_H9{U){E!EV$_s7Iov)tRFphS0O73|Tkx4Gr
z*4ny!ChhX7oOafWYmMByV2z?KR0%fhH|0j#fbV!HENLWL?I|IIs-HoZ@4+lTAkq9o
zLe<?gf+OHh=4LWPcJ~%wmi5tK!<G7=v0&Uas|0(}SBQJ+f=JtpEC{<A5A|*_@d)mT
zE9O_etqDE=2(!_el-kS2N`m?^lPQmAgRfG8XaT-;Nn+*U6#!Ewz9X#mLd)49@ypxU
zkz$BW4PEitKf`ORWRbU$E;2%eJeA<&wwpjIR}2d?`*05HL|K0ZJ@MZVKu{qw9}zVB
z5yR9-weU;+W>{Nvngq%G4>*apK#;;(vP$&0%162Ph+CPNf|^bg$FCV-f)Af!&Gi|l
z*BrVNS^QZKmjiNpl}pn)zRkpdp@P8rSzJRCQU2_V8dCqz>eB$By(r_U#2yuz6aA<C
ztJwGy$Kof}Xc`cmyp{_4lM)s4yP>W80NHl>^P;4@-0}lLNokDSD62qQcUNXvKP{4&
z)h=Gp*6s|<@h3ny_QXr6BcouN)$6?IUZZpUiC1qv2?qybSw(Gj6x20YMQyVn%W{K4
zr*_65sqU~Tpd?eMH)9=p2xY%T5#N;3UCYO1`jWN=wf);KL=71k`L(vrL?B&!+ueYk
z9w58f+L~KrR+$)?Eq`BBirB0ayC!`gmI1lG873m|)6{zpJF4vLVSD`Yj(-{nr1uF+
z{G&z>Ki$LZA%+zLGE!X4<)b=(Y*%{NRA_X@F_^zYDsp0eFTkS=7>^qSY>&ko;~S`E
z>lna4{(FTae~Z@)9okNQz%=Wn0eFu3Yq+bx#)Ga7uaI`Z$1j{eZ|O+i;OiICsHJ?;
z4KOR&dEaLEfMc1}aW@RcrMO}Fr!e?At*MELb5IEB$|Xhd^oBi@?G7EsG+%h?vH|{l
z0>%6Aw|7<xUfNa~BnOMwK4zANPowAV+!7D>pV~}S`LA54Nb;oh>1wv|bTqu46K+8&
z;1twk(hDP?YNTB%xV%nOhG|!X-oAVVQnR?sF{Et4|NhyTfM>^<(y_v5`UrypkYSEr
zffB}5ukO{PR!=dmnnUIE7_}0A#mh!m!cT%B<-OVZOv?EHg%BO1B4!xx77igwddRy-
zhmmeJl)4WmrkH?2?<0z8%<0Zw6U*t@QFD587aBOK*>*sAd5L*LVby0(vX~8*{>uEl
zl!yuHjt|h*vOIYsarcAO<1Z@cVhSjGXw#<PAPIk;$J_VRoOHK$h`_AkZ+JR=Gi;ks
z>70DlIS0-lFlcLXdhrcdcN_L;tz4PFk-YDe!NtzhJAS{fp$W3Gc1Lfpqve(-w%fTx
zQ7m@Lj^<6$T04<3dU%?@{dUsg;@17WpkXN<L?^GG8Nbv4$Fmc&C`+2H6h|+XD0ru{
zchdn@`so3_+<8mq;eDy!_aFZI%551jObP-yLz9ZH<hQ_}{NK$7Q`j!$BY+Z{4GNgD
zM)ekTx#Go_rX~}K!a@Dez!g?{R<spXy&k<*Ip>^ptMHtN`M=B$k#m8U1J7rj#>P{8
zN+5TUcgtxId=>Xok-GfFX+pNNqTONftPaA};X~@`)Krg{iHJh2rz>RjrV|u%f8y)A
zzii0X&3LL`MkVbZgroTnyd`poR`&t7<lSaLk6D7sw!X1V#wfwI^@|@R>*=yv`~flz
zOR0-!Tyow$J_|Li{=gvs-ctQ5IKF$gWUsUiEk?FM=_ARQ=qvH5T7@LrDs!KuWkm!O
z>PihGLU;G0b<#z)D$+JDr_OF`X9i2;_#dJxW~`vlP!d54Jw1g+g6eUw&GFycKfpeL
zQl)-<IvguYmrh&JuD%Rk%PE~Z7{K<?$v1V9ud&!LsfVt6L=3*)_k$m;{>m6+Q@rU`
zV!e7!TKJX2EFy!P&Q}ipSN_2*pFB$$R^5or;tf&?NCD+Gw-y@oDfyO;vqC2(0t@dn
zz8#7J@d|=Eq`P8dw+ac-BRMe01P6RvDv2MCmiy`|CX>NZuPaDM)<4gb8Hf2k-#ol>
zD||<@<42*4bsf$TjGk5bJo#{1FaGUtG&XQ2TbkJL0k7S<*|HdVMh#kk7gv&D%{eH5
zcBq(|`s5Lng-ErcsvfopKgxhoNDZ@GRv-E)9DJ`yXgRbzaKJbqM_7m-w&-&djuAzm
zf0+Y(N9%=-{S)p3lI~{T6M%=v((-YsNOjA1ABY7}PWd)93$on_GWUz~8O#}`3S9+d
zJOJ~U@tHs<TmS@a61rv09Sc6>N62L#l#qc+WR5pT3Isjm2j^aRlT9wM|0Z$<`3}yA
zol2QOdyRBxS#_M(UgngO=nI7{*SLP?IegUTmhGRk4kg=)LyRfy^$GD=PhO4x_(=Ci
zQEvw9lfV0@mGwXV2XD}v2c@Iya^HxUiy8Q+L0(SLh9sdU%pDGWiJVn?FJg&8<1;%>
zUc8ab%VQrNVUXIKkN&UjB|3LT{q>*k_oPbAA!Kkl^G=06u;!bLqh@wrM*c8>%Xd?r
zPNpE01Cv3~q3Y%|e!Q8gbd68ss%qJPWk`bf9Y^#h<+r3-4{n>j4<~m>@PQmAdMyc)
zvM){W#EE^E5?Otbg7}LXlN%=5N;)MW4aE|*ivcm$$-bQ!>DQxvId2Px7rX8wC@?Eh
zx}YsNJlK=7FHXlt;&~{Vv~!|klSB{;eo$<c0RjoSA93Jq>ZkWOo<5gz?~Ztm{s{O>
zvf|64;3xTCyIFRc`=s(E`xf0}=>2M;!(qIj_%NaYj=$jMw>?F6x0NTKd*MNHV0T*W
zEHh<3#e_fE+SZ&86^7&5S607%0|qY9)a;F|8q!IW5@YUfa+7Q9#6iBpaYsUmr_isH
z3;W`&CmUkYS}eb2|J(&v(hCy1zioJ$-`Mz}NyuX0Oco@Fwql=g`c}tHvreYo-3iK{
z^pf}$p%|c4&0qY@%dc`@P8iAz+P0#-qq@PVEiG7-Dfv^z=WZWFTym#*K3;DJuDSVk
zkjLCb)TWi51c-NOaQqD{4k0YoR7w0#nDJq88k4Tda_#-3fj;tYzc8`?s=UR%MI1`*
zf$B7V+Ry)=2(--RaqsfQ>j$!1|N1Ue>C6#N3VsfEVpnM_hdWpI8iGVjC&axppCR&9
z<i;a7;g(LAr$?V;Xb6^O?&OSONt1y^@XHQ`pk}Gzz@{a-bd^!1R!cdGPxqk&`7N#d
z)fW|A9fu`Y70@ut!?$qAutG$!2y%EhU}Z5I#y<X<+i7PM%9&IoB`WNrj=h0)+}Ro0
zmZf@?)M<325e+7Tb3>CA4z?x{3LjmO4g>lky4EG0SN%mFkK6H?2~FlSB{iy+jML0S
zwUkh0U*xp<@eh#T9am@=+9SBQdrSJ!W=4E>(B@IgGWBGpRE~NX7KOrc600)C>~59h
zsteuj$-i{`BZH>_kq*X>Ko5up>3N>&pi|6L`0mj$+CbC5l#KS><Q{jVh;uUadCQiV
zAG)6hel60V2!nu=Co+`Gc0446DSj!|B&bklqCiJ%F<_E7GcEX&CO6luKEq;Wxr9~L
z9Wv+OV`(ZZ!(%w+{zBbVu9{HjG8NHt9}5}cD>v!>`U=}l9wFgpKrqPTHA^Xfre?B4
z@wfthEL!#U=m)HdK^em0<zh?fm*l9XlF~;Oa5_@b4M(C4nv61Lb}8b{`_eEmd8p5R
z(U>?0tXlq9iHMw~gb|y)@%M+|tJkvzj{3Q2QSG3qv`ICo?VlG9LEo{F4R;}A;cRLD
z$%TihkQEDvc(LLN|0C9AR{(e(ehbytC1_fZoR^erp6=Tw4{M5nG)Cs{5WP?F^$T1b
zO&H&@k={jD|5Z<6;e;^G@;&fQ7(>6#XE2MDhz%ohI6?)q#;THvj=`$@kl>ghV}+K8
z7<XU`U)rR;OjDkx8FOO+5^2fq2qyHsP)3snx>~Y~|Jt#Rc>0}=2nagKV0-gK&Z>Zc
zv-=M=Lt@J2s0Ah{*`gSH$BcC$H+H$71Tz%Ez(~Z{XL8$zq~400?dQs@!iJ3hEvpXx
zSvYvSc*<bYyD2*H*6`dC5ebW`2GyO|uV9~{3$qV8<)jWZ?*6GP&mA{^I5<VzVM$?Q
zhL-0<kRri8?)Y)ZHBJD%E8*@F=wT|aJLG_lc@@lX!iO<Fija>E5=%Xqg6-gAK?oG0
z7TOT@_L+T2S0Dm|RHmm-$}p*u&Ik}@%Xsp=00eQE&lUqc*UQiM%XrI81G6II8e&nF
zqmBp=EZ#l;zQ*dBAV?a@2#21T)p2a;d=O-og^`Al_JiB?AEX<Ani*{PVjRfs+pXb#
zEI#Qx-_ieMT`-uz|J<CNR_-!}SKLlaNsO3CN$egvY7pxx$=!-3g~&YVqX~5Vde|{*
zBc^0_O(7SNA_+fwQ*%}u-Mjb>tpBXIwxb0T^>&idqgwk%OvDe~W6hfO*EzkgCkFPs
z7;tP8M`FOoA~g{U^*_A-*VDPiGyVR5{IeOGXa`A@W@d$&+E6(+Gv*va4yg>y`H(q=
za+p&&%z2I>b1EH(oGPbKhDxZM&rz02sZ`(p{&#*iu3PWx=I3!;@6Yvqy`C?u>M1lP
zWl|x|<H9n|kD+4-mT&oZ<43gfy+?P_Q-oVBHu%KVU>M+@$K4BaJz_3wd~A}>7fdKN
zD(kQuiG5>t1?WmUXeZe>j3+-xBj=GqVBbIGDO(MJGwphYPQ2^Ryvhe5?dJ4G`<rF`
zMS#Fo=hvE-&QJJlMb9c=Cu#`yL6K!$#cu1x`~P}=OO|e_8ee+JoqMFvpN!FRvQ-<#
zq5#gN^Q}$e+bZu4GKh()M@iJO)I~~M%$hWhM|*it{_P$Zb{AknV!zs`fp2_x5&Nzr
zk<Yq#8`?68M!VkcchEdu#5Q|Q8y>=r>5B#&8w8W;*23?%^?bi#nAPj>b(+Im=P>eq
z$Yvb*jyjXj7;Y+6!2s>E9y$zE-%N+)(PX=-TgnHB70;!##b_=Npz_Z4eA&6OYd`-*
zW*(todJ}z4zb)Ib1^1N!1{4^1fwy%lK!AGbmktOBNES@cw)J-OBIS79>Z4CcV=3=;
z%Q{zY>s^La7;#jj=~PENm7B$VC8RXi^YLnG5t68RCL>G~6<{x1P7sc-J^3bk=!EZU
zLK5Lwptw+cAQaa-P-_avQ$&zv6DXYp;ns-si5S?_v-6G`<vq7laSX7%0STtq>Gnwi
z?N96FDHoFjG-BlQcuFsRO%*!w1GcM|WsXC}#v<XV6kmq&>14nKQ$|Twg7Gb~z1c!c
z<gLg!jg<uyrdzXxs?>V^#X){tHRL}024H@kes;=p<>G?^JewID*O`K)LV)o+>Tr)@
z?iG$-IHS5ag$_wnxO}!NsW8+sI_71D#RZBxWIHghGRb$}+eNDfhEve;FnYyrJ?dwz
z6JTkeJHk9fjw&ohaFqy!75Mi!Q>GS{zc+l|5pc=Ay`u|%(`-^GOb+)9HGrDvk+TB@
z%Ko}_I9i%y3>)w+XBLJq;NY(<it=SZC9Gnm{b6Ba)snUUBty`T9iU(;&1Q(P<zx`H
z0RtAp7@o<$Q+SC4p6C}dwdF1sTn-z%w^rR`gnL(a+EUULUk~mqW^T!#Z;iB%v&~Xy
z`++@%@H<n{zS%zm;lus{at0#Eu6ID2Ar(C-syP4nOX9t1Eh-72^eerN4ip-;h;S_J
z8v`L*>QBgXwbPO*O0qk8Nqj_e-<RMw=)nJCYu?K19IBxIdrP?np+cIhO~1UXTsTy6
z{D9tWMV$C4n3y8gU0#d#mMxe0X2_$`)QR<gRiXVd7DPLm2HS+^%7azq_v}~Ahe<0q
zzBQ-7QahWP+v_+s!3Lb2ov&X~U^CD}jp|mPAGhjar0ee1ML&XG_#+L`CCEOxB>}{A
z8h2q^EuT#vlt+GL{w_9Il{oe;wn7s#Z36=Uhfq%ddJ`8zLdpeI$vU;h#~js?cRZPm
zOeV3coVsK?MWq&aTn4JjzeluSe^LtDSS2+;*~5rUL*xcrFtLa7{D%37$^IyJpc1t{
z=f#yk#xjOekOtv3k%5$x-7E=dez_Vn=($zpB`^Q7%)3f53Wx>N0?`}uVnG^&;v3Xa
z?o6LQ!Sfx~wXVYxz3V9}{O$p9lsh`2n9%KZ_L%X4*Dr9eedU}W%&S24MtkeKjnK*M
z1E`X`BNALm29BMh)4)zs#ybw;5bA23lN;}MrnaN&6tDy$n@lNNAz4Way>Xp|0>WSO
zNA9hUI|-FJ?Q0ZhKVK0!L|&%+^2pllJegGoIp|zxTyH{jC|>Z9C<bk}o;hJa{$8fN
zX$ie7S+yP*eIbw3=6tWdN#NWXx>;I!@p%5<L7#Eqq+7|#q~p#httN*qyUL^0p{^?(
zNFC1(O|p(i@P3>A58is&cY171m(SX}8dp^xfEZ=jV_t5=ssvFao_2jYs_i$sEy(ty
zv&b+sT)v8#PGXHi^t%m0Dsdx{7GXw*^r~{U()<luSn;jZ@$0hd=;S-2J(&ZI6#5Zd
zoHUa%t61@9+|*0!V5UG-|8MzFf^)JZr8~j&w}g@?sv&8OE)|=aqcTx`taZYZcEiF>
z+bEx-^OcqQK*Zth#}ALSF<>g?{617>PSC9-d|2Z5dbI;KF|nagA<EK@f$04;W*t=C
z`Yxi!DgV<|)<=P&PBE=^JoK6r^@N2IE(d3U_4V6J9Q*1Lj0<%)r6f(bTE^#JG8r;7
z8o`xRpNfO6m>oa?YtW}<NYrgdKnN{7IzHCPt{hKD?w8IviwHfX2{sN^xZR~0CZ_0~
zM9L_a^6sRhj~@Q-@9ZC7zS}lvuNefqE<69AIS#26*-}tjD<QuRZ?RI$oV{+<GRZOI
zfMBkE8&MY&U|<JGCR--?HTQ4}AcmBIJW8On6}Fk2FAlsCSnt+%GO>-R+*CQO3+a5a
zL795*G$>&lDrxaHsj&L17H@h=NJw<&(@OIlpL6+otDI~Ky9MFqMU$#@O}8;n!Ba=j
zE2tQ_o<-8IS6e_MLhTs<S^5*HYeC`(vAM{`!rdEprTF~PS`DDDn126QHEp7HUIbg8
zBWyioJ(lSycm5#zl2b>=g$pzOI~?!(X);QFnnFRJy{~hd>PH@j;gtRKDPqz#7iW(_
z^KF)D_U>tCKJDmeQ{K~>U};D>{L4FMFAImybpTLo+k?g&h)JISOzE9>$b<~*l>nGE
z>*W*0RTGoV8`DC+IgxTP!H@k&w&${GLIk<A!lvdLA&kXX{kAz{(yz!(uVlDhT^#2Q
zQ$InD>wLAk(JVyr@d*cBe*4C3>-9hPIr4M#FtI>z=jVU)k#jqYfztiGZ7ed8NKjW#
zzw9r?`jadGK}SiIyx)d{x))Z=r@Z$_*$9TNZeVcGg^qw7jzMEu+Eh=ftJLE&f$AY8
zi34s*Dfq$b6v4x<ot+?ezSiknzSF)8!r=21!SEl%HZDTD?I%J<>$eA+9a#xyLYPNs
zQwBp$K93Q&;pH=2+-WkV!bD8WzMn+6xuf?(&n{rHIU|-;f8s=BM8veeHlf6FRdcoZ
zGqcLt6?BY6A>~gDeqxNSY%T{MYl{9Y&~Q7&5&=8AqylbUfrL<r0ZIwnCta5}?NPyG
z!qtYdrkx9x!yPR$_7h-mk8^P(3pdQSCH9!p>Kmd6Hf138I0!eUAF_gYx=4})m2=`*
zfi7B%$|QXoFHrb&7!-GG6#ocb9c>BG>a;!RcDH&@3dUq%7yG<MXK|IkAVNt=bdiMA
z->ZrXyFq|--qJl|egs&2$s=A-0tvC#m3sM!06o3`Ck?qcI#?a~IXkMZT`r?YyQW_~
zx%OT1tKgexR4Q>S4y22G$xAq@wkNj?a7&7b(NRKeszm+xP$$tisPlu=uo8I6&N5^z
zR^_^jfYD@q1A1D}z2p{m0rFrFN<sdLDz1kYrMkIg0+N@2PD+6?%irubudh#w8R`~F
z5+UQ5B1991XYp;Z+Q0-^pF6DAC$4r-gq(0mo`Mj`A~na?UR4iMz7Rgw0Zp18_P~>C
zM?_=B-@le}5`_)<It2|YE&qXaI;$5aGcS>YQd5i_)Psg><Dz9(l4~g(Mxq9~XStGg
zx^y63{d)4FdLdH%#*C^0kn=E;{Gvj6-{UFm<@j1Oio(VY&~{~_x)!qwpGiluR0d5#
zDtFE4-*j1-iM)_JQ{t1H44hM5$&;MWS%=1oeBp;?1}=30`|Efl_KY{g+n^_8{B;XN
z1k8pO^t^!u=BXxKjCNb8ETK};*H$-?1~}JH1B$<&p%U*C3C5%C#s@VFnUj_Oj>p`!
zX<wNv6`eu+S8lwq<tJCyH*kpSL`ha4=IO0`e-HA6=N=BpJv*V9<WYiP^U<A<IXcF6
z>a`56Pdei2U(&M{W3xo7lW)w<Id18_4z~htJ_uYpx1Z}+<9HGq;husMPMT~M&A;S`
zHgAc#$&4wuXo4U7Z%acgOotE)2UB4|03<cC3C*e(l`>LFw}sPm)L1^_S^Chs5LoY0
zIt1i(<YrOM?%hCU*M^=WSsd3xkaC41sDY$-fMjtpFA~FzEK^V=n4bW<8*P(}5LRN;
zn+#Me9q4+8fXG*wu6Abqh~@~|c!a~0-QHI^4^8NKy`Ns_*W05+dn40!!=7(o5zmBP
zbEDoN=1zA{J&L}W^jW^9fC`igxBMz`8b~TlO*cB+Dfd$yRN)b^-+$d0CfRHJpxKn!
z;`F2)GK|PpKdck_vH}Xu)I>4?t`ApP!r<ik`!EDkOzctZT2S(+-@3ZJ-KNr#EhLua
zl#Y*8|9mwjW$g-Nv}=@Ad4Nioqn-0twjF#Wf)$gS>^$M>Z3NTpvq)XyL*AMi_7db`
zcvGfpfu0Y}`9OEgx48~_FVUSvpi#w<gHM0EF5N!u5!cvim2V+bFjDQtv|RV*@0>`G
z0hRnj9$)JGUDhgHIfDjxI=tT>qJ2Lv|2p@pug7FRI%ripUN?kSXX7Vpbub&(l2`FI
zqWBEcY@9i#8)&m@s8_)@<WuBLJ#(=`7FM>a=6B<Bik}`dde$VLsQ?<>A~fM^J5{G7
zGbHzMp-CYJ8GTrE4H|+ohLLc#umlxZ(VR|YKI<*1GDnts0NPqa#mGPV)v@qIPPO@4
zP{ma7fZ+duLc#6VN;HxkXG)TID|!~7nvrsU+6~2ikyx{N8W3XzbYdbxVmSfEv`aiZ
zC4Di^fUIW5@cZ|JSmJgJ3z;+4ucew?h-%osc<h_D$gVH2dyYmrSBr$`MzPwpd-$k7
zL}?Zw{vn-mBlxUJ#&s53F8jh?v%=nz(=5vm^w!Jx2V+V1Ps=ca?rFe{rsY!(wKZbP
z&K#xmx-&o;!9loGcWNmG8vMcx45z3SjRx^P!mH-tS9Pw1BCu6h-h%gvK18x0UipCv
z1XdPb88UlVBGagqeR!|t;^2-nF@*(tZFg^cxeJk?T_lldrn%4!x&vX{3B8Fh69!x~
zog*9ZS_~DL0fa<5Bu4*7_7##&^pP&xv9%ZhFL#KXMr6bk^u1J%Nr63lD+;t?_JtHh
zSI|@}$X~6m?!2Gwcl<Z-{GyuLE8D@<68;3^L4Z)L;;5Pj6GaC^!&6`pvf!u+>s?bS
z8fwo^b5ftDUM@mRqy(#(d73PJj4KG}aZEqUx*d4wIx6Y%-<~F);fPjeyQZd4y?Znm
zaXdsNVYOI!%J}+|ogP1oW|TK0Uu>p&cfasbqgh(#BParuMsV)h8`I#M&=V9M)f0Ga
zYAMGo%MxmZb#4Asv6A{YAiBmlJ$3bqefXR>Ac?YRNk8v#)!|I!;wGo(`)!BLJ+-#q
zNrWxp*fdvgZV5>lp|+5<EK(d34pki}r~W<)b_H%EwYR6s&_DE%@j9Q$GccS4N%h7%
zZRTaj?niDD@dd(}s?72@7gXtEO^Aw5&;W+770pP*P(Orye{ay6vi<nrukYaji~grM
zCAZs+%G%qQUvHp@(cb8Vi2);cMprcD<OLSzTT1+8cPSv0)N-+3efuful@RAPvLzE*
zS)m>wro0m#wYr#a`M(>4UDPFg1FSv$ShBpc#O)_X?cnF3Q3tiN+CkDb?Ps2M;{n8;
zsBat)dge*WGyY*ET+khBu=M%u=$3Q9%11+7rui)rQ~0`5Q1Vn4Z8>c92G&8ti9*?>
zw5Vh$WZSr6p=A%a01`rh$RID{@=?3pA6(M+x?_WELK=U1KmEZ0uvj<T^78G#N%p%G
zU%4wasX=vUQ%{{-_%#(UY!}XmWwq@yD_5p3|I_q08JHtMC8SKe-L$M!F<8x(!lDAL
zhGE)^E^pjdiVpbAlrEk&&+LVX<iO5k{WxD4z_+2Y6w_h}(#oAMguU$MfT<q-@`|x_
z{q1EVXSKmx`CsNC=76iKWV3|KENt1IK7b%%vyorh(Er??-+SaHPUan&jm%uXy7svJ
zcKb0O0hA7JMycFsnw?Dlb49W=Nqp(9LX^%4in(R#fc<%?sa#a4`~IyQ%eJJ%+~(fm
z_0iWIP(u1;Y&sobus{X7<#{1tNu#!4JX{jfjUVIn6{8pD74kzoY46}>R!vUXx>+xZ
zdcyNHqW#2&P|kKCo|Lw$w=|!ba|ST_^}sGI>3zn@;v6#NY{`K0Io-Y?k$Jwfvxd5#
znhtiiT&D`MOGXyNVP9|8#+n=o9fO65!Jto%M~L>zdQ-o?jwxs{7NtVqBPW;HeeQb=
z9WU6BmGTZ*A8~!^cS%CJxX0$mC;$1FaHYJ2Jsa*M48+A)>z2jHNi4c_77&?FPAnf4
zCm06*$n`>N-qGveH~3#N`SX$3Kd8zloIFBHse!dewy26?$>KHy@FRjD8Eo8jNGkX~
zC$G6ff;BqSDVDN|`*Uo9-U~}4Flw8cn!!Pt`fsQ=*HI|LLgU9b#vJSrTU{z_&?^N3
zCONB#FOpX{tMS4pHGXU)>}iJVoe|BW_7t3sZyMv1Ne}PvQH8Ps5RbOLc(rwU4URPG
zGUqRW;L=Dq9WG7W)>W}OwE5xat?c&=E`6DR5S2k$B8J`+kbHqKaw0}ZjN79Cbvz<k
z5xGJ${vCS&8KiP~_9adtBYmaF_Se3Dn+0NfegxFF6&B9Rv(HqB4A-`16B<`CT~O4C
z)FQXfsY~0Z^a2W7xz36KcHYGR=F7iJnp?wOs)P6>+!pLy_^EkH$w`myaYyeD0z0wq
zb<U`vy3CwOh3XCSupK?*>Z#2~McjH`*II;9@E-T@aGROE7S~>hAN~MI%6(i&S3dOo
z2vU4LxwU1X%Vf|$lXv9@31sZt@T74wo_wlW0Y)_X8CW`s|F{t4p7-Yc_}l57k}}gA
zTzT=n13=DMl^ePB8AKi<_w12L+eT$2{n!Bl6#aW5CdWZUUR8s@yq#7s^u_?x9Z!<a
z2U>g7sYiSquiPx1S0H$(IWBn+(nwV~a5>*`qh-C&3GHiAv?+E3|CJ!lszZ`rbtHpu
z<^D$<GFoA`C>8pCdjsirI(Zr;;6{>{z9mc%a(+qtvU~xj!1V^wrK^B2&7SjD+>z_^
z5GD)MkOM0o#a09k>Ezg9bj-CI|0KADf7OU~k?#d#lEu6Hdn8lku}0f&+j)fr<VtgC
zY}By%J~)JSK-Jt%OmVBW5Oq)&#>UwHt!X3GtdU&R)V{;;hEtDEqVn$U!5nN*d?0RT
zFMMj(O9B|z{il?50t*)dLkFhEMcv(3^zb5Cx<%2a=rg96R6q=YP(68CcK4enW7JW5
zap4CagDU|@TRVVzD)lTACR(82>J+ZwJr@{u$&zx40z>(q^T@$e_S5J_`Y!?X&sxH@
z$bA)S^KcwErW}pLOMLJ*P4KR#r&D4+@l6OA41(7YoMViO@#N2s?(S2!J2Xu2mez+J
z*T{9#Ukm5FJ*Gqy>ilG&0Kc8{)cI%O#n$}+e%1YiRnK-fKjQh2=4_`Oe6C=Ohh2M!
z(9Ur8Sv}lKlb*YuYdgj*VSSXX8lCQ(exemGo0WLyiYeSBW$yA(^wWXyfAsQAm;2S<
z?p(@UDmdzO<O5OPoos{;zPX9DK$u6rxK+B0brb(?JYFFzxRnZu3eIGBh5bbIbZ?h)
zbD}+;XadNcmY#%uCwSN+pp4VwFE9z&wC_?k6QkdFF_(_!ua{FeMw(LdBK0cl+k0eF
zFyN`FsqNZH4kPqp2FRTIko!4tASz615El1=La@+%-H`9>SGVI=R0aJ0z-)9K{16cn
z5dLX^+&iPFM#Z3N+X@z=4Gv|sd<kZ?-*c$oKALn7&2)QmZDcEU0EUq7vp!aNdi?U0
z&o<+K+T@o0OxXKAY+8XJ6G7Z@JP#C;0*YxcdU}9^etjq43A%++gDS_}+nr!bw-myN
zPi_}H(wmx!e^)>pe3(=U%`{bpm(NT`XTeLP=e$%|5UxX6;GqTQT}I}YV}jpBco_J5
zD_Cbe-X2|>E*@RMRp4)dN?Ls<PsATUaqmjNWI9h|YwDUNYFmcQS!5hO_1U<7gWeIE
zFJaJYj-7dBFt5L`JN53aBycG<U#`^yJdl~MX~c3$6y1zSOLjU>%TP%mYM-TK;cJ9S
zoKvx~T-%2G$-86+=2zxYU0srS!iMhM;%T%O0;~4LryV+a`ErTpq2GTKYnOJkVrrlG
zO%|{FW4j@Ybb3lDG#sKx<_PEz^cbWzYxdN^a^rtkzEyN+e`|7h?MFA;-!*y-ylarD
zq%eKT!z-?O0tW@ZO=fM>lY!m%@;8NB_^hqeaOuk9Lhk<e{E@syxl|3nAFwaMZh6jp
zUZHzEOwL$Xux<^QEd3~kl8K$h{PJ!xeQ{JAyZCEf^S}yR#%>S(2PvpyDl{zMW0tn7
z^2=D+4&&Y1;ve{>pKFaxHrNFUSp^%BBaa?78Rh&@A8AdywYK#w;;{j;HfvKri;>`%
zIxi&CDv?T@ccZ^`{MPTI+f%}MzTX|{yl##@0NY$HV!&%A$ItnMc!{$W^m<(+u=ctQ
z!h*-%eopi!3ft>=KuGCOfM4#$lWPRTgwWBQv)O0ehx9ufy+b!^YOOJZR)P$@pa8Z?
zxYF`%W{+Ppe)iucbvZKl_H5|FPpeM%U$X9uP+Qv&Ka~Evj@jCHiu&K<b*~l|f6||P
z|4#@@lK4&kj~4;}03z7XA=uQ)kg8%GLihCwjsP@N`zalN1SQn}N(KSG0YS__y4xi{
zHFmeWV15P2|F396_Y3s(^7l|-(A|Os+W^&YRXj1A`2TC!da^~Z889)lq}(OD#Qh)X
CbnBe}
literal 0
HcmV?d00001
diff --git a/helm/matita/icons/whelp.png b/helm/matita/icons/whelp.png
new file mode 100644
index 0000000000000000000000000000000000000000..5597d51e6b415ea647062df0c3ed5213a54e43c0
GIT binary patch
literal 1072
zcmV-01kd}4P)<h*8VUda018P+L{b0%02BZK022rX0001xj4ibQ000DYLP=Bz2nYy#
z2xN!=000?uMObuGZ)S9NVRB^vcXxL#X>MzCV_|S*E^l&Yo9;Xs000BSNkl<ZIE{^z
zYfM{Z7{~vIb9$vIthJ@By>MAQNNJHO7{NKSIhJ8!m?pS5BML0u5}dch_+_G*`eB$&
zzi5bq%<N*agk&?BaaF=#$d)shEn#JYLOU3(gLV<<O3yic{a|QXiqYrO`@HY-{PO?5
zH;NE~|BAPons!%MEFa4Nmmrm1pN>Wk9qH-0v{@~)aiX!V?veV+%8o*n%HRu!Pkejo
z)S0asO;<%xkz;yc0qmA7Pv;SG6o9+N;V9WvUH!gNsZ?DF1dg8fc&<~K3Mq=BkF~YU
zmKu%b>2Me&1_Sy2^5r*PbUME_=yWpw+#JfyX3WK6YiEXrUVf>r?u1FJRq%p<<wSz#
z78gIv%T)J#ef?_=o6X$s^Fa_r$Qg#(SzZ0?o#o|g03c=lF|?9O{a(+q2TWS6VrpRl
z!+t+BDwV{hR<|<%P+L`HHS6^iqvPXe15W3c6&8zD5JeCG!C36Vq|euXUlc!JfVxN`
zF~rTxeDQ?E(gy%Dkq8)?1_02h)C2U|<mBNUcKgYv?DiIGaq%8sDD;U+F4uyl<6J0o
za%_GvSW;QLGgW9*hXo8@3j~IL?)PwJolfPlT6ZNy5jA!@0O01mdp}U$w71X3dEO?7
zA|5R(!;fC?>pgva-7PI|e_mehKESdST8g65+rsla0)ZQMZr%E$OZsO>{gBbv#4wC<
zVP)m~Z$96rOhOcI-cKfNMTLb}T3ucB&V<G~Iu4C(-@dylFE4A00RR$-1T5<^S*=^U
zIBsCz-LE>`gpkzwIxX=0h|Oe@CJ9;Mg2B!Q%WDrdG(7iYrmD?CB9XvsE-lvUb>_y#
zXU?T>O6IlMyZ4oY&CRV{3WXvqEtN_kQ|aK~FW9!NA)QB~cas+{o_*o;>E53JAj?x}
zDZ3*R1^`#DW<Lm?PiEyBjZSK{mNl*CS<U(RYIdWwXmk;T5O}>D03aS;&9SdmYaBU1
zilQi*X4D&t2}xmmd=&HZLBwK9kjs@hK$>O>a)5*ol1Rj-Hx|p~3UJ&I6bdCgo^x=y
z9?Jp7<13Tv<E+mi7Q1@`Kz-(%Mx#SPfd({9L#fP%UT@3+hQqhLX{VW|>~cMB+rR(K
zODy}aHK*%eVq#)!;`s3+?y0G%HDJS`c)eGGBO||l6pbz={tqk?ng7f0=U!ch<tSW_
zef!#)9gdn#r?a|zGmsz%n3xzH3IxXA>+St+AaiX~AOKJlC2MVc=QD%B;+Dx2B{a=w
q2@%4HM0_?9xjoq3eeCdNeSZV`afNGQ`6!400000<MNUMnLSTZh8u=~&
literal 0
HcmV?d00001
diff --git a/helm/matita/icons/whelp.svg b/helm/matita/icons/whelp.svg
new file mode 100644
index 000000000..c1da66f6d
--- /dev/null
+++ b/helm/matita/icons/whelp.svg
@@ -0,0 +1,221 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<!-- Created with Inkscape (http://www.inkscape.org/) -->
+<svg
+ xmlns:xml="http://www.w3.org/XML/1998/namespace"
+ xmlns:dc="http://purl.org/dc/elements/1.1/"
+ xmlns:cc="http://web.resource.org/cc/"
+ xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+ xmlns:svg="http://www.w3.org/2000/svg"
+ xmlns="http://www.w3.org/2000/svg"
+ xmlns:sodipodi="http://inkscape.sourceforge.net/DTD/sodipodi-0.dtd"
+ xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
+ inkscape:export-ydpi="2.8499999"
+ inkscape:export-xdpi="2.8499999"
+ inkscape:export-filename="/home/tassi/helm/matita/icons/whelp.png"
+ sodipodi:docname="whelp.svg"
+ sodipodi:docbase="/home/tassi/helm/matita/icons"
+ inkscape:version="0.41"
+ sodipodi:version="0.32"
+ id="svg2"
+ height="297mm"
+ width="210mm">
+ <defs
+ id="defs3" />
+ <sodipodi:namedview
+ inkscape:window-y="47"
+ inkscape:window-x="538"
+ inkscape:window-height="743"
+ inkscape:window-width="697"
+ inkscape:current-layer="layer1"
+ inkscape:document-units="px"
+ inkscape:cy="526.18109"
+ inkscape:cx="-47.832055"
+ inkscape:zoom="0.53878789"
+ inkscape:pageshadow="2"
+ inkscape:pageopacity="0.0"
+ borderopacity="1.0"
+ bordercolor="#666666"
+ pagecolor="#ffffff"
+ id="base" />
+ <metadata
+ id="metadata4">
+ <rdf:RDF
+ id="RDF5">
+ <cc:Work
+ id="Work6"
+ rdf:about="">
+ <dc:format
+ id="format7">image/svg+xml</dc:format>
+ <dc:type
+ rdf:resource="http://purl.org/dc/dcmitype/StillImage"
+ id="type9" />
+ </cc:Work>
+ </rdf:RDF>
+ </metadata>
+ <g
+ id="layer1"
+ inkscape:groupmode="layer"
+ inkscape:label="Layer 1">
+ <g
+ transform="translate(7.424147,-25.98425)"
+ id="g2113">
+ <path
+ transform="matrix(3.092445,0.000000,0.000000,3.244102,-1367.216,-1102.351)"
+ d="M 277.14285 465.21933 A 21.428572 18.571428 0 1 1 234.28571,465.21933 A 21.428572 18.571428 0 1 1 277.14285 465.21933 z"
+ sodipodi:ry="18.571428"
+ sodipodi:rx="21.428572"
+ sodipodi:cy="465.21933"
+ sodipodi:cx="255.71428"
+ id="path1310"
+ style="fill:#ffffff;fill-opacity:1.0000000;fill-rule:evenodd;stroke:#000000;stroke-width:0.31571975;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4.0000000;stroke-opacity:1.0000000"
+ sodipodi:type="arc" />
+ <path
+ transform="matrix(3.577041,0.000000,0.000000,3.764523,-1365.700,-1442.358)"
+ d="M 277.14285 465.21933 A 21.428572 18.571428 0 1 1 234.28571,465.21933 A 21.428572 18.571428 0 1 1 277.14285 465.21933 z"
+ sodipodi:ry="18.571428"
+ sodipodi:rx="21.428572"
+ sodipodi:cy="465.21933"
+ sodipodi:cx="255.71428"
+ id="path1316"
+ style="fill:#ffffff;fill-opacity:1.0000000;fill-rule:evenodd;stroke:#000000;stroke-width:0.27251038;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4.0000000;stroke-opacity:1.0000000"
+ sodipodi:type="arc" />
+ <path
+ transform="matrix(3.536915,0.000000,0.000000,3.972675,-1343.944,-1485.563)"
+ d="M 322.85714 442.36218 A 22.857143 18.571428 0 1 1 277.14286,442.36218 A 22.857143 18.571428 0 1 1 322.85714 442.36218 z"
+ sodipodi:ry="18.571428"
+ sodipodi:rx="22.857143"
+ sodipodi:cy="442.36218"
+ sodipodi:cx="300.00000"
+ id="path1322"
+ style="fill:#ffffff;fill-opacity:1.0000000;fill-rule:evenodd;stroke:#000000;stroke-width:0.26677564;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4.0000000;stroke-opacity:1.0000000"
+ sodipodi:type="arc" />
+ <path
+ transform="matrix(3.750966,0.000000,0.000000,3.972675,-1450.760,-1408.096)"
+ d="M 382.85716 436.64789 A 24.285715 21.428572 0 1 1 334.28573,436.64789 A 24.285715 21.428572 0 1 1 382.85716 436.64789 z"
+ sodipodi:ry="21.428572"
+ sodipodi:rx="24.285715"
+ sodipodi:cy="436.64789"
+ sodipodi:cx="358.57144"
+ id="path1328"
+ style="fill:#ffffff;fill-opacity:1.0000000;fill-rule:evenodd;stroke:#000000;stroke-width:0.25905198;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4.0000000;stroke-opacity:1.0000000"
+ sodipodi:type="arc" />
+ <path
+ transform="matrix(3.536915,0.000000,0.000000,3.972675,-1478.347,-1461.727)"
+ d="M 394.28573 513.79077 A 65.714287 52.857143 0 1 1 262.85715,513.79077 A 65.714287 52.857143 0 1 1 394.28573 513.79077 z"
+ sodipodi:ry="52.857143"
+ sodipodi:rx="65.714287"
+ sodipodi:cy="513.79077"
+ sodipodi:cx="328.57144"
+ id="path1334"
+ style="fill:#ffffff;fill-opacity:1.0000000;fill-rule:evenodd;stroke:#000000;stroke-width:0.26677564;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4.0000000;stroke-opacity:1.0000000"
+ sodipodi:type="arc" />
+ </g>
+ <g
+ id="g3923"
+ transform="matrix(3.536915,0.000000,0.000000,3.972675,-801.3348,-1982.086)"
+ inkscape:export-filename="/projects/helm/daemons/searchEngine/html/whelp.png"
+ inkscape:export-xdpi="100.84000"
+ inkscape:export-ydpi="100.84000">
+ <path
+ transform="matrix(0.874334,0.000000,0.000000,0.816604,44.53485,211.7504)"
+ d="M 277.14285 465.21933 A 21.428572 18.571428 0 1 1 234.28571,465.21933 A 21.428572 18.571428 0 1 1 277.14285 465.21933 z"
+ sodipodi:ry="18.571428"
+ sodipodi:rx="21.428572"
+ sodipodi:cy="465.21933"
+ sodipodi:cx="255.71428"
+ id="path2998"
+ style="fill:#780000;fill-opacity:0.48627451;fill-rule:evenodd;stroke:#000000;stroke-width:1.0000000px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1.0000000"
+ sodipodi:type="arc" />
+ <text
+ id="text3000"
+ y="600.53583"
+ x="257.61462"
+ style="font-size:36.000000;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;fill:#000000;fill-opacity:0.78431374;stroke:none;stroke-width:1.0000000px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1.0000000;font-family:Domestic Manners;text-anchor:start;writing-mode:lr-tb"
+ xml:space="preserve"><tspan
+ y="600.53583"
+ x="257.61462"
+ id="tspan3002"
+ sodipodi:role="line">h</tspan></text>
+ <path
+ transform="matrix(1.011345,0.000000,0.000000,0.947604,44.96344,126.1641)"
+ d="M 277.14285 465.21933 A 21.428572 18.571428 0 1 1 234.28571,465.21933 A 21.428572 18.571428 0 1 1 277.14285 465.21933 z"
+ sodipodi:ry="18.571428"
+ sodipodi:rx="21.428572"
+ sodipodi:cy="465.21933"
+ sodipodi:cx="255.71428"
+ id="path3004"
+ style="fill:#780000;fill-opacity:0.48627451;fill-rule:evenodd;stroke:#000000;stroke-width:1.0000000px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1.0000000"
+ sodipodi:type="arc" />
+ <text
+ id="text3006"
+ y="573.53583"
+ x="292.11462"
+ style="font-size:36.000000;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;fill:#000000;fill-opacity:0.78431374;stroke:none;stroke-width:1.0000000px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1.0000000;font-family:Domestic Manners;text-anchor:start;writing-mode:lr-tb"
+ xml:space="preserve"><tspan
+ y="573.53583"
+ x="292.11462"
+ id="tspan3008"
+ sodipodi:role="line">e</tspan></text>
+ <path
+ transform="translate(51.11460,115.2886)"
+ d="M 322.85714 442.36218 A 22.857143 18.571428 0 1 1 277.14286,442.36218 A 22.857143 18.571428 0 1 1 322.85714 442.36218 z"
+ sodipodi:ry="18.571428"
+ sodipodi:rx="22.857143"
+ sodipodi:cy="442.36218"
+ sodipodi:cx="300.00000"
+ id="path3010"
+ style="fill:#780000;fill-opacity:0.48627451;fill-rule:evenodd;stroke:#000000;stroke-width:1.0000000px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1.0000000"
+ sodipodi:type="arc" />
+ <text
+ id="text3012"
+ y="570.53583"
+ x="345.11462"
+ style="font-size:36.000000;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;fill:#000000;fill-opacity:0.78431374;stroke:none;stroke-width:1.0000000px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1.0000000;font-family:Domestic Manners;text-anchor:start;writing-mode:lr-tb"
+ xml:space="preserve"><tspan
+ y="570.53583"
+ x="345.11462"
+ id="tspan3014"
+ sodipodi:role="line">l</tspan></text>
+ <path
+ transform="matrix(1.060519,0.000000,0.000000,1.000000,20.91431,134.7886)"
+ d="M 382.85716 436.64789 A 24.285715 21.428572 0 1 1 334.28573,436.64789 A 24.285715 21.428572 0 1 1 382.85716 436.64789 z"
+ sodipodi:ry="21.428572"
+ sodipodi:rx="24.285715"
+ sodipodi:cy="436.64789"
+ sodipodi:cx="358.57144"
+ id="path3016"
+ style="fill:#780000;fill-opacity:0.48627451;fill-rule:evenodd;stroke:#000000;stroke-width:1.0000000px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1.0000000"
+ sodipodi:type="arc" />
+ <text
+ id="text3018"
+ y="575.03583"
+ x="392.11462"
+ style="font-size:36.000000;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;fill:#000000;fill-opacity:0.78431374;stroke:none;stroke-width:1.0000000px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1.0000000;font-family:Domestic Manners;text-anchor:start;writing-mode:lr-tb"
+ xml:space="preserve"><tspan
+ y="575.03583"
+ x="392.11462"
+ id="tspan3020"
+ sodipodi:role="line">p</tspan></text>
+ <path
+ transform="translate(13.11460,121.2886)"
+ d="M 394.28573 513.79077 A 65.714287 52.857143 0 1 1 262.85715,513.79077 A 65.714287 52.857143 0 1 1 394.28573 513.79077 z"
+ sodipodi:ry="52.857143"
+ sodipodi:rx="65.714287"
+ sodipodi:cy="513.79077"
+ sodipodi:cx="328.57144"
+ id="path3024"
+ style="fill:#000050;fill-opacity:0.31372550;fill-rule:evenodd;stroke:#000000;stroke-width:1.0000000px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1.0000000"
+ sodipodi:type="arc" />
+ <text
+ id="text3026"
+ y="655.03577"
+ x="317.61459"
+ style="font-size:64.000000;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;fill:#000000;fill-opacity:0.78431374;stroke:none;stroke-width:1.0000000px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1.0000000;font-family:Domestic Manners;text-anchor:start;writing-mode:lr-tb"
+ xml:space="preserve"><tspan
+ y="655.03577"
+ x="317.61459"
+ id="tspan3028"
+ sodipodi:role="line">W</tspan></text>
+ </g>
+ </g>
+</svg>
diff --git a/helm/matita/library/Makefile b/helm/matita/library/Makefile
new file mode 100644
index 000000000..fd278eb40
--- /dev/null
+++ b/helm/matita/library/Makefile
@@ -0,0 +1,57 @@
+SRC=$(shell find . -name "*.ma" -a -type f)
+
+MATITA_FLAGS =
+NODB=false
+ifeq ($(NODB),true)
+ MATITA_FLAGS += -nodb
+endif
+
+MATITAC=../scripts/do_tests.sh $(DO_TESTS_OPTS) "../matitac $(MATITA_FLAGS)" "../matitaclean $(MATITA_FLAGS)" /dev/null OK
+MATITACOPT=../scripts/do_tests.sh $(DO_TESTS_OPTS) "../matitac.opt $(MATITA_FLAGS)" "../matitaclean.opt $(MATITA_FLAGS)" /dev/null OK
+VERBOSEMATITAC=../matitac $(MATITA_FLAGS)
+VERBOSEMATITACOPT=../matitac.opt $(MATITA_FLAGS)
+
+MATITACLEAN=../matitaclean $(MATITA_FLAGS)
+MATITACLEANOPT=../matitaclean.opt $(MATITA_FLAGS)
+
+MATITADEP=../matitadep $(MATITA_FLAGS)
+MATITADEPOPT=../matitadep.opt $(MATITA_FLAGS)
+
+DEPEND_NAME=.depend
+
+H=@
+
+all: $(SRC:%.ma=%.mo)
+
+opt:
+ $(H)$(MAKE) MATITAC='$(MATITACOPT)' MATITACLEAN='$(MATITACLEANOPT)' MATITADEP='$(MATITADEPOPT)' all
+
+verbose:
+ $(H)$(MAKE) MATITAC='$(VERBOSEMATITAC)' MATITACLEAN='$(MATITACLEAN)' MATITADEP='$(MATITADEP)' all
+
+%.opt:
+ $(H)$(MAKE) MATITAC='$(MATITACOPT)' MATITACLEAN='$(MATITACLEANOPT)' MATITADEP='$(MATITADEPOPT)' $(@:%.opt=%)
+
+clean_:
+ $(H)rm -f __*not_for_matita
+
+clean: clean_
+ $(H)$(MATITACLEAN) $(SRC)
+
+cleanall:
+ $(H)rm -f $(SRC:%.ma=%.moo)
+ $(H)$(MATITACLEAN) all
+
+depend:
+ $(H)rm -f $(DEPEND_NAME)
+ $(H)$(MAKE) $(DEPEND_NAME)
+.PHONY: depend
+
+%.moo:
+ $(H)$(MATITAC) $<
+
+$(DEPEND_NAME): $(SRC)
+ $(H)$(MATITADEP) $(SRC) > $@ || rm -f $@
+
+#include $(DEPEND_NAME)
+include .depend
diff --git a/helm/matita/library/Q/q.ma b/helm/matita/library/Q/q.ma
new file mode 100644
index 000000000..340154979
--- /dev/null
+++ b/helm/matita/library/Q/q.ma
@@ -0,0 +1,320 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/Q/q".
+
+include "Z/compare.ma".
+include "Z/plus.ma".
+
+(* a fraction is a list of Z-coefficients for primes, in natural
+order. The last coefficient must eventually be different from 0 *)
+
+inductive fraction : Set \def
+ pp : nat \to fraction
+| nn: nat \to fraction
+| cons : Z \to fraction \to fraction.
+
+inductive ratio : Set \def
+ one : ratio
+ | frac : fraction \to ratio.
+
+(* a rational number is either O or a ratio with a sign *)
+inductive Q : Set \def
+ OQ : Q
+ | Qpos : ratio \to Q
+ | Qneg : ratio \to Q.
+
+(* double elimination principles *)
+theorem fraction_elim2:
+\forall R:fraction \to fraction \to Prop.
+(\forall n:nat.\forall g:fraction.R (pp n) g) \to
+(\forall n:nat.\forall g:fraction.R (nn n) g) \to
+(\forall x:Z.\forall f:fraction.\forall m:nat.R (cons x f) (pp m)) \to
+(\forall x:Z.\forall f:fraction.\forall m:nat.R (cons x f) (nn m)) \to
+(\forall x,y:Z.\forall f,g:fraction.R f g \to R (cons x f) (cons y g)) \to
+\forall f,g:fraction. R f g.
+intros 7.elim f.
+ apply H.
+ apply H1.
+ elim g.
+ apply H2.
+ apply H3.
+ apply H4.apply H5.
+qed.
+
+(* boolean equality *)
+let rec eqfb f g \def
+match f with
+[ (pp n) \Rightarrow
+ match g with
+ [ (pp m) \Rightarrow eqb n m
+ | (nn m) \Rightarrow false
+ | (cons y g1) \Rightarrow false]
+| (nn n) \Rightarrow
+ match g with
+ [ (pp m) \Rightarrow false
+ | (nn m) \Rightarrow eqb n m
+ | (cons y g1) \Rightarrow false]
+| (cons x f1) \Rightarrow
+ match g with
+ [ (pp m) \Rightarrow false
+ | (nn m) \Rightarrow false
+ | (cons y g1) \Rightarrow andb (eqZb x y) (eqfb f1 g1)]].
+
+(* discrimination *)
+definition aux \def
+ \lambda f. match f with
+ [ (pp n) \Rightarrow n
+ | (nn n) \Rightarrow n
+ | (cons x f) \Rightarrow O].
+
+definition fhd \def
+\lambda f. match f with
+ [ (pp n) \Rightarrow (pos n)
+ | (nn n) \Rightarrow (neg n)
+ | (cons x f) \Rightarrow x].
+
+definition ftl \def
+\lambda f. match f with
+ [ (pp n) \Rightarrow (pp n)
+ | (nn n) \Rightarrow (nn n)
+ | (cons x f) \Rightarrow f].
+
+theorem injective_pp : injective nat fraction pp.
+unfold injective.intros.
+change with ((aux (pp x)) = (aux (pp y))).
+apply eq_f.assumption.
+qed.
+
+theorem injective_nn : injective nat fraction nn.
+unfold injective.intros.
+change with ((aux (nn x)) = (aux (nn y))).
+apply eq_f.assumption.
+qed.
+
+theorem eq_cons_to_eq1: \forall f,g:fraction.\forall x,y:Z.
+(cons x f) = (cons y g) \to x = y.
+intros.
+change with ((fhd (cons x f)) = (fhd (cons y g))).
+apply eq_f.assumption.
+qed.
+
+theorem eq_cons_to_eq2: \forall x,y:Z.\forall f,g:fraction.
+(cons x f) = (cons y g) \to f = g.
+intros.
+change with ((ftl (cons x f)) = (ftl (cons y g))).
+apply eq_f.assumption.
+qed.
+
+theorem not_eq_pp_nn: \forall n,m:nat. pp n \neq nn m.
+intros.unfold Not. intro.
+change with match (pp n) with
+[ (pp n) \Rightarrow False
+| (nn n) \Rightarrow True
+| (cons x f) \Rightarrow True].
+rewrite > H.
+simplify.exact I.
+qed.
+
+theorem not_eq_pp_cons:
+\forall n:nat.\forall x:Z. \forall f:fraction.
+pp n \neq cons x f.
+intros.unfold Not. intro.
+change with match (pp n) with
+[ (pp n) \Rightarrow False
+| (nn n) \Rightarrow True
+| (cons x f) \Rightarrow True].
+rewrite > H.
+simplify.exact I.
+qed.
+
+theorem not_eq_nn_cons:
+\forall n:nat.\forall x:Z. \forall f:fraction.
+nn n \neq cons x f.
+intros.unfold Not. intro.
+change with match (nn n) with
+[ (pp n) \Rightarrow True
+| (nn n) \Rightarrow False
+| (cons x f) \Rightarrow True].
+rewrite > H.
+simplify.exact I.
+qed.
+
+theorem decidable_eq_fraction: \forall f,g:fraction.
+decidable (f = g).
+intros.unfold decidable.
+apply (fraction_elim2 (\lambda f,g. f=g \lor (f=g \to False))).
+ intros.elim g1.
+ elim ((decidable_eq_nat n n1) : n=n1 \lor (n=n1 \to False)).
+ left.apply eq_f. assumption.
+ right.intro.apply H.apply injective_pp.assumption.
+ right.apply not_eq_pp_nn.
+ right.apply not_eq_pp_cons.
+ intros. elim g1.
+ right.intro.apply (not_eq_pp_nn n1 n).apply sym_eq. assumption.
+ elim ((decidable_eq_nat n n1) : n=n1 \lor (n=n1 \to False)).
+ left. apply eq_f. assumption.
+ right.intro.apply H.apply injective_nn.assumption.
+ right.apply not_eq_nn_cons.
+ intros.right.intro.apply (not_eq_pp_cons m x f1).apply sym_eq.assumption.
+ intros.right.intro.apply (not_eq_nn_cons m x f1).apply sym_eq.assumption.
+ intros.elim H.
+ elim ((decidable_eq_Z x y) : x=y \lor (x=y \to False)).
+ left.apply eq_f2.assumption.
+ assumption.
+ right.intro.apply H2.apply (eq_cons_to_eq1 f1 g1).assumption.
+ right.intro.apply H1.apply (eq_cons_to_eq2 x y f1 g1).assumption.
+qed.
+
+theorem eqfb_to_Prop: \forall f,g:fraction.
+match (eqfb f g) with
+[true \Rightarrow f=g
+|false \Rightarrow f \neq g].
+intros.apply (fraction_elim2
+(\lambda f,g.match (eqfb f g) with
+[true \Rightarrow f=g
+|false \Rightarrow f \neq g])).
+ intros.elim g1.
+ simplify.apply eqb_elim.
+ intro.simplify.apply eq_f.assumption.
+ intro.simplify.unfold Not.intro.apply H.apply injective_pp.assumption.
+ simplify.apply not_eq_pp_nn.
+ simplify.apply not_eq_pp_cons.
+ intros.elim g1.
+ simplify.unfold Not.intro.apply (not_eq_pp_nn n1 n).apply sym_eq. assumption.
+ simplify.apply eqb_elim.intro.simplify.apply eq_f.assumption.
+ intro.simplify.unfold Not.intro.apply H.apply injective_nn.assumption.
+ simplify.apply not_eq_nn_cons.
+ intros.simplify.unfold Not.intro.apply (not_eq_pp_cons m x f1).apply sym_eq. assumption.
+ intros.simplify.unfold Not.intro.apply (not_eq_nn_cons m x f1).apply sym_eq. assumption.
+ intros.
+ change in match (eqfb (cons x f1) (cons y g1))
+ with (andb (eqZb x y) (eqfb f1 g1)).
+ apply eqZb_elim.
+ intro.generalize in match H.elim (eqfb f1 g1).
+ simplify.apply eq_f2.assumption.
+ apply H2.
+ simplify.unfold Not.intro.apply H2.apply (eq_cons_to_eq2 x y).assumption.
+ intro.simplify.unfold Not.intro.apply H1.apply (eq_cons_to_eq1 f1 g1).assumption.
+qed.
+
+let rec finv f \def
+ match f with
+ [ (pp n) \Rightarrow (nn n)
+ | (nn n) \Rightarrow (pp n)
+ | (cons x g) \Rightarrow (cons (Zopp x) (finv g))].
+
+definition Z_to_ratio :Z \to ratio \def
+\lambda x:Z. match x with
+[ OZ \Rightarrow one
+| (pos n) \Rightarrow frac (pp n)
+| (neg n) \Rightarrow frac (nn n)].
+
+let rec ftimes f g \def
+ match f with
+ [ (pp n) \Rightarrow
+ match g with
+ [(pp m) \Rightarrow Z_to_ratio (pos n + pos m)
+ | (nn m) \Rightarrow Z_to_ratio (pos n + neg m)
+ | (cons y g1) \Rightarrow frac (cons (pos n + y) g1)]
+ | (nn n) \Rightarrow
+ match g with
+ [(pp m) \Rightarrow Z_to_ratio (neg n + pos m)
+ | (nn m) \Rightarrow Z_to_ratio (neg n + neg m)
+ | (cons y g1) \Rightarrow frac (cons (neg n + y) g1)]
+ | (cons x f1) \Rightarrow
+ match g with
+ [ (pp m) \Rightarrow frac (cons (x + pos m) f1)
+ | (nn m) \Rightarrow frac (cons (x + neg m) f1)
+ | (cons y g1) \Rightarrow
+ match ftimes f1 g1 with
+ [ one \Rightarrow Z_to_ratio (x + y)
+ | (frac h) \Rightarrow frac (cons (x + y) h)]]].
+
+theorem symmetric2_ftimes: symmetric2 fraction ratio ftimes.
+unfold symmetric2. intros.apply (fraction_elim2 (\lambda f,g.ftimes f g = ftimes g f)).
+ intros.elim g.
+ change with (Z_to_ratio (pos n + pos n1) = Z_to_ratio (pos n1 + pos n)).
+ apply eq_f.apply sym_Zplus.
+ change with (Z_to_ratio (pos n + neg n1) = Z_to_ratio (neg n1 + pos n)).
+ apply eq_f.apply sym_Zplus.
+ change with (frac (cons (pos n + z) f) = frac (cons (z + pos n) f)).
+ rewrite < sym_Zplus.reflexivity.
+ intros.elim g.
+ change with (Z_to_ratio (neg n + pos n1) = Z_to_ratio (pos n1 + neg n)).
+ apply eq_f.apply sym_Zplus.
+ change with (Z_to_ratio (neg n + neg n1) = Z_to_ratio (neg n1 + neg n)).
+ apply eq_f.apply sym_Zplus.
+ change with (frac (cons (neg n + z) f) = frac (cons (z + neg n) f)).
+ rewrite < sym_Zplus.reflexivity.
+ intros.change with (frac (cons (x1 + pos m) f) = frac (cons (pos m + x1) f)).
+ rewrite < sym_Zplus.reflexivity.
+ intros.change with (frac (cons (x1 + neg m) f) = frac (cons (neg m + x1) f)).
+ rewrite < sym_Zplus.reflexivity.
+ intros.
+ change with
+ (match ftimes f g with
+ [ one \Rightarrow Z_to_ratio (x1 + y1)
+ | (frac h) \Rightarrow frac (cons (x1 + y1) h)] =
+ match ftimes g f with
+ [ one \Rightarrow Z_to_ratio (y1 + x1)
+ | (frac h) \Rightarrow frac (cons (y1 + x1) h)]).
+ rewrite < H.rewrite < sym_Zplus.reflexivity.
+qed.
+
+theorem ftimes_finv : \forall f:fraction. ftimes f (finv f) = one.
+intro.elim f.
+ change with (Z_to_ratio (pos n + - (pos n)) = one).
+ rewrite > Zplus_Zopp.reflexivity.
+ change with (Z_to_ratio (neg n + - (neg n)) = one).
+ rewrite > Zplus_Zopp.reflexivity.
+(* again: we would need something to help finding the right change *)
+ change with
+ (match ftimes f1 (finv f1) with
+ [ one \Rightarrow Z_to_ratio (z + - z)
+ | (frac h) \Rightarrow frac (cons (z + - z) h)] = one).
+ rewrite > H.rewrite > Zplus_Zopp.reflexivity.
+qed.
+
+definition rtimes : ratio \to ratio \to ratio \def
+\lambda r,s:ratio.
+ match r with
+ [one \Rightarrow s
+ | (frac f) \Rightarrow
+ match s with
+ [one \Rightarrow frac f
+ | (frac g) \Rightarrow ftimes f g]].
+
+theorem symmetric_rtimes : symmetric ratio rtimes.
+change with (\forall r,s:ratio. rtimes r s = rtimes s r).
+intros.
+elim r. elim s.
+reflexivity.
+reflexivity.
+elim s.
+reflexivity.
+simplify.apply symmetric2_ftimes.
+qed.
+
+definition rinv : ratio \to ratio \def
+\lambda r:ratio.
+ match r with
+ [one \Rightarrow one
+ | (frac f) \Rightarrow frac (finv f)].
+
+theorem rtimes_rinv: \forall r:ratio. rtimes r (rinv r) = one.
+intro.elim r.
+reflexivity.
+simplify.apply ftimes_finv.
+qed.
diff --git a/helm/matita/library/Z/compare.ma b/helm/matita/library/Z/compare.ma
new file mode 100644
index 000000000..4a5025975
--- /dev/null
+++ b/helm/matita/library/Z/compare.ma
@@ -0,0 +1,143 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/Z/compare".
+
+include "Z/orders.ma".
+include "nat/compare.ma".
+
+(* boolean equality *)
+definition eqZb : Z \to Z \to bool \def
+\lambda x,y:Z.
+ match x with
+ [ OZ \Rightarrow
+ match y with
+ [ OZ \Rightarrow true
+ | (pos q) \Rightarrow false
+ | (neg q) \Rightarrow false]
+ | (pos p) \Rightarrow
+ match y with
+ [ OZ \Rightarrow false
+ | (pos q) \Rightarrow eqb p q
+ | (neg q) \Rightarrow false]
+ | (neg p) \Rightarrow
+ match y with
+ [ OZ \Rightarrow false
+ | (pos q) \Rightarrow false
+ | (neg q) \Rightarrow eqb p q]].
+
+theorem eqZb_to_Prop:
+\forall x,y:Z.
+match eqZb x y with
+[ true \Rightarrow x=y
+| false \Rightarrow x \neq y].
+intros.
+elim x.
+ elim y.
+ simplify.reflexivity.
+ simplify.apply not_eq_OZ_pos.
+ simplify.apply not_eq_OZ_neg.
+ elim y.
+ simplify.unfold Not.intro.apply (not_eq_OZ_pos n).apply sym_eq.assumption.
+ simplify.apply eqb_elim.
+ intro.simplify.apply eq_f.assumption.
+ intro.simplify.unfold Not.intro.apply H.apply inj_pos.assumption.
+ simplify.apply not_eq_pos_neg.
+ elim y.
+ simplify.unfold Not.intro.apply (not_eq_OZ_neg n).apply sym_eq.assumption.
+ simplify.unfold Not.intro.apply (not_eq_pos_neg n1 n).apply sym_eq.assumption.
+ simplify.apply eqb_elim.
+ intro.simplify.apply eq_f.assumption.
+ intro.simplify.unfold Not.intro.apply H.apply inj_neg.assumption.
+qed.
+
+theorem eqZb_elim: \forall x,y:Z.\forall P:bool \to Prop.
+(x=y \to (P true)) \to (x \neq y \to (P false)) \to P (eqZb x y).
+intros.
+cut
+(match (eqZb x y) with
+[ true \Rightarrow x=y
+| false \Rightarrow x \neq y] \to P (eqZb x y)).
+apply Hcut.
+apply eqZb_to_Prop.
+elim (eqZb).
+apply (H H2).
+apply (H1 H2).
+qed.
+
+definition Z_compare : Z \to Z \to compare \def
+\lambda x,y:Z.
+ match x with
+ [ OZ \Rightarrow
+ match y with
+ [ OZ \Rightarrow EQ
+ | (pos m) \Rightarrow LT
+ | (neg m) \Rightarrow GT ]
+ | (pos n) \Rightarrow
+ match y with
+ [ OZ \Rightarrow GT
+ | (pos m) \Rightarrow (nat_compare n m)
+ | (neg m) \Rightarrow GT]
+ | (neg n) \Rightarrow
+ match y with
+ [ OZ \Rightarrow LT
+ | (pos m) \Rightarrow LT
+ | (neg m) \Rightarrow nat_compare m n ]].
+
+theorem Z_compare_to_Prop :
+\forall x,y:Z. match (Z_compare x y) with
+[ LT \Rightarrow x < y
+| EQ \Rightarrow x=y
+| GT \Rightarrow y < x].
+intros.
+elim x.
+ elim y.
+ simplify.apply refl_eq.
+ simplify.exact I.
+ simplify.exact I.
+ elim y.
+ simplify.exact I.
+ simplify.
+ cut (match (nat_compare n n1) with
+ [ LT \Rightarrow n<n1
+ | EQ \Rightarrow n=n1
+ | GT \Rightarrow n1<n] \to
+ match (nat_compare n n1) with
+ [ LT \Rightarrow (S n) \leq n1
+ | EQ \Rightarrow pos n = pos n1
+ | GT \Rightarrow (S n1) \leq n]).
+ apply Hcut.apply nat_compare_to_Prop.
+ elim (nat_compare n n1).
+ simplify.exact H.
+ simplify.apply eq_f.exact H.
+ simplify.exact H.
+ simplify.exact I.
+ elim y.
+ simplify.exact I.
+ simplify.exact I.
+ simplify.
+ cut (match (nat_compare n1 n) with
+ [ LT \Rightarrow n1<n
+ | EQ \Rightarrow n1=n
+ | GT \Rightarrow n<n1] \to
+ match (nat_compare n1 n) with
+ [ LT \Rightarrow (S n1) \leq n
+ | EQ \Rightarrow neg n = neg n1
+ | GT \Rightarrow (S n) \leq n1]).
+ apply Hcut. apply nat_compare_to_Prop.
+ elim (nat_compare n1 n).
+ simplify.exact H.
+ simplify.apply eq_f.apply sym_eq.exact H.
+ simplify.exact H.
+qed.
diff --git a/helm/matita/library/Z/orders.ma b/helm/matita/library/Z/orders.ma
new file mode 100644
index 000000000..c39f69308
--- /dev/null
+++ b/helm/matita/library/Z/orders.ma
@@ -0,0 +1,130 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/Z/orders".
+
+include "Z/z.ma".
+include "nat/orders.ma".
+
+definition Zle : Z \to Z \to Prop \def
+\lambda x,y:Z.
+ match x with
+ [ OZ \Rightarrow
+ match y with
+ [ OZ \Rightarrow True
+ | (pos m) \Rightarrow True
+ | (neg m) \Rightarrow False ]
+ | (pos n) \Rightarrow
+ match y with
+ [ OZ \Rightarrow False
+ | (pos m) \Rightarrow n \leq m
+ | (neg m) \Rightarrow False ]
+ | (neg n) \Rightarrow
+ match y with
+ [ OZ \Rightarrow True
+ | (pos m) \Rightarrow True
+ | (neg m) \Rightarrow m \leq n ]].
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "integer 'less or equal to'" 'leq x y = (cic:/matita/Z/orders/Zle.con x y).
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "integer 'neither less nor equal to'" 'nleq x y =
+ (cic:/matita/logic/connectives/Not.con (cic:/matita/Z/orders/Zle.con x y)).
+
+definition Zlt : Z \to Z \to Prop \def
+\lambda x,y:Z.
+ match x with
+ [ OZ \Rightarrow
+ match y with
+ [ OZ \Rightarrow False
+ | (pos m) \Rightarrow True
+ | (neg m) \Rightarrow False ]
+ | (pos n) \Rightarrow
+ match y with
+ [ OZ \Rightarrow False
+ | (pos m) \Rightarrow n<m
+ | (neg m) \Rightarrow False ]
+ | (neg n) \Rightarrow
+ match y with
+ [ OZ \Rightarrow True
+ | (pos m) \Rightarrow True
+ | (neg m) \Rightarrow m<n ]].
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "integer 'less than'" 'lt x y = (cic:/matita/Z/orders/Zlt.con x y).
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "integer 'not less than'" 'nless x y =
+ (cic:/matita/logic/connectives/Not.con (cic:/matita/Z/orders/Zlt.con x y)).
+
+theorem irreflexive_Zlt: irreflexive Z Zlt.
+change with (\forall x:Z. x < x \to False).
+intro.elim x.exact H.
+cut (neg n < neg n \to False).
+apply Hcut.apply H.simplify.unfold lt.apply not_le_Sn_n.
+cut (pos n < pos n \to False).
+apply Hcut.apply H.simplify.unfold lt.apply not_le_Sn_n.
+qed.
+
+theorem irrefl_Zlt: irreflexive Z Zlt
+\def irreflexive_Zlt.
+
+theorem Zlt_neg_neg_to_lt:
+\forall n,m:nat. neg n < neg m \to m < n.
+intros.apply H.
+qed.
+
+theorem lt_to_Zlt_neg_neg: \forall n,m:nat.m < n \to neg n < neg m.
+intros.
+simplify.apply H.
+qed.
+
+theorem Zlt_pos_pos_to_lt:
+\forall n,m:nat. pos n < pos m \to n < m.
+intros.apply H.
+qed.
+
+theorem lt_to_Zlt_pos_pos: \forall n,m:nat.n < m \to pos n < pos m.
+intros.
+simplify.apply H.
+qed.
+
+theorem Zlt_to_Zle: \forall x,y:Z. x < y \to Zsucc x \leq y.
+intros 2.
+elim x.
+(* goal: x=OZ *)
+ cut (OZ < y \to Zsucc OZ \leq y).
+ apply Hcut. assumption.
+ simplify.elim y.
+ simplify.exact H1.
+ simplify.apply le_O_n.
+ simplify.exact H1.
+(* goal: x=pos *)
+ exact H.
+(* goal: x=neg *)
+ cut (neg n < y \to Zsucc (neg n) \leq y).
+ apply Hcut. assumption.
+ elim n.
+ cut (neg O < y \to Zsucc (neg O) \leq y).
+ apply Hcut. assumption.
+ simplify.elim y.
+ simplify.exact I.
+ simplify.exact I.
+ simplify.apply (not_le_Sn_O n1 H2).
+ cut (neg (S n1) < y \to (Zsucc (neg (S n1))) \leq y).
+ apply Hcut. assumption.simplify.
+ elim y.
+ simplify.exact I.
+ simplify.exact I.
+ simplify.apply (le_S_S_to_le n2 n1 H3).
+qed.
diff --git a/helm/matita/library/Z/plus.ma b/helm/matita/library/Z/plus.ma
new file mode 100644
index 000000000..976f6cfb3
--- /dev/null
+++ b/helm/matita/library/Z/plus.ma
@@ -0,0 +1,301 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/Z/plus".
+
+include "Z/z.ma".
+include "nat/minus.ma".
+
+definition Zplus :Z \to Z \to Z \def
+\lambda x,y.
+ match x with
+ [ OZ \Rightarrow y
+ | (pos m) \Rightarrow
+ match y with
+ [ OZ \Rightarrow x
+ | (pos n) \Rightarrow (pos (pred ((S m)+(S n))))
+ | (neg n) \Rightarrow
+ match nat_compare m n with
+ [ LT \Rightarrow (neg (pred (n-m)))
+ | EQ \Rightarrow OZ
+ | GT \Rightarrow (pos (pred (m-n)))] ]
+ | (neg m) \Rightarrow
+ match y with
+ [ OZ \Rightarrow x
+ | (pos n) \Rightarrow
+ match nat_compare m n with
+ [ LT \Rightarrow (pos (pred (n-m)))
+ | EQ \Rightarrow OZ
+ | GT \Rightarrow (neg (pred (m-n)))]
+ | (neg n) \Rightarrow (neg (pred ((S m)+(S n))))] ].
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "integer plus" 'plus x y = (cic:/matita/Z/plus/Zplus.con x y).
+
+theorem Zplus_z_OZ: \forall z:Z. z+OZ = z.
+intro.elim z.
+simplify.reflexivity.
+simplify.reflexivity.
+simplify.reflexivity.
+qed.
+
+(* theorem symmetric_Zplus: symmetric Z Zplus. *)
+
+theorem sym_Zplus : \forall x,y:Z. x+y = y+x.
+intros.elim x.rewrite > Zplus_z_OZ.reflexivity.
+elim y.simplify.reflexivity.
+simplify.
+rewrite < plus_n_Sm. rewrite < plus_n_Sm.rewrite < sym_plus.reflexivity.
+simplify.
+rewrite > nat_compare_n_m_m_n.
+simplify.elim nat_compare.simplify.reflexivity.
+simplify. reflexivity.
+simplify. reflexivity.
+elim y.simplify.reflexivity.
+simplify.rewrite > nat_compare_n_m_m_n.
+simplify.elim nat_compare.simplify.reflexivity.
+simplify. reflexivity.
+simplify. reflexivity.
+simplify.rewrite < plus_n_Sm. rewrite < plus_n_Sm.rewrite < sym_plus.reflexivity.
+qed.
+
+theorem Zpred_Zplus_neg_O : \forall z:Z. Zpred z = (neg O)+z.
+intros.elim z.
+ simplify.reflexivity.
+ elim n.
+ simplify.reflexivity.
+ simplify.reflexivity.
+ simplify.reflexivity.
+qed.
+
+theorem Zsucc_Zplus_pos_O : \forall z:Z. Zsucc z = (pos O)+z.
+intros.elim z.
+ simplify.reflexivity.
+ simplify.reflexivity.
+ elim n.
+ simplify.reflexivity.
+ simplify.reflexivity.
+qed.
+
+theorem Zplus_pos_pos:
+\forall n,m. (pos n)+(pos m) = (Zsucc (pos n))+(Zpred (pos m)).
+intros.
+elim n.elim m.
+simplify.reflexivity.
+simplify.reflexivity.
+elim m.
+simplify.rewrite < plus_n_Sm.
+rewrite < plus_n_O.reflexivity.
+simplify.rewrite < plus_n_Sm.
+rewrite < plus_n_Sm.reflexivity.
+qed.
+
+theorem Zplus_pos_neg:
+\forall n,m. (pos n)+(neg m) = (Zsucc (pos n))+(Zpred (neg m)).
+intros.reflexivity.
+qed.
+
+theorem Zplus_neg_pos :
+\forall n,m. (neg n)+(pos m) = (Zsucc (neg n))+(Zpred (pos m)).
+intros.
+elim n.elim m.
+simplify.reflexivity.
+simplify.reflexivity.
+elim m.
+simplify.reflexivity.
+simplify.reflexivity.
+qed.
+
+theorem Zplus_neg_neg:
+\forall n,m. (neg n)+(neg m) = (Zsucc (neg n))+(Zpred (neg m)).
+intros.
+elim n.elim m.
+simplify.reflexivity.
+simplify.reflexivity.
+elim m.
+simplify.rewrite > plus_n_Sm.reflexivity.
+simplify.rewrite > plus_n_Sm.reflexivity.
+qed.
+
+theorem Zplus_Zsucc_Zpred:
+\forall x,y. x+y = (Zsucc x)+(Zpred y).
+intros.elim x.
+ elim y.
+ simplify.reflexivity.
+ rewrite < Zsucc_Zplus_pos_O.rewrite > Zsucc_Zpred.reflexivity.
+ simplify.reflexivity.
+ elim y.
+ simplify.reflexivity.
+ apply Zplus_pos_pos.
+ apply Zplus_pos_neg.
+ elim y.
+ rewrite < sym_Zplus.rewrite < (sym_Zplus (Zpred OZ)).
+ rewrite < Zpred_Zplus_neg_O.rewrite > Zpred_Zsucc.simplify.reflexivity.
+ apply Zplus_neg_pos.
+ rewrite < Zplus_neg_neg.reflexivity.
+qed.
+
+theorem Zplus_Zsucc_pos_pos :
+\forall n,m. (Zsucc (pos n))+(pos m) = Zsucc ((pos n)+(pos m)).
+intros.reflexivity.
+qed.
+
+theorem Zplus_Zsucc_pos_neg:
+\forall n,m. (Zsucc (pos n))+(neg m) = (Zsucc ((pos n)+(neg m))).
+intros.
+apply (nat_elim2
+(\lambda n,m. (Zsucc (pos n))+(neg m) = (Zsucc ((pos n)+(neg m))))).intro.
+intros.elim n1.
+simplify. reflexivity.
+elim n2.simplify. reflexivity.
+simplify. reflexivity.
+intros. elim n1.
+simplify. reflexivity.
+simplify.reflexivity.
+intros.
+rewrite < (Zplus_pos_neg ? m1).
+elim H.reflexivity.
+qed.
+
+theorem Zplus_Zsucc_neg_neg :
+\forall n,m. Zsucc (neg n) + neg m = Zsucc (neg n + neg m).
+intros.
+apply (nat_elim2
+(\lambda n,m. Zsucc (neg n) + neg m = Zsucc (neg n + neg m))).intro.
+intros.elim n1.
+simplify. reflexivity.
+elim n2.simplify. reflexivity.
+simplify. reflexivity.
+intros. elim n1.
+simplify. reflexivity.
+simplify.reflexivity.
+intros.
+rewrite < (Zplus_neg_neg ? m1).
+reflexivity.
+qed.
+
+theorem Zplus_Zsucc_neg_pos:
+\forall n,m. Zsucc (neg n)+(pos m) = Zsucc ((neg n)+(pos m)).
+intros.
+apply (nat_elim2
+(\lambda n,m. Zsucc (neg n) + (pos m) = Zsucc (neg n + pos m))).
+intros.elim n1.
+simplify. reflexivity.
+elim n2.simplify. reflexivity.
+simplify. reflexivity.
+intros. elim n1.
+simplify. reflexivity.
+simplify.reflexivity.
+intros.
+rewrite < H.
+rewrite < (Zplus_neg_pos ? (S m1)).
+reflexivity.
+qed.
+
+theorem Zplus_Zsucc : \forall x,y:Z. (Zsucc x)+y = Zsucc (x+y).
+intros.elim x.
+ elim y.
+ simplify. reflexivity.
+ simplify.reflexivity.
+ rewrite < Zsucc_Zplus_pos_O.reflexivity.
+ elim y.
+ rewrite < (sym_Zplus OZ).reflexivity.
+ apply Zplus_Zsucc_pos_pos.
+ apply Zplus_Zsucc_pos_neg.
+ elim y.
+ rewrite < sym_Zplus.rewrite < (sym_Zplus OZ).simplify.reflexivity.
+ apply Zplus_Zsucc_neg_pos.
+ apply Zplus_Zsucc_neg_neg.
+qed.
+
+theorem Zplus_Zpred: \forall x,y:Z. (Zpred x)+y = Zpred (x+y).
+intros.
+cut (Zpred (x+y) = Zpred ((Zsucc (Zpred x))+y)).
+rewrite > Hcut.
+rewrite > Zplus_Zsucc.
+rewrite > Zpred_Zsucc.
+reflexivity.
+rewrite > Zsucc_Zpred.
+reflexivity.
+qed.
+
+
+theorem associative_Zplus: associative Z Zplus.
+change with (\forall x,y,z:Z. (x + y) + z = x + (y + z)).
+(* simplify. *)
+intros.elim x.
+ simplify.reflexivity.
+ elim n.
+ rewrite < Zsucc_Zplus_pos_O.rewrite < Zsucc_Zplus_pos_O.
+ rewrite > Zplus_Zsucc.reflexivity.
+ rewrite > (Zplus_Zsucc (pos n1)).rewrite > (Zplus_Zsucc (pos n1)).
+ rewrite > (Zplus_Zsucc ((pos n1)+y)).apply eq_f.assumption.
+ elim n.
+ rewrite < (Zpred_Zplus_neg_O (y+z)).rewrite < (Zpred_Zplus_neg_O y).
+ rewrite < Zplus_Zpred.reflexivity.
+ rewrite > (Zplus_Zpred (neg n1)).rewrite > (Zplus_Zpred (neg n1)).
+ rewrite > (Zplus_Zpred ((neg n1)+y)).apply eq_f.assumption.
+qed.
+
+variant assoc_Zplus : \forall x,y,z:Z. (x+y)+z = x+(y+z)
+\def associative_Zplus.
+
+(* Zopp *)
+definition Zopp : Z \to Z \def
+\lambda x:Z. match x with
+[ OZ \Rightarrow OZ
+| (pos n) \Rightarrow (neg n)
+| (neg n) \Rightarrow (pos n) ].
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "integer unary minus" 'uminus x = (cic:/matita/Z/plus/Zopp.con x).
+
+theorem Zopp_Zplus: \forall x,y:Z. -(x+y) = -x + -y.
+intros.
+elim x.elim y.
+simplify. reflexivity.
+simplify. reflexivity.
+simplify. reflexivity.
+elim y.
+simplify. reflexivity.
+simplify. reflexivity.
+simplify. apply nat_compare_elim.
+intro.simplify.reflexivity.
+intro.simplify.reflexivity.
+intro.simplify.reflexivity.
+elim y.
+simplify. reflexivity.
+simplify. apply nat_compare_elim.
+intro.simplify.reflexivity.
+intro.simplify.reflexivity.
+intro.simplify.reflexivity.
+simplify.reflexivity.
+qed.
+
+theorem Zopp_Zopp: \forall x:Z. --x = x.
+intro. elim x.
+reflexivity.reflexivity.reflexivity.
+qed.
+
+theorem Zplus_Zopp: \forall x:Z. x+ -x = OZ.
+intro.elim x.
+apply refl_eq.
+simplify.
+rewrite > nat_compare_n_n.
+simplify.apply refl_eq.
+simplify.
+rewrite > nat_compare_n_n.
+simplify.apply refl_eq.
+qed.
+
diff --git a/helm/matita/library/Z/times.ma b/helm/matita/library/Z/times.ma
new file mode 100644
index 000000000..e5e1cdb45
--- /dev/null
+++ b/helm/matita/library/Z/times.ma
@@ -0,0 +1,235 @@
+(**************************************************************************)
+(* __ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/Z/times".
+
+include "nat/lt_arith.ma".
+include "Z/plus.ma".
+
+definition Ztimes :Z \to Z \to Z \def
+\lambda x,y.
+ match x with
+ [ OZ \Rightarrow OZ
+ | (pos m) \Rightarrow
+ match y with
+ [ OZ \Rightarrow OZ
+ | (pos n) \Rightarrow (pos (pred ((S m) * (S n))))
+ | (neg n) \Rightarrow (neg (pred ((S m) * (S n))))]
+ | (neg m) \Rightarrow
+ match y with
+ [ OZ \Rightarrow OZ
+ | (pos n) \Rightarrow (neg (pred ((S m) * (S n))))
+ | (neg n) \Rightarrow (pos (pred ((S m) * (S n))))]].
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "integer times" 'times x y = (cic:/matita/Z/times/Ztimes.con x y).
+
+theorem Ztimes_z_OZ: \forall z:Z. z*OZ = OZ.
+intro.elim z.
+simplify.reflexivity.
+simplify.reflexivity.
+simplify.reflexivity.
+qed.
+
+theorem Ztimes_neg_Zopp: \forall n:nat.\forall x:Z.
+neg n * x = - (pos n * x).
+intros.elim x.
+simplify.reflexivity.
+simplify.reflexivity.
+simplify.reflexivity.
+qed.
+theorem symmetric_Ztimes : symmetric Z Ztimes.
+change with (\forall x,y:Z. x*y = y*x).
+intros.elim x.rewrite > Ztimes_z_OZ.reflexivity.
+elim y.simplify.reflexivity.
+change with (pos (pred ((S n) * (S n1))) = pos (pred ((S n1) * (S n)))).
+rewrite < sym_times.reflexivity.
+change with (neg (pred ((S n) * (S n1))) = neg (pred ((S n1) * (S n)))).
+rewrite < sym_times.reflexivity.
+elim y.simplify.reflexivity.
+change with (neg (pred ((S n) * (S n1))) = neg (pred ((S n1) * (S n)))).
+rewrite < sym_times.reflexivity.
+change with (pos (pred ((S n) * (S n1))) = pos (pred ((S n1) * (S n)))).
+rewrite < sym_times.reflexivity.
+qed.
+
+variant sym_Ztimes : \forall x,y:Z. x*y = y*x
+\def symmetric_Ztimes.
+
+theorem associative_Ztimes: associative Z Ztimes.
+change with (\forall x,y,z:Z. (x*y)*z = x*(y*z)).
+intros.elim x.
+ simplify.reflexivity.
+ elim y.
+ simplify.reflexivity.
+ elim z.
+ simplify.reflexivity.
+ change with
+ (pos (pred ((S (pred ((S n) * (S n1)))) * (S n2))) =
+ pos (pred ((S n) * (S (pred ((S n1) * (S n2))))))).
+ rewrite < S_pred.rewrite < S_pred.rewrite < assoc_times.reflexivity.
+ apply lt_O_times_S_S.apply lt_O_times_S_S.
+ change with
+ (neg (pred ((S (pred ((S n) * (S n1)))) * (S n2))) =
+ neg (pred ((S n) * (S (pred ((S n1) * (S n2))))))).
+ rewrite < S_pred.rewrite < S_pred.rewrite < assoc_times.reflexivity.
+ apply lt_O_times_S_S.apply lt_O_times_S_S.
+ elim z.
+ simplify.reflexivity.
+ change with
+ (neg (pred ((S (pred ((S n) * (S n1)))) * (S n2))) =
+ neg (pred ((S n) * (S (pred ((S n1) * (S n2))))))).
+ rewrite < S_pred.rewrite < S_pred.rewrite < assoc_times.reflexivity.
+ apply lt_O_times_S_S.apply lt_O_times_S_S.
+ change with
+ (pos (pred ((S (pred ((S n) * (S n1)))) * (S n2))) =
+ pos(pred ((S n) * (S (pred ((S n1) * (S n2))))))).
+ rewrite < S_pred.rewrite < S_pred.rewrite < assoc_times.reflexivity.
+ apply lt_O_times_S_S.apply lt_O_times_S_S.
+ elim y.
+ simplify.reflexivity.
+ elim z.
+ simplify.reflexivity.
+ change with
+ (neg (pred ((S (pred ((S n) * (S n1)))) * (S n2))) =
+ neg (pred ((S n) * (S (pred ((S n1) * (S n2))))))).
+ rewrite < S_pred.rewrite < S_pred.rewrite < assoc_times.reflexivity.
+ apply lt_O_times_S_S.apply lt_O_times_S_S.
+ change with
+ (pos (pred ((S (pred ((S n) * (S n1)))) * (S n2))) =
+ pos (pred ((S n) * (S (pred ((S n1) * (S n2))))))).
+ rewrite < S_pred.rewrite < S_pred.rewrite < assoc_times.reflexivity.
+ apply lt_O_times_S_S.apply lt_O_times_S_S.
+ elim z.
+ simplify.reflexivity.
+ change with
+ (pos (pred ((S (pred ((S n) * (S n1)))) * (S n2))) =
+ pos (pred ((S n) * (S (pred ((S n1) * (S n2))))))).
+ rewrite < S_pred.rewrite < S_pred.rewrite < assoc_times.reflexivity.
+ apply lt_O_times_S_S.apply lt_O_times_S_S.
+ change with
+ (neg (pred ((S (pred ((S n) * (S n1)))) * (S n2))) =
+ neg(pred ((S n) * (S (pred ((S n1) * (S n2))))))).
+ rewrite < S_pred.rewrite < S_pred.rewrite < assoc_times.reflexivity.
+ apply lt_O_times_S_S.apply lt_O_times_S_S.
+qed.
+
+variant assoc_Ztimes : \forall x,y,z:Z.
+(x * y) * z = x * (y * z) \def
+associative_Ztimes.
+
+lemma times_minus1: \forall n,p,q:nat. lt q p \to
+(S n) * (S (pred ((S p) - (S q)))) =
+pred ((S n) * (S p)) - pred ((S n) * (S q)).
+intros.
+rewrite < S_pred.
+rewrite > minus_pred_pred.
+rewrite < distr_times_minus.
+reflexivity.
+(* we now close all positivity conditions *)
+apply lt_O_times_S_S.
+apply lt_O_times_S_S.
+simplify.unfold lt.
+apply le_SO_minus. exact H.
+qed.
+
+lemma Ztimes_Zplus_pos_neg_pos: \forall n,p,q:nat.
+(pos n)*((neg p)+(pos q)) = (pos n)*(neg p)+ (pos n)*(pos q).
+intros.
+simplify.
+change in match (p + n * (S p)) with (pred ((S n) * (S p))).
+change in match (q + n * (S q)) with (pred ((S n) * (S q))).
+rewrite < nat_compare_pred_pred.
+rewrite < nat_compare_times_l.
+rewrite < nat_compare_S_S.
+apply (nat_compare_elim p q).
+intro.
+(* uff *)
+change with (pos (pred ((S n) * (S (pred ((S q) - (S p)))))) =
+ pos (pred ((pred ((S n) * (S q))) - (pred ((S n) * (S p)))))).
+rewrite < (times_minus1 n q p H).reflexivity.
+intro.rewrite < H.simplify.reflexivity.
+intro.
+change with (neg (pred ((S n) * (S (pred ((S p) - (S q)))))) =
+ neg (pred ((pred ((S n) * (S p))) - (pred ((S n) * (S q)))))).
+rewrite < (times_minus1 n p q H).reflexivity.
+(* two more positivity conditions from nat_compare_pred_pred *)
+apply lt_O_times_S_S.
+apply lt_O_times_S_S.
+qed.
+
+lemma Ztimes_Zplus_pos_pos_neg: \forall n,p,q:nat.
+(pos n)*((pos p)+(neg q)) = (pos n)*(pos p)+ (pos n)*(neg q).
+intros.
+rewrite < sym_Zplus.
+rewrite > Ztimes_Zplus_pos_neg_pos.
+apply sym_Zplus.
+qed.
+
+lemma distributive2_Ztimes_pos_Zplus:
+distributive2 nat Z (\lambda n,z. (pos n) * z) Zplus.
+change with (\forall n,y,z.
+(pos n) * (y + z) = (pos n) * y + (pos n) * z).
+intros.elim y.
+ reflexivity.
+ elim z.
+ reflexivity.
+ change with
+ (pos (pred ((S n) * ((S n1) + (S n2)))) =
+ pos (pred ((S n) * (S n1) + (S n) * (S n2)))).
+ rewrite < distr_times_plus.reflexivity.
+ apply Ztimes_Zplus_pos_pos_neg.
+ elim z.
+ reflexivity.
+ apply Ztimes_Zplus_pos_neg_pos.
+ change with
+ (neg (pred ((S n) * ((S n1) + (S n2)))) =
+ neg (pred ((S n) * (S n1) + (S n) * (S n2)))).
+ rewrite < distr_times_plus.reflexivity.
+qed.
+
+variant distr_Ztimes_Zplus_pos: \forall n,y,z.
+(pos n) * (y + z) = ((pos n) * y + (pos n) * z) \def
+distributive2_Ztimes_pos_Zplus.
+
+lemma distributive2_Ztimes_neg_Zplus :
+distributive2 nat Z (\lambda n,z. (neg n) * z) Zplus.
+change with (\forall n,y,z.
+(neg n) * (y + z) = (neg n) * y + (neg n) * z).
+intros.
+rewrite > Ztimes_neg_Zopp.
+rewrite > distr_Ztimes_Zplus_pos.
+rewrite > Zopp_Zplus.
+rewrite < Ztimes_neg_Zopp. rewrite < Ztimes_neg_Zopp.
+reflexivity.
+qed.
+
+variant distr_Ztimes_Zplus_neg: \forall n,y,z.
+(neg n) * (y + z) = (neg n) * y + (neg n) * z \def
+distributive2_Ztimes_neg_Zplus.
+
+theorem distributive_Ztimes_Zplus: distributive Z Ztimes Zplus.
+change with (\forall x,y,z:Z. x * (y + z) = x*y + x*z).
+intros.elim x.
+(* case x = OZ *)
+simplify.reflexivity.
+(* case x = pos n *)
+apply distr_Ztimes_Zplus_pos.
+(* case x = neg n *)
+apply distr_Ztimes_Zplus_neg.
+qed.
+
+variant distr_Ztimes_Zplus: \forall x,y,z.
+x * (y + z) = x*y + x*z \def
+distributive_Ztimes_Zplus.
diff --git a/helm/matita/library/Z/z.ma b/helm/matita/library/Z/z.ma
new file mode 100644
index 000000000..ea50a2cd9
--- /dev/null
+++ b/helm/matita/library/Z/z.ma
@@ -0,0 +1,173 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/Z/z".
+
+include "datatypes/bool.ma".
+include "nat/nat.ma".
+
+inductive Z : Set \def
+ OZ : Z
+| pos : nat \to Z
+| neg : nat \to Z.
+
+definition Z_of_nat \def
+\lambda n. match n with
+[ O \Rightarrow OZ
+| (S n)\Rightarrow pos n].
+
+coercion cic:/matita/Z/z/Z_of_nat.con.
+
+definition neg_Z_of_nat \def
+\lambda n. match n with
+[ O \Rightarrow OZ
+| (S n)\Rightarrow neg n].
+
+definition abs \def
+\lambda z.
+ match z with
+[ OZ \Rightarrow O
+| (pos n) \Rightarrow n
+| (neg n) \Rightarrow n].
+
+definition OZ_test \def
+\lambda z.
+match z with
+[ OZ \Rightarrow true
+| (pos n) \Rightarrow false
+| (neg n) \Rightarrow false].
+
+theorem OZ_test_to_Prop :\forall z:Z.
+match OZ_test z with
+[true \Rightarrow z=OZ
+|false \Rightarrow z \neq OZ].
+intros.elim z.
+simplify.reflexivity.
+simplify. unfold Not. intros (H).
+discriminate H.
+simplify. unfold Not. intros (H).
+discriminate H.
+qed.
+
+(* discrimination *)
+theorem injective_pos: injective nat Z pos.
+unfold injective.
+intros.
+change with (abs (pos x) = abs (pos y)).
+apply eq_f.assumption.
+qed.
+
+variant inj_pos : \forall n,m:nat. pos n = pos m \to n = m
+\def injective_pos.
+
+theorem injective_neg: injective nat Z neg.
+unfold injective.
+intros.
+change with (abs (neg x) = abs (neg y)).
+apply eq_f.assumption.
+qed.
+
+variant inj_neg : \forall n,m:nat. neg n = neg m \to n = m
+\def injective_neg.
+
+theorem not_eq_OZ_pos: \forall n:nat. OZ \neq pos n.
+unfold Not.intros (n H).
+discriminate H.
+qed.
+
+theorem not_eq_OZ_neg :\forall n:nat. OZ \neq neg n.
+unfold Not.intros (n H).
+discriminate H.
+qed.
+
+theorem not_eq_pos_neg :\forall n,m:nat. pos n \neq neg m.
+unfold Not.intros (n m H).
+discriminate H.
+qed.
+
+theorem decidable_eq_Z : \forall x,y:Z. decidable (x=y).
+intros.unfold decidable.
+elim x.
+(* goal: x=OZ *)
+ elim y.
+ (* goal: x=OZ y=OZ *)
+ left.reflexivity.
+ (* goal: x=OZ 2=2 *)
+ right.apply not_eq_OZ_pos.
+ (* goal: x=OZ 2=3 *)
+ right.apply not_eq_OZ_neg.
+(* goal: x=pos *)
+ elim y.
+ (* goal: x=pos y=OZ *)
+ right.unfold Not.intro.
+ apply (not_eq_OZ_pos n). symmetry. assumption.
+ (* goal: x=pos y=pos *)
+ elim (decidable_eq_nat n n1:((n=n1) \lor ((n=n1) \to False))).
+ left.apply eq_f.assumption.
+ right.unfold Not.intros (H_inj).apply H. injection H_inj. assumption.
+ (* goal: x=pos y=neg *)
+ right.unfold Not.intro.apply (not_eq_pos_neg n n1). assumption.
+(* goal: x=neg *)
+ elim y.
+ (* goal: x=neg y=OZ *)
+ right.unfold Not.intro.
+ apply (not_eq_OZ_neg n). symmetry. assumption.
+ (* goal: x=neg y=pos *)
+ right. unfold Not.intro. apply (not_eq_pos_neg n1 n). symmetry. assumption.
+ (* goal: x=neg y=neg *)
+ elim (decidable_eq_nat n n1:((n=n1) \lor ((n=n1) \to False))).
+ left.apply eq_f.assumption.
+ right.unfold Not.intro.apply H.apply injective_neg.assumption.
+qed.
+
+(* end discrimination *)
+
+definition Zsucc \def
+\lambda z. match z with
+[ OZ \Rightarrow pos O
+| (pos n) \Rightarrow pos (S n)
+| (neg n) \Rightarrow
+ match n with
+ [ O \Rightarrow OZ
+ | (S p) \Rightarrow neg p]].
+
+definition Zpred \def
+\lambda z. match z with
+[ OZ \Rightarrow neg O
+| (pos n) \Rightarrow
+ match n with
+ [ O \Rightarrow OZ
+ | (S p) \Rightarrow pos p]
+| (neg n) \Rightarrow neg (S n)].
+
+theorem Zpred_Zsucc: \forall z:Z. Zpred (Zsucc z) = z.
+intros.
+elim z.
+ reflexivity.
+ reflexivity.
+ elim n.
+ reflexivity.
+ reflexivity.
+qed.
+
+theorem Zsucc_Zpred: \forall z:Z. Zsucc (Zpred z) = z.
+intros.
+elim z.
+ reflexivity.
+ elim n.
+ reflexivity.
+ reflexivity.
+ reflexivity.
+qed.
+
diff --git a/helm/matita/library/datatypes/bool.ma b/helm/matita/library/datatypes/bool.ma
new file mode 100644
index 000000000..3292e6789
--- /dev/null
+++ b/helm/matita/library/datatypes/bool.ma
@@ -0,0 +1,126 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/datatypes/bool/".
+
+include "logic/equality.ma".
+
+inductive bool : Set \def
+ | true : bool
+ | false : bool.
+
+theorem bool_elim: \forall P:bool \to Prop. \forall b:bool.
+ (b = true \to P true)
+ \to (b = false \to P false)
+ \to P b.
+ intros 2 (P b).
+ elim b;
+ [ apply H; reflexivity
+ | apply H1; reflexivity
+ ]
+qed.
+
+theorem not_eq_true_false : true \neq false.
+unfold Not.intro.
+change with
+match true with
+[ true \Rightarrow False
+| flase \Rightarrow True].
+rewrite > H.simplify.exact I.
+qed.
+
+definition notb : bool \to bool \def
+\lambda b:bool.
+ match b with
+ [ true \Rightarrow false
+ | false \Rightarrow true ].
+
+theorem notb_elim: \forall b:bool.\forall P:bool \to Prop.
+match b with
+[ true \Rightarrow P false
+| false \Rightarrow P true] \to P (notb b).
+intros 2.elim b.exact H. exact H.
+qed.
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "boolean not" 'not x = (cic:/matita/datatypes/bool/notb.con x).
+
+definition andb : bool \to bool \to bool\def
+\lambda b1,b2:bool.
+ match b1 with
+ [ true \Rightarrow b2
+ | false \Rightarrow false ].
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "boolean and" 'and x y = (cic:/matita/datatypes/bool/andb.con x y).
+
+theorem andb_elim: \forall b1,b2:bool. \forall P:bool \to Prop.
+match b1 with
+[ true \Rightarrow P b2
+| false \Rightarrow P false] \to P (b1 \land b2).
+intros 3.elim b1.exact H. exact H.
+qed.
+
+theorem andb_true_true: \forall b1,b2. (b1 \land b2) = true \to b1 = true.
+intro. elim b1.
+reflexivity.
+assumption.
+qed.
+
+definition orb : bool \to bool \to bool\def
+\lambda b1,b2:bool.
+ match b1 with
+ [ true \Rightarrow true
+ | false \Rightarrow b2].
+
+theorem orb_elim: \forall b1,b2:bool. \forall P:bool \to Prop.
+match b1 with
+[ true \Rightarrow P true
+| false \Rightarrow P b2] \to P (orb b1 b2).
+intros 3.elim b1.exact H. exact H.
+qed.
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "boolean or" 'or x y = (cic:/matita/datatypes/bool/orb.con x y).
+
+definition if_then_else : bool \to Prop \to Prop \to Prop \def
+\lambda b:bool.\lambda P,Q:Prop.
+match b with
+[ true \Rightarrow P
+| false \Rightarrow Q].
+
+(*CSC: missing notation for if_then_else *)
+
+theorem bool_to_decidable_eq:
+ \forall b1,b2:bool. decidable (b1=b2).
+ intros.
+ unfold decidable.
+ elim b1.
+ elim b2.
+ left. reflexivity.
+ right. exact not_eq_true_false.
+ elim b2.
+ right. unfold Not. intro.
+ apply not_eq_true_false.
+ symmetry. exact H.
+ left. reflexivity.
+qed.
+
+theorem P_x_to_P_x_to_eq:
+ \forall A:Set. \forall P: A \to bool.
+ \forall x:A. \forall p1,p2:P x = true. p1 = p2.
+ intros.
+ apply eq_to_eq_to_eq_p_q.
+ exact bool_to_decidable_eq.
+qed.
diff --git a/helm/matita/library/datatypes/compare.ma b/helm/matita/library/datatypes/compare.ma
new file mode 100644
index 000000000..c4fd119a5
--- /dev/null
+++ b/helm/matita/library/datatypes/compare.ma
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/datatypes/compare/".
+
+inductive compare :Set \def
+| LT : compare
+| EQ : compare
+| GT : compare.
+
+definition compare_invert: compare \to compare \def
+ \lambda c.
+ match c with
+ [ LT \Rightarrow GT
+ | EQ \Rightarrow EQ
+ | GT \Rightarrow LT ].
diff --git a/helm/matita/library/datatypes/constructors.ma b/helm/matita/library/datatypes/constructors.ma
new file mode 100644
index 000000000..2ac1cb376
--- /dev/null
+++ b/helm/matita/library/datatypes/constructors.ma
@@ -0,0 +1,38 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/datatypes/constructors/".
+include "logic/equality.ma".
+
+inductive void : Set \def.
+
+inductive Prod (A,B:Set) : Set \def
+pair : A \to B \to Prod A B.
+
+definition fst \def \lambda A,B:Set.\lambda p: Prod A B.
+match p with
+[(pair a b) \Rightarrow a].
+
+definition snd \def \lambda A,B:Set.\lambda p: Prod A B.
+match p with
+[(pair a b) \Rightarrow b].
+
+theorem eq_pair_fst_snd: \forall A,B:Set.\forall p: Prod A B.
+p = pair A B (fst A B p) (snd A B p).
+intros.elim p.simplify.reflexivity.
+qed.
+
+inductive Sum (A,B:Set) : Set \def
+ inl : A \to Sum A B
+| inr : B \to Sum A B.
diff --git a/helm/matita/library/higher_order_defs/functions.ma b/helm/matita/library/higher_order_defs/functions.ma
new file mode 100644
index 000000000..a1b54c80c
--- /dev/null
+++ b/helm/matita/library/higher_order_defs/functions.ma
@@ -0,0 +1,67 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/higher_order_defs/functions/".
+
+include "logic/equality.ma".
+
+definition compose \def
+ \lambda A,B,C:Type.\lambda f:(B\to C).\lambda g:(A\to B).\lambda x:A.
+ f (g x).
+
+notation "hvbox(a break \circ b)"
+ left associative with precedence 70
+for @{ 'compose $a $b }.
+
+interpretation "function composition" 'compose f g =
+ (cic:/matita/higher_order_defs/functions/compose.con _ _ _ f g).
+
+definition injective: \forall A,B:Type.\forall f:A \to B.Prop
+\def \lambda A,B.\lambda f.
+ \forall x,y:A.f x = f y \to x=y.
+
+definition surjective: \forall A,B:Type.\forall f:A \to B.Prop
+\def \lambda A,B.\lambda f.
+ \forall z:B. \exists x:A.z=f x.
+
+definition symmetric: \forall A:Type.\forall f:A \to A\to A.Prop
+\def \lambda A.\lambda f.\forall x,y.f x y = f y x.
+
+definition symmetric2: \forall A,B:Type.\forall f:A \to A\to B.Prop
+\def \lambda A,B.\lambda f.\forall x,y.f x y = f y x.
+
+definition associative: \forall A:Type.\forall f:A \to A\to A.Prop
+\def \lambda A.\lambda f.\forall x,y,z.f (f x y) z = f x (f y z).
+
+theorem eq_f_g_h:
+ \forall A,B,C,D:Type.
+ \forall f:C \to D.\forall g:B \to C.\forall h:A \to B.
+ f \circ (g \circ h) = (f \circ g) \circ h.
+ intros.
+ reflexivity.
+qed.
+
+(* functions and relations *)
+definition monotonic : \forall A:Type.\forall R:A \to A \to Prop.
+\forall f:A \to A.Prop \def
+\lambda A. \lambda R. \lambda f. \forall x,y:A.R x y \to R (f x) (f y).
+
+(* functions and functions *)
+definition distributive: \forall A:Type.\forall f,g:A \to A \to A.Prop
+\def \lambda A.\lambda f,g.\forall x,y,z:A. f x (g y z) = g (f x y) (f x z).
+
+definition distributive2: \forall A,B:Type.\forall f:A \to B \to B.
+\forall g: B\to B\to B. Prop
+\def \lambda A,B.\lambda f,g.\forall x:A.\forall y,z:B. f x (g y z) = g (f x y) (f x z).
+
diff --git a/helm/matita/library/higher_order_defs/ordering.ma b/helm/matita/library/higher_order_defs/ordering.ma
new file mode 100644
index 000000000..c2b351d7a
--- /dev/null
+++ b/helm/matita/library/higher_order_defs/ordering.ma
@@ -0,0 +1,22 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/higher_order_defs/ordering/".
+
+include "logic/equality.ma".
+
+definition antisymmetric: \forall A:Type.\forall R:A \to A \to Prop.Prop
+\def
+\lambda A.\lambda R.\forall x,y:A.R x y \to R y x \to x=y.
+
diff --git a/helm/matita/library/higher_order_defs/relations.ma b/helm/matita/library/higher_order_defs/relations.ma
new file mode 100644
index 000000000..029b229dc
--- /dev/null
+++ b/helm/matita/library/higher_order_defs/relations.ma
@@ -0,0 +1,33 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/higher_order_defs/relations/".
+
+include "logic/connectives.ma".
+
+definition reflexive: \forall A:Type.\forall R:A \to A \to Prop.Prop
+\def
+\lambda A.\lambda R.\forall x:A.R x x.
+
+definition symmetric: \forall A:Type.\forall R:A \to A \to Prop.Prop
+\def
+\lambda A.\lambda R.\forall x,y:A.R x y \to R y x.
+
+definition transitive: \forall A:Type.\forall R:A \to A \to Prop.Prop
+\def
+\lambda A.\lambda R.\forall x,y,z:A.R x y \to R y z \to R x z.
+
+definition irreflexive: \forall A:Type.\forall R:A \to A \to Prop.Prop
+\def
+\lambda A.\lambda R.\forall x:A.\lnot (R x x).
diff --git a/helm/matita/library/legacy/coq.ma b/helm/matita/library/legacy/coq.ma
new file mode 100644
index 000000000..ea1f5935d
--- /dev/null
+++ b/helm/matita/library/legacy/coq.ma
@@ -0,0 +1,44 @@
+set "baseuri" "cic:/matita/legacy/".
+
+(* aritmetic operators *)
+
+interpretation "Coq's natural plus" 'plus x y = (cic:/Coq/Init/Peano/plus.con x y).
+interpretation "Coq's real plus" 'plus x y = (cic:/Coq/Reals/Rdefinitions/Rplus.con x y).
+interpretation "Coq's binary integer plus" 'plus x y = (cic:/Coq/ZArith/BinInt/Zplus.con x y).
+interpretation "Coq's binary positive plus" 'plus x y = (cic:/Coq/NArith/BinPos/Pplus.con x y).
+interpretation "Coq's natural minus" 'minus x y = (cic:/Coq/Init/Peano/minus.con x y).
+interpretation "Coq's real minus" 'minus x y = (cic:/Coq/Reals/Rdefinitions/Rminus.con x y).
+interpretation "Coq's binary integer minus" 'minus x y = (cic:/Coq/ZArith/BinInt/Zminus.con x y).
+interpretation "Coq's binary positive minus" 'minus x y = (cic:/Coq/NArith/BinPos/Pminus.con x y).
+interpretation "Coq's natural times" 'times x y = (cic:/Coq/Init/Peano/mult.con x y).
+interpretation "Coq's real times" 'times x y = (cic:/Coq/Reals/Rdefinitions/Rmult.con x y).
+interpretation "Coq's binary positive times" 'times x y = (cic:/Coq/NArith/BinPos/Pmult.con x y).
+interpretation "Coq's binary integer times" 'times x y = (cic:/Coq/ZArith/BinInt/Zmult.con x y).
+interpretation "Coq's real power" 'power x y = (cic:/Coq/Reals/Rfunctions/pow.con x y).
+interpretation "Coq's integer power" 'power x y = (cic:/Coq/ZArith/Zpower/Zpower.con x y).
+interpretation "Coq's real divide" 'divide x y = (cic:/Coq/Reals/Rdefinitions/Rdiv.con x y).
+interpretation "Coq's real unary minus" 'uminus x = (cic:/Coq/Reals/Rdefinitions/Ropp.con x).
+interpretation "Coq's binary integer negative sign" 'uminus x = (cic:/Coq/ZArith/BinInt/Z.ind#xpointer(1/1/3) x).
+interpretation "Coq's binary integer unary minus" 'uminus x = (cic:/Coq/ZArith/BinInt/Zopp.con x).
+
+(* logical operators *)
+
+interpretation "Coq's logical and" 'and x y = (cic:/Coq/Init/Logic/and.ind#xpointer(1/1) x y).
+interpretation "Coq's logical or" 'or x y = (cic:/Coq/Init/Logic/or.ind#xpointer(1/1) x y).
+interpretation "Coq's logical not" 'not x = (cic:/Coq/Init/Logic/not.con x).
+interpretation "Coq's exists" 'exists \eta.x = (cic:/Coq/Init/Logic/ex.ind#xpointer(1/1) _ x).
+
+(* relational operators *)
+
+interpretation "Coq's natural 'less or equal to'" 'leq x y = (cic:/Coq/Init/Peano/le.ind#xpointer(1/1) x y).
+interpretation "Coq's real 'less or equal to'" 'leq x y = (cic:/Coq/Reals/Rdefinitions/Rle.con x y).
+interpretation "Coq's natural 'greater or equal to'" 'geq x y = (cic:/Coq/Init/Peano/ge.con x y).
+interpretation "Coq's real 'greater or equal to'" 'geq x y = (cic:/Coq/Reals/Rdefinitions/Rge.con x y).
+interpretation "Coq's natural 'less than'" 'lt x y = (cic:/Coq/Init/Peano/lt.con x y).
+interpretation "Coq's real 'less than'" 'lt x y = (cic:/Coq/Reals/Rdefinitions/Rlt.con x y).
+interpretation "Coq's natural 'greater than'" 'gt x y = (cic:/Coq/Init/Peano/gt.con x y).
+interpretation "Coq's real 'greater than'" 'gt x y = (cic:/Coq/Reals/Rdefinitions/Rgt.con x y).
+
+interpretation "Coq's leibnitz's equality" 'eq x y = (cic:/Coq/Init/Logic/eq.ind#xpointer(1/1) _ x y).
+interpretation "Coq's not equal to (leibnitz)" 'neq x y = (cic:/Coq/Init/Logic/not.con (cic:/Coq/Init/Logic/eq.ind#xpointer(1/1) _ x y)).
+
diff --git a/helm/matita/library/list/list.ma b/helm/matita/library/list/list.ma
new file mode 100644
index 000000000..ffa2c8ef9
--- /dev/null
+++ b/helm/matita/library/list/list.ma
@@ -0,0 +1,112 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/list/".
+include "logic/equality.ma".
+include "higher_order_defs/functions.ma".
+
+inductive list (A:Set) : Set :=
+ | nil: list A
+ | cons: A -> list A -> list A.
+
+notation "hvbox(hd break :: tl)"
+ right associative with precedence 46
+ for @{'cons $hd $tl}.
+
+notation "[ list0 x sep ; ]"
+ non associative with precedence 90
+ for ${fold right @'nil rec acc @{'cons $x $acc}}.
+
+notation "hvbox(l1 break @ l2)"
+ right associative with precedence 47
+ for @{'append $l1 $l2 }.
+
+interpretation "nil" 'nil = (cic:/matita/list/list.ind#xpointer(1/1/1) _).
+interpretation "cons" 'cons hd tl =
+ (cic:/matita/list/list.ind#xpointer(1/1/2) _ hd tl).
+
+(* theorem test_notation: [O; S O; S (S O)] = O :: S O :: S (S O) :: []. *)
+
+theorem nil_cons:
+ \forall A:Set.\forall l:list A.\forall a:A.
+ a::l <> [].
+ intros;
+ unfold Not;
+ intros;
+ discriminate H.
+qed.
+
+let rec id_list A (l: list A) on l :=
+ match l with
+ [ nil => []
+ | (cons hd tl) => hd :: id_list A tl ].
+
+let rec append A (l1: list A) l2 on l1 :=
+ match l1 with
+ [ nil => l2
+ | (cons hd tl) => hd :: append A tl l2 ].
+
+definition tail := \lambda A:Set. \lambda l: list A.
+ match l with
+ [ nil => []
+ | (cons hd tl) => tl].
+
+interpretation "append" 'append l1 l2 = (cic:/matita/list/append.con _ l1 l2).
+
+theorem append_nil: \forall A:Set.\forall l:list A.l @ [] = l.
+ intros;
+ elim l;
+ [ reflexivity;
+ | simplify;
+ rewrite > H;
+ reflexivity;
+ ]
+qed.
+
+theorem associative_append: \forall A:Set.associative (list A) (append A).
+ intros; unfold; intros;
+ elim x;
+ [ simplify;
+ reflexivity;
+ | simplify;
+ rewrite > H;
+ reflexivity;
+ ]
+qed.
+
+theorem cons_append_commute:
+ \forall A:Set.\forall l1,l2:list A.\forall a:A.
+ a :: (l1 @ l2) = (a :: l1) @ l2.
+ intros;
+ reflexivity;
+qed.
+
+(*
+theorem nil_append_nil_both:
+ \forall A:Set.\forall l1,l2:list A.
+ l1 @ l2 = [] \to l1 = [] \land l2 = [].
+*)
+
+(*
+include "nat/nat.ma".
+
+theorem test_notation: [O; S O; S (S O)] = O :: S O :: S (S O) :: [].
+reflexivity.
+qed.
+
+theorem test_append: [O;O;O;O;O;O] = [O;O;O] @ [O;O] @ [O].
+simplify.
+reflexivity.
+qed.
+*)
diff --git a/helm/matita/library/list/sort.ma b/helm/matita/library/list/sort.ma
new file mode 100644
index 000000000..939cecede
--- /dev/null
+++ b/helm/matita/library/list/sort.ma
@@ -0,0 +1,172 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/list/sort/".
+
+include "datatypes/bool.ma".
+include "datatypes/constructors.ma".
+include "list/list.ma".
+
+let rec mem (A:Set) (eq: A â A â bool) x (l: list A) on l â
+ match l with
+ [ nil â false
+ | (cons a l') â
+ match eq x a with
+ [ true â true
+ | false â mem A eq x l'
+ ]
+ ].
+
+let rec ordered (A:Set) (le: A â A â bool) (l: list A) on l â
+ match l with
+ [ nil â true
+ | (cons x l') â
+ match l' with
+ [ nil â true
+ | (cons y l'') â
+ le x y \land ordered A le l'
+ ]
+ ].
+
+let rec insert (A:Set) (le: A â A â bool) x (l: list A) on l â
+ match l with
+ [ nil â [x]
+ | (cons he l') â
+ match le x he with
+ [ true â x::l
+ | false â he::(insert A le x l')
+ ]
+ ].
+
+lemma insert_ind :
+ âA:Set. âle: A â A â bool. âx.
+ âP:(list A â list A â Prop).
+ âH:(âl: list A. l=[] â P [] [x]).
+ âH2:
+ (âl: list A. âhe. âl'. P l' (insert ? le x l') â
+ le x he = false â l=he::l' â P (he::l') (he::(insert ? le x l'))).
+ âH3:
+ (âl: list A. âhe. âl'. P l' (insert ? le x l') â
+ le x he = true â l=he::l' â P (he::l') (x::he::l')).
+ âl:list A. P l (insert ? le x l).
+ intros.
+ apply (
+ let rec insert_ind (l: list A) \def
+ match l in list
+ return
+ λli.
+ l = li â P li (insert ? le x li)
+ with
+ [ nil â H l
+ | (cons he l') â
+ match le x he
+ return
+ λb. le x he = b â l = he::l' â
+ P (he::l')
+ (match b with
+ [ true â x::he::l'
+ | false â he::(insert ? le x l') ])
+ with
+ [ true â H2 l he l' (insert_ind l')
+ | false â H1 l he l' (insert_ind l')
+ ]
+ (refl_eq ? (le x he))
+ ] (refl_eq ? l) in insert_ind l).
+qed.
+
+
+let rec insertionsort (A:Set) (le: A â A â bool) (l: list A) on l â
+ match l with
+ [ nil â []
+ | (cons he l') â
+ let l'' â insertionsort A le l' in
+ insert A le he l''
+ ].
+
+lemma ordered_injective:
+ âA:Set. âle:A â A â bool.
+ âl:list A. ordered A le l = true â ordered A le (tail A l) = true.
+ intros 3 (A le l).
+ elim l
+ [ simplify; reflexivity;
+ | simplify;
+ generalize in match H1;
+ clear H1;
+ elim l1;
+ [ simplify; reflexivity;
+ | cut ((le s s1 \land ordered A le (s1::l2)) = true);
+ [ generalize in match Hcut;
+ apply andb_elim;
+ elim (le s s1);
+ [ simplify;
+ fold simplify (ordered ? le (s1::l2));
+ intros; assumption;
+ | simplify;
+ intros (Habsurd);
+ apply False_ind;
+ apply (not_eq_true_false);
+ symmetry;
+ assumption
+ ]
+ | exact H2;
+ ]
+ ]
+ ].
+qed.
+
+lemma insert_sorted:
+ \forall A:Set. \forall le:A\to A\to bool.
+ (\forall a,b:A. le a b = false \to le b a = true) \to
+ \forall l:list A. \forall x:A.
+ ordered A le l = true \to ordered A le (insert A le x l) = true.
+ intros 5 (A le H l x).
+ apply (insert_ind ? ? ? (λl,il. ordered ? le l = true â ordered ? le il = true));
+ clear l; intros; simplify; intros;
+ [2: rewrite > H1;
+ [ generalize in match (H ? ? H2); clear H2; intro;
+ generalize in match H4; clear H4;
+ elim l'; simplify;
+ [ rewrite > H5;
+ reflexivity
+ | elim (le x s); simplify;
+ [ rewrite > H5;
+ reflexivity
+ | simplify in H4;
+ rewrite > (andb_true_true ? ? H4);
+ reflexivity
+ ]
+ ]
+ | apply (ordered_injective ? ? ? H4)
+ ]
+ | reflexivity
+ | rewrite > H2;
+ rewrite > H4;
+ reflexivity
+ ].
+qed.
+
+theorem insertionsort_sorted:
+ âA:Set.
+ âle:A â A â bool.âeq:A â A â bool.
+ (âa,b:A. le a b = false â le b a = true) \to
+ âl:list A.
+ ordered A le (insertionsort A le l) = true.
+ intros 5 (A le eq le_tot l).
+ elim l;
+ [ simplify;
+ reflexivity;
+ | apply (insert_sorted ? ? le_tot (insertionsort ? le l1) s);
+ assumption;
+ ]
+qed.
\ No newline at end of file
diff --git a/helm/matita/library/logic/connectives.ma b/helm/matita/library/logic/connectives.ma
new file mode 100644
index 000000000..4cbea3529
--- /dev/null
+++ b/helm/matita/library/logic/connectives.ma
@@ -0,0 +1,90 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/logic/connectives/".
+
+inductive True: Prop \def
+I : True.
+
+default "true" cic:/matita/logic/connectives/True.ind.
+
+inductive False: Prop \def .
+
+default "false" cic:/matita/logic/connectives/False.ind.
+
+definition Not: Prop \to Prop \def
+\lambda A. (A \to False).
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "logical not" 'not x = (cic:/matita/logic/connectives/Not.con x).
+
+theorem absurd : \forall A,C:Prop. A \to \lnot A \to C.
+intros. elim (H1 H).
+qed.
+
+default "absurd" cic:/matita/logic/connectives/absurd.con.
+
+inductive And (A,B:Prop) : Prop \def
+ conj : A \to B \to (And A B).
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "logical and" 'and x y = (cic:/matita/logic/connectives/And.ind#xpointer(1/1) x y).
+
+theorem proj1: \forall A,B:Prop. A \land B \to A.
+intros. elim H. assumption.
+qed.
+
+theorem proj2: \forall A,B:Prop. A \land B \to B.
+intros. elim H. assumption.
+qed.
+
+inductive Or (A,B:Prop) : Prop \def
+ or_introl : A \to (Or A B)
+ | or_intror : B \to (Or A B).
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "logical or" 'or x y =
+ (cic:/matita/logic/connectives/Or.ind#xpointer(1/1) x y).
+
+theorem Or_ind':
+ \forall A,B:Prop.
+ \forall P: A \lor B \to Prop.
+ (\forall p:A. P (or_introl ? ? p)) \to
+ (\forall q:B. P (or_intror ? ? q)) \to
+ \forall p:A \lor B. P p.
+ intros.
+ apply
+ (match p return \lambda p.P p with
+ [(or_introl p) \Rightarrow H p
+ |(or_intror q) \Rightarrow H1 q]).
+qed.
+
+definition decidable : Prop \to Prop \def \lambda A:Prop. A \lor \lnot A.
+
+inductive ex (A:Type) (P:A \to Prop) : Prop \def
+ ex_intro: \forall x:A. P x \to ex A P.
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "exists" 'exists \eta.x =
+ (cic:/matita/logic/connectives/ex.ind#xpointer(1/1) _ x).
+
+notation < "hvbox(\exists ident i opt (: ty) break . p)"
+ right associative with precedence 20
+for @{ 'exists ${default
+ @{\lambda ${ident i} : $ty. $p)}
+ @{\lambda ${ident i} . $p}}}.
+
+inductive ex2 (A:Type) (P,Q:A \to Prop) : Prop \def
+ ex_intro2: \forall x:A. P x \to Q x \to ex2 A P Q.
+
diff --git a/helm/matita/library/logic/equality.ma b/helm/matita/library/logic/equality.ma
new file mode 100644
index 000000000..b87dc6c95
--- /dev/null
+++ b/helm/matita/library/logic/equality.ma
@@ -0,0 +1,214 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/logic/equality/".
+
+include "higher_order_defs/relations.ma".
+
+inductive eq (A:Type) (x:A) : A \to Prop \def
+ refl_eq : eq A x x.
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "leibnitz's equality"
+ 'eq x y = (cic:/matita/logic/equality/eq.ind#xpointer(1/1) _ x y).
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "leibnitz's non-equality"
+ 'neq x y = (cic:/matita/logic/connectives/Not.con
+ (cic:/matita/logic/equality/eq.ind#xpointer(1/1) _ x y)).
+
+theorem eq_ind':
+ \forall A. \forall x:A. \forall P: \forall y:A. x=y \to Prop.
+ P ? (refl_eq ? x) \to \forall y:A. \forall p:x=y. P y p.
+ intros.
+ exact
+ (match p return \lambda y. \lambda p.P y p with
+ [refl_eq \Rightarrow H]).
+qed.
+
+theorem reflexive_eq : \forall A:Type. reflexive A (eq A).
+simplify.intros.apply refl_eq.
+qed.
+
+theorem symmetric_eq: \forall A:Type. symmetric A (eq A).
+unfold symmetric.intros.elim H. apply refl_eq.
+qed.
+
+theorem sym_eq : \forall A:Type.\forall x,y:A. x=y \to y=x
+\def symmetric_eq.
+
+theorem transitive_eq : \forall A:Type. transitive A (eq A).
+unfold transitive.intros.elim H1.assumption.
+qed.
+
+theorem trans_eq : \forall A:Type.\forall x,y,z:A. x=y \to y=z \to x=z
+\def transitive_eq.
+
+theorem eq_elim_r:
+ \forall A:Type.\forall x:A. \forall P: A \to Prop.
+ P x \to \forall y:A. y=x \to P y.
+intros. elim (sym_eq ? ? ? H1).assumption.
+qed.
+
+default "equality"
+ cic:/matita/logic/equality/eq.ind
+ cic:/matita/logic/equality/sym_eq.con
+ cic:/matita/logic/equality/trans_eq.con
+ cic:/matita/logic/equality/eq_ind.con
+ cic:/matita/logic/equality/eq_elim_r.con.
+
+theorem eq_f: \forall A,B:Type.\forall f:A\to B.
+\forall x,y:A. x=y \to f x = f y.
+intros.elim H.reflexivity.
+qed.
+
+theorem eq_f2: \forall A,B,C:Type.\forall f:A\to B \to C.
+\forall x1,x2:A. \forall y1,y2:B.
+x1=x2 \to y1=y2 \to f x1 y1 = f x2 y2.
+intros.elim H1.elim H.reflexivity.
+qed.
+
+definition comp \def
+ \lambda A.
+ \lambda x,y,y':A.
+ \lambda eq1:x=y.
+ \lambda eq2:x=y'.
+ eq_ind ? ? (\lambda a.a=y') eq2 ? eq1.
+
+lemma trans_sym_eq:
+ \forall A.
+ \forall x,y:A.
+ \forall u:x=y.
+ comp ? ? ? ? u u = refl_eq ? y.
+ intros.
+ apply (eq_ind' ? ? ? ? ? u).
+ reflexivity.
+qed.
+
+definition nu \def
+ \lambda A.
+ \lambda H: \forall x,y:A. decidable (x=y).
+ \lambda x,y. \lambda p:x=y.
+ match H x y with
+ [ (or_introl p') \Rightarrow p'
+ | (or_intror K) \Rightarrow False_ind ? (K p) ].
+
+theorem nu_constant:
+ \forall A.
+ \forall H: \forall x,y:A. decidable (x=y).
+ \forall x,y:A.
+ \forall u,v:x=y.
+ nu ? H ? ? u = nu ? H ? ? v.
+ intros.
+ unfold nu.
+ unfold decidable in H.
+ apply (Or_ind' ? ? ? ? ? (H x y)); simplify.
+ intro; reflexivity.
+ intro; elim (q u).
+qed.
+
+definition nu_inv \def
+ \lambda A.
+ \lambda H: \forall x,y:A. decidable (x=y).
+ \lambda x,y:A.
+ \lambda v:x=y.
+ comp ? ? ? ? (nu ? H ? ? (refl_eq ? x)) v.
+
+theorem nu_left_inv:
+ \forall A.
+ \forall H: \forall x,y:A. decidable (x=y).
+ \forall x,y:A.
+ \forall u:x=y.
+ nu_inv ? H ? ? (nu ? H ? ? u) = u.
+ intros.
+ apply (eq_ind' ? ? ? ? ? u).
+ unfold nu_inv.
+ apply trans_sym_eq.
+qed.
+
+theorem eq_to_eq_to_eq_p_q:
+ \forall A. \forall x,y:A.
+ (\forall x,y:A. decidable (x=y)) \to
+ \forall p,q:x=y. p=q.
+ intros.
+ rewrite < (nu_left_inv ? H ? ? p).
+ rewrite < (nu_left_inv ? H ? ? q).
+ elim (nu_constant ? H ? ? q).
+ reflexivity.
+qed.
+
+(*CSC: alternative proof that does not pollute the environment with
+ technical lemmata. Unfortunately, it is a pain to do without proper
+ support for let-ins.
+theorem eq_to_eq_to_eq_p_q:
+ \forall A. \forall x,y:A.
+ (\forall x,y:A. decidable (x=y)) \to
+ \forall p,q:x=y. p=q.
+intros.
+letin nu \def
+ (\lambda x,y. \lambda p:x=y.
+ match H x y with
+ [ (or_introl p') \Rightarrow p'
+ | (or_intror K) \Rightarrow False_ind ? (K p) ]).
+cut
+ (\forall q:x=y.
+ eq_ind ? ? (\lambda z. z=y) (nu ? ? q) ? (nu ? ? (refl_eq ? x))
+ = q).
+focus 8.
+ clear q; clear p.
+ intro.
+ apply (eq_ind' ? ? ? ? ? q);
+ fold simplify (nu ? ? (refl_eq ? x)).
+ generalize in match (nu ? ? (refl_eq ? x)); intro.
+ apply
+ (eq_ind' A x
+ (\lambda y. \lambda u.
+ eq_ind A x (\lambda a.a=y) u y u = refl_eq ? y)
+ ? x H1).
+ reflexivity.
+unfocus.
+rewrite < (Hcut p); fold simplify (nu ? ? p).
+rewrite < (Hcut q); fold simplify (nu ? ? q).
+apply (Or_ind' (x=x) (x \neq x)
+ (\lambda p:decidable (x=x). eq_ind A x (\lambda z.z=y) (nu x y p) x
+ ([\lambda H1.eq A x x]
+ match p with
+ [(or_introl p') \Rightarrow p'
+ |(or_intror K) \Rightarrow False_ind (x=x) (K (refl_eq A x))]) =
+ eq_ind A x (\lambda z.z=y) (nu x y q) x
+ ([\lambda H1.eq A x x]
+ match p with
+ [(or_introl p') \Rightarrow p'
+ |(or_intror K) \Rightarrow False_ind (x=x) (K (refl_eq A x))]))
+ ? ? (H x x)).
+intro; simplify; reflexivity.
+intro q; elim (q (refl_eq ? x)).
+qed.
+*)
+
+(*
+theorem a:\forall x.x=x\land True.
+[
+2:intros;
+ split;
+ [
+ exact (refl_eq Prop x);
+ |
+ exact I;
+ ]
+1:
+ skip
+]
+qed.
+*)
+
diff --git a/helm/matita/library/nat/chinese_reminder.ma b/helm/matita/library/nat/chinese_reminder.ma
new file mode 100644
index 000000000..30cc7440f
--- /dev/null
+++ b/helm/matita/library/nat/chinese_reminder.ma
@@ -0,0 +1,251 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/chinese_reminder".
+
+include "nat/exp.ma".
+include "nat/gcd.ma".
+include "nat/permutation.ma".
+include "nat/congruence.ma".
+
+theorem and_congruent_congruent: \forall m,n,a,b:nat. O < n \to O < m \to
+gcd n m = (S O) \to ex nat (\lambda x. congruent x a m \land congruent x b n).
+intros.
+cut (\exists c,d.c*n - d*m = (S O) \lor d*m - c*n = (S O)).
+elim Hcut.elim H3.elim H4.
+apply (ex_intro nat ? ((a+b*m)*a1*n-b*a2*m)).
+split.
+(* congruent to a *)
+cut (a1*n = a2*m + (S O)).
+rewrite > assoc_times.
+rewrite > Hcut1.
+rewrite < (sym_plus ? (a2*m)).
+rewrite > distr_times_plus.
+rewrite < times_n_SO.
+rewrite > assoc_plus.
+rewrite < assoc_times.
+rewrite < times_plus_l.
+rewrite > eq_minus_plus_plus_minus.
+rewrite < times_minus_l.
+rewrite > sym_plus.
+apply (eq_times_plus_to_congruent ? ? ? ((b+(a+b*m)*a2)-b*a2)).
+assumption.reflexivity.
+apply le_times_l.
+apply (trans_le ? ((a+b*m)*a2)).
+apply le_times_l.
+apply (trans_le ? (b*m)).
+rewrite > times_n_SO in \vdash (? % ?).
+apply le_times_r.assumption.
+apply le_plus_n.
+apply le_plus_n.
+apply minus_to_plus.
+apply lt_to_le.
+change with (O + a2*m < a1*n).
+apply lt_minus_to_plus.
+rewrite > H5.unfold lt.apply le_n.
+assumption.
+(* congruent to b *)
+cut (a2*m = a1*n - (S O)).
+rewrite > (assoc_times b a2).
+rewrite > Hcut1.
+rewrite > distr_times_minus.
+rewrite < assoc_times.
+rewrite < eq_plus_minus_minus_minus.
+rewrite < times_n_SO.
+rewrite < times_minus_l.
+rewrite < sym_plus.
+apply (eq_times_plus_to_congruent ? ? ? ((a+b*m)*a1-b*a1)).
+assumption.reflexivity.
+rewrite > assoc_times.
+apply le_times_r.
+apply (trans_le ? (a1*n - a2*m)).
+rewrite > H5.apply le_n.
+apply (le_minus_m ? (a2*m)).
+apply le_times_l.
+apply le_times_l.
+apply (trans_le ? (b*m)).
+rewrite > times_n_SO in \vdash (? % ?).
+apply le_times_r.assumption.
+apply le_plus_n.
+apply sym_eq. apply plus_to_minus.
+rewrite > sym_plus.
+apply minus_to_plus.
+apply lt_to_le.
+change with (O + a2*m < a1*n).
+apply lt_minus_to_plus.
+rewrite > H5.unfold lt.apply le_n.
+assumption.
+(* and now the symmetric case; the price to pay for working
+ in nat instead than Z *)
+apply (ex_intro nat ? ((b+a*n)*a2*m-a*a1*n)).
+split.
+(* congruent to a *)
+cut (a1*n = a2*m - (S O)).
+rewrite > (assoc_times a a1).
+rewrite > Hcut1.
+rewrite > distr_times_minus.
+rewrite < assoc_times.
+rewrite < eq_plus_minus_minus_minus.
+rewrite < times_n_SO.
+rewrite < times_minus_l.
+rewrite < sym_plus.
+apply (eq_times_plus_to_congruent ? ? ? ((b+a*n)*a2-a*a2)).
+assumption.reflexivity.
+rewrite > assoc_times.
+apply le_times_r.
+apply (trans_le ? (a2*m - a1*n)).
+rewrite > H5.apply le_n.
+apply (le_minus_m ? (a1*n)).
+rewrite > assoc_times.rewrite > assoc_times.
+apply le_times_l.
+apply (trans_le ? (a*n)).
+rewrite > times_n_SO in \vdash (? % ?).
+apply le_times_r.assumption.
+apply le_plus_n.
+apply sym_eq.apply plus_to_minus.
+rewrite > sym_plus.
+apply minus_to_plus.
+apply lt_to_le.
+change with (O + a1*n < a2*m).
+apply lt_minus_to_plus.
+rewrite > H5.unfold lt.apply le_n.
+assumption.
+(* congruent to a *)
+cut (a2*m = a1*n + (S O)).
+rewrite > assoc_times.
+rewrite > Hcut1.
+rewrite > (sym_plus (a1*n)).
+rewrite > distr_times_plus.
+rewrite < times_n_SO.
+rewrite < assoc_times.
+rewrite > assoc_plus.
+rewrite < times_plus_l.
+rewrite > eq_minus_plus_plus_minus.
+rewrite < times_minus_l.
+rewrite > sym_plus.
+apply (eq_times_plus_to_congruent ? ? ? ((a+(b+a*n)*a1)-a*a1)).
+assumption.reflexivity.
+apply le_times_l.
+apply (trans_le ? ((b+a*n)*a1)).
+apply le_times_l.
+apply (trans_le ? (a*n)).
+rewrite > times_n_SO in \vdash (? % ?).
+apply le_times_r.
+assumption.
+apply le_plus_n.
+apply le_plus_n.
+apply minus_to_plus.
+apply lt_to_le.
+change with (O + a1*n < a2*m).
+apply lt_minus_to_plus.
+rewrite > H5.unfold lt.apply le_n.
+assumption.
+(* proof of the cut *)
+rewrite < H2.
+apply eq_minus_gcd.
+qed.
+
+theorem and_congruent_congruent_lt: \forall m,n,a,b:nat. O < n \to O < m \to
+gcd n m = (S O) \to
+ex nat (\lambda x. (congruent x a m \land congruent x b n) \land
+ (x < m*n)).
+intros.elim (and_congruent_congruent m n a b).
+elim H3.
+apply (ex_intro ? ? (a1 \mod (m*n))).
+split.split.
+apply (transitive_congruent m ? a1).
+unfold congruent.
+apply sym_eq.
+change with (congruent a1 (a1 \mod (m*n)) m).
+rewrite < sym_times.
+apply congruent_n_mod_times.
+assumption.assumption.assumption.
+apply (transitive_congruent n ? a1).
+unfold congruent.
+apply sym_eq.
+change with (congruent a1 (a1 \mod (m*n)) n).
+apply congruent_n_mod_times.
+assumption.assumption.assumption.
+apply lt_mod_m_m.
+rewrite > (times_n_O O).
+apply lt_times.assumption.assumption.
+assumption.assumption.assumption.
+qed.
+
+definition cr_pair : nat \to nat \to nat \to nat \to nat \def
+\lambda n,m,a,b.
+min (pred (n*m)) (\lambda x. andb (eqb (x \mod n) a) (eqb (x \mod m) b)).
+
+theorem cr_pair1: cr_pair (S (S O)) (S (S (S O))) O O = O.
+reflexivity.
+qed.
+
+theorem cr_pair2: cr_pair (S(S O)) (S(S(S O))) (S O) O = (S(S(S O))).
+simplify.
+reflexivity.
+qed.
+
+theorem cr_pair3: cr_pair (S(S O)) (S(S(S O))) (S O) (S(S O)) = (S(S(S(S(S O))))).
+reflexivity.
+qed.
+
+theorem cr_pair4: cr_pair (S(S(S(S(S O))))) (S(S(S(S(S(S(S O))))))) (S(S(S O))) (S(S O)) =
+(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S O))))))))))))))))))))))).
+reflexivity.
+qed.
+
+theorem mod_cr_pair : \forall m,n,a,b. a \lt m \to b \lt n \to
+gcd n m = (S O) \to
+(cr_pair m n a b) \mod m = a \land (cr_pair m n a b) \mod n = b.
+intros.
+cut (andb (eqb ((cr_pair m n a b) \mod m) a)
+ (eqb ((cr_pair m n a b) \mod n) b) = true).
+generalize in match Hcut.
+apply andb_elim.
+apply eqb_elim.intro.
+rewrite > H3.
+change with
+(eqb ((cr_pair m n a b) \mod n) b = true \to
+a = a \land (cr_pair m n a b) \mod n = b).
+intro.split.reflexivity.
+apply eqb_true_to_eq.assumption.
+intro.
+change with (false = true \to
+(cr_pair m n a b) \mod m = a \land (cr_pair m n a b) \mod n = b).
+intro.apply False_ind.
+apply not_eq_true_false.apply sym_eq.assumption.
+apply (f_min_aux_true
+(\lambda x. andb (eqb (x \mod m) a) (eqb (x \mod n) b)) (pred (m*n)) (pred (m*n))).
+elim (and_congruent_congruent_lt m n a b).
+apply (ex_intro ? ? a1).split.split.
+rewrite < minus_n_n.apply le_O_n.
+elim H3.apply le_S_S_to_le.apply (trans_le ? (m*n)).
+assumption.apply (nat_case (m*n)).apply le_O_n.
+intro.
+rewrite < pred_Sn.apply le_n.
+elim H3.elim H4.
+apply andb_elim.
+cut (a1 \mod m = a).
+cut (a1 \mod n = b).
+rewrite > (eq_to_eqb_true ? ? Hcut).
+rewrite > (eq_to_eqb_true ? ? Hcut1).
+simplify.reflexivity.
+rewrite < (lt_to_eq_mod b n).assumption.
+assumption.
+rewrite < (lt_to_eq_mod a m).assumption.
+assumption.
+apply (le_to_lt_to_lt ? b).apply le_O_n.assumption.
+apply (le_to_lt_to_lt ? a).apply le_O_n.assumption.
+assumption.
+qed.
\ No newline at end of file
diff --git a/helm/matita/library/nat/compare.ma b/helm/matita/library/nat/compare.ma
new file mode 100644
index 000000000..264731580
--- /dev/null
+++ b/helm/matita/library/nat/compare.ma
@@ -0,0 +1,227 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/compare".
+
+include "datatypes/bool.ma".
+include "datatypes/compare.ma".
+include "nat/orders.ma".
+
+let rec eqb n m \def
+match n with
+ [ O \Rightarrow
+ match m with
+ [ O \Rightarrow true
+ | (S q) \Rightarrow false]
+ | (S p) \Rightarrow
+ match m with
+ [ O \Rightarrow false
+ | (S q) \Rightarrow eqb p q]].
+
+theorem eqb_to_Prop: \forall n,m:nat.
+match (eqb n m) with
+[ true \Rightarrow n = m
+| false \Rightarrow n \neq m].
+intros.
+apply (nat_elim2
+(\lambda n,m:nat.match (eqb n m) with
+[ true \Rightarrow n = m
+| false \Rightarrow n \neq m])).
+intro.elim n1.
+simplify.reflexivity.
+simplify.apply not_eq_O_S.
+intro.
+simplify.unfold Not.
+intro. apply (not_eq_O_S n1).apply sym_eq.assumption.
+intros.simplify.
+generalize in match H.
+elim ((eqb n1 m1)).
+simplify.apply eq_f.apply H1.
+simplify.unfold Not.intro.apply H1.apply inj_S.assumption.
+qed.
+
+theorem eqb_elim : \forall n,m:nat.\forall P:bool \to Prop.
+(n=m \to (P true)) \to (n \neq m \to (P false)) \to (P (eqb n m)).
+intros.
+cut
+(match (eqb n m) with
+[ true \Rightarrow n = m
+| false \Rightarrow n \neq m] \to (P (eqb n m))).
+apply Hcut.apply eqb_to_Prop.
+elim (eqb n m).
+apply ((H H2)).
+apply ((H1 H2)).
+qed.
+
+theorem eqb_n_n: \forall n. eqb n n = true.
+intro.elim n.simplify.reflexivity.
+simplify.assumption.
+qed.
+
+theorem eqb_true_to_eq: \forall n,m:nat.
+eqb n m = true \to n = m.
+intros.
+change with
+match true with
+[ true \Rightarrow n = m
+| false \Rightarrow n \neq m].
+rewrite < H.
+apply eqb_to_Prop.
+qed.
+
+theorem eqb_false_to_not_eq: \forall n,m:nat.
+eqb n m = false \to n \neq m.
+intros.
+change with
+match false with
+[ true \Rightarrow n = m
+| false \Rightarrow n \neq m].
+rewrite < H.
+apply eqb_to_Prop.
+qed.
+
+theorem eq_to_eqb_true: \forall n,m:nat.
+n = m \to eqb n m = true.
+intros.apply (eqb_elim n m).
+intros. reflexivity.
+intros.apply False_ind.apply (H1 H).
+qed.
+
+theorem not_eq_to_eqb_false: \forall n,m:nat.
+\lnot (n = m) \to eqb n m = false.
+intros.apply (eqb_elim n m).
+intros. apply False_ind.apply (H H1).
+intros.reflexivity.
+qed.
+
+let rec leb n m \def
+match n with
+ [ O \Rightarrow true
+ | (S p) \Rightarrow
+ match m with
+ [ O \Rightarrow false
+ | (S q) \Rightarrow leb p q]].
+
+theorem leb_to_Prop: \forall n,m:nat.
+match (leb n m) with
+[ true \Rightarrow n \leq m
+| false \Rightarrow n \nleq m].
+intros.
+apply (nat_elim2
+(\lambda n,m:nat.match (leb n m) with
+[ true \Rightarrow n \leq m
+| false \Rightarrow n \nleq m])).
+simplify.exact le_O_n.
+simplify.exact not_le_Sn_O.
+intros 2.simplify.elim ((leb n1 m1)).
+simplify.apply le_S_S.apply H.
+simplify.unfold Not.intros.apply H.apply le_S_S_to_le.assumption.
+qed.
+
+theorem leb_elim: \forall n,m:nat. \forall P:bool \to Prop.
+(n \leq m \to (P true)) \to (n \nleq m \to (P false)) \to
+P (leb n m).
+intros.
+cut
+(match (leb n m) with
+[ true \Rightarrow n \leq m
+| false \Rightarrow n \nleq m] \to (P (leb n m))).
+apply Hcut.apply leb_to_Prop.
+elim (leb n m).
+apply ((H H2)).
+apply ((H1 H2)).
+qed.
+
+let rec nat_compare n m: compare \def
+match n with
+[ O \Rightarrow
+ match m with
+ [ O \Rightarrow EQ
+ | (S q) \Rightarrow LT ]
+| (S p) \Rightarrow
+ match m with
+ [ O \Rightarrow GT
+ | (S q) \Rightarrow nat_compare p q]].
+
+theorem nat_compare_n_n: \forall n:nat. nat_compare n n = EQ.
+intro.elim n.
+simplify.reflexivity.
+simplify.assumption.
+qed.
+
+theorem nat_compare_S_S: \forall n,m:nat.
+nat_compare n m = nat_compare (S n) (S m).
+intros.simplify.reflexivity.
+qed.
+
+theorem S_pred: \forall n:nat.lt O n \to eq nat n (S (pred n)).
+intro.elim n.apply False_ind.exact (not_le_Sn_O O H).
+apply eq_f.apply pred_Sn.
+qed.
+
+theorem nat_compare_pred_pred:
+\forall n,m:nat.lt O n \to lt O m \to
+eq compare (nat_compare n m) (nat_compare (pred n) (pred m)).
+intros.
+apply (lt_O_n_elim n H).
+apply (lt_O_n_elim m H1).
+intros.
+simplify.reflexivity.
+qed.
+
+theorem nat_compare_to_Prop: \forall n,m:nat.
+match (nat_compare n m) with
+ [ LT \Rightarrow n < m
+ | EQ \Rightarrow n=m
+ | GT \Rightarrow m < n ].
+intros.
+apply (nat_elim2 (\lambda n,m.match (nat_compare n m) with
+ [ LT \Rightarrow n < m
+ | EQ \Rightarrow n=m
+ | GT \Rightarrow m < n ])).
+intro.elim n1.simplify.reflexivity.
+simplify.unfold lt.apply le_S_S.apply le_O_n.
+intro.simplify.unfold lt.apply le_S_S. apply le_O_n.
+intros 2.simplify.elim ((nat_compare n1 m1)).
+simplify. unfold lt. apply le_S_S.apply H.
+simplify. apply eq_f. apply H.
+simplify. unfold lt.apply le_S_S.apply H.
+qed.
+
+theorem nat_compare_n_m_m_n: \forall n,m:nat.
+nat_compare n m = compare_invert (nat_compare m n).
+intros.
+apply (nat_elim2 (\lambda n,m. nat_compare n m = compare_invert (nat_compare m n))).
+intros.elim n1.simplify.reflexivity.
+simplify.reflexivity.
+intro.elim n1.simplify.reflexivity.
+simplify.reflexivity.
+intros.simplify.elim H.reflexivity.
+qed.
+
+theorem nat_compare_elim : \forall n,m:nat. \forall P:compare \to Prop.
+(n < m \to P LT) \to (n=m \to P EQ) \to (m < n \to P GT) \to
+(P (nat_compare n m)).
+intros.
+cut (match (nat_compare n m) with
+[ LT \Rightarrow n < m
+| EQ \Rightarrow n=m
+| GT \Rightarrow m < n] \to
+(P (nat_compare n m))).
+apply Hcut.apply nat_compare_to_Prop.
+elim ((nat_compare n m)).
+apply ((H H3)).
+apply ((H1 H3)).
+apply ((H2 H3)).
+qed.
diff --git a/helm/matita/library/nat/congruence.ma b/helm/matita/library/nat/congruence.ma
new file mode 100644
index 000000000..af744cf34
--- /dev/null
+++ b/helm/matita/library/nat/congruence.ma
@@ -0,0 +1,177 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / Matita is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/congruence".
+
+include "nat/relevant_equations.ma".
+include "nat/primes.ma".
+
+definition S_mod: nat \to nat \to nat \def
+\lambda n,m:nat. (S m) \mod n.
+
+definition congruent: nat \to nat \to nat \to Prop \def
+\lambda n,m,p:nat. mod n p = mod m p.
+
+theorem congruent_n_n: \forall n,p:nat.congruent n n p.
+intros.unfold congruent.reflexivity.
+qed.
+
+theorem transitive_congruent: \forall p:nat. transitive nat
+(\lambda n,m. congruent n m p).
+intros.unfold transitive.unfold congruent.intros.
+whd.apply (trans_eq ? ? (y \mod p)).
+apply H.apply H1.
+qed.
+
+theorem le_to_mod: \forall n,m:nat. n \lt m \to n = n \mod m.
+intros.
+apply (div_mod_spec_to_eq2 n m O n (n/m) (n \mod m)).
+constructor 1.assumption.simplify.reflexivity.
+apply div_mod_spec_div_mod.
+apply (le_to_lt_to_lt O n m).apply le_O_n.assumption.
+qed.
+
+theorem mod_mod : \forall n,p:nat. O<p \to n \mod p = (n \mod p) \mod p.
+intros.
+rewrite > (div_mod (n \mod p) p) in \vdash (? ? % ?).
+rewrite > (eq_div_O ? p).reflexivity.
+(* uffa: hint non lo trova lt vs. le*)
+apply lt_mod_m_m.
+assumption.
+assumption.
+qed.
+
+theorem mod_times_mod : \forall n,m,p:nat. O<p \to O<m \to n \mod p = (n \mod (m*p)) \mod p.
+intros.
+apply (div_mod_spec_to_eq2 n p (n/p) (n \mod p)
+(n/(m*p)*m + (n \mod (m*p)/p))).
+apply div_mod_spec_div_mod.assumption.
+constructor 1.
+apply lt_mod_m_m.assumption.
+rewrite > times_plus_l.
+rewrite > assoc_plus.
+rewrite < div_mod.
+rewrite > assoc_times.
+rewrite < div_mod.
+reflexivity.
+rewrite > (times_n_O O).
+apply lt_times.
+assumption.assumption.assumption.
+qed.
+
+theorem congruent_n_mod_n :
+\forall n,p:nat. O < p \to congruent n (n \mod p) p.
+intros.unfold congruent.
+apply mod_mod.assumption.
+qed.
+
+theorem congruent_n_mod_times :
+\forall n,m,p:nat. O < p \to O < m \to congruent n (n \mod (m*p)) p.
+intros.unfold congruent.
+apply mod_times_mod.assumption.assumption.
+qed.
+
+theorem eq_times_plus_to_congruent: \forall n,m,p,r:nat. O< p \to
+n = r*p+m \to congruent n m p.
+intros.unfold congruent.
+apply (div_mod_spec_to_eq2 n p (div n p) (mod n p) (r +(div m p)) (mod m p)).
+apply div_mod_spec_div_mod.assumption.
+constructor 1.
+apply lt_mod_m_m.assumption.
+rewrite > sym_times.
+rewrite > distr_times_plus.
+rewrite > sym_times.
+rewrite > (sym_times p).
+rewrite > assoc_plus.
+rewrite < div_mod.
+assumption.assumption.
+qed.
+
+theorem divides_to_congruent: \forall n,m,p:nat. O < p \to m \le n \to
+divides p (n - m) \to congruent n m p.
+intros.elim H2.
+apply (eq_times_plus_to_congruent n m p n2).
+assumption.
+rewrite < sym_plus.
+apply minus_to_plus.assumption.
+rewrite > sym_times. assumption.
+qed.
+
+theorem congruent_to_divides: \forall n,m,p:nat.
+O < p \to congruent n m p \to divides p (n - m).
+intros.unfold congruent in H1.
+apply (witness ? ? ((n / p)-(m / p))).
+rewrite > sym_times.
+rewrite > (div_mod n p) in \vdash (? ? % ?).
+rewrite > (div_mod m p) in \vdash (? ? % ?).
+rewrite < (sym_plus (m \mod p)).
+rewrite < H1.
+rewrite < (eq_minus_minus_minus_plus ? (n \mod p)).
+rewrite < minus_plus_m_m.
+apply sym_eq.
+apply times_minus_l.
+assumption.assumption.
+qed.
+
+theorem mod_times: \forall n,m,p:nat.
+O < p \to mod (n*m) p = mod ((mod n p)*(mod m p)) p.
+intros.
+change with (congruent (n*m) ((mod n p)*(mod m p)) p).
+apply (eq_times_plus_to_congruent ? ? p
+((n / p)*p*(m / p) + (n / p)*(m \mod p) + (n \mod p)*(m / p))).
+assumption.
+apply (trans_eq ? ? (((n/p)*p+(n \mod p))*((m/p)*p+(m \mod p)))).
+apply eq_f2.
+apply div_mod.assumption.
+apply div_mod.assumption.
+apply (trans_eq ? ? (((n/p)*p)*((m/p)*p) + (n/p)*p*(m \mod p) +
+(n \mod p)*((m / p)*p) + (n \mod p)*(m \mod p))).
+apply times_plus_plus.
+apply eq_f2.
+rewrite < assoc_times.
+rewrite > (assoc_times (n/p) p (m \mod p)).
+rewrite > (sym_times p (m \mod p)).
+rewrite < (assoc_times (n/p) (m \mod p) p).
+rewrite < times_plus_l.
+rewrite < (assoc_times (n \mod p)).
+rewrite < times_plus_l.
+apply eq_f2.
+apply eq_f2.reflexivity.
+reflexivity.reflexivity.
+reflexivity.
+qed.
+
+theorem congruent_times: \forall n,m,n1,m1,p. O < p \to congruent n n1 p \to
+congruent m m1 p \to congruent (n*m) (n1*m1) p.
+unfold congruent.
+intros.
+rewrite > (mod_times n m p H).
+rewrite > H1.
+rewrite > H2.
+apply sym_eq.
+apply mod_times.assumption.
+qed.
+
+theorem congruent_pi: \forall f:nat \to nat. \forall n,m,p:nat.O < p \to
+congruent (pi n f m) (pi n (\lambda m. mod (f m) p) m) p.
+intros.
+elim n.change with (congruent (f m) (f m \mod p) p).
+apply congruent_n_mod_n.assumption.
+change with (congruent ((f (S n1+m))*(pi n1 f m))
+(((f (S n1+m))\mod p)*(pi n1 (\lambda m.(f m) \mod p) m)) p).
+apply congruent_times.
+assumption.
+apply congruent_n_mod_n.assumption.
+assumption.
+qed.
diff --git a/helm/matita/library/nat/count.ma b/helm/matita/library/nat/count.ma
new file mode 100644
index 000000000..20913fa60
--- /dev/null
+++ b/helm/matita/library/nat/count.ma
@@ -0,0 +1,246 @@
+(**************************************************************************)
+(* __ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/count".
+
+include "nat/relevant_equations.ma".
+include "nat/sigma_and_pi.ma".
+include "nat/permutation.ma".
+
+theorem sigma_f_g : \forall n,m:nat.\forall f,g:nat \to nat.
+sigma n (\lambda p.f p + g p) m = sigma n f m + sigma n g m.
+intros.elim n.
+simplify.reflexivity.
+simplify.rewrite > H.
+rewrite > assoc_plus.
+rewrite < (assoc_plus (g (S (n1+m)))).
+rewrite > (sym_plus (g (S (n1+m)))).
+rewrite > (assoc_plus (sigma n1 f m)).
+rewrite < assoc_plus.
+reflexivity.
+qed.
+
+theorem sigma_plus: \forall n,p,m:nat.\forall f:nat \to nat.
+sigma (S (p+n)) f m = sigma p (\lambda x.(f ((S n) + x))) m + sigma n f m.
+intros. elim p.
+simplify.
+rewrite < (sym_plus n m).reflexivity.
+simplify.
+rewrite > assoc_plus in \vdash (? ? ? %).
+rewrite < H.
+simplify.
+rewrite < plus_n_Sm.
+rewrite > (sym_plus n).
+rewrite > assoc_plus.
+rewrite < (sym_plus m).
+rewrite < (assoc_plus n1).
+reflexivity.
+qed.
+
+theorem sigma_plus1: \forall n,p,m:nat.\forall f:nat \to nat.
+sigma (p+(S n)) f m = sigma p (\lambda x.(f ((S n) + x))) m + sigma n f m.
+intros. elim p.
+simplify.reflexivity.
+simplify.
+rewrite > assoc_plus in \vdash (? ? ? %).
+rewrite < H.
+rewrite < plus_n_Sm.
+rewrite < plus_n_Sm.simplify.
+rewrite < (sym_plus n).
+rewrite > assoc_plus.
+rewrite < (sym_plus m).
+rewrite < (assoc_plus n).
+reflexivity.
+qed.
+
+theorem eq_sigma_sigma : \forall n,m:nat.\forall f:nat \to nat.
+sigma (pred ((S n)*(S m))) f O =
+sigma m (\lambda a.(sigma n (\lambda b.f (b*(S m) + a)) O)) O.
+intro.elim n.simplify.
+rewrite < plus_n_O.
+apply eq_sigma.intros.reflexivity.
+change with
+(sigma (m+(S n1)*(S m)) f O =
+sigma m (\lambda a.(f ((S(n1+O))*(S m)+a)) + (sigma n1 (\lambda b.f (b*(S m)+a)) O)) O).
+rewrite > sigma_f_g.
+rewrite < plus_n_O.
+rewrite < H.
+rewrite > (S_pred ((S n1)*(S m))).
+apply sigma_plus1.
+simplify.unfold lt.apply le_S_S.apply le_O_n.
+qed.
+
+theorem eq_sigma_sigma1 : \forall n,m:nat.\forall f:nat \to nat.
+sigma (pred ((S n)*(S m))) f O =
+sigma n (\lambda a.(sigma m (\lambda b.f (b*(S n) + a)) O)) O.
+intros.
+rewrite > sym_times.
+apply eq_sigma_sigma.
+qed.
+
+theorem sigma_times: \forall n,m,p:nat.\forall f:nat \to nat.
+(sigma n f m)*p = sigma n (\lambda i.(f i) * p) m.
+intro. elim n.simplify.reflexivity.
+simplify.rewrite < H.
+apply times_plus_l.
+qed.
+
+definition bool_to_nat: bool \to nat \def
+\lambda b. match b with
+[ true \Rightarrow (S O)
+| false \Rightarrow O ].
+
+theorem bool_to_nat_andb: \forall a,b:bool.
+bool_to_nat (andb a b) = (bool_to_nat a)*(bool_to_nat b).
+intros. elim a.elim b.
+simplify.reflexivity.
+reflexivity.
+reflexivity.
+qed.
+
+definition count : nat \to (nat \to bool) \to nat \def
+\lambda n.\lambda f. sigma (pred n) (\lambda n.(bool_to_nat (f n))) O.
+
+theorem count_times:\forall n,m:nat.
+\forall f,f1,f2:nat \to bool.
+\forall g:nat \to nat \to nat.
+\forall g1,g2: nat \to nat.
+(\forall a,b:nat. a < (S n) \to b < (S m) \to (g b a) < (S n)*(S m)) \to
+(\forall a,b:nat. a < (S n) \to b < (S m) \to (g1 (g b a)) = a) \to
+(\forall a,b:nat. a < (S n) \to b < (S m) \to (g2 (g b a)) = b) \to
+(\forall a,b:nat. a < (S n) \to b < (S m) \to f (g b a) = andb (f2 b) (f1 a)) \to
+(count ((S n)*(S m)) f) = (count (S n) f1)*(count (S m) f2).
+intros.unfold count.
+rewrite < eq_map_iter_i_sigma.
+rewrite > (permut_to_eq_map_iter_i plus assoc_plus sym_plus ? ? ?
+ (\lambda i.g (div i (S n)) (mod i (S n)))).
+rewrite > eq_map_iter_i_sigma.
+rewrite > eq_sigma_sigma1.
+apply (trans_eq ? ?
+(sigma n (\lambda a.
+ sigma m (\lambda b.(bool_to_nat (f2 b))*(bool_to_nat (f1 a))) O) O)).
+apply eq_sigma.intros.
+apply eq_sigma.intros.
+rewrite > (div_mod_spec_to_eq (i1*(S n) + i) (S n) ((i1*(S n) + i)/(S n))
+ ((i1*(S n) + i) \mod (S n)) i1 i).
+rewrite > (div_mod_spec_to_eq2 (i1*(S n) + i) (S n) ((i1*(S n) + i)/(S n))
+ ((i1*(S n) + i) \mod (S n)) i1 i).
+rewrite > H3.
+apply bool_to_nat_andb.
+unfold lt.apply le_S_S.assumption.
+unfold lt.apply le_S_S.assumption.
+apply div_mod_spec_div_mod.
+unfold lt.apply le_S_S.apply le_O_n.
+constructor 1.unfold lt.apply le_S_S.assumption.
+reflexivity.
+apply div_mod_spec_div_mod.
+unfold lt.apply le_S_S.apply le_O_n.
+constructor 1.unfold lt.apply le_S_S.assumption.
+reflexivity.
+apply (trans_eq ? ?
+(sigma n (\lambda n.((bool_to_nat (f1 n)) *
+(sigma m (\lambda n.bool_to_nat (f2 n)) O))) O)).
+apply eq_sigma.
+intros.
+rewrite > sym_times.
+apply (trans_eq ? ?
+(sigma m (\lambda n.(bool_to_nat (f2 n))*(bool_to_nat (f1 i))) O)).
+reflexivity.
+apply sym_eq. apply sigma_times.
+change in match (pred (S n)) with n.
+change in match (pred (S m)) with m.
+apply sym_eq. apply sigma_times.
+unfold permut.
+split.
+intros.
+rewrite < plus_n_O.
+apply le_S_S_to_le.
+rewrite < S_pred in \vdash (? ? %).
+change with ((g (i/(S n)) (i \mod (S n))) \lt (S n)*(S m)).
+apply H.
+apply lt_mod_m_m.
+unfold lt. apply le_S_S.apply le_O_n.
+apply (lt_times_to_lt_l n).
+apply (le_to_lt_to_lt ? i).
+rewrite > (div_mod i (S n)) in \vdash (? ? %).
+rewrite > sym_plus.
+apply le_plus_n.
+unfold lt. apply le_S_S.apply le_O_n.
+unfold lt.
+rewrite > S_pred in \vdash (? ? %).
+apply le_S_S.
+rewrite > plus_n_O in \vdash (? ? %).
+rewrite > sym_times. assumption.
+rewrite > (times_n_O O).
+apply lt_times.
+unfold lt. apply le_S_S.apply le_O_n.
+unfold lt. apply le_S_S.apply le_O_n.
+rewrite > (times_n_O O).
+apply lt_times.
+unfold lt. apply le_S_S.apply le_O_n.
+unfold lt. apply le_S_S.apply le_O_n.
+rewrite < plus_n_O.
+unfold injn.
+intros.
+cut (i < (S n)*(S m)).
+cut (j < (S n)*(S m)).
+cut ((i \mod (S n)) < (S n)).
+cut ((i/(S n)) < (S m)).
+cut ((j \mod (S n)) < (S n)).
+cut ((j/(S n)) < (S m)).
+rewrite > (div_mod i (S n)).
+rewrite > (div_mod j (S n)).
+rewrite < (H1 (i \mod (S n)) (i/(S n)) Hcut2 Hcut3).
+rewrite < (H2 (i \mod (S n)) (i/(S n)) Hcut2 Hcut3) in \vdash (? ? (? % ?) ?).
+rewrite < (H1 (j \mod (S n)) (j/(S n)) Hcut4 Hcut5).
+rewrite < (H2 (j \mod (S n)) (j/(S n)) Hcut4 Hcut5) in \vdash (? ? ? (? % ?)).
+rewrite > H6.reflexivity.
+unfold lt. apply le_S_S.apply le_O_n.
+unfold lt. apply le_S_S.apply le_O_n.
+apply (lt_times_to_lt_l n).
+apply (le_to_lt_to_lt ? j).
+rewrite > (div_mod j (S n)) in \vdash (? ? %).
+rewrite > sym_plus.
+apply le_plus_n.
+unfold lt. apply le_S_S.apply le_O_n.
+rewrite < sym_times. assumption.
+apply lt_mod_m_m.
+unfold lt. apply le_S_S.apply le_O_n.
+apply (lt_times_to_lt_l n).
+apply (le_to_lt_to_lt ? i).
+rewrite > (div_mod i (S n)) in \vdash (? ? %).
+rewrite > sym_plus.
+apply le_plus_n.
+unfold lt. apply le_S_S.apply le_O_n.
+rewrite < sym_times. assumption.
+apply lt_mod_m_m.
+unfold lt. apply le_S_S.apply le_O_n.
+unfold lt.
+rewrite > S_pred in \vdash (? ? %).
+apply le_S_S.assumption.
+rewrite > (times_n_O O).
+apply lt_times.
+unfold lt. apply le_S_S.apply le_O_n.
+unfold lt. apply le_S_S.apply le_O_n.
+unfold lt.
+rewrite > S_pred in \vdash (? ? %).
+apply le_S_S.assumption.
+rewrite > (times_n_O O).
+apply lt_times.
+unfold lt. apply le_S_S.apply le_O_n.
+unfold lt. apply le_S_S.apply le_O_n.
+intros.
+apply False_ind.
+apply (not_le_Sn_O m1 H4).
+qed.
diff --git a/helm/matita/library/nat/div_and_mod.ma b/helm/matita/library/nat/div_and_mod.ma
new file mode 100644
index 000000000..e9831f82a
--- /dev/null
+++ b/helm/matita/library/nat/div_and_mod.ma
@@ -0,0 +1,298 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / Matita is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/div_and_mod".
+
+include "nat/minus.ma".
+
+let rec mod_aux p m n: nat \def
+match (leb m n) with
+[ true \Rightarrow m
+| false \Rightarrow
+ match p with
+ [O \Rightarrow m
+ |(S q) \Rightarrow mod_aux q (m-(S n)) n]].
+
+definition mod : nat \to nat \to nat \def
+\lambda n,m.
+match m with
+[O \Rightarrow m
+| (S p) \Rightarrow mod_aux n n p].
+
+interpretation "natural remainder" 'module x y =
+ (cic:/matita/nat/div_and_mod/mod.con x y).
+
+let rec div_aux p m n : nat \def
+match (leb m n) with
+[ true \Rightarrow O
+| false \Rightarrow
+ match p with
+ [O \Rightarrow O
+ |(S q) \Rightarrow S (div_aux q (m-(S n)) n)]].
+
+definition div : nat \to nat \to nat \def
+\lambda n,m.
+match m with
+[O \Rightarrow S n
+| (S p) \Rightarrow div_aux n n p].
+
+interpretation "natural divide" 'divide x y =
+ (cic:/matita/nat/div_and_mod/div.con x y).
+
+theorem le_mod_aux_m_m:
+\forall p,n,m. n \leq p \to (mod_aux p n m) \leq m.
+intro.elim p.
+apply (le_n_O_elim n H (\lambda n.(mod_aux O n m) \leq m)).
+simplify.apply le_O_n.
+simplify.
+apply (leb_elim n1 m).
+simplify.intro.assumption.
+simplify.intro.apply H.
+cut (n1 \leq (S n) \to n1-(S m) \leq n).
+apply Hcut.assumption.
+elim n1.
+simplify.apply le_O_n.
+simplify.apply (trans_le ? n2 n).
+apply le_minus_m.apply le_S_S_to_le.assumption.
+qed.
+
+theorem lt_mod_m_m: \forall n,m. O < m \to (n \mod m) < m.
+intros 2.elim m.apply False_ind.
+apply (not_le_Sn_O O H).
+simplify.unfold lt.apply le_S_S.apply le_mod_aux_m_m.
+apply le_n.
+qed.
+
+theorem div_aux_mod_aux: \forall p,n,m:nat.
+(n=(div_aux p n m)*(S m) + (mod_aux p n m)).
+intro.elim p.
+simplify.elim (leb n m).
+simplify.apply refl_eq.
+simplify.apply refl_eq.
+simplify.
+apply (leb_elim n1 m).
+simplify.intro.apply refl_eq.
+simplify.intro.
+rewrite > assoc_plus.
+elim (H (n1-(S m)) m).
+change with (n1=(S m)+(n1-(S m))).
+rewrite < sym_plus.
+apply plus_minus_m_m.
+change with (m < n1).
+apply not_le_to_lt.exact H1.
+qed.
+
+theorem div_mod: \forall n,m:nat. O < m \to n=(n / m)*m+(n \mod m).
+intros 2.elim m.elim (not_le_Sn_O O H).
+simplify.
+apply div_aux_mod_aux.
+qed.
+
+inductive div_mod_spec (n,m,q,r:nat) : Prop \def
+div_mod_spec_intro: r < m \to n=q*m+r \to (div_mod_spec n m q r).
+
+(*
+definition div_mod_spec : nat \to nat \to nat \to nat \to Prop \def
+\lambda n,m,q,r:nat.r < m \land n=q*m+r).
+*)
+
+theorem div_mod_spec_to_not_eq_O: \forall n,m,q,r.(div_mod_spec n m q r) \to m \neq O.
+intros 4.unfold Not.intros.elim H.absurd (le (S r) O).
+rewrite < H1.assumption.
+exact (not_le_Sn_O r).
+qed.
+
+theorem div_mod_spec_div_mod:
+\forall n,m. O < m \to (div_mod_spec n m (n / m) (n \mod m)).
+intros.
+apply div_mod_spec_intro.
+apply lt_mod_m_m.assumption.
+apply div_mod.assumption.
+qed.
+
+theorem div_mod_spec_to_eq :\forall a,b,q,r,q1,r1.
+(div_mod_spec a b q r) \to (div_mod_spec a b q1 r1) \to
+(eq nat q q1).
+intros.elim H.elim H1.
+apply (nat_compare_elim q q1).intro.
+apply False_ind.
+cut (eq nat ((q1-q)*b+r1) r).
+cut (b \leq (q1-q)*b+r1).
+cut (b \leq r).
+apply (lt_to_not_le r b H2 Hcut2).
+elim Hcut.assumption.
+apply (trans_le ? ((q1-q)*b)).
+apply le_times_n.
+apply le_SO_minus.exact H6.
+rewrite < sym_plus.
+apply le_plus_n.
+rewrite < sym_times.
+rewrite > distr_times_minus.
+rewrite > plus_minus.
+rewrite > sym_times.
+rewrite < H5.
+rewrite < sym_times.
+apply plus_to_minus.
+apply H3.
+apply le_times_r.
+apply lt_to_le.
+apply H6.
+(* eq case *)
+intros.assumption.
+(* the following case is symmetric *)
+intro.
+apply False_ind.
+cut (eq nat ((q-q1)*b+r) r1).
+cut (b \leq (q-q1)*b+r).
+cut (b \leq r1).
+apply (lt_to_not_le r1 b H4 Hcut2).
+elim Hcut.assumption.
+apply (trans_le ? ((q-q1)*b)).
+apply le_times_n.
+apply le_SO_minus.exact H6.
+rewrite < sym_plus.
+apply le_plus_n.
+rewrite < sym_times.
+rewrite > distr_times_minus.
+rewrite > plus_minus.
+rewrite > sym_times.
+rewrite < H3.
+rewrite < sym_times.
+apply plus_to_minus.
+apply H5.
+apply le_times_r.
+apply lt_to_le.
+apply H6.
+qed.
+
+theorem div_mod_spec_to_eq2 :\forall a,b,q,r,q1,r1.
+(div_mod_spec a b q r) \to (div_mod_spec a b q1 r1) \to
+(eq nat r r1).
+intros.elim H.elim H1.
+apply (inj_plus_r (q*b)).
+rewrite < H3.
+rewrite > (div_mod_spec_to_eq a b q r q1 r1 H H1).
+assumption.
+qed.
+
+theorem div_mod_spec_times : \forall n,m:nat.div_mod_spec ((S n)*m) (S n) m O.
+intros.constructor 1.
+unfold lt.apply le_S_S.apply le_O_n.
+rewrite < plus_n_O.rewrite < sym_times.reflexivity.
+qed.
+
+(* some properties of div and mod *)
+theorem div_times: \forall n,m:nat. ((S n)*m) / (S n) = m.
+intros.
+apply (div_mod_spec_to_eq ((S n)*m) (S n) ? ? ? O).
+goal 15. (* ?11 is closed with the following tactics *)
+apply div_mod_spec_div_mod.
+unfold lt.apply le_S_S.apply le_O_n.
+apply div_mod_spec_times.
+qed.
+
+theorem div_n_n: \forall n:nat. O < n \to n / n = S O.
+intros.
+apply (div_mod_spec_to_eq n n (n / n) (n \mod n) (S O) O).
+apply div_mod_spec_div_mod.assumption.
+constructor 1.assumption.
+rewrite < plus_n_O.simplify.rewrite < plus_n_O.reflexivity.
+qed.
+
+theorem eq_div_O: \forall n,m. n < m \to n / m = O.
+intros.
+apply (div_mod_spec_to_eq n m (n/m) (n \mod m) O n).
+apply div_mod_spec_div_mod.
+apply (le_to_lt_to_lt O n m).
+apply le_O_n.assumption.
+constructor 1.assumption.reflexivity.
+qed.
+
+theorem mod_n_n: \forall n:nat. O < n \to n \mod n = O.
+intros.
+apply (div_mod_spec_to_eq2 n n (n / n) (n \mod n) (S O) O).
+apply div_mod_spec_div_mod.assumption.
+constructor 1.assumption.
+rewrite < plus_n_O.simplify.rewrite < plus_n_O.reflexivity.
+qed.
+
+theorem mod_S: \forall n,m:nat. O < m \to S (n \mod m) < m \to
+((S n) \mod m) = S (n \mod m).
+intros.
+apply (div_mod_spec_to_eq2 (S n) m ((S n) / m) ((S n) \mod m) (n / m) (S (n \mod m))).
+apply div_mod_spec_div_mod.assumption.
+constructor 1.assumption.rewrite < plus_n_Sm.
+apply eq_f.
+apply div_mod.
+assumption.
+qed.
+
+theorem mod_O_n: \forall n:nat.O \mod n = O.
+intro.elim n.simplify.reflexivity.
+simplify.reflexivity.
+qed.
+
+theorem lt_to_eq_mod:\forall n,m:nat. n < m \to n \mod m = n.
+intros.
+apply (div_mod_spec_to_eq2 n m (n/m) (n \mod m) O n).
+apply div_mod_spec_div_mod.
+apply (le_to_lt_to_lt O n m).apply le_O_n.assumption.
+constructor 1.
+assumption.reflexivity.
+qed.
+
+(* injectivity *)
+theorem injective_times_r: \forall n:nat.injective nat nat (\lambda m:nat.(S n)*m).
+change with (\forall n,p,q:nat.(S n)*p = (S n)*q \to p=q).
+intros.
+rewrite < (div_times n).
+rewrite < (div_times n q).
+apply eq_f2.assumption.
+reflexivity.
+qed.
+
+variant inj_times_r : \forall n,p,q:nat.(S n)*p = (S n)*q \to p=q \def
+injective_times_r.
+
+theorem lt_O_to_injective_times_r: \forall n:nat. O < n \to injective nat nat (\lambda m:nat.n*m).
+change with (\forall n. O < n \to \forall p,q:nat.n*p = n*q \to p=q).
+intros 4.
+apply (lt_O_n_elim n H).intros.
+apply (inj_times_r m).assumption.
+qed.
+
+variant inj_times_r1:\forall n. O < n \to \forall p,q:nat.n*p = n*q \to p=q
+\def lt_O_to_injective_times_r.
+
+theorem injective_times_l: \forall n:nat.injective nat nat (\lambda m:nat.m*(S n)).
+change with (\forall n,p,q:nat.p*(S n) = q*(S n) \to p=q).
+intros.
+apply (inj_times_r n p q).
+rewrite < sym_times.
+rewrite < (sym_times q).
+assumption.
+qed.
+
+variant inj_times_l : \forall n,p,q:nat. p*(S n) = q*(S n) \to p=q \def
+injective_times_l.
+
+theorem lt_O_to_injective_times_l: \forall n:nat. O < n \to injective nat nat (\lambda m:nat.m*n).
+change with (\forall n. O < n \to \forall p,q:nat.p*n = q*n \to p=q).
+intros 4.
+apply (lt_O_n_elim n H).intros.
+apply (inj_times_l m).assumption.
+qed.
+
+variant inj_times_l1:\forall n. O < n \to \forall p,q:nat.p*n = q*n \to p=q
+\def lt_O_to_injective_times_l.
diff --git a/helm/matita/library/nat/exp.ma b/helm/matita/library/nat/exp.ma
new file mode 100644
index 000000000..11d84f74c
--- /dev/null
+++ b/helm/matita/library/nat/exp.ma
@@ -0,0 +1,97 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/exp".
+
+include "nat/div_and_mod.ma".
+
+let rec exp n m on m\def
+ match m with
+ [ O \Rightarrow (S O)
+ | (S p) \Rightarrow (times n (exp n p)) ].
+
+interpretation "natural exponent" 'exp a b = (cic:/matita/nat/exp/exp.con a b).
+
+theorem exp_plus_times : \forall n,p,q:nat.
+n \sup (p + q) = (n \sup p) * (n \sup q).
+intros.elim p.
+simplify.rewrite < plus_n_O.reflexivity.
+simplify.rewrite > H.symmetry.
+apply assoc_times.
+qed.
+
+theorem exp_n_O : \forall n:nat. S O = n \sup O.
+intro.simplify.reflexivity.
+qed.
+
+theorem exp_n_SO : \forall n:nat. n = n \sup (S O).
+intro.simplify.rewrite < times_n_SO.reflexivity.
+qed.
+
+theorem exp_exp_times : \forall n,p,q:nat.
+(n \sup p) \sup q = n \sup (p * q).
+intros.
+elim q.simplify.rewrite < times_n_O.simplify.reflexivity.
+simplify.rewrite > H.rewrite < exp_plus_times.
+rewrite < times_n_Sm.reflexivity.
+qed.
+
+theorem lt_O_exp: \forall n,m:nat. O < n \to O < n \sup m.
+intros.elim m.simplify.unfold lt.apply le_n.
+simplify.unfold lt.rewrite > times_n_SO.
+apply le_times.assumption.assumption.
+qed.
+
+theorem lt_m_exp_nm: \forall n,m:nat. (S O) < n \to m < n \sup m.
+intros.elim m.simplify.unfold lt.reflexivity.
+simplify.unfold lt.
+apply (trans_le ? ((S(S O))*(S n1))).
+simplify.
+rewrite < plus_n_Sm.apply le_S_S.apply le_S_S.
+rewrite < sym_plus.
+apply le_plus_n.
+apply le_times.assumption.assumption.
+qed.
+
+theorem exp_to_eq_O: \forall n,m:nat. (S O) < n
+\to n \sup m = (S O) \to m = O.
+intros.apply antisym_le.apply le_S_S_to_le.
+rewrite < H1.change with (m < n \sup m).
+apply lt_m_exp_nm.assumption.
+apply le_O_n.
+qed.
+
+theorem injective_exp_r: \forall n:nat. (S O) < n \to
+injective nat nat (\lambda m:nat. n \sup m).
+simplify.intros 4.
+apply (nat_elim2 (\lambda x,y.n \sup x = n \sup y \to x = y)).
+intros.apply sym_eq.apply (exp_to_eq_O n).assumption.
+rewrite < H1.reflexivity.
+intros.apply (exp_to_eq_O n).assumption.assumption.
+intros.apply eq_f.
+apply H1.
+(* esprimere inj_times senza S *)
+cut (\forall a,b:nat.O < n \to n*a=n*b \to a=b).
+apply Hcut.simplify.unfold lt.apply le_S_S_to_le. apply le_S. assumption.
+assumption.
+intros 2.
+apply (nat_case n).
+intros.apply False_ind.apply (not_le_Sn_O O H3).
+intros.
+apply (inj_times_r m1).assumption.
+qed.
+
+variant inj_exp_r: \forall p:nat. (S O) < p \to \forall n,m:nat.
+p \sup n = p \sup m \to n = m \def
+injective_exp_r.
diff --git a/helm/matita/library/nat/factorial.ma b/helm/matita/library/nat/factorial.ma
new file mode 100644
index 000000000..14217bbcb
--- /dev/null
+++ b/helm/matita/library/nat/factorial.ma
@@ -0,0 +1,61 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / Matita is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/factorial".
+
+include "nat/le_arith.ma".
+
+let rec fact n \def
+ match n with
+ [ O \Rightarrow (S O)
+ | (S m) \Rightarrow (S m)*(fact m)].
+
+interpretation "factorial" 'fact n = (cic:/matita/nat/factorial/fact.con n).
+
+theorem le_SO_fact : \forall n. (S O) \le n!.
+intro.elim n.simplify.apply le_n.
+change with ((S O) \le (S n1)*n1!).
+apply (trans_le ? ((S n1)*(S O))).simplify.
+apply le_S_S.apply le_O_n.
+apply le_times_r.assumption.
+qed.
+
+theorem le_SSO_fact : \forall n. (S O) < n \to (S(S O)) \le n!.
+intro.apply (nat_case n).intro.apply False_ind.apply (not_le_Sn_O (S O) H).
+intros.change with ((S (S O)) \le (S m)*m!).
+apply (trans_le ? ((S(S O))*(S O))).apply le_n.
+apply le_times.exact H.apply le_SO_fact.
+qed.
+
+theorem le_n_fact_n: \forall n. n \le n!.
+intro. elim n.apply le_O_n.
+change with (S n1 \le (S n1)*n1!).
+apply (trans_le ? ((S n1)*(S O))).
+rewrite < times_n_SO.apply le_n.
+apply le_times.apply le_n.
+apply le_SO_fact.
+qed.
+
+theorem lt_n_fact_n: \forall n. (S(S O)) < n \to n < n!.
+intro.apply (nat_case n).intro.apply False_ind.apply (not_le_Sn_O (S(S O)) H).
+intros.change with ((S m) < (S m)*m!).
+apply (lt_to_le_to_lt ? ((S m)*(S (S O)))).
+rewrite < sym_times.
+simplify.unfold lt.
+apply le_S_S.rewrite < plus_n_O.
+apply le_plus_n.
+apply le_times_r.apply le_SSO_fact.
+simplify.unfold lt.apply le_S_S_to_le.exact H.
+qed.
+
diff --git a/helm/matita/library/nat/factorization.ma b/helm/matita/library/nat/factorization.ma
new file mode 100644
index 000000000..6a3094303
--- /dev/null
+++ b/helm/matita/library/nat/factorization.ma
@@ -0,0 +1,613 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / Matita is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/factorization".
+
+include "nat/ord.ma".
+include "nat/gcd.ma".
+include "nat/nth_prime.ma".
+
+(* the following factorization algorithm looks for the largest prime
+ factor. *)
+definition max_prime_factor \def \lambda n:nat.
+(max n (\lambda p:nat.eqb (n \mod (nth_prime p)) O)).
+
+(* max_prime_factor is indeed a factor *)
+theorem divides_max_prime_factor_n: \forall n:nat. (S O) < n \to
+nth_prime (max_prime_factor n) \divides n.
+intros.apply divides_b_true_to_divides.
+apply lt_O_nth_prime_n.
+apply (f_max_true (\lambda p:nat.eqb (n \mod (nth_prime p)) O) n).
+cut (\exists i. nth_prime i = smallest_factor n).
+elim Hcut.
+apply (ex_intro nat ? a).
+split.
+apply (trans_le a (nth_prime a)).
+apply le_n_fn.
+exact lt_nth_prime_n_nth_prime_Sn.
+rewrite > H1. apply le_smallest_factor_n.
+rewrite > H1.
+change with (divides_b (smallest_factor n) n = true).
+apply divides_to_divides_b_true.
+apply (trans_lt ? (S O)).unfold lt. apply le_n.
+apply lt_SO_smallest_factor.assumption.
+apply divides_smallest_factor_n.
+apply (trans_lt ? (S O)). unfold lt. apply le_n. assumption.
+apply prime_to_nth_prime.
+apply prime_smallest_factor_n.assumption.
+qed.
+
+theorem divides_to_max_prime_factor : \forall n,m. (S O) < n \to O < m \to n \divides m \to
+max_prime_factor n \le max_prime_factor m.
+intros.change with
+((max n (\lambda p:nat.eqb (n \mod (nth_prime p)) O)) \le
+(max m (\lambda p:nat.eqb (m \mod (nth_prime p)) O))).
+apply f_m_to_le_max.
+apply (trans_le ? n).
+apply le_max_n.apply divides_to_le.assumption.assumption.
+change with (divides_b (nth_prime (max_prime_factor n)) m = true).
+apply divides_to_divides_b_true.
+cut (prime (nth_prime (max_prime_factor n))).
+apply lt_O_nth_prime_n.apply prime_nth_prime.
+cut (nth_prime (max_prime_factor n) \divides n).
+apply (transitive_divides ? n).
+apply divides_max_prime_factor_n.
+assumption.assumption.
+apply divides_b_true_to_divides.
+apply lt_O_nth_prime_n.
+apply divides_to_divides_b_true.
+apply lt_O_nth_prime_n.
+apply divides_max_prime_factor_n.
+assumption.
+qed.
+
+theorem p_ord_to_lt_max_prime_factor: \forall n,p,q,r. O < n \to
+p = max_prime_factor n \to
+(pair nat nat q r) = p_ord n (nth_prime p) \to
+(S O) < r \to max_prime_factor r < p.
+intros.
+rewrite > H1.
+cut (max_prime_factor r \lt max_prime_factor n \lor
+ max_prime_factor r = max_prime_factor n).
+elim Hcut.assumption.
+absurd (nth_prime (max_prime_factor n) \divides r).
+rewrite < H4.
+apply divides_max_prime_factor_n.
+assumption.
+change with (nth_prime (max_prime_factor n) \divides r \to False).
+intro.
+cut (r \mod (nth_prime (max_prime_factor n)) \neq O).
+apply Hcut1.apply divides_to_mod_O.
+apply lt_O_nth_prime_n.assumption.
+apply (p_ord_aux_to_not_mod_O n n ? q r).
+apply lt_SO_nth_prime_n.assumption.
+apply le_n.
+rewrite < H1.assumption.
+apply (le_to_or_lt_eq (max_prime_factor r) (max_prime_factor n)).
+apply divides_to_max_prime_factor.
+assumption.assumption.
+apply (witness r n ((nth_prime p) \sup q)).
+rewrite < sym_times.
+apply (p_ord_aux_to_exp n n ? q r).
+apply lt_O_nth_prime_n.assumption.
+qed.
+
+theorem p_ord_to_lt_max_prime_factor1: \forall n,p,q,r. O < n \to
+max_prime_factor n \le p \to
+(pair nat nat q r) = p_ord n (nth_prime p) \to
+(S O) < r \to max_prime_factor r < p.
+intros.
+cut (max_prime_factor n < p \lor max_prime_factor n = p).
+elim Hcut.apply (le_to_lt_to_lt ? (max_prime_factor n)).
+apply divides_to_max_prime_factor.assumption.assumption.
+apply (witness r n ((nth_prime p) \sup q)).
+rewrite > sym_times.
+apply (p_ord_aux_to_exp n n).
+apply lt_O_nth_prime_n.
+assumption.assumption.
+apply (p_ord_to_lt_max_prime_factor n ? q).
+assumption.apply sym_eq.assumption.assumption.assumption.
+apply (le_to_or_lt_eq ? p H1).
+qed.
+
+(* datatypes and functions *)
+
+inductive nat_fact : Set \def
+ nf_last : nat \to nat_fact
+ | nf_cons : nat \to nat_fact \to nat_fact.
+
+inductive nat_fact_all : Set \def
+ nfa_zero : nat_fact_all
+ | nfa_one : nat_fact_all
+ | nfa_proper : nat_fact \to nat_fact_all.
+
+let rec factorize_aux p n acc \def
+ match p with
+ [ O \Rightarrow acc
+ | (S p1) \Rightarrow
+ match p_ord n (nth_prime p1) with
+ [ (pair q r) \Rightarrow
+ factorize_aux p1 r (nf_cons q acc)]].
+
+definition factorize : nat \to nat_fact_all \def \lambda n:nat.
+ match n with
+ [ O \Rightarrow nfa_zero
+ | (S n1) \Rightarrow
+ match n1 with
+ [ O \Rightarrow nfa_one
+ | (S n2) \Rightarrow
+ let p \def (max (S(S n2)) (\lambda p:nat.eqb ((S(S n2)) \mod (nth_prime p)) O)) in
+ match p_ord (S(S n2)) (nth_prime p) with
+ [ (pair q r) \Rightarrow
+ nfa_proper (factorize_aux p r (nf_last (pred q)))]]].
+
+let rec defactorize_aux f i \def
+ match f with
+ [ (nf_last n) \Rightarrow (nth_prime i) \sup (S n)
+ | (nf_cons n g) \Rightarrow
+ (nth_prime i) \sup n *(defactorize_aux g (S i))].
+
+definition defactorize : nat_fact_all \to nat \def
+\lambda f : nat_fact_all.
+match f with
+[ nfa_zero \Rightarrow O
+| nfa_one \Rightarrow (S O)
+| (nfa_proper g) \Rightarrow defactorize_aux g O].
+
+theorem lt_O_defactorize_aux: \forall f:nat_fact.\forall i:nat.
+O < defactorize_aux f i.
+intro.elim f.simplify.unfold lt.
+rewrite > times_n_SO.
+apply le_times.
+change with (O < nth_prime i).
+apply lt_O_nth_prime_n.
+change with (O < exp (nth_prime i) n).
+apply lt_O_exp.
+apply lt_O_nth_prime_n.
+simplify.unfold lt.
+rewrite > times_n_SO.
+apply le_times.
+change with (O < exp (nth_prime i) n).
+apply lt_O_exp.
+apply lt_O_nth_prime_n.
+change with (O < defactorize_aux n1 (S i)).
+apply H.
+qed.
+
+theorem lt_SO_defactorize_aux: \forall f:nat_fact.\forall i:nat.
+S O < defactorize_aux f i.
+intro.elim f.simplify.unfold lt.
+rewrite > times_n_SO.
+apply le_times.
+change with (S O < nth_prime i).
+apply lt_SO_nth_prime_n.
+change with (O < exp (nth_prime i) n).
+apply lt_O_exp.
+apply lt_O_nth_prime_n.
+simplify.unfold lt.
+rewrite > times_n_SO.
+rewrite > sym_times.
+apply le_times.
+change with (O < exp (nth_prime i) n).
+apply lt_O_exp.
+apply lt_O_nth_prime_n.
+change with (S O < defactorize_aux n1 (S i)).
+apply H.
+qed.
+
+theorem defactorize_aux_factorize_aux :
+\forall p,n:nat.\forall acc:nat_fact.O < n \to
+((n=(S O) \land p=O) \lor max_prime_factor n < p) \to
+defactorize_aux (factorize_aux p n acc) O = n*(defactorize_aux acc p).
+intro.elim p.simplify.
+elim H1.elim H2.rewrite > H3.
+rewrite > sym_times. apply times_n_SO.
+apply False_ind.apply (not_le_Sn_O (max_prime_factor n) H2).
+simplify.
+(* generalizing the goal: I guess there exists a better way *)
+cut (\forall q,r.(pair nat nat q r) = (p_ord_aux n1 n1 (nth_prime n)) \to
+defactorize_aux match (p_ord_aux n1 n1 (nth_prime n)) with
+[(pair q r) \Rightarrow (factorize_aux n r (nf_cons q acc))] O =
+n1*defactorize_aux acc (S n)).
+apply (Hcut (fst ? ? (p_ord_aux n1 n1 (nth_prime n)))
+(snd ? ? (p_ord_aux n1 n1 (nth_prime n)))).
+apply sym_eq.apply eq_pair_fst_snd.
+intros.
+rewrite < H3.
+simplify.
+cut (n1 = r * (nth_prime n) \sup q).
+rewrite > H.
+simplify.rewrite < assoc_times.
+rewrite < Hcut.reflexivity.
+cut (O < r \lor O = r).
+elim Hcut1.assumption.absurd (n1 = O).
+rewrite > Hcut.rewrite < H4.reflexivity.
+unfold Not. intro.apply (not_le_Sn_O O).
+rewrite < H5 in \vdash (? ? %).assumption.
+apply le_to_or_lt_eq.apply le_O_n.
+cut ((S O) < r \lor (S O) \nlt r).
+elim Hcut1.
+right.
+apply (p_ord_to_lt_max_prime_factor1 n1 ? q r).
+assumption.elim H2.
+elim H5.
+apply False_ind.
+apply (not_eq_O_S n).apply sym_eq.assumption.
+apply le_S_S_to_le.
+exact H5.
+assumption.assumption.
+cut (r=(S O)).
+apply (nat_case n).
+left.split.assumption.reflexivity.
+intro.right.rewrite > Hcut2.
+simplify.unfold lt.apply le_S_S.apply le_O_n.
+cut (r \lt (S O) \or r=(S O)).
+elim Hcut2.absurd (O=r).
+apply le_n_O_to_eq.apply le_S_S_to_le.exact H5.
+unfold Not.intro.
+cut (O=n1).
+apply (not_le_Sn_O O).
+rewrite > Hcut3 in \vdash (? ? %).
+assumption.rewrite > Hcut.
+rewrite < H6.reflexivity.
+assumption.
+apply (le_to_or_lt_eq r (S O)).
+apply not_lt_to_le.assumption.
+apply (decidable_lt (S O) r).
+rewrite > sym_times.
+apply (p_ord_aux_to_exp n1 n1).
+apply lt_O_nth_prime_n.assumption.
+qed.
+
+theorem defactorize_factorize: \forall n:nat.defactorize (factorize n) = n.
+intro.
+apply (nat_case n).reflexivity.
+intro.apply (nat_case m).reflexivity.
+intro.change with
+(let p \def (max (S(S m1)) (\lambda p:nat.eqb ((S(S m1)) \mod (nth_prime p)) O)) in
+defactorize (match p_ord (S(S m1)) (nth_prime p) with
+[ (pair q r) \Rightarrow
+ nfa_proper (factorize_aux p r (nf_last (pred q)))])=(S(S m1))).
+intro.
+(* generalizing the goal; find a better way *)
+cut (\forall q,r.(pair nat nat q r) = (p_ord (S(S m1)) (nth_prime p)) \to
+defactorize (match p_ord (S(S m1)) (nth_prime p) with
+[ (pair q r) \Rightarrow
+ nfa_proper (factorize_aux p r (nf_last (pred q)))])=(S(S m1))).
+apply (Hcut (fst ? ? (p_ord (S(S m1)) (nth_prime p)))
+(snd ? ? (p_ord (S(S m1)) (nth_prime p)))).
+apply sym_eq.apply eq_pair_fst_snd.
+intros.
+rewrite < H.
+change with
+(defactorize_aux (factorize_aux p r (nf_last (pred q))) O = (S(S m1))).
+cut ((S(S m1)) = (nth_prime p) \sup q *r).
+cut (O<r).
+rewrite > defactorize_aux_factorize_aux.
+change with (r*(nth_prime p) \sup (S (pred q)) = (S(S m1))).
+cut ((S (pred q)) = q).
+rewrite > Hcut2.
+rewrite > sym_times.
+apply sym_eq.
+apply (p_ord_aux_to_exp (S(S m1))).
+apply lt_O_nth_prime_n.
+assumption.
+(* O < q *)
+apply sym_eq. apply S_pred.
+cut (O < q \lor O = q).
+elim Hcut2.assumption.
+absurd (nth_prime p \divides S (S m1)).
+apply (divides_max_prime_factor_n (S (S m1))).
+unfold lt.apply le_S_S.apply le_S_S. apply le_O_n.
+cut ((S(S m1)) = r).
+rewrite > Hcut3 in \vdash (? (? ? %)).
+change with (nth_prime p \divides r \to False).
+intro.
+apply (p_ord_aux_to_not_mod_O (S(S m1)) (S(S m1)) (nth_prime p) q r).
+apply lt_SO_nth_prime_n.
+unfold lt.apply le_S_S.apply le_O_n.apply le_n.
+assumption.
+apply divides_to_mod_O.apply lt_O_nth_prime_n.assumption.
+rewrite > times_n_SO in \vdash (? ? ? %).
+rewrite < sym_times.
+rewrite > (exp_n_O (nth_prime p)).
+rewrite > H1 in \vdash (? ? ? (? (? ? %) ?)).
+assumption.
+apply le_to_or_lt_eq.apply le_O_n.assumption.
+(* e adesso l'ultimo goal. TASSI: che ora non e' piu' l'ultimo :P *)
+cut ((S O) < r \lor S O \nlt r).
+elim Hcut2.
+right.
+apply (p_ord_to_lt_max_prime_factor1 (S(S m1)) ? q r).
+unfold lt.apply le_S_S. apply le_O_n.
+apply le_n.
+assumption.assumption.
+cut (r=(S O)).
+apply (nat_case p).
+left.split.assumption.reflexivity.
+intro.right.rewrite > Hcut3.
+simplify.unfold lt.apply le_S_S.apply le_O_n.
+cut (r \lt (S O) \or r=(S O)).
+elim Hcut3.absurd (O=r).
+apply le_n_O_to_eq.apply le_S_S_to_le.exact H2.
+unfold Not.intro.
+apply (not_le_Sn_O O).
+rewrite > H3 in \vdash (? ? %).assumption.assumption.
+apply (le_to_or_lt_eq r (S O)).
+apply not_lt_to_le.assumption.
+apply (decidable_lt (S O) r).
+(* O < r *)
+cut (O < r \lor O = r).
+elim Hcut1.assumption.
+apply False_ind.
+apply (not_eq_O_S (S m1)).
+rewrite > Hcut.rewrite < H1.rewrite < times_n_O.reflexivity.
+apply le_to_or_lt_eq.apply le_O_n.
+(* prova del cut *)
+goal 20.
+apply (p_ord_aux_to_exp (S(S m1))).
+apply lt_O_nth_prime_n.
+assumption.
+(* fine prova cut *)
+qed.
+
+let rec max_p f \def
+match f with
+[ (nf_last n) \Rightarrow O
+| (nf_cons n g) \Rightarrow S (max_p g)].
+
+let rec max_p_exponent f \def
+match f with
+[ (nf_last n) \Rightarrow n
+| (nf_cons n g) \Rightarrow max_p_exponent g].
+
+theorem divides_max_p_defactorize: \forall f:nat_fact.\forall i:nat.
+nth_prime ((max_p f)+i) \divides defactorize_aux f i.
+intro.
+elim f.simplify.apply (witness ? ? ((nth_prime i) \sup n)).
+reflexivity.
+change with
+(nth_prime (S(max_p n1)+i) \divides
+(nth_prime i) \sup n *(defactorize_aux n1 (S i))).
+elim (H (S i)).
+rewrite > H1.
+rewrite < sym_times.
+rewrite > assoc_times.
+rewrite < plus_n_Sm.
+apply (witness ? ? (n2* (nth_prime i) \sup n)).
+reflexivity.
+qed.
+
+theorem divides_exp_to_divides:
+\forall p,n,m:nat. prime p \to
+p \divides n \sup m \to p \divides n.
+intros 3.elim m.simplify in H1.
+apply (transitive_divides p (S O)).assumption.
+apply divides_SO_n.
+cut (p \divides n \lor p \divides n \sup n1).
+elim Hcut.assumption.
+apply H.assumption.assumption.
+apply divides_times_to_divides.assumption.
+exact H2.
+qed.
+
+theorem divides_exp_to_eq:
+\forall p,q,m:nat. prime p \to prime q \to
+p \divides q \sup m \to p = q.
+intros.
+unfold prime in H1.
+elim H1.apply H4.
+apply (divides_exp_to_divides p q m).
+assumption.assumption.
+unfold prime in H.elim H.assumption.
+qed.
+
+theorem not_divides_defactorize_aux: \forall f:nat_fact. \forall i,j:nat.
+i < j \to nth_prime i \ndivides defactorize_aux f j.
+intro.elim f.
+change with
+(nth_prime i \divides (nth_prime j) \sup (S n) \to False).
+intro.absurd ((nth_prime i) = (nth_prime j)).
+apply (divides_exp_to_eq ? ? (S n)).
+apply prime_nth_prime.apply prime_nth_prime.
+assumption.
+change with ((nth_prime i) = (nth_prime j) \to False).
+intro.cut (i = j).
+apply (not_le_Sn_n i).rewrite > Hcut in \vdash (? ? %).assumption.
+apply (injective_nth_prime ? ? H2).
+change with
+(nth_prime i \divides (nth_prime j) \sup n *(defactorize_aux n1 (S j)) \to False).
+intro.
+cut (nth_prime i \divides (nth_prime j) \sup n
+\lor nth_prime i \divides defactorize_aux n1 (S j)).
+elim Hcut.
+absurd ((nth_prime i) = (nth_prime j)).
+apply (divides_exp_to_eq ? ? n).
+apply prime_nth_prime.apply prime_nth_prime.
+assumption.
+change with ((nth_prime i) = (nth_prime j) \to False).
+intro.
+cut (i = j).
+apply (not_le_Sn_n i).rewrite > Hcut1 in \vdash (? ? %).assumption.
+apply (injective_nth_prime ? ? H4).
+apply (H i (S j)).
+apply (trans_lt ? j).assumption.unfold lt.apply le_n.
+assumption.
+apply divides_times_to_divides.
+apply prime_nth_prime.assumption.
+qed.
+
+lemma not_eq_nf_last_nf_cons: \forall g:nat_fact.\forall n,m,i:nat.
+\lnot (defactorize_aux (nf_last n) i= defactorize_aux (nf_cons m g) i).
+intros.
+change with
+(exp (nth_prime i) (S n) = defactorize_aux (nf_cons m g) i \to False).
+intro.
+cut (S(max_p g)+i= i).
+apply (not_le_Sn_n i).
+rewrite < Hcut in \vdash (? ? %).
+simplify.apply le_S_S.
+apply le_plus_n.
+apply injective_nth_prime.
+(* uffa, perche' semplifica ? *)
+change with (nth_prime (S(max_p g)+i)= nth_prime i).
+apply (divides_exp_to_eq ? ? (S n)).
+apply prime_nth_prime.apply prime_nth_prime.
+rewrite > H.
+change with (divides (nth_prime ((max_p (nf_cons m g))+i))
+(defactorize_aux (nf_cons m g) i)).
+apply divides_max_p_defactorize.
+qed.
+
+lemma not_eq_nf_cons_O_nf_cons: \forall f,g:nat_fact.\forall n,i:nat.
+\lnot (defactorize_aux (nf_cons O f) i= defactorize_aux (nf_cons (S n) g) i).
+intros.
+simplify.unfold Not.rewrite < plus_n_O.
+intro.
+apply (not_divides_defactorize_aux f i (S i) ?).
+unfold lt.apply le_n.
+rewrite > H.
+rewrite > assoc_times.
+apply (witness ? ? ((exp (nth_prime i) n)*(defactorize_aux g (S i)))).
+reflexivity.
+qed.
+
+theorem eq_defactorize_aux_to_eq: \forall f,g:nat_fact.\forall i:nat.
+defactorize_aux f i = defactorize_aux g i \to f = g.
+intro.
+elim f.
+generalize in match H.
+elim g.
+apply eq_f.
+apply inj_S. apply (inj_exp_r (nth_prime i)).
+apply lt_SO_nth_prime_n.
+assumption.
+apply False_ind.
+apply (not_eq_nf_last_nf_cons n2 n n1 i H2).
+generalize in match H1.
+elim g.
+apply False_ind.
+apply (not_eq_nf_last_nf_cons n1 n2 n i).
+apply sym_eq. assumption.
+simplify in H3.
+generalize in match H3.
+apply (nat_elim2 (\lambda n,n2.
+((nth_prime i) \sup n)*(defactorize_aux n1 (S i)) =
+((nth_prime i) \sup n2)*(defactorize_aux n3 (S i)) \to
+nf_cons n n1 = nf_cons n2 n3)).
+intro.
+elim n4. apply eq_f.
+apply (H n3 (S i)).
+simplify in H4.
+rewrite > plus_n_O.
+rewrite > (plus_n_O (defactorize_aux n3 (S i))).assumption.
+apply False_ind.
+apply (not_eq_nf_cons_O_nf_cons n1 n3 n5 i).assumption.
+intros.
+apply False_ind.
+apply (not_eq_nf_cons_O_nf_cons n3 n1 n4 i).
+apply sym_eq.assumption.
+intros.
+cut (nf_cons n4 n1 = nf_cons m n3).
+cut (n4=m).
+cut (n1=n3).
+rewrite > Hcut1.rewrite > Hcut2.reflexivity.
+change with
+(match nf_cons n4 n1 with
+[ (nf_last m) \Rightarrow n1
+| (nf_cons m g) \Rightarrow g ] = n3).
+rewrite > Hcut.simplify.reflexivity.
+change with
+(match nf_cons n4 n1 with
+[ (nf_last m) \Rightarrow m
+| (nf_cons m g) \Rightarrow m ] = m).
+rewrite > Hcut.simplify.reflexivity.
+apply H4.simplify in H5.
+apply (inj_times_r1 (nth_prime i)).
+apply lt_O_nth_prime_n.
+rewrite < assoc_times.rewrite < assoc_times.assumption.
+qed.
+
+theorem injective_defactorize_aux: \forall i:nat.
+injective nat_fact nat (\lambda f.defactorize_aux f i).
+change with (\forall i:nat.\forall f,g:nat_fact.
+defactorize_aux f i = defactorize_aux g i \to f = g).
+intros.
+apply (eq_defactorize_aux_to_eq f g i H).
+qed.
+
+theorem injective_defactorize:
+injective nat_fact_all nat defactorize.
+change with (\forall f,g:nat_fact_all.
+defactorize f = defactorize g \to f = g).
+intro.elim f.
+generalize in match H.elim g.
+(* zero - zero *)
+reflexivity.
+(* zero - one *)
+simplify in H1.
+apply False_ind.
+apply (not_eq_O_S O H1).
+(* zero - proper *)
+simplify in H1.
+apply False_ind.
+apply (not_le_Sn_n O).
+rewrite > H1 in \vdash (? ? %).
+change with (O < defactorize_aux n O).
+apply lt_O_defactorize_aux.
+generalize in match H.
+elim g.
+(* one - zero *)
+simplify in H1.
+apply False_ind.
+apply (not_eq_O_S O).apply sym_eq. assumption.
+(* one - one *)
+reflexivity.
+(* one - proper *)
+simplify in H1.
+apply False_ind.
+apply (not_le_Sn_n (S O)).
+rewrite > H1 in \vdash (? ? %).
+change with ((S O) < defactorize_aux n O).
+apply lt_SO_defactorize_aux.
+generalize in match H.elim g.
+(* proper - zero *)
+simplify in H1.
+apply False_ind.
+apply (not_le_Sn_n O).
+rewrite < H1 in \vdash (? ? %).
+change with (O < defactorize_aux n O).
+apply lt_O_defactorize_aux.
+(* proper - one *)
+simplify in H1.
+apply False_ind.
+apply (not_le_Sn_n (S O)).
+rewrite < H1 in \vdash (? ? %).
+change with ((S O) < defactorize_aux n O).
+apply lt_SO_defactorize_aux.
+(* proper - proper *)
+apply eq_f.
+apply (injective_defactorize_aux O).
+exact H1.
+qed.
+
+theorem factorize_defactorize:
+\forall f,g: nat_fact_all. factorize (defactorize f) = f.
+intros.
+apply injective_defactorize.
+(* uffa: perche' semplifica ??? *)
+change with (defactorize(factorize (defactorize f)) = (defactorize f)).
+apply defactorize_factorize.
+qed.
+
diff --git a/helm/matita/library/nat/fermat_little_theorem.ma b/helm/matita/library/nat/fermat_little_theorem.ma
new file mode 100644
index 000000000..cc18a8bb9
--- /dev/null
+++ b/helm/matita/library/nat/fermat_little_theorem.ma
@@ -0,0 +1,250 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/fermat_little_theorem".
+
+include "nat/exp.ma".
+include "nat/gcd.ma".
+include "nat/permutation.ma".
+include "nat/congruence.ma".
+
+theorem permut_S_mod: \forall n:nat. permut (S_mod (S n)) n.
+intro.unfold permut.split.intros.
+unfold S_mod.
+apply le_S_S_to_le.
+change with ((S i) \mod (S n) < S n).
+apply lt_mod_m_m.
+unfold lt.apply le_S_S.apply le_O_n.
+unfold injn.intros.
+apply inj_S.
+rewrite < (lt_to_eq_mod i (S n)).
+rewrite < (lt_to_eq_mod j (S n)).
+cut (i < n \lor i = n).
+cut (j < n \lor j = n).
+elim Hcut.
+elim Hcut1.
+(* i < n, j< n *)
+rewrite < mod_S.
+rewrite < mod_S.
+apply H2.unfold lt.apply le_S_S.apply le_O_n.
+rewrite > lt_to_eq_mod.
+unfold lt.apply le_S_S.assumption.
+unfold lt.apply le_S_S.assumption.
+unfold lt.apply le_S_S.apply le_O_n.
+rewrite > lt_to_eq_mod.
+unfold lt.apply le_S_S.assumption.
+unfold lt.apply le_S_S.assumption.
+(* i < n, j=n *)
+unfold S_mod in H2.
+simplify.
+apply False_ind.
+apply (not_eq_O_S (i \mod (S n))).
+apply sym_eq.
+rewrite < (mod_n_n (S n)).
+rewrite < H4 in \vdash (? ? ? (? %?)).
+rewrite < mod_S.assumption.
+unfold lt.apply le_S_S.apply le_O_n.
+rewrite > lt_to_eq_mod.
+unfold lt.apply le_S_S.assumption.
+unfold lt.apply le_S_S.assumption.
+unfold lt.apply le_S_S.apply le_O_n.
+(* i = n, j < n *)
+elim Hcut1.
+apply False_ind.
+apply (not_eq_O_S (j \mod (S n))).
+rewrite < (mod_n_n (S n)).
+rewrite < H3 in \vdash (? ? (? %?) ?).
+rewrite < mod_S.assumption.
+unfold lt.apply le_S_S.apply le_O_n.
+rewrite > lt_to_eq_mod.
+unfold lt.apply le_S_S.assumption.
+unfold lt.apply le_S_S.assumption.
+unfold lt.apply le_S_S.apply le_O_n.
+(* i = n, j= n*)
+rewrite > H3.
+rewrite > H4.
+reflexivity.
+apply le_to_or_lt_eq.assumption.
+apply le_to_or_lt_eq.assumption.
+unfold lt.apply le_S_S.assumption.
+unfold lt.apply le_S_S.assumption.
+qed.
+
+(*
+theorem eq_fact_pi: \forall n,m:nat. n < m \to n! = pi n (S_mod m).
+intro.elim n.
+simplify.reflexivity.
+change with (S n1)*n1!=(S_mod m n1)*(pi n1 (S_mod m)).
+unfold S_mod in \vdash (? ? ? (? % ?)).
+rewrite > lt_to_eq_mod.
+apply eq_f.apply H.apply (trans_lt ? (S n1)).
+simplify. apply le_n.assumption.assumption.
+qed.
+*)
+
+theorem prime_to_not_divides_fact: \forall p:nat. prime p \to \forall n:nat.
+n \lt p \to \not divides p n!.
+intros 3.elim n.unfold Not.intros.
+apply (lt_to_not_le (S O) p).
+unfold prime in H.elim H.
+assumption.apply divides_to_le.unfold lt.apply le_n.
+assumption.
+change with (divides p ((S n1)*n1!) \to False).
+intro.
+cut (divides p (S n1) \lor divides p n1!).
+elim Hcut.apply (lt_to_not_le (S n1) p).
+assumption.
+apply divides_to_le.unfold lt.apply le_S_S.apply le_O_n.
+assumption.apply H1.
+apply (trans_lt ? (S n1)).unfold lt. apply le_n.
+assumption.assumption.
+apply divides_times_to_divides.
+assumption.assumption.
+qed.
+
+theorem permut_mod: \forall p,a:nat. prime p \to
+\lnot divides p a\to permut (\lambda n.(mod (a*n) p)) (pred p).
+unfold permut.intros.
+split.intros.apply le_S_S_to_le.
+apply (trans_le ? p).
+change with (mod (a*i) p < p).
+apply lt_mod_m_m.
+unfold prime in H.elim H.
+unfold lt.apply (trans_le ? (S (S O))).
+apply le_n_Sn.assumption.
+rewrite < S_pred.apply le_n.
+unfold prime in H.
+elim H.
+apply (trans_lt ? (S O)).unfold lt.apply le_n.assumption.
+unfold injn.intros.
+apply (nat_compare_elim i j).
+(* i < j *)
+intro.
+absurd (j-i \lt p).
+unfold lt.
+rewrite > (S_pred p).
+apply le_S_S.
+apply le_plus_to_minus.
+apply (trans_le ? (pred p)).assumption.
+rewrite > sym_plus.
+apply le_plus_n.
+unfold prime in H.
+elim H.
+apply (trans_lt ? (S O)).unfold lt.apply le_n.assumption.
+apply (le_to_not_lt p (j-i)).
+apply divides_to_le.unfold lt.
+apply le_SO_minus.assumption.
+cut (divides p a \lor divides p (j-i)).
+elim Hcut.apply False_ind.apply H1.assumption.assumption.
+apply divides_times_to_divides.assumption.
+rewrite > distr_times_minus.
+apply eq_mod_to_divides.
+unfold prime in H.
+elim H.
+apply (trans_lt ? (S O)).unfold lt.apply le_n.assumption.
+apply sym_eq.
+apply H4.
+(* i = j *)
+intro. assumption.
+(* j < i *)
+intro.
+absurd (i-j \lt p).
+unfold lt.
+rewrite > (S_pred p).
+apply le_S_S.
+apply le_plus_to_minus.
+apply (trans_le ? (pred p)).assumption.
+rewrite > sym_plus.
+apply le_plus_n.
+unfold prime in H.
+elim H.
+apply (trans_lt ? (S O)).unfold lt.apply le_n.assumption.
+apply (le_to_not_lt p (i-j)).
+apply divides_to_le.unfold lt.
+apply le_SO_minus.assumption.
+cut (divides p a \lor divides p (i-j)).
+elim Hcut.apply False_ind.apply H1.assumption.assumption.
+apply divides_times_to_divides.assumption.
+rewrite > distr_times_minus.
+apply eq_mod_to_divides.
+unfold prime in H.
+elim H.
+apply (trans_lt ? (S O)).unfold lt.apply le_n.assumption.
+apply H4.
+qed.
+
+theorem congruent_exp_pred_SO: \forall p,a:nat. prime p \to \lnot divides p a \to
+congruent (exp a (pred p)) (S O) p.
+intros.
+cut (O < a).
+cut (O < p).
+cut (O < pred p).
+apply divides_to_congruent.
+assumption.
+change with (O < exp a (pred p)).
+apply lt_O_exp.assumption.
+cut (divides p (exp a (pred p)-(S O)) \lor divides p (pred p)!).
+elim Hcut3.
+assumption.
+apply False_ind.
+apply (prime_to_not_divides_fact p H (pred p)).
+change with (S (pred p) \le p).
+rewrite < S_pred.apply le_n.
+assumption.assumption.
+apply divides_times_to_divides.
+assumption.
+rewrite > times_minus_l.
+rewrite > (sym_times (S O)).
+rewrite < times_n_SO.
+rewrite > (S_pred (pred p)).
+rewrite > eq_fact_pi.
+(* in \vdash (? ? (? % ?)). *)
+rewrite > exp_pi_l.
+apply congruent_to_divides.
+assumption.
+apply (transitive_congruent p ?
+(pi (pred (pred p)) (\lambda m. a*m \mod p) (S O))).
+apply (congruent_pi (\lambda m. a*m)).
+assumption.
+cut (pi (pred(pred p)) (\lambda m.m) (S O)
+= pi (pred(pred p)) (\lambda m.a*m \mod p) (S O)).
+rewrite > Hcut3.apply congruent_n_n.
+rewrite < eq_map_iter_i_pi.
+rewrite < eq_map_iter_i_pi.
+apply permut_to_eq_map_iter_i.
+apply assoc_times.
+apply sym_times.
+rewrite < plus_n_Sm.rewrite < plus_n_O.
+rewrite < S_pred.
+apply permut_mod.assumption.
+assumption.assumption.
+intros.cut (m=O).
+rewrite > Hcut3.rewrite < times_n_O.
+apply mod_O_n.apply sym_eq.apply le_n_O_to_eq.
+apply le_S_S_to_le.assumption.
+assumption.
+change with ((S O) \le pred p).
+apply le_S_S_to_le.rewrite < S_pred.
+unfold prime in H.elim H.assumption.assumption.
+unfold prime in H.elim H.apply (trans_lt ? (S O)).
+unfold lt.apply le_n.assumption.
+cut (O < a \lor O = a).
+elim Hcut.assumption.
+apply False_ind.apply H1.
+rewrite < H2.
+apply (witness ? ? O).apply times_n_O.
+apply le_to_or_lt_eq.
+apply le_O_n.
+qed.
+
diff --git a/helm/matita/library/nat/gcd.ma b/helm/matita/library/nat/gcd.ma
new file mode 100644
index 000000000..65f61b581
--- /dev/null
+++ b/helm/matita/library/nat/gcd.ma
@@ -0,0 +1,608 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / Matita is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/gcd".
+
+include "nat/primes.ma".
+
+let rec gcd_aux p m n: nat \def
+match divides_b n m with
+[ true \Rightarrow n
+| false \Rightarrow
+ match p with
+ [O \Rightarrow n
+ |(S q) \Rightarrow gcd_aux q n (m \mod n)]].
+
+definition gcd : nat \to nat \to nat \def
+\lambda n,m:nat.
+ match leb n m with
+ [ true \Rightarrow
+ match n with
+ [ O \Rightarrow m
+ | (S p) \Rightarrow gcd_aux (S p) m (S p) ]
+ | false \Rightarrow
+ match m with
+ [ O \Rightarrow n
+ | (S p) \Rightarrow gcd_aux (S p) n (S p) ]].
+
+theorem divides_mod: \forall p,m,n:nat. O < n \to p \divides m \to p \divides n \to
+p \divides (m \mod n).
+intros.elim H1.elim H2.
+apply (witness ? ? (n2 - n1*(m / n))).
+rewrite > distr_times_minus.
+rewrite < H3.
+rewrite < assoc_times.
+rewrite < H4.
+apply sym_eq.
+apply plus_to_minus.
+rewrite > sym_times.
+apply div_mod.
+assumption.
+qed.
+
+theorem divides_mod_to_divides: \forall p,m,n:nat. O < n \to
+p \divides (m \mod n) \to p \divides n \to p \divides m.
+intros.elim H1.elim H2.
+apply (witness p m ((n1*(m / n))+n2)).
+rewrite > distr_times_plus.
+rewrite < H3.
+rewrite < assoc_times.
+rewrite < H4.rewrite < sym_times.
+apply div_mod.assumption.
+qed.
+
+theorem divides_gcd_aux_mn: \forall p,m,n. O < n \to n \le m \to n \le p \to
+gcd_aux p m n \divides m \land gcd_aux p m n \divides n.
+intro.elim p.
+absurd (O < n).assumption.apply le_to_not_lt.assumption.
+cut ((n1 \divides m) \lor (n1 \ndivides m)).
+change with
+((match divides_b n1 m with
+[ true \Rightarrow n1
+| false \Rightarrow gcd_aux n n1 (m \mod n1)]) \divides m \land
+(match divides_b n1 m with
+[ true \Rightarrow n1
+| false \Rightarrow gcd_aux n n1 (m \mod n1)]) \divides n1).
+elim Hcut.rewrite > divides_to_divides_b_true.
+simplify.
+split.assumption.apply (witness n1 n1 (S O)).apply times_n_SO.
+assumption.assumption.
+rewrite > not_divides_to_divides_b_false.
+change with
+(gcd_aux n n1 (m \mod n1) \divides m \land
+gcd_aux n n1 (m \mod n1) \divides n1).
+cut (gcd_aux n n1 (m \mod n1) \divides n1 \land
+gcd_aux n n1 (m \mod n1) \divides mod m n1).
+elim Hcut1.
+split.apply (divides_mod_to_divides ? ? n1).
+assumption.assumption.assumption.assumption.
+apply H.
+cut (O \lt m \mod n1 \lor O = mod m n1).
+elim Hcut1.assumption.
+apply False_ind.apply H4.apply mod_O_to_divides.
+assumption.apply sym_eq.assumption.
+apply le_to_or_lt_eq.apply le_O_n.
+apply lt_to_le.
+apply lt_mod_m_m.assumption.
+apply le_S_S_to_le.
+apply (trans_le ? n1).
+change with (m \mod n1 < n1).
+apply lt_mod_m_m.assumption.assumption.
+assumption.assumption.
+apply (decidable_divides n1 m).assumption.
+qed.
+
+theorem divides_gcd_nm: \forall n,m.
+gcd n m \divides m \land gcd n m \divides n.
+intros.
+change with
+(match leb n m with
+ [ true \Rightarrow
+ match n with
+ [ O \Rightarrow m
+ | (S p) \Rightarrow gcd_aux (S p) m (S p) ]
+ | false \Rightarrow
+ match m with
+ [ O \Rightarrow n
+ | (S p) \Rightarrow gcd_aux (S p) n (S p) ] ] \divides m
+\land
+match leb n m with
+ [ true \Rightarrow
+ match n with
+ [ O \Rightarrow m
+ | (S p) \Rightarrow gcd_aux (S p) m (S p) ]
+ | false \Rightarrow
+ match m with
+ [ O \Rightarrow n
+ | (S p) \Rightarrow gcd_aux (S p) n (S p) ] ] \divides n).
+apply (leb_elim n m).
+apply (nat_case1 n).
+simplify.intros.split.
+apply (witness m m (S O)).apply times_n_SO.
+apply (witness m O O).apply times_n_O.
+intros.change with
+(gcd_aux (S m1) m (S m1) \divides m
+\land
+gcd_aux (S m1) m (S m1) \divides (S m1)).
+apply divides_gcd_aux_mn.
+unfold lt.apply le_S_S.apply le_O_n.
+assumption.apply le_n.
+simplify.intro.
+apply (nat_case1 m).
+simplify.intros.split.
+apply (witness n O O).apply times_n_O.
+apply (witness n n (S O)).apply times_n_SO.
+intros.change with
+(gcd_aux (S m1) n (S m1) \divides (S m1)
+\land
+gcd_aux (S m1) n (S m1) \divides n).
+cut (gcd_aux (S m1) n (S m1) \divides n
+\land
+gcd_aux (S m1) n (S m1) \divides S m1).
+elim Hcut.split.assumption.assumption.
+apply divides_gcd_aux_mn.
+unfold lt.apply le_S_S.apply le_O_n.
+apply not_lt_to_le.unfold Not. unfold lt.intro.apply H.
+rewrite > H1.apply (trans_le ? (S n)).
+apply le_n_Sn.assumption.apply le_n.
+qed.
+
+theorem divides_gcd_n: \forall n,m. gcd n m \divides n.
+intros.
+exact (proj2 ? ? (divides_gcd_nm n m)).
+qed.
+
+theorem divides_gcd_m: \forall n,m. gcd n m \divides m.
+intros.
+exact (proj1 ? ? (divides_gcd_nm n m)).
+qed.
+
+theorem divides_gcd_aux: \forall p,m,n,d. O < n \to n \le m \to n \le p \to
+d \divides m \to d \divides n \to d \divides gcd_aux p m n.
+intro.elim p.
+absurd (O < n).assumption.apply le_to_not_lt.assumption.
+change with
+(d \divides
+(match divides_b n1 m with
+[ true \Rightarrow n1
+| false \Rightarrow gcd_aux n n1 (m \mod n1)])).
+cut (n1 \divides m \lor n1 \ndivides m).
+elim Hcut.
+rewrite > divides_to_divides_b_true.
+simplify.assumption.
+assumption.assumption.
+rewrite > not_divides_to_divides_b_false.
+change with (d \divides gcd_aux n n1 (m \mod n1)).
+apply H.
+cut (O \lt m \mod n1 \lor O = m \mod n1).
+elim Hcut1.assumption.
+absurd (n1 \divides m).apply mod_O_to_divides.
+assumption.apply sym_eq.assumption.assumption.
+apply le_to_or_lt_eq.apply le_O_n.
+apply lt_to_le.
+apply lt_mod_m_m.assumption.
+apply le_S_S_to_le.
+apply (trans_le ? n1).
+change with (m \mod n1 < n1).
+apply lt_mod_m_m.assumption.assumption.
+assumption.
+apply divides_mod.assumption.assumption.assumption.
+assumption.assumption.
+apply (decidable_divides n1 m).assumption.
+qed.
+
+theorem divides_d_gcd: \forall m,n,d.
+d \divides m \to d \divides n \to d \divides gcd n m.
+intros.
+change with
+(d \divides
+match leb n m with
+ [ true \Rightarrow
+ match n with
+ [ O \Rightarrow m
+ | (S p) \Rightarrow gcd_aux (S p) m (S p) ]
+ | false \Rightarrow
+ match m with
+ [ O \Rightarrow n
+ | (S p) \Rightarrow gcd_aux (S p) n (S p) ]]).
+apply (leb_elim n m).
+apply (nat_case1 n).simplify.intros.assumption.
+intros.
+change with (d \divides gcd_aux (S m1) m (S m1)).
+apply divides_gcd_aux.
+unfold lt.apply le_S_S.apply le_O_n.assumption.apply le_n.assumption.
+rewrite < H2.assumption.
+apply (nat_case1 m).simplify.intros.assumption.
+intros.
+change with (d \divides gcd_aux (S m1) n (S m1)).
+apply divides_gcd_aux.
+unfold lt.apply le_S_S.apply le_O_n.
+apply lt_to_le.apply not_le_to_lt.assumption.apply le_n.assumption.
+rewrite < H2.assumption.
+qed.
+
+theorem eq_minus_gcd_aux: \forall p,m,n.O < n \to n \le m \to n \le p \to
+\exists a,b. a*n - b*m = gcd_aux p m n \lor b*m - a*n = gcd_aux p m n.
+intro.
+elim p.
+absurd (O < n).assumption.apply le_to_not_lt.assumption.
+cut (O < m).
+cut (n1 \divides m \lor n1 \ndivides m).
+change with
+(\exists a,b.
+a*n1 - b*m = match divides_b n1 m with
+[ true \Rightarrow n1
+| false \Rightarrow gcd_aux n n1 (m \mod n1)]
+\lor
+b*m - a*n1 = match divides_b n1 m with
+[ true \Rightarrow n1
+| false \Rightarrow gcd_aux n n1 (m \mod n1)]).
+elim Hcut1.
+rewrite > divides_to_divides_b_true.
+simplify.
+apply (ex_intro ? ? (S O)).
+apply (ex_intro ? ? O).
+left.simplify.rewrite < plus_n_O.
+apply sym_eq.apply minus_n_O.
+assumption.assumption.
+rewrite > not_divides_to_divides_b_false.
+change with
+(\exists a,b.
+a*n1 - b*m = gcd_aux n n1 (m \mod n1)
+\lor
+b*m - a*n1 = gcd_aux n n1 (m \mod n1)).
+cut
+(\exists a,b.
+a*(m \mod n1) - b*n1= gcd_aux n n1 (m \mod n1)
+\lor
+b*n1 - a*(m \mod n1) = gcd_aux n n1 (m \mod n1)).
+elim Hcut2.elim H5.elim H6.
+(* first case *)
+rewrite < H7.
+apply (ex_intro ? ? (a1+a*(m / n1))).
+apply (ex_intro ? ? a).
+right.
+rewrite < sym_plus.
+rewrite < (sym_times n1).
+rewrite > distr_times_plus.
+rewrite > (sym_times n1).
+rewrite > (sym_times n1).
+rewrite > (div_mod m n1) in \vdash (? ? (? % ?) ?).
+rewrite > assoc_times.
+rewrite < sym_plus.
+rewrite > distr_times_plus.
+rewrite < eq_minus_minus_minus_plus.
+rewrite < sym_plus.
+rewrite < plus_minus.
+rewrite < minus_n_n.reflexivity.
+apply le_n.
+assumption.
+(* second case *)
+rewrite < H7.
+apply (ex_intro ? ? (a1+a*(m / n1))).
+apply (ex_intro ? ? a).
+left.
+(* clear Hcut2.clear H5.clear H6.clear H. *)
+rewrite > sym_times.
+rewrite > distr_times_plus.
+rewrite > sym_times.
+rewrite > (sym_times n1).
+rewrite > (div_mod m n1) in \vdash (? ? (? ? %) ?).
+rewrite > distr_times_plus.
+rewrite > assoc_times.
+rewrite < eq_minus_minus_minus_plus.
+rewrite < sym_plus.
+rewrite < plus_minus.
+rewrite < minus_n_n.reflexivity.
+apply le_n.
+assumption.
+apply (H n1 (m \mod n1)).
+cut (O \lt m \mod n1 \lor O = m \mod n1).
+elim Hcut2.assumption.
+absurd (n1 \divides m).apply mod_O_to_divides.
+assumption.
+symmetry.assumption.assumption.
+apply le_to_or_lt_eq.apply le_O_n.
+apply lt_to_le.
+apply lt_mod_m_m.assumption.
+apply le_S_S_to_le.
+apply (trans_le ? n1).
+change with (m \mod n1 < n1).
+apply lt_mod_m_m.
+assumption.assumption.assumption.assumption.
+apply (decidable_divides n1 m).assumption.
+apply (lt_to_le_to_lt ? n1).assumption.assumption.
+qed.
+
+theorem eq_minus_gcd:
+ \forall m,n.\exists a,b.a*n - b*m = (gcd n m) \lor b*m - a*n = (gcd n m).
+intros.
+unfold gcd.
+apply (leb_elim n m).
+apply (nat_case1 n).
+simplify.intros.
+apply (ex_intro ? ? O).
+apply (ex_intro ? ? (S O)).
+right.simplify.
+rewrite < plus_n_O.
+apply sym_eq.apply minus_n_O.
+intros.
+change with
+(\exists a,b.
+a*(S m1) - b*m = (gcd_aux (S m1) m (S m1))
+\lor b*m - a*(S m1) = (gcd_aux (S m1) m (S m1))).
+apply eq_minus_gcd_aux.
+unfold lt. apply le_S_S.apply le_O_n.
+assumption.apply le_n.
+apply (nat_case1 m).
+simplify.intros.
+apply (ex_intro ? ? (S O)).
+apply (ex_intro ? ? O).
+left.simplify.
+rewrite < plus_n_O.
+apply sym_eq.apply minus_n_O.
+intros.
+change with
+(\exists a,b.
+a*n - b*(S m1) = (gcd_aux (S m1) n (S m1))
+\lor b*(S m1) - a*n = (gcd_aux (S m1) n (S m1))).
+cut
+(\exists a,b.
+a*(S m1) - b*n = (gcd_aux (S m1) n (S m1))
+\lor
+b*n - a*(S m1) = (gcd_aux (S m1) n (S m1))).
+elim Hcut.elim H2.elim H3.
+apply (ex_intro ? ? a1).
+apply (ex_intro ? ? a).
+right.assumption.
+apply (ex_intro ? ? a1).
+apply (ex_intro ? ? a).
+left.assumption.
+apply eq_minus_gcd_aux.
+unfold lt. apply le_S_S.apply le_O_n.
+apply lt_to_le.apply not_le_to_lt.assumption.
+apply le_n.
+qed.
+
+(* some properties of gcd *)
+
+theorem gcd_O_n: \forall n:nat. gcd O n = n.
+intro.simplify.reflexivity.
+qed.
+
+theorem gcd_O_to_eq_O:\forall m,n:nat. (gcd m n) = O \to
+m = O \land n = O.
+intros.cut (O \divides n \land O \divides m).
+elim Hcut.elim H2.split.
+assumption.elim H1.assumption.
+rewrite < H.
+apply divides_gcd_nm.
+qed.
+
+theorem lt_O_gcd:\forall m,n:nat. O < n \to O < gcd m n.
+intros.
+apply (nat_case1 (gcd m n)).
+intros.
+generalize in match (gcd_O_to_eq_O m n H1).
+intros.elim H2.
+rewrite < H4 in \vdash (? ? %).assumption.
+intros.unfold lt.apply le_S_S.apply le_O_n.
+qed.
+
+theorem symmetric_gcd: symmetric nat gcd.
+change with
+(\forall n,m:nat. gcd n m = gcd m n).
+intros.
+cut (O < (gcd n m) \lor O = (gcd n m)).
+elim Hcut.
+cut (O < (gcd m n) \lor O = (gcd m n)).
+elim Hcut1.
+apply antisym_le.
+apply divides_to_le.assumption.
+apply divides_d_gcd.apply divides_gcd_n.apply divides_gcd_m.
+apply divides_to_le.assumption.
+apply divides_d_gcd.apply divides_gcd_n.apply divides_gcd_m.
+rewrite < H1.
+cut (m=O \land n=O).
+elim Hcut2.rewrite > H2.rewrite > H3.reflexivity.
+apply gcd_O_to_eq_O.apply sym_eq.assumption.
+apply le_to_or_lt_eq.apply le_O_n.
+rewrite < H.
+cut (n=O \land m=O).
+elim Hcut1.rewrite > H1.rewrite > H2.reflexivity.
+apply gcd_O_to_eq_O.apply sym_eq.assumption.
+apply le_to_or_lt_eq.apply le_O_n.
+qed.
+
+variant sym_gcd: \forall n,m:nat. gcd n m = gcd m n \def
+symmetric_gcd.
+
+theorem le_gcd_times: \forall m,n,p:nat. O< p \to gcd m n \le gcd m (n*p).
+intros.
+apply (nat_case n).reflexivity.
+intro.
+apply divides_to_le.
+apply lt_O_gcd.
+rewrite > (times_n_O O).
+apply lt_times.unfold lt.apply le_S_S.apply le_O_n.assumption.
+apply divides_d_gcd.
+apply (transitive_divides ? (S m1)).
+apply divides_gcd_m.
+apply (witness ? ? p).reflexivity.
+apply divides_gcd_n.
+qed.
+
+theorem gcd_times_SO_to_gcd_SO: \forall m,n,p:nat. O < n \to O < p \to
+gcd m (n*p) = (S O) \to gcd m n = (S O).
+intros.
+apply antisymmetric_le.
+rewrite < H2.
+apply le_gcd_times.assumption.
+change with (O < gcd m n).
+apply lt_O_gcd.assumption.
+qed.
+
+(* for the "converse" of the previous result see the end of this development *)
+
+theorem gcd_SO_n: \forall n:nat. gcd (S O) n = (S O).
+intro.
+apply antisym_le.apply divides_to_le.unfold lt.apply le_n.
+apply divides_gcd_n.
+cut (O < gcd (S O) n \lor O = gcd (S O) n).
+elim Hcut.assumption.
+apply False_ind.
+apply (not_eq_O_S O).
+cut ((S O)=O \land n=O).
+elim Hcut1.apply sym_eq.assumption.
+apply gcd_O_to_eq_O.apply sym_eq.assumption.
+apply le_to_or_lt_eq.apply le_O_n.
+qed.
+
+theorem divides_gcd_mod: \forall m,n:nat. O < n \to
+divides (gcd m n) (gcd n (m \mod n)).
+intros.
+apply divides_d_gcd.
+apply divides_mod.assumption.
+apply divides_gcd_n.
+apply divides_gcd_m.
+apply divides_gcd_m.
+qed.
+
+theorem divides_mod_gcd: \forall m,n:nat. O < n \to
+divides (gcd n (m \mod n)) (gcd m n) .
+intros.
+apply divides_d_gcd.
+apply divides_gcd_n.
+apply (divides_mod_to_divides ? ? n).
+assumption.
+apply divides_gcd_m.
+apply divides_gcd_n.
+qed.
+
+theorem gcd_mod: \forall m,n:nat. O < n \to
+(gcd n (m \mod n)) = (gcd m n) .
+intros.
+apply antisymmetric_divides.
+apply divides_mod_gcd.assumption.
+apply divides_gcd_mod.assumption.
+qed.
+
+(* gcd and primes *)
+
+theorem prime_to_gcd_SO: \forall n,m:nat. prime n \to n \ndivides m \to
+gcd n m = (S O).
+intros.unfold prime in H.change with (gcd n m = (S O)).
+elim H.
+apply antisym_le.
+apply not_lt_to_le.
+change with ((S (S O)) \le gcd n m \to False).intro.
+apply H1.rewrite < (H3 (gcd n m)).
+apply divides_gcd_m.
+apply divides_gcd_n.assumption.
+cut (O < gcd n m \lor O = gcd n m).
+elim Hcut.assumption.
+apply False_ind.
+apply (not_le_Sn_O (S O)).
+cut (n=O \land m=O).
+elim Hcut1.rewrite < H5 in \vdash (? ? %).assumption.
+apply gcd_O_to_eq_O.apply sym_eq.assumption.
+apply le_to_or_lt_eq.apply le_O_n.
+qed.
+
+theorem divides_times_to_divides: \forall n,p,q:nat.prime n \to n \divides p*q \to
+n \divides p \lor n \divides q.
+intros.
+cut (n \divides p \lor n \ndivides p).
+elim Hcut.
+left.assumption.
+right.
+cut (\exists a,b. a*n - b*p = (S O) \lor b*p - a*n = (S O)).
+elim Hcut1.elim H3.elim H4.
+(* first case *)
+rewrite > (times_n_SO q).rewrite < H5.
+rewrite > distr_times_minus.
+rewrite > (sym_times q (a1*p)).
+rewrite > (assoc_times a1).
+elim H1.rewrite > H6.
+rewrite < (sym_times n).rewrite < assoc_times.
+rewrite > (sym_times q).rewrite > assoc_times.
+rewrite < (assoc_times a1).rewrite < (sym_times n).
+rewrite > (assoc_times n).
+rewrite < distr_times_minus.
+apply (witness ? ? (q*a-a1*n2)).reflexivity.
+(* second case *)
+rewrite > (times_n_SO q).rewrite < H5.
+rewrite > distr_times_minus.
+rewrite > (sym_times q (a1*p)).
+rewrite > (assoc_times a1).
+elim H1.rewrite > H6.
+rewrite < sym_times.rewrite > assoc_times.
+rewrite < (assoc_times q).
+rewrite < (sym_times n).
+rewrite < distr_times_minus.
+apply (witness ? ? (n2*a1-q*a)).reflexivity.
+(* end second case *)
+rewrite < (prime_to_gcd_SO n p).
+apply eq_minus_gcd.
+assumption.assumption.
+apply (decidable_divides n p).
+apply (trans_lt ? (S O)).unfold lt.apply le_n.
+unfold prime in H.elim H. assumption.
+qed.
+
+theorem eq_gcd_times_SO: \forall m,n,p:nat. O < n \to O < p \to
+gcd m n = (S O) \to gcd m p = (S O) \to gcd m (n*p) = (S O).
+intros.
+apply antisymmetric_le.
+apply not_lt_to_le.
+unfold Not.intro.
+cut (divides (smallest_factor (gcd m (n*p))) n \lor
+ divides (smallest_factor (gcd m (n*p))) p).
+elim Hcut.
+apply (not_le_Sn_n (S O)).
+change with ((S O) < (S O)).
+rewrite < H2 in \vdash (? ? %).
+apply (lt_to_le_to_lt ? (smallest_factor (gcd m (n*p)))).
+apply lt_SO_smallest_factor.assumption.
+apply divides_to_le.
+rewrite > H2.unfold lt.apply le_n.
+apply divides_d_gcd.assumption.
+apply (transitive_divides ? (gcd m (n*p))).
+apply divides_smallest_factor_n.
+apply (trans_lt ? (S O)). unfold lt. apply le_n. assumption.
+apply divides_gcd_n.
+apply (not_le_Sn_n (S O)).
+change with ((S O) < (S O)).
+rewrite < H3 in \vdash (? ? %).
+apply (lt_to_le_to_lt ? (smallest_factor (gcd m (n*p)))).
+apply lt_SO_smallest_factor.assumption.
+apply divides_to_le.
+rewrite > H3.unfold lt.apply le_n.
+apply divides_d_gcd.assumption.
+apply (transitive_divides ? (gcd m (n*p))).
+apply divides_smallest_factor_n.
+apply (trans_lt ? (S O)). unfold lt. apply le_n. assumption.
+apply divides_gcd_n.
+apply divides_times_to_divides.
+apply prime_smallest_factor_n.
+assumption.
+apply (transitive_divides ? (gcd m (n*p))).
+apply divides_smallest_factor_n.
+apply (trans_lt ? (S O)).unfold lt. apply le_n. assumption.
+apply divides_gcd_m.
+change with (O < gcd m (n*p)).
+apply lt_O_gcd.
+rewrite > (times_n_O O).
+apply lt_times.assumption.assumption.
+qed.
diff --git a/helm/matita/library/nat/le_arith.ma b/helm/matita/library/nat/le_arith.ma
new file mode 100644
index 000000000..a76183063
--- /dev/null
+++ b/helm/matita/library/nat/le_arith.ma
@@ -0,0 +1,95 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/le_arith".
+
+include "nat/times.ma".
+include "nat/orders.ma".
+
+(* plus *)
+theorem monotonic_le_plus_r:
+\forall n:nat.monotonic nat le (\lambda m.n + m).
+simplify.intros.elim n.
+simplify.assumption.
+simplify.apply le_S_S.assumption.
+qed.
+
+theorem le_plus_r: \forall p,n,m:nat. n \le m \to p + n \le p + m
+\def monotonic_le_plus_r.
+
+theorem monotonic_le_plus_l:
+\forall m:nat.monotonic nat le (\lambda n.n + m).
+simplify.intros.
+rewrite < sym_plus.rewrite < (sym_plus m).
+apply le_plus_r.assumption.
+qed.
+
+theorem le_plus_l: \forall p,n,m:nat. n \le m \to n + p \le m + p
+\def monotonic_le_plus_l.
+
+theorem le_plus: \forall n1,n2,m1,m2:nat. n1 \le n2 \to m1 \le m2
+\to n1 + m1 \le n2 + m2.
+intros.
+apply (trans_le ? (n2 + m1)).
+apply le_plus_l.assumption.
+apply le_plus_r.assumption.
+qed.
+
+theorem le_plus_n :\forall n,m:nat. m \le n + m.
+intros.change with (O+m \le n+m).
+apply le_plus_l.apply le_O_n.
+qed.
+
+theorem eq_plus_to_le: \forall n,m,p:nat.n=m+p \to m \le n.
+intros.rewrite > H.
+rewrite < sym_plus.
+apply le_plus_n.
+qed.
+
+(* times *)
+theorem monotonic_le_times_r:
+\forall n:nat.monotonic nat le (\lambda m. n * m).
+simplify.intros.elim n.
+simplify.apply le_O_n.
+simplify.apply le_plus.
+assumption.
+assumption.
+qed.
+
+theorem le_times_r: \forall p,n,m:nat. n \le m \to p*n \le p*m
+\def monotonic_le_times_r.
+
+theorem monotonic_le_times_l:
+\forall m:nat.monotonic nat le (\lambda n.n*m).
+simplify.intros.
+rewrite < sym_times.rewrite < (sym_times m).
+apply le_times_r.assumption.
+qed.
+
+theorem le_times_l: \forall p,n,m:nat. n \le m \to n*p \le m*p
+\def monotonic_le_times_l.
+
+theorem le_times: \forall n1,n2,m1,m2:nat. n1 \le n2 \to m1 \le m2
+\to n1*m1 \le n2*m2.
+intros.
+apply (trans_le ? (n2*m1)).
+apply le_times_l.assumption.
+apply le_times_r.assumption.
+qed.
+
+theorem le_times_n: \forall n,m:nat.(S O) \le n \to m \le n*m.
+intros.elim H.simplify.
+elim (plus_n_O ?).apply le_n.
+simplify.rewrite < sym_plus.apply le_plus_n.
+qed.
diff --git a/helm/matita/library/nat/lt_arith.ma b/helm/matita/library/nat/lt_arith.ma
new file mode 100644
index 000000000..b8339f374
--- /dev/null
+++ b/helm/matita/library/nat/lt_arith.ma
@@ -0,0 +1,217 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/lt_arith".
+
+include "nat/div_and_mod.ma".
+
+(* plus *)
+theorem monotonic_lt_plus_r:
+\forall n:nat.monotonic nat lt (\lambda m.n+m).
+simplify.intros.
+elim n.simplify.assumption.
+simplify.unfold lt.
+apply le_S_S.assumption.
+qed.
+
+variant lt_plus_r: \forall n,p,q:nat. p < q \to n + p < n + q \def
+monotonic_lt_plus_r.
+
+theorem monotonic_lt_plus_l:
+\forall n:nat.monotonic nat lt (\lambda m.m+n).
+change with (\forall n,p,q:nat. p < q \to p + n < q + n).
+intros.
+rewrite < sym_plus. rewrite < (sym_plus n).
+apply lt_plus_r.assumption.
+qed.
+
+variant lt_plus_l: \forall n,p,q:nat. p < q \to p + n < q + n \def
+monotonic_lt_plus_l.
+
+theorem lt_plus: \forall n,m,p,q:nat. n < m \to p < q \to n + p < m + q.
+intros.
+apply (trans_lt ? (n + q)).
+apply lt_plus_r.assumption.
+apply lt_plus_l.assumption.
+qed.
+
+theorem lt_plus_to_lt_l :\forall n,p,q:nat. p+n < q+n \to p<q.
+intro.elim n.
+rewrite > plus_n_O.
+rewrite > (plus_n_O q).assumption.
+apply H.
+unfold lt.apply le_S_S_to_le.
+rewrite > plus_n_Sm.
+rewrite > (plus_n_Sm q).
+exact H1.
+qed.
+
+theorem lt_plus_to_lt_r :\forall n,p,q:nat. n+p < n+q \to p<q.
+intros.apply (lt_plus_to_lt_l n).
+rewrite > sym_plus.
+rewrite > (sym_plus q).assumption.
+qed.
+
+(* times and zero *)
+theorem lt_O_times_S_S: \forall n,m:nat.O < (S n)*(S m).
+intros.simplify.unfold lt.apply le_S_S.apply le_O_n.
+qed.
+
+(* times *)
+theorem monotonic_lt_times_r:
+\forall n:nat.monotonic nat lt (\lambda m.(S n)*m).
+change with (\forall n,p,q:nat. p < q \to (S n) * p < (S n) * q).
+intros.elim n.
+simplify.rewrite < plus_n_O.rewrite < plus_n_O.assumption.
+change with (p + (S n1) * p < q + (S n1) * q).
+apply lt_plus.assumption.assumption.
+qed.
+
+theorem lt_times_r: \forall n,p,q:nat. p < q \to (S n) * p < (S n) * q
+\def monotonic_lt_times_r.
+
+theorem monotonic_lt_times_l:
+\forall m:nat.monotonic nat lt (\lambda n.n * (S m)).
+change with
+(\forall n,p,q:nat. p < q \to p*(S n) < q*(S n)).
+intros.
+rewrite < sym_times.rewrite < (sym_times (S n)).
+apply lt_times_r.assumption.
+qed.
+
+variant lt_times_l: \forall n,p,q:nat. p<q \to p*(S n) < q*(S n)
+\def monotonic_lt_times_l.
+
+theorem lt_times:\forall n,m,p,q:nat. n<m \to p<q \to n*p < m*q.
+intro.
+elim n.
+apply (lt_O_n_elim m H).
+intro.
+cut (lt O q).
+apply (lt_O_n_elim q Hcut).
+intro.change with (O < (S m1)*(S m2)).
+apply lt_O_times_S_S.
+apply (ltn_to_ltO p q H1).
+apply (trans_lt ? ((S n1)*q)).
+apply lt_times_r.assumption.
+cut (lt O q).
+apply (lt_O_n_elim q Hcut).
+intro.
+apply lt_times_l.
+assumption.
+apply (ltn_to_ltO p q H2).
+qed.
+
+theorem lt_times_to_lt_l:
+\forall n,p,q:nat. p*(S n) < q*(S n) \to p < q.
+intros.
+cut (p < q \lor p \nlt q).
+elim Hcut.
+assumption.
+absurd (p * (S n) < q * (S n)).
+assumption.
+apply le_to_not_lt.
+apply le_times_l.
+apply not_lt_to_le.
+assumption.
+exact (decidable_lt p q).
+qed.
+
+theorem lt_times_to_lt_r:
+\forall n,p,q:nat. (S n)*p < (S n)*q \to lt p q.
+intros.
+apply (lt_times_to_lt_l n).
+rewrite < sym_times.
+rewrite < (sym_times (S n)).
+assumption.
+qed.
+
+theorem nat_compare_times_l : \forall n,p,q:nat.
+nat_compare p q = nat_compare ((S n) * p) ((S n) * q).
+intros.apply nat_compare_elim.intro.
+apply nat_compare_elim.
+intro.reflexivity.
+intro.absurd (p=q).
+apply (inj_times_r n).assumption.
+apply lt_to_not_eq. assumption.
+intro.absurd (q<p).
+apply (lt_times_to_lt_r n).assumption.
+apply le_to_not_lt.apply lt_to_le.assumption.
+intro.rewrite < H.rewrite > nat_compare_n_n.reflexivity.
+intro.apply nat_compare_elim.intro.
+absurd (p<q).
+apply (lt_times_to_lt_r n).assumption.
+apply le_to_not_lt.apply lt_to_le.assumption.
+intro.absurd (q=p).
+symmetry.
+apply (inj_times_r n).assumption.
+apply lt_to_not_eq.assumption.
+intro.reflexivity.
+qed.
+
+(* div *)
+
+theorem eq_mod_O_to_lt_O_div: \forall n,m:nat. O < m \to O < n\to n \mod m = O \to O < n / m.
+intros 4.apply (lt_O_n_elim m H).intros.
+apply (lt_times_to_lt_r m1).
+rewrite < times_n_O.
+rewrite > (plus_n_O ((S m1)*(n / (S m1)))).
+rewrite < H2.
+rewrite < sym_times.
+rewrite < div_mod.
+rewrite > H2.
+assumption.
+unfold lt.apply le_S_S.apply le_O_n.
+qed.
+
+theorem lt_div_n_m_n: \forall n,m:nat. (S O) < m \to O < n \to n / m \lt n.
+intros.
+apply (nat_case1 (n / m)).intro.
+assumption.intros.rewrite < H2.
+rewrite > (div_mod n m) in \vdash (? ? %).
+apply (lt_to_le_to_lt ? ((n / m)*m)).
+apply (lt_to_le_to_lt ? ((n / m)*(S (S O)))).
+rewrite < sym_times.
+rewrite > H2.
+simplify.unfold lt.
+rewrite < plus_n_O.
+rewrite < plus_n_Sm.
+apply le_S_S.
+apply le_S_S.
+apply le_plus_n.
+apply le_times_r.
+assumption.
+rewrite < sym_plus.
+apply le_plus_n.
+apply (trans_lt ? (S O)).
+unfold lt. apply le_n.assumption.
+qed.
+
+(* general properties of functions *)
+theorem monotonic_to_injective: \forall f:nat\to nat.
+monotonic nat lt f \to injective nat nat f.
+unfold injective.intros.
+apply (nat_compare_elim x y).
+intro.apply False_ind.apply (not_le_Sn_n (f x)).
+rewrite > H1 in \vdash (? ? %).apply H.apply H2.
+intros.assumption.
+intro.apply False_ind.apply (not_le_Sn_n (f y)).
+rewrite < H1 in \vdash (? ? %).apply H.apply H2.
+qed.
+
+theorem increasing_to_injective: \forall f:nat\to nat.
+increasing f \to injective nat nat f.
+intros.apply monotonic_to_injective.
+apply increasing_to_monotonic.assumption.
+qed.
diff --git a/helm/matita/library/nat/minimization.ma b/helm/matita/library/nat/minimization.ma
new file mode 100644
index 000000000..0abed5ad3
--- /dev/null
+++ b/helm/matita/library/nat/minimization.ma
@@ -0,0 +1,222 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / Matita is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/minimization".
+
+include "nat/minus.ma".
+
+let rec max i f \def
+ match (f i) with
+ [ true \Rightarrow i
+ | false \Rightarrow
+ match i with
+ [ O \Rightarrow O
+ | (S j) \Rightarrow max j f ]].
+
+theorem max_O_f : \forall f: nat \to bool. max O f = O.
+intro. simplify.
+elim (f O).
+simplify.reflexivity.
+simplify.reflexivity.
+qed.
+
+theorem max_S_max : \forall f: nat \to bool. \forall n:nat.
+(f (S n) = true \land max (S n) f = (S n)) \lor
+(f (S n) = false \land max (S n) f = max n f).
+intros.simplify.elim (f (S n)).
+simplify.left.split.reflexivity.reflexivity.
+simplify.right.split.reflexivity.reflexivity.
+qed.
+
+theorem le_max_n : \forall f: nat \to bool. \forall n:nat.
+max n f \le n.
+intros.elim n.rewrite > max_O_f.apply le_n.
+simplify.elim (f (S n1)).simplify.apply le_n.
+simplify.apply le_S.assumption.
+qed.
+
+theorem le_to_le_max : \forall f: nat \to bool. \forall n,m:nat.
+n\le m \to max n f \le max m f.
+intros.elim H.
+apply le_n.
+apply (trans_le ? (max n1 f)).apply H2.
+cut ((f (S n1) = true \land max (S n1) f = (S n1)) \lor
+(f (S n1) = false \land max (S n1) f = max n1 f)).
+elim Hcut.elim H3.
+rewrite > H5.
+apply le_S.apply le_max_n.
+elim H3.rewrite > H5.apply le_n.
+apply max_S_max.
+qed.
+
+theorem f_m_to_le_max: \forall f: nat \to bool. \forall n,m:nat.
+m\le n \to f m = true \to m \le max n f.
+intros 3.elim n.apply (le_n_O_elim m H).
+apply le_O_n.
+apply (le_n_Sm_elim m n1 H1).
+intro.apply (trans_le ? (max n1 f)).
+apply H.apply le_S_S_to_le.assumption.assumption.
+apply le_to_le_max.apply le_n_Sn.
+intro.simplify.rewrite < H3.
+rewrite > H2.simplify.apply le_n.
+qed.
+
+
+definition max_spec \def \lambda f:nat \to bool.\lambda n: nat.
+\exists i. (le i n) \land (f i = true) \to
+(f n) = true \land (\forall i. i < n \to (f i = false)).
+
+theorem f_max_true : \forall f:nat \to bool. \forall n:nat.
+(\exists i:nat. le i n \land f i = true) \to f (max n f) = true.
+intros 2.
+elim n.elim H.elim H1.generalize in match H3.
+apply (le_n_O_elim a H2).intro.simplify.rewrite > H4.
+simplify.assumption.
+simplify.
+apply (bool_ind (\lambda b:bool.
+(f (S n1) = b) \to (f (match b in bool with
+[ true \Rightarrow (S n1)
+| false \Rightarrow (max n1 f)])) = true)).
+simplify.intro.assumption.
+simplify.intro.apply H.
+elim H1.elim H3.generalize in match H5.
+apply (le_n_Sm_elim a n1 H4).
+intros.
+apply (ex_intro nat ? a).
+split.apply le_S_S_to_le.assumption.assumption.
+intros.apply False_ind.apply not_eq_true_false.
+rewrite < H2.rewrite < H7.rewrite > H6. reflexivity.
+reflexivity.
+qed.
+
+theorem lt_max_to_false : \forall f:nat \to bool.
+\forall n,m:nat. (max n f) < m \to m \leq n \to f m = false.
+intros 2.
+elim n.absurd (le m O).assumption.
+cut (O < m).apply (lt_O_n_elim m Hcut).exact not_le_Sn_O.
+rewrite < (max_O_f f).assumption.
+generalize in match H1.
+elim (max_S_max f n1).
+elim H3.
+absurd (m \le S n1).assumption.
+apply lt_to_not_le.rewrite < H6.assumption.
+elim H3.
+apply (le_n_Sm_elim m n1 H2).
+intro.
+apply H.rewrite < H6.assumption.
+apply le_S_S_to_le.assumption.
+intro.rewrite > H7.assumption.
+qed.
+
+let rec min_aux off n f \def
+ match f (n-off) with
+ [ true \Rightarrow (n-off)
+ | false \Rightarrow
+ match off with
+ [ O \Rightarrow n
+ | (S p) \Rightarrow min_aux p n f]].
+
+definition min : nat \to (nat \to bool) \to nat \def
+\lambda n.\lambda f. min_aux n n f.
+
+theorem min_aux_O_f: \forall f:nat \to bool. \forall i :nat.
+min_aux O i f = i.
+intros.simplify.rewrite < minus_n_O.
+elim (f i).reflexivity.
+simplify.reflexivity.
+qed.
+
+theorem min_O_f : \forall f:nat \to bool.
+min O f = O.
+intro.apply (min_aux_O_f f O).
+qed.
+
+theorem min_aux_S : \forall f: nat \to bool. \forall i,n:nat.
+(f (n -(S i)) = true \land min_aux (S i) n f = (n - (S i))) \lor
+(f (n -(S i)) = false \land min_aux (S i) n f = min_aux i n f).
+intros.simplify.elim (f (n - (S i))).
+simplify.left.split.reflexivity.reflexivity.
+simplify.right.split.reflexivity.reflexivity.
+qed.
+
+theorem f_min_aux_true: \forall f:nat \to bool. \forall off,m:nat.
+(\exists i. le (m-off) i \land le i m \land f i = true) \to
+f (min_aux off m f) = true.
+intros 2.
+elim off.elim H.elim H1.elim H2.
+cut (a = m).
+rewrite > (min_aux_O_f f).rewrite < Hcut.assumption.
+apply (antisym_le a m).assumption.rewrite > (minus_n_O m).assumption.
+simplify.
+apply (bool_ind (\lambda b:bool.
+(f (m-(S n)) = b) \to (f (match b in bool with
+[ true \Rightarrow m-(S n)
+| false \Rightarrow (min_aux n m f)])) = true)).
+simplify.intro.assumption.
+simplify.intro.apply H.
+elim H1.elim H3.elim H4.
+elim (le_to_or_lt_eq (m-(S n)) a H6).
+apply (ex_intro nat ? a).
+split.split.
+apply lt_minus_S_n_to_le_minus_n.assumption.
+assumption.assumption.
+absurd (f a = false).rewrite < H8.assumption.
+rewrite > H5.
+apply not_eq_true_false.
+reflexivity.
+qed.
+
+theorem lt_min_aux_to_false : \forall f:nat \to bool.
+\forall n,off,m:nat. (n-off) \leq m \to m < (min_aux off n f) \to f m = false.
+intros 3.
+elim off.absurd (le n m).rewrite > minus_n_O.assumption.
+apply lt_to_not_le.rewrite < (min_aux_O_f f n).assumption.
+generalize in match H1.
+elim (min_aux_S f n1 n).
+elim H3.
+absurd (n - S n1 \le m).assumption.
+apply lt_to_not_le.rewrite < H6.assumption.
+elim H3.
+elim (le_to_or_lt_eq (n -(S n1)) m).
+apply H.apply lt_minus_S_n_to_le_minus_n.assumption.
+rewrite < H6.assumption.
+rewrite < H7.assumption.
+assumption.
+qed.
+
+theorem le_min_aux : \forall f:nat \to bool.
+\forall n,off:nat. (n-off) \leq (min_aux off n f).
+intros 3.
+elim off.rewrite < minus_n_O.
+rewrite > (min_aux_O_f f n).apply le_n.
+elim (min_aux_S f n1 n).
+elim H1.rewrite > H3.apply le_n.
+elim H1.rewrite > H3.
+apply (trans_le (n-(S n1)) (n-n1)).
+apply monotonic_le_minus_r.
+apply le_n_Sn.
+assumption.
+qed.
+
+theorem le_min_aux_r : \forall f:nat \to bool.
+\forall n,off:nat. (min_aux off n f) \le n.
+intros.
+elim off.simplify.rewrite < minus_n_O.
+elim (f n).simplify.apply le_n.
+simplify.apply le_n.
+simplify.elim (f (n -(S n1))).
+simplify.apply le_plus_to_minus.
+rewrite < sym_plus.apply le_plus_n.
+simplify.assumption.
+qed.
diff --git a/helm/matita/library/nat/minus.ma b/helm/matita/library/nat/minus.ma
new file mode 100644
index 000000000..710418d72
--- /dev/null
+++ b/helm/matita/library/nat/minus.ma
@@ -0,0 +1,300 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+
+set "baseuri" "cic:/matita/nat/minus".
+
+include "nat/le_arith.ma".
+include "nat/compare.ma".
+
+let rec minus n m \def
+ match n with
+ [ O \Rightarrow O
+ | (S p) \Rightarrow
+ match m with
+ [O \Rightarrow (S p)
+ | (S q) \Rightarrow minus p q ]].
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "natural minus" 'minus x y = (cic:/matita/nat/minus/minus.con x y).
+
+theorem minus_n_O: \forall n:nat.n=n-O.
+intros.elim n.simplify.reflexivity.
+simplify.reflexivity.
+qed.
+
+theorem minus_n_n: \forall n:nat.O=n-n.
+intros.elim n.simplify.
+reflexivity.
+simplify.apply H.
+qed.
+
+theorem minus_Sn_n: \forall n:nat. S O = (S n)-n.
+intro.elim n.
+simplify.reflexivity.
+elim H.reflexivity.
+qed.
+
+theorem minus_Sn_m: \forall n,m:nat. m \leq n \to (S n)-m = S (n-m).
+intros 2.
+apply (nat_elim2
+(\lambda n,m.m \leq n \to (S n)-m = S (n-m))).
+intros.apply (le_n_O_elim n1 H).
+simplify.reflexivity.
+intros.simplify.reflexivity.
+intros.rewrite < H.reflexivity.
+apply le_S_S_to_le. assumption.
+qed.
+
+theorem plus_minus:
+\forall n,m,p:nat. m \leq n \to (n-m)+p = (n+p)-m.
+intros 2.
+apply (nat_elim2
+(\lambda n,m.\forall p:nat.m \leq n \to (n-m)+p = (n+p)-m)).
+intros.apply (le_n_O_elim ? H).
+simplify.rewrite < minus_n_O.reflexivity.
+intros.simplify.reflexivity.
+intros.simplify.apply H.apply le_S_S_to_le.assumption.
+qed.
+
+theorem minus_plus_m_m: \forall n,m:nat.n = (n+m)-m.
+intros 2.
+generalize in match n.
+elim m.
+rewrite < minus_n_O.apply plus_n_O.
+elim n2.simplify.
+apply minus_n_n.
+rewrite < plus_n_Sm.
+change with (S n3 = (S n3 + n1)-n1).
+apply H.
+qed.
+
+theorem plus_minus_m_m: \forall n,m:nat.
+m \leq n \to n = (n-m)+m.
+intros 2.
+apply (nat_elim2 (\lambda n,m.m \leq n \to n = (n-m)+m)).
+intros.apply (le_n_O_elim n1 H).
+reflexivity.
+intros.simplify.rewrite < plus_n_O.reflexivity.
+intros.simplify.rewrite < sym_plus.simplify.
+apply eq_f.rewrite < sym_plus.apply H.
+apply le_S_S_to_le.assumption.
+qed.
+
+theorem minus_to_plus :\forall n,m,p:nat.m \leq n \to n-m = p \to
+n = m+p.
+intros.apply (trans_eq ? ? ((n-m)+m)).
+apply plus_minus_m_m.
+apply H.elim H1.
+apply sym_plus.
+qed.
+
+theorem plus_to_minus :\forall n,m,p:nat.
+n = m+p \to n-m = p.
+intros.
+apply (inj_plus_r m).
+rewrite < H.
+rewrite < sym_plus.
+symmetry.
+apply plus_minus_m_m.rewrite > H.
+rewrite > sym_plus.
+apply le_plus_n.
+qed.
+
+theorem minus_S_S : \forall n,m:nat.
+eq nat (minus (S n) (S m)) (minus n m).
+intros.
+reflexivity.
+qed.
+
+theorem minus_pred_pred : \forall n,m:nat. lt O n \to lt O m \to
+eq nat (minus (pred n) (pred m)) (minus n m).
+intros.
+apply (lt_O_n_elim n H).intro.
+apply (lt_O_n_elim m H1).intro.
+simplify.reflexivity.
+qed.
+
+theorem eq_minus_n_m_O: \forall n,m:nat.
+n \leq m \to n-m = O.
+intros 2.
+apply (nat_elim2 (\lambda n,m.n \leq m \to n-m = O)).
+intros.simplify.reflexivity.
+intros.apply False_ind.
+apply not_le_Sn_O.
+goal 13.apply H.
+intros.
+simplify.apply H.apply le_S_S_to_le. apply H1.
+qed.
+
+theorem le_SO_minus: \forall n,m:nat.S n \leq m \to S O \leq m-n.
+intros.elim H.elim (minus_Sn_n n).apply le_n.
+rewrite > minus_Sn_m.
+apply le_S.assumption.
+apply lt_to_le.assumption.
+qed.
+
+theorem minus_le_S_minus_S: \forall n,m:nat. m-n \leq S (m-(S n)).
+intros.apply (nat_elim2 (\lambda n,m.m-n \leq S (m-(S n)))).
+intro.elim n1.simplify.apply le_n_Sn.
+simplify.rewrite < minus_n_O.apply le_n.
+intros.simplify.apply le_n_Sn.
+intros.simplify.apply H.
+qed.
+
+theorem lt_minus_S_n_to_le_minus_n : \forall n,m,p:nat. m-(S n) < p \to m-n \leq p.
+intros 3.simplify.intro.
+apply (trans_le (m-n) (S (m-(S n))) p).
+apply minus_le_S_minus_S.
+assumption.
+qed.
+
+theorem le_minus_m: \forall n,m:nat. n-m \leq n.
+intros.apply (nat_elim2 (\lambda m,n. n-m \leq n)).
+intros.rewrite < minus_n_O.apply le_n.
+intros.simplify.apply le_n.
+intros.simplify.apply le_S.assumption.
+qed.
+
+theorem lt_minus_m: \forall n,m:nat. O < n \to O < m \to n-m \lt n.
+intros.apply (lt_O_n_elim n H).intro.
+apply (lt_O_n_elim m H1).intro.
+simplify.unfold lt.apply le_S_S.apply le_minus_m.
+qed.
+
+theorem minus_le_O_to_le: \forall n,m:nat. n-m \leq O \to n \leq m.
+intros 2.
+apply (nat_elim2 (\lambda n,m:nat.n-m \leq O \to n \leq m)).
+intros.apply le_O_n.
+simplify.intros. assumption.
+simplify.intros.apply le_S_S.apply H.assumption.
+qed.
+
+(* galois *)
+theorem monotonic_le_minus_r:
+\forall p,q,n:nat. q \leq p \to n-p \le n-q.
+simplify.intros 2.apply (nat_elim2
+(\lambda p,q.\forall a.q \leq p \to a-p \leq a-q)).
+intros.apply (le_n_O_elim n H).apply le_n.
+intros.rewrite < minus_n_O.
+apply le_minus_m.
+intros.elim a.simplify.apply le_n.
+simplify.apply H.apply le_S_S_to_le.assumption.
+qed.
+
+theorem le_minus_to_plus: \forall n,m,p. (le (n-m) p) \to (le n (p+m)).
+intros 2.apply (nat_elim2 (\lambda n,m.\forall p.(le (n-m) p) \to (le n (p+m)))).
+intros.apply le_O_n.
+simplify.intros.rewrite < plus_n_O.assumption.
+intros.
+rewrite < plus_n_Sm.
+apply le_S_S.apply H.
+exact H1.
+qed.
+
+theorem le_plus_to_minus: \forall n,m,p. (le n (p+m)) \to (le (n-m) p).
+intros 2.apply (nat_elim2 (\lambda n,m.\forall p.(le n (p+m)) \to (le (n-m) p))).
+intros.simplify.apply le_O_n.
+intros 2.rewrite < plus_n_O.intro.simplify.assumption.
+intros.simplify.apply H.
+apply le_S_S_to_le.rewrite > plus_n_Sm.assumption.
+qed.
+
+(* the converse of le_plus_to_minus does not hold *)
+theorem le_plus_to_minus_r: \forall n,m,p. (le (n+m) p) \to (le n (p-m)).
+intros 3.apply (nat_elim2 (\lambda m,p.(le (n+m) p) \to (le n (p-m)))).
+intro.rewrite < plus_n_O.rewrite < minus_n_O.intro.assumption.
+intro.intro.cut (n=O).rewrite > Hcut.apply le_O_n.
+apply sym_eq. apply le_n_O_to_eq.
+apply (trans_le ? (n+(S n1))).
+rewrite < sym_plus.
+apply le_plus_n.assumption.
+intros.simplify.
+apply H.apply le_S_S_to_le.
+rewrite > plus_n_Sm.assumption.
+qed.
+
+(* minus and lt - to be completed *)
+theorem lt_minus_to_plus: \forall n,m,p. (lt n (p-m)) \to (lt (n+m) p).
+intros 3.apply (nat_elim2 (\lambda m,p.(lt n (p-m)) \to (lt (n+m) p))).
+intro.rewrite < plus_n_O.rewrite < minus_n_O.intro.assumption.
+simplify.intros.apply False_ind.apply (not_le_Sn_O n H).
+simplify.intros.unfold lt.
+apply le_S_S.
+rewrite < plus_n_Sm.
+apply H.apply H1.
+qed.
+
+theorem distributive_times_minus: distributive nat times minus.
+unfold distributive.
+intros.
+apply ((leb_elim z y)).
+ intro.cut (x*(y-z)+x*z = (x*y-x*z)+x*z).
+ apply (inj_plus_l (x*z)).assumption.
+ apply (trans_eq nat ? (x*y)).
+ rewrite < distr_times_plus.rewrite < (plus_minus_m_m ? ? H).reflexivity.
+ rewrite < plus_minus_m_m.
+ reflexivity.
+ apply le_times_r.assumption.
+ intro.rewrite > eq_minus_n_m_O.
+ rewrite > (eq_minus_n_m_O (x*y)).
+ rewrite < sym_times.simplify.reflexivity.
+ apply le_times_r.apply lt_to_le.apply not_le_to_lt.assumption.
+ apply lt_to_le.apply not_le_to_lt.assumption.
+qed.
+
+theorem distr_times_minus: \forall n,m,p:nat. n*(m-p) = n*m-n*p
+\def distributive_times_minus.
+
+theorem eq_minus_plus_plus_minus: \forall n,m,p:nat. p \le m \to (n+m)-p = n+(m-p).
+intros.
+apply plus_to_minus.
+rewrite > sym_plus in \vdash (? ? ? %).
+rewrite > assoc_plus.
+rewrite < plus_minus_m_m.
+reflexivity.assumption.
+qed.
+
+theorem eq_minus_minus_minus_plus: \forall n,m,p:nat. (n-m)-p = n-(m+p).
+intros.
+cut (m+p \le n \or m+p \nleq n).
+ elim Hcut.
+ symmetry.apply plus_to_minus.
+ rewrite > assoc_plus.rewrite > (sym_plus p).rewrite < plus_minus_m_m.
+ rewrite > sym_plus.rewrite < plus_minus_m_m.
+ reflexivity.
+ apply (trans_le ? (m+p)).
+ rewrite < sym_plus.apply le_plus_n.
+ assumption.
+ apply le_plus_to_minus_r.rewrite > sym_plus.assumption.
+ rewrite > (eq_minus_n_m_O n (m+p)).
+ rewrite > (eq_minus_n_m_O (n-m) p).
+ reflexivity.
+ apply le_plus_to_minus.apply lt_to_le. rewrite < sym_plus.
+ apply not_le_to_lt. assumption.
+ apply lt_to_le.apply not_le_to_lt.assumption.
+ apply (decidable_le (m+p) n).
+qed.
+
+theorem eq_plus_minus_minus_minus: \forall n,m,p:nat. p \le m \to m \le n \to
+p+(n-m) = n-(m-p).
+intros.
+apply sym_eq.
+apply plus_to_minus.
+rewrite < assoc_plus.
+rewrite < plus_minus_m_m.
+rewrite < sym_plus.
+rewrite < plus_minus_m_m.reflexivity.
+assumption.assumption.
+qed.
diff --git a/helm/matita/library/nat/nat.ma b/helm/matita/library/nat/nat.ma
new file mode 100644
index 000000000..a75032d71
--- /dev/null
+++ b/helm/matita/library/nat/nat.ma
@@ -0,0 +1,106 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/nat".
+
+include "higher_order_defs/functions.ma".
+
+inductive nat : Set \def
+ | O : nat
+ | S : nat \to nat.
+
+definition pred: nat \to nat \def
+\lambda n:nat. match n with
+[ O \Rightarrow O
+| (S p) \Rightarrow p ].
+
+theorem pred_Sn : \forall n:nat.n=(pred (S n)).
+intros. reflexivity.
+qed.
+
+theorem injective_S : injective nat nat S.
+unfold injective.
+intros.
+rewrite > pred_Sn.
+rewrite > (pred_Sn y).
+apply eq_f. assumption.
+qed.
+
+theorem inj_S : \forall n,m:nat.(S n)=(S m) \to n=m
+\def injective_S.
+
+theorem not_eq_S : \forall n,m:nat.
+\lnot n=m \to S n \neq S m.
+intros. unfold Not. intros.
+apply H. apply injective_S. assumption.
+qed.
+
+definition not_zero : nat \to Prop \def
+\lambda n: nat.
+ match n with
+ [ O \Rightarrow False
+ | (S p) \Rightarrow True ].
+
+theorem not_eq_O_S : \forall n:nat. O \neq S n.
+intros. unfold Not. intros.
+cut (not_zero O).
+exact Hcut.
+rewrite > H.exact I.
+qed.
+
+theorem not_eq_n_Sn : \forall n:nat. n \neq S n.
+intros.elim n.
+apply not_eq_O_S.
+apply not_eq_S.assumption.
+qed.
+
+theorem nat_case:
+\forall n:nat.\forall P:nat \to Prop.
+P O \to (\forall m:nat. P (S m)) \to P n.
+intros.elim n.assumption.apply H1.
+qed.
+
+theorem nat_case1:
+\forall n:nat.\forall P:nat \to Prop.
+(n=O \to P O) \to (\forall m:nat. (n=(S m) \to P (S m))) \to P n.
+intros 2.elim n.
+apply H.reflexivity.
+apply H2.reflexivity.
+qed.
+
+theorem nat_elim2 :
+\forall R:nat \to nat \to Prop.
+(\forall n:nat. R O n) \to
+(\forall n:nat. R (S n) O) \to
+(\forall n,m:nat. R n m \to R (S n) (S m)) \to \forall n,m:nat. R n m.
+intros 5.elim n.
+apply H.
+apply (nat_case m).apply H1.
+intros.apply H2. apply H3.
+qed.
+
+theorem decidable_eq_nat : \forall n,m:nat.decidable (n=m).
+intros.unfold decidable.
+apply (nat_elim2 (\lambda n,m.(Or (n=m) ((n=m) \to False)))).
+intro.elim n1.
+left.reflexivity.
+right.apply not_eq_O_S.
+intro.right.intro.
+apply (not_eq_O_S n1).
+apply sym_eq.assumption.
+intros.elim H.
+left.apply eq_f. assumption.
+right.intro.apply H1.apply inj_S.assumption.
+qed.
+
diff --git a/helm/matita/library/nat/nth_prime.ma b/helm/matita/library/nat/nth_prime.ma
new file mode 100644
index 000000000..5330f52ad
--- /dev/null
+++ b/helm/matita/library/nat/nth_prime.ma
@@ -0,0 +1,200 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / Matita is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/nth_prime".
+
+include "nat/primes.ma".
+include "nat/lt_arith.ma".
+
+(* upper bound by Bertrand's conjecture. *)
+(* Too difficult to prove.
+let rec nth_prime n \def
+match n with
+ [ O \Rightarrow (S(S O))
+ | (S p) \Rightarrow
+ let previous_prime \def S (nth_prime p) in
+ min_aux previous_prime ((S(S O))*previous_prime) primeb].
+
+theorem example8 : nth_prime (S(S O)) = (S(S(S(S(S O))))).
+normalize.reflexivity.
+qed.
+
+theorem example9 : nth_prime (S(S(S O))) = (S(S(S(S(S(S(S O))))))).
+normalize.reflexivity.
+qed.
+
+theorem example10 : nth_prime (S(S(S(S O)))) = (S(S(S(S(S(S(S(S(S(S(S O))))))))))).
+normalize.reflexivity.
+qed. *)
+
+theorem smallest_factor_fact: \forall n:nat.
+n < smallest_factor (S n!).
+intros.
+apply not_le_to_lt.
+change with (smallest_factor (S n!) \le n \to False).intro.
+apply (not_divides_S_fact n (smallest_factor(S n!))).
+apply lt_SO_smallest_factor.
+unfold lt.apply le_S_S.apply le_SO_fact.
+assumption.
+apply divides_smallest_factor_n.
+unfold lt.apply le_S_S.apply le_O_n.
+qed.
+
+theorem ex_prime: \forall n. (S O) \le n \to \exists m.
+n < m \land m \le S n! \land (prime m).
+intros.
+elim H.
+apply (ex_intro nat ? (S(S O))).
+split.split.apply (le_n (S(S O))).
+apply (le_n (S(S O))).apply (primeb_to_Prop (S(S O))).
+apply (ex_intro nat ? (smallest_factor (S (S n1)!))).
+split.split.
+apply smallest_factor_fact.
+apply le_smallest_factor_n.
+(* Andrea: ancora hint non lo trova *)
+apply prime_smallest_factor_n.
+change with ((S(S O)) \le S (S n1)!).
+apply le_S.apply le_SSO_fact.
+unfold lt.apply le_S_S.assumption.
+qed.
+
+let rec nth_prime n \def
+match n with
+ [ O \Rightarrow (S(S O))
+ | (S p) \Rightarrow
+ let previous_prime \def (nth_prime p) in
+ let upper_bound \def S previous_prime! in
+ min_aux (upper_bound - (S previous_prime)) upper_bound primeb].
+
+(* it works, but nth_prime 4 takes already a few minutes -
+it must compute factorial of 7 ...
+
+theorem example11 : nth_prime (S(S O)) = (S(S(S(S(S O))))).
+normalize.reflexivity.
+qed.
+
+theorem example12: nth_prime (S(S(S O))) = (S(S(S(S(S(S(S O))))))).
+normalize.reflexivity.
+qed.
+
+theorem example13 : nth_prime (S(S(S(S O)))) = (S(S(S(S(S(S(S(S(S(S(S O))))))))))).
+normalize.reflexivity.
+*)
+
+theorem prime_nth_prime : \forall n:nat.prime (nth_prime n).
+intro.
+apply (nat_case n).
+change with (prime (S(S O))).
+apply (primeb_to_Prop (S(S O))).
+intro.
+change with
+(let previous_prime \def (nth_prime m) in
+let upper_bound \def S previous_prime! in
+prime (min_aux (upper_bound - (S previous_prime)) upper_bound primeb)).
+apply primeb_true_to_prime.
+apply f_min_aux_true.
+apply (ex_intro nat ? (smallest_factor (S (nth_prime m)!))).
+split.split.
+cut (S (nth_prime m)!-(S (nth_prime m)! - (S (nth_prime m))) = (S (nth_prime m))).
+rewrite > Hcut.exact (smallest_factor_fact (nth_prime m)).
+(* maybe we could factorize this proof *)
+apply plus_to_minus.
+apply plus_minus_m_m.
+apply le_S_S.
+apply le_n_fact_n.
+apply le_smallest_factor_n.
+apply prime_to_primeb_true.
+apply prime_smallest_factor_n.
+change with ((S(S O)) \le S (nth_prime m)!).
+apply le_S_S.apply le_SO_fact.
+qed.
+
+(* properties of nth_prime *)
+theorem increasing_nth_prime: increasing nth_prime.
+change with (\forall n:nat. (nth_prime n) < (nth_prime (S n))).
+intros.
+change with
+(let previous_prime \def (nth_prime n) in
+let upper_bound \def S previous_prime! in
+(S previous_prime) \le min_aux (upper_bound - (S previous_prime)) upper_bound primeb).
+intros.
+cut (upper_bound - (upper_bound -(S previous_prime)) = (S previous_prime)).
+rewrite < Hcut in \vdash (? % ?).
+apply le_min_aux.
+apply plus_to_minus.
+apply plus_minus_m_m.
+apply le_S_S.
+apply le_n_fact_n.
+qed.
+
+variant lt_nth_prime_n_nth_prime_Sn :\forall n:nat.
+(nth_prime n) < (nth_prime (S n)) \def increasing_nth_prime.
+
+theorem injective_nth_prime: injective nat nat nth_prime.
+apply increasing_to_injective.
+apply increasing_nth_prime.
+qed.
+
+theorem lt_SO_nth_prime_n : \forall n:nat. (S O) \lt nth_prime n.
+intros. elim n.unfold lt.apply le_n.
+apply (trans_lt ? (nth_prime n1)).
+assumption.apply lt_nth_prime_n_nth_prime_Sn.
+qed.
+
+theorem lt_O_nth_prime_n : \forall n:nat. O \lt nth_prime n.
+intros.apply (trans_lt O (S O)).
+unfold lt. apply le_n.apply lt_SO_nth_prime_n.
+qed.
+
+theorem ex_m_le_n_nth_prime_m:
+\forall n: nat. nth_prime O \le n \to
+\exists m. nth_prime m \le n \land n < nth_prime (S m).
+intros.
+apply increasing_to_le2.
+exact lt_nth_prime_n_nth_prime_Sn.assumption.
+qed.
+
+theorem lt_nth_prime_to_not_prime: \forall n,m. nth_prime n < m \to m < nth_prime (S n)
+\to \lnot (prime m).
+intros.
+apply primeb_false_to_not_prime.
+letin previous_prime \def (nth_prime n).
+letin upper_bound \def (S previous_prime!).
+apply (lt_min_aux_to_false primeb upper_bound (upper_bound - (S previous_prime)) m).
+cut (S (nth_prime n)!-(S (nth_prime n)! - (S (nth_prime n))) = (S (nth_prime n))).
+rewrite > Hcut.assumption.
+apply plus_to_minus.
+apply plus_minus_m_m.
+apply le_S_S.
+apply le_n_fact_n.
+assumption.
+qed.
+
+(* nth_prime enumerates all primes *)
+theorem prime_to_nth_prime : \forall p:nat. prime p \to
+\exists i. nth_prime i = p.
+intros.
+cut (\exists m. nth_prime m \le p \land p < nth_prime (S m)).
+elim Hcut.elim H1.
+cut (nth_prime a < p \lor nth_prime a = p).
+elim Hcut1.
+absurd (prime p).
+assumption.
+apply (lt_nth_prime_to_not_prime a).assumption.assumption.
+apply (ex_intro nat ? a).assumption.
+apply le_to_or_lt_eq.assumption.
+apply ex_m_le_n_nth_prime_m.
+simplify.unfold prime in H.elim H.assumption.
+qed.
+
diff --git a/helm/matita/library/nat/ord.ma b/helm/matita/library/nat/ord.ma
new file mode 100644
index 000000000..24874c08a
--- /dev/null
+++ b/helm/matita/library/nat/ord.ma
@@ -0,0 +1,193 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / Matita is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/log".
+
+include "datatypes/constructors.ma".
+include "nat/exp.ma".
+include "nat/lt_arith.ma".
+include "nat/primes.ma".
+
+(* this definition of log is based on pairs, with a remainder *)
+
+let rec p_ord_aux p n m \def
+ match n \mod m with
+ [ O \Rightarrow
+ match p with
+ [ O \Rightarrow pair nat nat O n
+ | (S p) \Rightarrow
+ match (p_ord_aux p (n / m) m) with
+ [ (pair q r) \Rightarrow pair nat nat (S q) r] ]
+ | (S a) \Rightarrow pair nat nat O n].
+
+(* p_ord n m = <q,r> if m divides n q times, with remainder r *)
+definition p_ord \def \lambda n,m:nat.p_ord_aux n n m.
+
+theorem p_ord_aux_to_Prop: \forall p,n,m. O < m \to
+ match p_ord_aux p n m with
+ [ (pair q r) \Rightarrow n = m \sup q *r ].
+intro.
+elim p.
+change with
+match (
+match n \mod m with
+ [ O \Rightarrow pair nat nat O n
+ | (S a) \Rightarrow pair nat nat O n] )
+with
+ [ (pair q r) \Rightarrow n = m \sup q * r ].
+apply (nat_case (n \mod m)).
+simplify.apply plus_n_O.
+intros.
+simplify.apply plus_n_O.
+change with
+match (
+match n1 \mod m with
+ [ O \Rightarrow
+ match (p_ord_aux n (n1 / m) m) with
+ [ (pair q r) \Rightarrow pair nat nat (S q) r]
+ | (S a) \Rightarrow pair nat nat O n1] )
+with
+ [ (pair q r) \Rightarrow n1 = m \sup q * r].
+apply (nat_case1 (n1 \mod m)).intro.
+change with
+match (
+ match (p_ord_aux n (n1 / m) m) with
+ [ (pair q r) \Rightarrow pair nat nat (S q) r])
+with
+ [ (pair q r) \Rightarrow n1 = m \sup q * r].
+generalize in match (H (n1 / m) m).
+elim (p_ord_aux n (n1 / m) m).
+simplify.
+rewrite > assoc_times.
+rewrite < H3.rewrite > (plus_n_O (m*(n1 / m))).
+rewrite < H2.
+rewrite > sym_times.
+rewrite < div_mod.reflexivity.
+assumption.assumption.
+intros.simplify.apply plus_n_O.
+qed.
+
+theorem p_ord_aux_to_exp: \forall p,n,m,q,r. O < m \to
+ (pair nat nat q r) = p_ord_aux p n m \to n = m \sup q * r.
+intros.
+change with
+match (pair nat nat q r) with
+ [ (pair q r) \Rightarrow n = m \sup q * r ].
+rewrite > H1.
+apply p_ord_aux_to_Prop.
+assumption.
+qed.
+(* questo va spostato in primes1.ma *)
+theorem p_ord_exp: \forall n,m,i. O < m \to n \mod m \neq O \to
+\forall p. i \le p \to p_ord_aux p (m \sup i * n) m = pair nat nat i n.
+intros 5.
+elim i.
+simplify.
+rewrite < plus_n_O.
+apply (nat_case p).
+change with
+ (match n \mod m with
+ [ O \Rightarrow pair nat nat O n
+ | (S a) \Rightarrow pair nat nat O n]
+ = pair nat nat O n).
+elim (n \mod m).simplify.reflexivity.simplify.reflexivity.
+intro.
+change with
+ (match n \mod m with
+ [ O \Rightarrow
+ match (p_ord_aux m1 (n / m) m) with
+ [ (pair q r) \Rightarrow pair nat nat (S q) r]
+ | (S a) \Rightarrow pair nat nat O n]
+ = pair nat nat O n).
+cut (O < n \mod m \lor O = n \mod m).
+elim Hcut.apply (lt_O_n_elim (n \mod m) H3).
+intros. simplify.reflexivity.
+apply False_ind.
+apply H1.apply sym_eq.assumption.
+apply le_to_or_lt_eq.apply le_O_n.
+generalize in match H3.
+apply (nat_case p).intro.apply False_ind.apply (not_le_Sn_O n1 H4).
+intros.
+change with
+ (match ((m \sup (S n1) *n) \mod m) with
+ [ O \Rightarrow
+ match (p_ord_aux m1 ((m \sup (S n1) *n) / m) m) with
+ [ (pair q r) \Rightarrow pair nat nat (S q) r]
+ | (S a) \Rightarrow pair nat nat O (m \sup (S n1) *n)]
+ = pair nat nat (S n1) n).
+cut (((m \sup (S n1)*n) \mod m) = O).
+rewrite > Hcut.
+change with
+(match (p_ord_aux m1 ((m \sup (S n1)*n) / m) m) with
+ [ (pair q r) \Rightarrow pair nat nat (S q) r]
+ = pair nat nat (S n1) n).
+cut ((m \sup (S n1) *n) / m = m \sup n1 *n).
+rewrite > Hcut1.
+rewrite > (H2 m1). simplify.reflexivity.
+apply le_S_S_to_le.assumption.
+(* div_exp *)
+change with ((m* m \sup n1 *n) / m = m \sup n1 * n).
+rewrite > assoc_times.
+apply (lt_O_n_elim m H).
+intro.apply div_times.
+(* mod_exp = O *)
+apply divides_to_mod_O.
+assumption.
+simplify.rewrite > assoc_times.
+apply (witness ? ? (m \sup n1 *n)).reflexivity.
+qed.
+
+theorem p_ord_aux_to_Prop1: \forall p,n,m. (S O) < m \to O < n \to n \le p \to
+ match p_ord_aux p n m with
+ [ (pair q r) \Rightarrow r \mod m \neq O].
+intro.elim p.absurd (O < n).assumption.
+apply le_to_not_lt.assumption.
+change with
+match
+ (match n1 \mod m with
+ [ O \Rightarrow
+ match (p_ord_aux n(n1 / m) m) with
+ [ (pair q r) \Rightarrow pair nat nat (S q) r]
+ | (S a) \Rightarrow pair nat nat O n1])
+with
+ [ (pair q r) \Rightarrow r \mod m \neq O].
+apply (nat_case1 (n1 \mod m)).intro.
+generalize in match (H (n1 / m) m).
+elim (p_ord_aux n (n1 / m) m).
+apply H5.assumption.
+apply eq_mod_O_to_lt_O_div.
+apply (trans_lt ? (S O)).unfold lt.apply le_n.
+assumption.assumption.assumption.
+apply le_S_S_to_le.
+apply (trans_le ? n1).change with (n1 / m < n1).
+apply lt_div_n_m_n.assumption.assumption.assumption.
+intros.
+change with (n1 \mod m \neq O).
+rewrite > H4.
+unfold Not.intro.
+apply (not_eq_O_S m1).
+rewrite > H5.reflexivity.
+qed.
+
+theorem p_ord_aux_to_not_mod_O: \forall p,n,m,q,r. (S O) < m \to O < n \to n \le p \to
+ pair nat nat q r = p_ord_aux p n m \to r \mod m \neq O.
+intros.
+change with
+ match (pair nat nat q r) with
+ [ (pair q r) \Rightarrow r \mod m \neq O].
+rewrite > H3.
+apply p_ord_aux_to_Prop1.
+assumption.assumption.assumption.
+qed.
+
diff --git a/helm/matita/library/nat/orders.ma b/helm/matita/library/nat/orders.ma
new file mode 100644
index 000000000..6ec0c9992
--- /dev/null
+++ b/helm/matita/library/nat/orders.ma
@@ -0,0 +1,312 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/orders".
+
+include "nat/nat.ma".
+include "higher_order_defs/ordering.ma".
+
+(* definitions *)
+inductive le (n:nat) : nat \to Prop \def
+ | le_n : le n n
+ | le_S : \forall m:nat. le n m \to le n (S m).
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "natural 'less or equal to'" 'leq x y = (cic:/matita/nat/orders/le.ind#xpointer(1/1) x y).
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "natural 'neither less nor equal to'" 'nleq x y =
+ (cic:/matita/logic/connectives/Not.con
+ (cic:/matita/nat/orders/le.ind#xpointer(1/1) x y)).
+
+definition lt: nat \to nat \to Prop \def
+\lambda n,m:nat.(S n) \leq m.
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "natural 'less than'" 'lt x y = (cic:/matita/nat/orders/lt.con x y).
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "natural 'not less than'" 'nless x y =
+ (cic:/matita/logic/connectives/Not.con (cic:/matita/nat/orders/lt.con x y)).
+
+definition ge: nat \to nat \to Prop \def
+\lambda n,m:nat.m \leq n.
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "natural 'greater or equal to'" 'geq x y = (cic:/matita/nat/orders/ge.con x y).
+
+definition gt: nat \to nat \to Prop \def
+\lambda n,m:nat.m<n.
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "natural 'greater than'" 'gt x y = (cic:/matita/nat/orders/gt.con x y).
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "natural 'not greater than'" 'ngtr x y =
+ (cic:/matita/logic/connectives/Not.con (cic:/matita/nat/orders/gt.con x y)).
+
+theorem transitive_le : transitive nat le.
+unfold transitive.intros.elim H1.
+assumption.
+apply le_S.assumption.
+qed.
+
+theorem trans_le: \forall n,m,p:nat. n \leq m \to m \leq p \to n \leq p
+\def transitive_le.
+
+theorem transitive_lt: transitive nat lt.
+unfold transitive.unfold lt.intros.elim H1.
+apply le_S. assumption.
+apply le_S.assumption.
+qed.
+
+theorem trans_lt: \forall n,m,p:nat. lt n m \to lt m p \to lt n p
+\def transitive_lt.
+
+theorem le_S_S: \forall n,m:nat. n \leq m \to S n \leq S m.
+intros.elim H.
+apply le_n.
+apply le_S.assumption.
+qed.
+
+theorem le_O_n : \forall n:nat. O \leq n.
+intros.elim n.
+apply le_n.apply
+le_S. assumption.
+qed.
+
+theorem le_n_Sn : \forall n:nat. n \leq S n.
+intros. apply le_S.apply le_n.
+qed.
+
+theorem le_pred_n : \forall n:nat. pred n \leq n.
+intros.elim n.
+simplify.apply le_n.
+simplify.apply le_n_Sn.
+qed.
+
+theorem le_S_S_to_le : \forall n,m:nat. S n \leq S m \to n \leq m.
+intros.change with (pred (S n) \leq pred (S m)).
+elim H.apply le_n.apply (trans_le ? (pred n1)).assumption.
+apply le_pred_n.
+qed.
+
+theorem leS_to_not_zero : \forall n,m:nat. S n \leq m \to not_zero m.
+intros.elim H.exact I.exact I.
+qed.
+
+(* not le *)
+theorem not_le_Sn_O: \forall n:nat. S n \nleq O.
+intros.unfold Not.simplify.intros.apply (leS_to_not_zero ? ? H).
+qed.
+
+theorem not_le_Sn_n: \forall n:nat. S n \nleq n.
+intros.elim n.apply not_le_Sn_O.unfold Not.simplify.intros.cut (S n1 \leq n1).
+apply H.assumption.
+apply le_S_S_to_le.assumption.
+qed.
+
+(* le to lt or eq *)
+theorem le_to_or_lt_eq : \forall n,m:nat.
+n \leq m \to n < m \lor n = m.
+intros.elim H.
+right.reflexivity.
+left.unfold lt.apply le_S_S.assumption.
+qed.
+
+(* not eq *)
+theorem lt_to_not_eq : \forall n,m:nat. n<m \to n \neq m.
+unfold Not.intros.cut ((le (S n) m) \to False).
+apply Hcut.assumption.rewrite < H1.
+apply not_le_Sn_n.
+qed.
+
+(* le vs. lt *)
+theorem lt_to_le : \forall n,m:nat. n<m \to n \leq m.
+simplify.intros.unfold lt in H.elim H.
+apply le_S. apply le_n.
+apply le_S. assumption.
+qed.
+
+theorem lt_S_to_le : \forall n,m:nat. n < S m \to n \leq m.
+simplify.intros.
+apply le_S_S_to_le.assumption.
+qed.
+
+theorem not_le_to_lt: \forall n,m:nat. n \nleq m \to m<n.
+intros 2.
+apply (nat_elim2 (\lambda n,m.n \nleq m \to m<n)).
+intros.apply (absurd (O \leq n1)).apply le_O_n.assumption.
+unfold Not.unfold lt.intros.apply le_S_S.apply le_O_n.
+unfold Not.unfold lt.intros.apply le_S_S.apply H.intros.apply H1.apply le_S_S.
+assumption.
+qed.
+
+theorem lt_to_not_le: \forall n,m:nat. n<m \to m \nleq n.
+unfold Not.unfold lt.intros 3.elim H.
+apply (not_le_Sn_n n H1).
+apply H2.apply lt_to_le. apply H3.
+qed.
+
+theorem not_lt_to_le: \forall n,m:nat. Not (lt n m) \to le m n.
+simplify.intros.
+apply lt_S_to_le.
+apply not_le_to_lt.exact H.
+qed.
+
+theorem le_to_not_lt: \forall n,m:nat. le n m \to Not (lt m n).
+intros.
+change with (Not (le (S m) n)).
+apply lt_to_not_le.unfold lt.
+apply le_S_S.assumption.
+qed.
+
+(* le elimination *)
+theorem le_n_O_to_eq : \forall n:nat. n \leq O \to O=n.
+intro.elim n.reflexivity.
+apply False_ind.
+apply not_le_Sn_O.
+goal 17. apply H1.
+qed.
+
+theorem le_n_O_elim: \forall n:nat.n \leq O \to \forall P: nat \to Prop.
+P O \to P n.
+intro.elim n.
+assumption.
+apply False_ind.
+apply (not_le_Sn_O ? H1).
+qed.
+
+theorem le_n_Sm_elim : \forall n,m:nat.n \leq S m \to
+\forall P:Prop. (S n \leq S m \to P) \to (n=S m \to P) \to P.
+intros 4.elim H.
+apply H2.reflexivity.
+apply H3. apply le_S_S. assumption.
+qed.
+
+(* lt and le trans *)
+theorem lt_to_le_to_lt: \forall n,m,p:nat. lt n m \to le m p \to lt n p.
+intros.elim H1.
+assumption.unfold lt.apply le_S.assumption.
+qed.
+
+theorem le_to_lt_to_lt: \forall n,m,p:nat. le n m \to lt m p \to lt n p.
+intros 4.elim H.
+assumption.apply H2.unfold lt.
+apply lt_to_le.assumption.
+qed.
+
+theorem ltn_to_ltO: \forall n,m:nat. lt n m \to lt O m.
+intros.apply (le_to_lt_to_lt O n).
+apply le_O_n.assumption.
+qed.
+
+theorem lt_O_n_elim: \forall n:nat. lt O n \to
+\forall P:nat\to Prop. (\forall m:nat.P (S m)) \to P n.
+intro.elim n.apply False_ind.exact (not_le_Sn_O O H).
+apply H2.
+qed.
+
+(* other abstract properties *)
+theorem antisymmetric_le : antisymmetric nat le.
+unfold antisymmetric.intros 2.
+apply (nat_elim2 (\lambda n,m.(n \leq m \to m \leq n \to n=m))).
+intros.apply le_n_O_to_eq.assumption.
+intros.apply False_ind.apply (not_le_Sn_O ? H).
+intros.apply eq_f.apply H.
+apply le_S_S_to_le.assumption.
+apply le_S_S_to_le.assumption.
+qed.
+
+theorem antisym_le: \forall n,m:nat. n \leq m \to m \leq n \to n=m
+\def antisymmetric_le.
+
+theorem decidable_le: \forall n,m:nat. decidable (n \leq m).
+intros.
+apply (nat_elim2 (\lambda n,m.decidable (n \leq m))).
+intros.unfold decidable.left.apply le_O_n.
+intros.unfold decidable.right.exact (not_le_Sn_O n1).
+intros 2.unfold decidable.intro.elim H.
+left.apply le_S_S.assumption.
+right.unfold Not.intro.apply H1.apply le_S_S_to_le.assumption.
+qed.
+
+theorem decidable_lt: \forall n,m:nat. decidable (n < m).
+intros.exact (decidable_le (S n) m).
+qed.
+
+(* well founded induction principles *)
+
+theorem nat_elim1 : \forall n:nat.\forall P:nat \to Prop.
+(\forall m.(\forall p. (p \lt m) \to P p) \to P m) \to P n.
+intros.cut (\forall q:nat. q \le n \to P q).
+apply (Hcut n).apply le_n.
+elim n.apply (le_n_O_elim q H1).
+apply H.
+intros.apply False_ind.apply (not_le_Sn_O p H2).
+apply H.intros.apply H1.
+cut (p < S n1).
+apply lt_S_to_le.assumption.
+apply (lt_to_le_to_lt p q (S n1) H3 H2).
+qed.
+
+(* some properties of functions *)
+
+definition increasing \def \lambda f:nat \to nat.
+\forall n:nat. f n < f (S n).
+
+theorem increasing_to_monotonic: \forall f:nat \to nat.
+increasing f \to monotonic nat lt f.
+unfold monotonic.unfold lt.unfold increasing.unfold lt.intros.elim H1.apply H.
+apply (trans_le ? (f n1)).
+assumption.apply (trans_le ? (S (f n1))).
+apply le_n_Sn.
+apply H.
+qed.
+
+theorem le_n_fn: \forall f:nat \to nat. (increasing f)
+\to \forall n:nat. n \le (f n).
+intros.elim n.
+apply le_O_n.
+apply (trans_le ? (S (f n1))).
+apply le_S_S.apply H1.
+simplify in H. unfold increasing in H.unfold lt in H.apply H.
+qed.
+
+theorem increasing_to_le: \forall f:nat \to nat. (increasing f)
+\to \forall m:nat. \exists i. m \le (f i).
+intros.elim m.
+apply (ex_intro ? ? O).apply le_O_n.
+elim H1.
+apply (ex_intro ? ? (S a)).
+apply (trans_le ? (S (f a))).
+apply le_S_S.assumption.
+simplify in H.unfold increasing in H.unfold lt in H.
+apply H.
+qed.
+
+theorem increasing_to_le2: \forall f:nat \to nat. (increasing f)
+\to \forall m:nat. (f O) \le m \to
+\exists i. (f i) \le m \land m <(f (S i)).
+intros.elim H1.
+apply (ex_intro ? ? O).
+split.apply le_n.apply H.
+elim H3.elim H4.
+cut ((S n1) < (f (S a)) \lor (S n1) = (f (S a))).
+elim Hcut.
+apply (ex_intro ? ? a).
+split.apply le_S. assumption.assumption.
+apply (ex_intro ? ? (S a)).
+split.rewrite < H7.apply le_n.
+rewrite > H7.
+apply H.
+apply le_to_or_lt_eq.apply H6.
+qed.
diff --git a/helm/matita/library/nat/permutation.ma b/helm/matita/library/nat/permutation.ma
new file mode 100644
index 000000000..3e987e9e8
--- /dev/null
+++ b/helm/matita/library/nat/permutation.ma
@@ -0,0 +1,740 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/permutation".
+
+include "nat/compare.ma".
+include "nat/sigma_and_pi.ma".
+
+definition injn: (nat \to nat) \to nat \to Prop \def
+\lambda f:nat \to nat.\lambda n:nat.\forall i,j:nat.
+i \le n \to j \le n \to f i = f j \to i = j.
+
+theorem injn_Sn_n: \forall f:nat \to nat. \forall n:nat.
+injn f (S n) \to injn f n.unfold injn.
+intros.apply H.
+apply le_S.assumption.
+apply le_S.assumption.
+assumption.
+qed.
+
+theorem injective_to_injn: \forall f:nat \to nat. \forall n:nat.
+injective nat nat f \to injn f n.
+unfold injective.unfold injn.intros.apply H.assumption.
+qed.
+
+definition permut : (nat \to nat) \to nat \to Prop
+\def \lambda f:nat \to nat. \lambda m:nat.
+(\forall i:nat. i \le m \to f i \le m )\land injn f m.
+
+theorem permut_O_to_eq_O: \forall h:nat \to nat.
+permut h O \to (h O) = O.
+intros.unfold permut in H.
+elim H.apply sym_eq.apply le_n_O_to_eq.
+apply H1.apply le_n.
+qed.
+
+theorem permut_S_to_permut: \forall f:nat \to nat. \forall m:nat.
+permut f (S m) \to f (S m) = (S m) \to permut f m.
+unfold permut.intros.
+elim H.
+split.intros.
+cut (f i < S m \lor f i = S m).
+elim Hcut.
+apply le_S_S_to_le.assumption.
+apply False_ind.
+apply (not_le_Sn_n m).
+cut ((S m) = i).
+rewrite > Hcut1.assumption.
+apply H3.apply le_n.apply le_S.assumption.
+rewrite > H5.assumption.
+apply le_to_or_lt_eq.apply H2.apply le_S.assumption.
+apply (injn_Sn_n f m H3).
+qed.
+
+(* transpositions *)
+
+definition transpose : nat \to nat \to nat \to nat \def
+\lambda i,j,n:nat.
+match eqb n i with
+ [ true \Rightarrow j
+ | false \Rightarrow
+ match eqb n j with
+ [ true \Rightarrow i
+ | false \Rightarrow n]].
+
+lemma transpose_i_j_i: \forall i,j:nat. transpose i j i = j.
+intros.unfold transpose.
+rewrite > (eqb_n_n i).simplify. reflexivity.
+qed.
+
+lemma transpose_i_j_j: \forall i,j:nat. transpose i j j = i.
+intros.unfold transpose.
+apply (eqb_elim j i).simplify.intro.assumption.
+rewrite > (eqb_n_n j).simplify.
+intros. reflexivity.
+qed.
+
+theorem transpose_i_i: \forall i,n:nat. (transpose i i n) = n.
+intros.unfold transpose.
+apply (eqb_elim n i).
+intro.simplify.apply sym_eq. assumption.
+intro.simplify.reflexivity.
+qed.
+
+theorem transpose_i_j_j_i: \forall i,j,n:nat.
+transpose i j n = transpose j i n.
+intros.unfold transpose.
+apply (eqb_elim n i).
+apply (eqb_elim n j).
+intros. simplify.rewrite < H. rewrite < H1.
+reflexivity.
+intros.simplify.reflexivity.
+apply (eqb_elim n j).
+intros.simplify.reflexivity.
+intros.simplify.reflexivity.
+qed.
+
+theorem transpose_transpose: \forall i,j,n:nat.
+(transpose i j (transpose i j n)) = n.
+intros.unfold transpose. unfold transpose.
+apply (eqb_elim n i).simplify.
+intro.
+apply (eqb_elim j i).
+simplify.intros.rewrite > H. rewrite > H1.reflexivity.
+rewrite > (eqb_n_n j).simplify.intros.
+apply sym_eq.
+assumption.
+apply (eqb_elim n j).simplify.
+rewrite > (eqb_n_n i).intros.simplify.
+apply sym_eq. assumption.
+simplify.intros.
+rewrite > (not_eq_to_eqb_false n i H1).
+rewrite > (not_eq_to_eqb_false n j H).
+simplify.reflexivity.
+qed.
+
+theorem injective_transpose : \forall i,j:nat.
+injective nat nat (transpose i j).
+unfold injective.
+intros.
+rewrite < (transpose_transpose i j x).
+rewrite < (transpose_transpose i j y).
+apply eq_f.assumption.
+qed.
+
+variant inj_transpose: \forall i,j,n,m:nat.
+transpose i j n = transpose i j m \to n = m \def
+injective_transpose.
+
+theorem permut_transpose: \forall i,j,n:nat. i \le n \to j \le n \to
+permut (transpose i j) n.
+unfold permut.intros.
+split.unfold transpose.
+intros.
+elim (eqb i1 i).simplify.assumption.
+elim (eqb i1 j).simplify.assumption.
+simplify.assumption.
+apply (injective_to_injn (transpose i j) n).
+apply injective_transpose.
+qed.
+
+theorem permut_fg: \forall f,g:nat \to nat. \forall n:nat.
+permut f n \to permut g n \to permut (\lambda m.(f(g m))) n.
+unfold permut. intros.
+elim H.elim H1.
+split.intros.simplify.apply H2.
+apply H4.assumption.
+simplify.intros.
+apply H5.assumption.assumption.
+apply H3.apply H4.assumption.apply H4.assumption.
+assumption.
+qed.
+
+theorem permut_transpose_l:
+\forall f:nat \to nat. \forall m,i,j:nat.
+i \le m \to j \le m \to permut f m \to permut (\lambda n.transpose i j (f n)) m.
+intros.apply (permut_fg (transpose i j) f m ? ?).
+apply permut_transpose.assumption.assumption.
+assumption.
+qed.
+
+theorem permut_transpose_r:
+\forall f:nat \to nat. \forall m,i,j:nat.
+i \le m \to j \le m \to permut f m \to permut (\lambda n.f (transpose i j n)) m.
+intros.apply (permut_fg f (transpose i j) m ? ?).
+assumption.apply permut_transpose.assumption.assumption.
+qed.
+
+theorem eq_transpose : \forall i,j,k,n:nat. \lnot j=i \to
+ \lnot i=k \to \lnot j=k \to
+transpose i j n = transpose i k (transpose k j (transpose i k n)).
+(* uffa: triplo unfold? *)
+intros.unfold transpose.unfold transpose.unfold transpose.
+apply (eqb_elim n i).intro.
+simplify.rewrite > (eqb_n_n k).
+simplify.rewrite > (not_eq_to_eqb_false j i H).
+rewrite > (not_eq_to_eqb_false j k H2).
+reflexivity.
+intro.apply (eqb_elim n j).
+intro.
+cut (\lnot n = k).
+cut (\lnot n = i).
+rewrite > (not_eq_to_eqb_false n k Hcut).
+simplify.
+rewrite > (not_eq_to_eqb_false n k Hcut).
+rewrite > (eq_to_eqb_true n j H4).
+simplify.
+rewrite > (not_eq_to_eqb_false k i).
+rewrite > (eqb_n_n k).
+simplify.reflexivity.
+unfold Not.intro.apply H1.apply sym_eq.assumption.
+assumption.
+unfold Not.intro.apply H2.apply (trans_eq ? ? n).
+apply sym_eq.assumption.assumption.
+intro.apply (eqb_elim n k).intro.
+simplify.
+rewrite > (not_eq_to_eqb_false i k H1).
+rewrite > (not_eq_to_eqb_false i j).
+simplify.
+rewrite > (eqb_n_n i).
+simplify.assumption.
+unfold Not.intro.apply H.apply sym_eq.assumption.
+intro.simplify.
+rewrite > (not_eq_to_eqb_false n k H5).
+rewrite > (not_eq_to_eqb_false n j H4).
+simplify.
+rewrite > (not_eq_to_eqb_false n i H3).
+rewrite > (not_eq_to_eqb_false n k H5).
+simplify.reflexivity.
+qed.
+
+theorem permut_S_to_permut_transpose: \forall f:nat \to nat.
+\forall m:nat. permut f (S m) \to permut (\lambda n.transpose (f (S m)) (S m)
+(f n)) m.
+unfold permut.intros.
+elim H.
+split.intros.simplify.unfold transpose.
+apply (eqb_elim (f i) (f (S m))).
+intro.apply False_ind.
+cut (i = (S m)).
+apply (not_le_Sn_n m).
+rewrite < Hcut.assumption.
+apply H2.apply le_S.assumption.apply le_n.assumption.
+intro.simplify.
+apply (eqb_elim (f i) (S m)).
+intro.
+cut (f (S m) \lt (S m) \lor f (S m) = (S m)).
+elim Hcut.apply le_S_S_to_le.assumption.
+apply False_ind.apply H4.rewrite > H6.assumption.
+apply le_to_or_lt_eq.apply H1.apply le_n.
+intro.simplify.
+cut (f i \lt (S m) \lor f i = (S m)).
+elim Hcut.apply le_S_S_to_le.assumption.
+apply False_ind.apply H5.assumption.
+apply le_to_or_lt_eq.apply H1.apply le_S.assumption.
+unfold injn.intros.
+apply H2.apply le_S.assumption.apply le_S.assumption.
+apply (inj_transpose (f (S m)) (S m)).
+apply H5.
+qed.
+
+(* bounded bijectivity *)
+
+definition bijn : (nat \to nat) \to nat \to Prop \def
+\lambda f:nat \to nat. \lambda n. \forall m:nat. m \le n \to
+ex nat (\lambda p. p \le n \land f p = m).
+
+theorem eq_to_bijn: \forall f,g:nat\to nat. \forall n:nat.
+(\forall i:nat. i \le n \to (f i) = (g i)) \to
+bijn f n \to bijn g n.
+intros 4.unfold bijn.
+intros.elim (H1 m).
+apply (ex_intro ? ? a).
+rewrite < (H a).assumption.
+elim H3.assumption.assumption.
+qed.
+
+theorem bijn_Sn_n: \forall f:nat \to nat. \forall n:nat.
+bijn f (S n) \to f (S n) = (S n) \to bijn f n.
+unfold bijn.intros.elim (H m).
+elim H3.
+apply (ex_intro ? ? a).split.
+cut (a < S n \lor a = S n).
+elim Hcut.apply le_S_S_to_le.assumption.
+apply False_ind.
+apply (not_le_Sn_n n).
+rewrite < H1.rewrite < H6.rewrite > H5.assumption.
+apply le_to_or_lt_eq.assumption.assumption.
+apply le_S.assumption.
+qed.
+
+theorem bijn_n_Sn: \forall f:nat \to nat. \forall n:nat.
+bijn f n \to f (S n) = (S n) \to bijn f (S n).
+unfold bijn.intros.
+cut (m < S n \lor m = S n).
+elim Hcut.
+elim (H m).
+elim H4.
+apply (ex_intro ? ? a).split.
+apply le_S.assumption.assumption.
+apply le_S_S_to_le.assumption.
+apply (ex_intro ? ? (S n)).
+split.apply le_n.
+rewrite > H3.assumption.
+apply le_to_or_lt_eq.assumption.
+qed.
+
+theorem bijn_fg: \forall f,g:nat\to nat. \forall n:nat.
+bijn f n \to bijn g n \to bijn (\lambda p.f(g p)) n.
+unfold bijn.
+intros.simplify.
+elim (H m).elim H3.
+elim (H1 a).elim H6.
+apply (ex_intro ? ? a1).
+split.assumption.
+rewrite > H8.assumption.
+assumption.assumption.
+qed.
+
+theorem bijn_transpose : \forall n,i,j. i \le n \to j \le n \to
+bijn (transpose i j) n.
+intros.unfold bijn.unfold transpose.intros.
+cut (m = i \lor \lnot m = i).
+elim Hcut.
+apply (ex_intro ? ? j).
+split.assumption.
+apply (eqb_elim j i).
+intro.simplify.rewrite > H3.rewrite > H4.reflexivity.
+rewrite > (eqb_n_n j).simplify.
+intros. apply sym_eq.assumption.
+cut (m = j \lor \lnot m = j).
+elim Hcut1.
+apply (ex_intro ? ? i).
+split.assumption.
+rewrite > (eqb_n_n i).simplify.
+apply sym_eq. assumption.
+apply (ex_intro ? ? m).
+split.assumption.
+rewrite > (not_eq_to_eqb_false m i).
+rewrite > (not_eq_to_eqb_false m j).
+simplify. reflexivity.
+assumption.
+assumption.
+apply (decidable_eq_nat m j).
+apply (decidable_eq_nat m i).
+qed.
+
+theorem bijn_transpose_r: \forall f:nat\to nat.\forall n,i,j. i \le n \to j \le n \to
+bijn f n \to bijn (\lambda p.f (transpose i j p)) n.
+intros.
+apply (bijn_fg f ?).assumption.
+apply (bijn_transpose n i j).assumption.assumption.
+qed.
+
+theorem bijn_transpose_l: \forall f:nat\to nat.\forall n,i,j. i \le n \to j \le n \to
+bijn f n \to bijn (\lambda p.transpose i j (f p)) n.
+intros.
+apply (bijn_fg ? f).
+apply (bijn_transpose n i j).assumption.assumption.
+assumption.
+qed.
+
+theorem permut_to_bijn: \forall n:nat.\forall f:nat\to nat.
+permut f n \to bijn f n.
+intro.
+elim n.unfold bijn.intros.
+apply (ex_intro ? ? m).
+split.assumption.
+apply (le_n_O_elim m ? (\lambda p. f p = p)).
+assumption.unfold permut in H.
+elim H.apply sym_eq. apply le_n_O_to_eq.apply H2.apply le_n.
+apply (eq_to_bijn (\lambda p.
+(transpose (f (S n1)) (S n1)) (transpose (f (S n1)) (S n1) (f p))) f).
+intros.apply transpose_transpose.
+apply (bijn_fg (transpose (f (S n1)) (S n1))).
+apply bijn_transpose.
+unfold permut in H1.
+elim H1.apply H2.apply le_n.apply le_n.
+apply bijn_n_Sn.
+apply H.
+apply permut_S_to_permut_transpose.
+assumption.unfold transpose.
+rewrite > (eqb_n_n (f (S n1))).simplify.reflexivity.
+qed.
+
+let rec invert_permut n f m \def
+ match eqb m (f n) with
+ [true \Rightarrow n
+ |false \Rightarrow
+ match n with
+ [O \Rightarrow O
+ |(S p) \Rightarrow invert_permut p f m]].
+
+theorem invert_permut_f: \forall f:nat \to nat. \forall n,m:nat.
+m \le n \to injn f n\to invert_permut n f (f m) = m.
+intros 4.
+elim H.
+apply (nat_case1 m).
+intro.simplify.
+rewrite > (eqb_n_n (f O)).simplify.reflexivity.
+intros.simplify.
+rewrite > (eqb_n_n (f (S m1))).simplify.reflexivity.
+simplify.
+rewrite > (not_eq_to_eqb_false (f m) (f (S n1))).
+simplify.apply H2.
+apply injn_Sn_n. assumption.
+unfold Not.intro.absurd (m = S n1).
+apply H3.apply le_S.assumption.apply le_n.assumption.
+unfold Not.intro.
+apply (not_le_Sn_n n1).rewrite < H5.assumption.
+qed.
+
+theorem injective_invert_permut: \forall f:nat \to nat. \forall n:nat.
+permut f n \to injn (invert_permut n f) n.
+intros.
+unfold injn.intros.
+cut (bijn f n).
+unfold bijn in Hcut.
+generalize in match (Hcut i H1).intro.
+generalize in match (Hcut j H2).intro.
+elim H4.elim H6.
+elim H5.elim H9.
+rewrite < H8.
+rewrite < H11.
+apply eq_f.
+rewrite < (invert_permut_f f n a).
+rewrite < (invert_permut_f f n a1).
+rewrite > H8.
+rewrite > H11.
+assumption.assumption.
+unfold permut in H.elim H. assumption.
+assumption.
+unfold permut in H.elim H. assumption.
+apply permut_to_bijn.assumption.
+qed.
+
+theorem permut_invert_permut: \forall f:nat \to nat. \forall n:nat.
+permut f n \to permut (invert_permut n f) n.
+intros.unfold permut.split.
+intros.simplify.elim n.
+simplify.elim (eqb i (f O)).simplify.apply le_n.simplify.apply le_n.
+simplify.elim (eqb i (f (S n1))).simplify.apply le_n.
+simplify.apply le_S. assumption.
+apply injective_invert_permut.assumption.
+qed.
+
+theorem f_invert_permut: \forall f:nat \to nat. \forall n,m:nat.
+m \le n \to permut f n\to f (invert_permut n f m) = m.
+intros.
+apply (injective_invert_permut f n H1).
+unfold permut in H1.elim H1.
+apply H2.
+cut (permut (invert_permut n f) n).unfold permut in Hcut.
+elim Hcut.apply H4.assumption.
+apply permut_invert_permut.assumption.assumption.
+(* uffa: lo ha espanso troppo *)
+change with (invert_permut n f (f (invert_permut n f m)) = invert_permut n f m).
+apply invert_permut_f.
+cut (permut (invert_permut n f) n).unfold permut in Hcut.
+elim Hcut.apply H2.assumption.
+apply permut_invert_permut.assumption.
+unfold permut in H1.elim H1.assumption.
+qed.
+
+theorem permut_n_to_eq_n: \forall h:nat \to nat.\forall n:nat.
+permut h n \to (\forall m:nat. m < n \to h m = m) \to h n = n.
+intros.unfold permut in H.elim H.
+cut (invert_permut n h n < n \lor invert_permut n h n = n).
+elim Hcut.
+rewrite < (f_invert_permut h n n) in \vdash (? ? ? %).
+apply eq_f.
+rewrite < (f_invert_permut h n n) in \vdash (? ? % ?).
+apply H1.assumption.apply le_n.assumption.apply le_n.assumption.
+rewrite < H4 in \vdash (? ? % ?).
+apply (f_invert_permut h).apply le_n.assumption.
+apply le_to_or_lt_eq.
+cut (permut (invert_permut n h) n).
+unfold permut in Hcut.elim Hcut.
+apply H4.apply le_n.
+apply permut_invert_permut.assumption.
+qed.
+
+theorem permut_n_to_le: \forall h:nat \to nat.\forall k,n:nat.
+k \le n \to permut h n \to (\forall m:nat. m < k \to h m = m) \to
+\forall j. k \le j \to j \le n \to k \le h j.
+intros.unfold permut in H1.elim H1.
+cut (h j < k \lor \not(h j < k)).
+elim Hcut.absurd (k \le j).assumption.
+apply lt_to_not_le.
+cut (h j = j).rewrite < Hcut1.assumption.
+apply H6.apply H5.assumption.assumption.
+apply H2.assumption.
+apply not_lt_to_le.assumption.
+apply (decidable_lt (h j) k).
+qed.
+
+(* applications *)
+
+let rec map_iter_i k (g:nat \to nat) f (i:nat) \def
+ match k with
+ [ O \Rightarrow g i
+ | (S k) \Rightarrow f (g (S (k+i))) (map_iter_i k g f i)].
+
+theorem eq_map_iter_i: \forall g1,g2:nat \to nat.
+\forall f:nat \to nat \to nat. \forall n,i:nat.
+(\forall m:nat. i\le m \to m \le n+i \to g1 m = g2 m) \to
+map_iter_i n g1 f i = map_iter_i n g2 f i.
+intros 5.elim n.simplify.apply H.apply le_n.
+apply le_n.simplify.apply eq_f2.apply H1.simplify.
+apply le_S.apply le_plus_n.simplify.apply le_n.
+apply H.intros.apply H1.assumption.simplify.apply le_S.assumption.
+qed.
+
+(* map_iter examples *)
+
+theorem eq_map_iter_i_sigma: \forall g:nat \to nat. \forall n,m:nat.
+map_iter_i n g plus m = sigma n g m.
+intros.elim n.simplify.reflexivity.
+simplify.
+apply eq_f.assumption.
+qed.
+
+theorem eq_map_iter_i_pi: \forall g:nat \to nat. \forall n,m:nat.
+map_iter_i n g times m = pi n g m.
+intros.elim n.simplify.reflexivity.
+simplify.
+apply eq_f.assumption.
+qed.
+
+theorem eq_map_iter_i_fact: \forall n:nat.
+map_iter_i n (\lambda m.m) times (S O) = (S n)!.
+intros.elim n.
+simplify.reflexivity.
+change with
+(((S n1)+(S O))*(map_iter_i n1 (\lambda m.m) times (S O)) = (S(S n1))*(S n1)!).
+rewrite < plus_n_Sm.rewrite < plus_n_O.
+apply eq_f.assumption.
+qed.
+
+theorem eq_map_iter_i_transpose_l : \forall f:nat\to nat \to nat.associative nat f \to
+symmetric2 nat nat f \to \forall g:nat \to nat. \forall n,k:nat.
+map_iter_i (S k) g f n = map_iter_i (S k) (\lambda m. g (transpose (k+n) (S k+n) m)) f n.
+intros.apply (nat_case1 k).
+intros.simplify.
+change with
+(f (g (S n)) (g n) =
+f (g (transpose n (S n) (S n))) (g (transpose n (S n) n))).
+rewrite > transpose_i_j_i.
+rewrite > transpose_i_j_j.
+apply H1.
+intros.
+change with
+(f (g (S (S (m+n)))) (f (g (S (m+n))) (map_iter_i m g f n)) =
+f (g (transpose (S m + n) (S (S m) + n) (S (S m)+n)))
+(f (g (transpose (S m + n) (S (S m) + n) (S m+n)))
+(map_iter_i m (\lambda m1. g (transpose (S m+n) (S (S m)+n) m1)) f n))).
+rewrite > transpose_i_j_i.
+rewrite > transpose_i_j_j.
+rewrite < H.
+rewrite < H.
+rewrite < (H1 (g (S m + n))).
+apply eq_f.
+apply eq_map_iter_i.
+intros.simplify.unfold transpose.
+rewrite > (not_eq_to_eqb_false m1 (S m+n)).
+rewrite > (not_eq_to_eqb_false m1 (S (S m)+n)).
+simplify.
+reflexivity.
+apply (lt_to_not_eq m1 (S ((S m)+n))).
+unfold lt.apply le_S_S.change with (m1 \leq S (m+n)).apply le_S.assumption.
+apply (lt_to_not_eq m1 (S m+n)).
+simplify.unfold lt.apply le_S_S.assumption.
+qed.
+
+theorem eq_map_iter_i_transpose_i_Si : \forall f:nat\to nat \to nat.associative nat f \to
+symmetric2 nat nat f \to \forall g:nat \to nat. \forall n,k,i:nat. n \le i \to i \le k+n \to
+map_iter_i (S k) g f n = map_iter_i (S k) (\lambda m. g (transpose i (S i) m)) f n.
+intros 6.elim k.cut (i=n).
+rewrite > Hcut.
+apply (eq_map_iter_i_transpose_l f H H1 g n O).
+apply antisymmetric_le.assumption.assumption.
+cut (i < S n1 + n \lor i = S n1 + n).
+elim Hcut.
+change with
+(f (g (S (S n1)+n)) (map_iter_i (S n1) g f n) =
+f (g (transpose i (S i) (S (S n1)+n))) (map_iter_i (S n1) (\lambda m. g (transpose i (S i) m)) f n)).
+apply eq_f2.unfold transpose.
+rewrite > (not_eq_to_eqb_false (S (S n1)+n) i).
+rewrite > (not_eq_to_eqb_false (S (S n1)+n) (S i)).
+simplify.reflexivity.
+simplify.unfold Not.intro.
+apply (lt_to_not_eq i (S n1+n)).assumption.
+apply inj_S.apply sym_eq. assumption.
+simplify.unfold Not.intro.
+apply (lt_to_not_eq i (S (S n1+n))).simplify.unfold lt.
+apply le_S_S.assumption.
+apply sym_eq. assumption.
+apply H2.assumption.apply le_S_S_to_le.
+assumption.
+rewrite > H5.
+apply (eq_map_iter_i_transpose_l f H H1 g n (S n1)).
+apply le_to_or_lt_eq.assumption.
+qed.
+
+theorem eq_map_iter_i_transpose:
+\forall f:nat\to nat \to nat.
+associative nat f \to symmetric2 nat nat f \to \forall n,k,o:nat.
+\forall g:nat \to nat. \forall i:nat. n \le i \to S (o + i) \le S k+n \to
+map_iter_i (S k) g f n = map_iter_i (S k) (\lambda m. g (transpose i (S(o + i)) m)) f n.
+intros 6.
+apply (nat_elim1 o).
+intro.
+apply (nat_case m ?).
+intros.
+apply (eq_map_iter_i_transpose_i_Si ? H H1).
+exact H3.apply le_S_S_to_le.assumption.
+intros.
+apply (trans_eq ? ? (map_iter_i (S k) (\lambda m. g (transpose i (S(m1 + i)) m)) f n)).
+apply H2.
+unfold lt. apply le_n.assumption.
+apply (trans_le ? (S(S (m1+i)))).
+apply le_S.apply le_n.assumption.
+apply (trans_eq ? ? (map_iter_i (S k) (\lambda m. g
+(transpose i (S(m1 + i)) (transpose (S(m1 + i)) (S(S(m1 + i))) m))) f n)).
+apply (H2 O ? ? (S(m1+i))).
+unfold lt.apply le_S_S.apply le_O_n.
+apply (trans_le ? i).assumption.
+change with (i \le (S m1)+i).apply le_plus_n.
+exact H4.
+apply (trans_eq ? ? (map_iter_i (S k) (\lambda m. g
+(transpose i (S(m1 + i))
+(transpose (S(m1 + i)) (S(S(m1 + i)))
+(transpose i (S(m1 + i)) m)))) f n)).
+apply (H2 m1).
+unfold lt. apply le_n.assumption.
+apply (trans_le ? (S(S (m1+i)))).
+apply le_S.apply le_n.assumption.
+apply eq_map_iter_i.
+intros.apply eq_f.
+apply sym_eq. apply eq_transpose.
+unfold Not. intro.
+apply (not_le_Sn_n i).
+rewrite < H7 in \vdash (? ? %).
+apply le_S_S.apply le_S.
+apply le_plus_n.
+unfold Not. intro.
+apply (not_le_Sn_n i).
+rewrite > H7 in \vdash (? ? %).
+apply le_S_S.
+apply le_plus_n.
+unfold Not. intro.
+apply (not_eq_n_Sn (S m1+i)).
+apply sym_eq.assumption.
+qed.
+
+theorem eq_map_iter_i_transpose1: \forall f:nat\to nat \to nat.associative nat f \to
+symmetric2 nat nat f \to \forall n,k,i,j:nat.
+\forall g:nat \to nat. n \le i \to i < j \to j \le S k+n \to
+map_iter_i (S k) g f n = map_iter_i (S k) (\lambda m. g (transpose i j m)) f n.
+intros.
+simplify in H3.
+cut ((S i) < j \lor (S i) = j).
+elim Hcut.
+cut (j = S ((j - (S i)) + i)).
+rewrite > Hcut1.
+apply (eq_map_iter_i_transpose f H H1 n k (j - (S i)) g i).
+assumption.
+rewrite < Hcut1.assumption.
+rewrite > plus_n_Sm.
+apply plus_minus_m_m.apply lt_to_le.assumption.
+rewrite < H5.
+apply (eq_map_iter_i_transpose_i_Si f H H1 g).
+simplify.
+assumption.apply le_S_S_to_le.
+apply (trans_le ? j).assumption.assumption.
+apply le_to_or_lt_eq.assumption.
+qed.
+
+theorem eq_map_iter_i_transpose2: \forall f:nat\to nat \to nat.associative nat f \to
+symmetric2 nat nat f \to \forall n,k,i,j:nat.
+\forall g:nat \to nat. n \le i \to i \le (S k+n) \to n \le j \to j \le (S k+n) \to
+map_iter_i (S k) g f n = map_iter_i (S k) (\lambda m. g (transpose i j m)) f n.
+intros.
+apply (nat_compare_elim i j).
+intro.apply (eq_map_iter_i_transpose1 f H H1 n k i j g H2 H6 H5).
+intro.rewrite > H6.
+apply eq_map_iter_i.intros.
+rewrite > (transpose_i_i j).reflexivity.
+intro.
+apply (trans_eq ? ? (map_iter_i (S k) (\lambda m:nat.g (transpose j i m)) f n)).
+apply (eq_map_iter_i_transpose1 f H H1 n k j i g H4 H6 H3).
+apply eq_map_iter_i.
+intros.apply eq_f.apply transpose_i_j_j_i.
+qed.
+
+theorem permut_to_eq_map_iter_i:\forall f:nat\to nat \to nat.associative nat f \to
+symmetric2 nat nat f \to \forall k,n:nat.\forall g,h:nat \to nat.
+permut h (k+n) \to (\forall m:nat. m \lt n \to h m = m) \to
+map_iter_i k g f n = map_iter_i k (\lambda m.g(h m)) f n.
+intros 4.elim k.
+simplify.rewrite > (permut_n_to_eq_n h).reflexivity.assumption.assumption.
+apply (trans_eq ? ? (map_iter_i (S n) (\lambda m.g ((transpose (h (S n+n1)) (S n+n1)) m)) f n1)).
+unfold permut in H3.
+elim H3.
+apply (eq_map_iter_i_transpose2 f H H1 n1 n ? ? g).
+apply (permut_n_to_le h n1 (S n+n1)).
+apply le_plus_n.assumption.assumption.apply le_plus_n.apply le_n.
+apply H5.apply le_n.apply le_plus_n.apply le_n.
+apply (trans_eq ? ? (map_iter_i (S n) (\lambda m.
+(g(transpose (h (S n+n1)) (S n+n1)
+(transpose (h (S n+n1)) (S n+n1) (h m)))) )f n1)).
+change with
+(f (g (transpose (h (S n+n1)) (S n+n1) (S n+n1)))
+(map_iter_i n (\lambda m.
+g (transpose (h (S n+n1)) (S n+n1) m)) f n1)
+=
+f
+(g(transpose (h (S n+n1)) (S n+n1)
+(transpose (h (S n+n1)) (S n+n1) (h (S n+n1)))))
+(map_iter_i n
+(\lambda m.
+(g(transpose (h (S n+n1)) (S n+n1)
+(transpose (h (S n+n1)) (S n+n1) (h m))))) f n1)).
+apply eq_f2.apply eq_f.
+rewrite > transpose_i_j_j.
+rewrite > transpose_i_j_i.
+rewrite > transpose_i_j_j.reflexivity.
+apply (H2 n1 (\lambda m.(g(transpose (h (S n+n1)) (S n+n1) m)))).
+apply permut_S_to_permut_transpose.
+assumption.
+intros.
+unfold transpose.
+rewrite > (not_eq_to_eqb_false (h m) (h (S n+n1))).
+rewrite > (not_eq_to_eqb_false (h m) (S n+n1)).
+simplify.apply H4.assumption.
+rewrite > H4.
+apply lt_to_not_eq.apply (trans_lt ? n1).assumption.
+simplify.unfold lt.apply le_S_S.apply le_plus_n.assumption.
+unfold permut in H3.elim H3.
+simplify.unfold Not.intro.
+apply (lt_to_not_eq m (S n+n1)).apply (trans_lt ? n1).assumption.
+simplify.unfold lt.apply le_S_S.apply le_plus_n.
+unfold injn in H7.
+apply (H7 m (S n+n1)).apply (trans_le ? n1).
+apply lt_to_le.assumption.apply le_plus_n.apply le_n.
+assumption.
+apply eq_map_iter_i.intros.
+rewrite > transpose_transpose.reflexivity.
+qed.
\ No newline at end of file
diff --git a/helm/matita/library/nat/plus.ma b/helm/matita/library/nat/plus.ma
new file mode 100644
index 000000000..d595dad19
--- /dev/null
+++ b/helm/matita/library/nat/plus.ma
@@ -0,0 +1,72 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/plus".
+
+include "nat/nat.ma".
+
+let rec plus n m \def
+ match n with
+ [ O \Rightarrow m
+ | (S p) \Rightarrow S (plus p m) ].
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "natural plus" 'plus x y = (cic:/matita/nat/plus/plus.con x y).
+
+theorem plus_n_O: \forall n:nat. n = n+O.
+intros.elim n.
+simplify.reflexivity.
+simplify.apply eq_f.assumption.
+qed.
+
+theorem plus_n_Sm : \forall n,m:nat. S (n+m) = n+(S m).
+intros.elim n.
+simplify.reflexivity.
+simplify.apply eq_f.assumption.
+qed.
+
+theorem sym_plus: \forall n,m:nat. n+m = m+n.
+intros.elim n.
+simplify.apply plus_n_O.
+simplify.rewrite > H.apply plus_n_Sm.
+qed.
+
+theorem associative_plus : associative nat plus.
+unfold associative.intros.elim x.
+simplify.reflexivity.
+simplify.apply eq_f.assumption.
+qed.
+
+theorem assoc_plus : \forall n,m,p:nat. (n+m)+p = n+(m+p)
+\def associative_plus.
+
+theorem injective_plus_r: \forall n:nat.injective nat nat (\lambda m.n+m).
+intro.simplify.intros 2.elim n.
+exact H.
+apply H.apply inj_S.apply H1.
+qed.
+
+theorem inj_plus_r: \forall p,n,m:nat. p+n = p+m \to n=m
+\def injective_plus_r.
+
+theorem injective_plus_l: \forall m:nat.injective nat nat (\lambda n.n+m).
+intro.simplify.intros.
+apply (injective_plus_r m).
+rewrite < sym_plus.
+rewrite < (sym_plus y).
+assumption.
+qed.
+
+theorem inj_plus_l: \forall p,n,m:nat. n+p = m+p \to n=m
+\def injective_plus_l.
diff --git a/helm/matita/library/nat/primes.ma b/helm/matita/library/nat/primes.ma
new file mode 100644
index 000000000..50b7d1221
--- /dev/null
+++ b/helm/matita/library/nat/primes.ma
@@ -0,0 +1,591 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / Matita is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/primes".
+
+include "nat/div_and_mod.ma".
+include "nat/minimization.ma".
+include "nat/sigma_and_pi.ma".
+include "nat/factorial.ma".
+
+inductive divides (n,m:nat) : Prop \def
+witness : \forall p:nat.m = times n p \to divides n m.
+
+interpretation "divides" 'divides n m = (cic:/matita/nat/primes/divides.ind#xpointer(1/1) n m).
+interpretation "not divides" 'ndivides n m =
+ (cic:/matita/logic/connectives/Not.con (cic:/matita/nat/primes/divides.ind#xpointer(1/1) n m)).
+
+theorem reflexive_divides : reflexive nat divides.
+unfold reflexive.
+intros.
+exact (witness x x (S O) (times_n_SO x)).
+qed.
+
+theorem divides_to_div_mod_spec :
+\forall n,m. O < n \to n \divides m \to div_mod_spec m n (m / n) O.
+intros.elim H1.rewrite > H2.
+constructor 1.assumption.
+apply (lt_O_n_elim n H).intros.
+rewrite < plus_n_O.
+rewrite > div_times.apply sym_times.
+qed.
+
+theorem div_mod_spec_to_divides :
+\forall n,m,p. div_mod_spec m n p O \to n \divides m.
+intros.elim H.
+apply (witness n m p).
+rewrite < sym_times.
+rewrite > (plus_n_O (p*n)).assumption.
+qed.
+
+theorem divides_to_mod_O:
+\forall n,m. O < n \to n \divides m \to (m \mod n) = O.
+intros.apply (div_mod_spec_to_eq2 m n (m / n) (m \mod n) (m / n) O).
+apply div_mod_spec_div_mod.assumption.
+apply divides_to_div_mod_spec.assumption.assumption.
+qed.
+
+theorem mod_O_to_divides:
+\forall n,m. O< n \to (m \mod n) = O \to n \divides m.
+intros.
+apply (witness n m (m / n)).
+rewrite > (plus_n_O (n * (m / n))).
+rewrite < H1.
+rewrite < sym_times.
+(* Andrea: perche' hint non lo trova ?*)
+apply div_mod.
+assumption.
+qed.
+
+theorem divides_n_O: \forall n:nat. n \divides O.
+intro. apply (witness n O O).apply times_n_O.
+qed.
+
+theorem divides_n_n: \forall n:nat. n \divides n.
+intro. apply (witness n n (S O)).apply times_n_SO.
+qed.
+
+theorem divides_SO_n: \forall n:nat. (S O) \divides n.
+intro. apply (witness (S O) n n). simplify.apply plus_n_O.
+qed.
+
+theorem divides_plus: \forall n,p,q:nat.
+n \divides p \to n \divides q \to n \divides p+q.
+intros.
+elim H.elim H1. apply (witness n (p+q) (n2+n1)).
+rewrite > H2.rewrite > H3.apply sym_eq.apply distr_times_plus.
+qed.
+
+theorem divides_minus: \forall n,p,q:nat.
+divides n p \to divides n q \to divides n (p-q).
+intros.
+elim H.elim H1. apply (witness n (p-q) (n2-n1)).
+rewrite > H2.rewrite > H3.apply sym_eq.apply distr_times_minus.
+qed.
+
+theorem divides_times: \forall n,m,p,q:nat.
+n \divides p \to m \divides q \to n*m \divides p*q.
+intros.
+elim H.elim H1. apply (witness (n*m) (p*q) (n2*n1)).
+rewrite > H2.rewrite > H3.
+apply (trans_eq nat ? (n*(m*(n2*n1)))).
+apply (trans_eq nat ? (n*(n2*(m*n1)))).
+apply assoc_times.
+apply eq_f.
+apply (trans_eq nat ? ((n2*m)*n1)).
+apply sym_eq. apply assoc_times.
+rewrite > (sym_times n2 m).apply assoc_times.
+apply sym_eq. apply assoc_times.
+qed.
+
+theorem transitive_divides: transitive ? divides.
+unfold.
+intros.
+elim H.elim H1. apply (witness x z (n2*n)).
+rewrite > H3.rewrite > H2.
+apply assoc_times.
+qed.
+
+variant trans_divides: \forall n,m,p.
+ n \divides m \to m \divides p \to n \divides p \def transitive_divides.
+
+theorem eq_mod_to_divides:\forall n,m,p. O< p \to
+mod n p = mod m p \to divides p (n-m).
+intros.
+cut (n \le m \or \not n \le m).
+elim Hcut.
+cut (n-m=O).
+rewrite > Hcut1.
+apply (witness p O O).
+apply times_n_O.
+apply eq_minus_n_m_O.
+assumption.
+apply (witness p (n-m) ((div n p)-(div m p))).
+rewrite > distr_times_minus.
+rewrite > sym_times.
+rewrite > (sym_times p).
+cut ((div n p)*p = n - (mod n p)).
+rewrite > Hcut1.
+rewrite > eq_minus_minus_minus_plus.
+rewrite > sym_plus.
+rewrite > H1.
+rewrite < div_mod.reflexivity.
+assumption.
+apply sym_eq.
+apply plus_to_minus.
+rewrite > sym_plus.
+apply div_mod.
+assumption.
+apply (decidable_le n m).
+qed.
+
+theorem antisymmetric_divides: antisymmetric nat divides.
+unfold antisymmetric.intros.elim H. elim H1.
+apply (nat_case1 n2).intro.
+rewrite > H3.rewrite > H2.rewrite > H4.
+rewrite < times_n_O.reflexivity.
+intros.
+apply (nat_case1 n).intro.
+rewrite > H2.rewrite > H3.rewrite > H5.
+rewrite < times_n_O.reflexivity.
+intros.
+apply antisymmetric_le.
+rewrite > H2.rewrite > times_n_SO in \vdash (? % ?).
+apply le_times_r.rewrite > H4.apply le_S_S.apply le_O_n.
+rewrite > H3.rewrite > times_n_SO in \vdash (? % ?).
+apply le_times_r.rewrite > H5.apply le_S_S.apply le_O_n.
+qed.
+
+(* divides le *)
+theorem divides_to_le : \forall n,m. O < m \to n \divides m \to n \le m.
+intros. elim H1.rewrite > H2.cut (O < n2).
+apply (lt_O_n_elim n2 Hcut).intro.rewrite < sym_times.
+simplify.rewrite < sym_plus.
+apply le_plus_n.
+elim (le_to_or_lt_eq O n2).
+assumption.
+absurd (O<m).assumption.
+rewrite > H2.rewrite < H3.rewrite < times_n_O.
+apply (not_le_Sn_n O).
+apply le_O_n.
+qed.
+
+theorem divides_to_lt_O : \forall n,m. O < m \to n \divides m \to O < n.
+intros.elim H1.
+elim (le_to_or_lt_eq O n (le_O_n n)).
+assumption.
+rewrite < H3.absurd (O < m).assumption.
+rewrite > H2.rewrite < H3.
+simplify.exact (not_le_Sn_n O).
+qed.
+
+(* boolean divides *)
+definition divides_b : nat \to nat \to bool \def
+\lambda n,m :nat. (eqb (m \mod n) O).
+
+theorem divides_b_to_Prop :
+\forall n,m:nat. O < n \to
+match divides_b n m with
+[ true \Rightarrow n \divides m
+| false \Rightarrow n \ndivides m].
+intros.
+change with
+match eqb (m \mod n) O with
+[ true \Rightarrow n \divides m
+| false \Rightarrow n \ndivides m].
+apply eqb_elim.
+intro.simplify.apply mod_O_to_divides.assumption.assumption.
+intro.simplify.unfold Not.intro.apply H1.apply divides_to_mod_O.assumption.assumption.
+qed.
+
+theorem divides_b_true_to_divides :
+\forall n,m:nat. O < n \to
+(divides_b n m = true ) \to n \divides m.
+intros.
+change with
+match true with
+[ true \Rightarrow n \divides m
+| false \Rightarrow n \ndivides m].
+rewrite < H1.apply divides_b_to_Prop.
+assumption.
+qed.
+
+theorem divides_b_false_to_not_divides :
+\forall n,m:nat. O < n \to
+(divides_b n m = false ) \to n \ndivides m.
+intros.
+change with
+match false with
+[ true \Rightarrow n \divides m
+| false \Rightarrow n \ndivides m].
+rewrite < H1.apply divides_b_to_Prop.
+assumption.
+qed.
+
+theorem decidable_divides: \forall n,m:nat.O < n \to
+decidable (n \divides m).
+intros.change with ((n \divides m) \lor n \ndivides m).
+cut
+(match divides_b n m with
+[ true \Rightarrow n \divides m
+| false \Rightarrow n \ndivides m] \to n \divides m \lor n \ndivides m).
+apply Hcut.apply divides_b_to_Prop.assumption.
+elim (divides_b n m).left.apply H1.right.apply H1.
+qed.
+
+theorem divides_to_divides_b_true : \forall n,m:nat. O < n \to
+n \divides m \to divides_b n m = true.
+intros.
+cut (match (divides_b n m) with
+[ true \Rightarrow n \divides m
+| false \Rightarrow n \ndivides m] \to ((divides_b n m) = true)).
+apply Hcut.apply divides_b_to_Prop.assumption.
+elim (divides_b n m).reflexivity.
+absurd (n \divides m).assumption.assumption.
+qed.
+
+theorem not_divides_to_divides_b_false: \forall n,m:nat. O < n \to
+\lnot(n \divides m) \to (divides_b n m) = false.
+intros.
+cut (match (divides_b n m) with
+[ true \Rightarrow n \divides m
+| false \Rightarrow n \ndivides m] \to ((divides_b n m) = false)).
+apply Hcut.apply divides_b_to_Prop.assumption.
+elim (divides_b n m).
+absurd (n \divides m).assumption.assumption.
+reflexivity.
+qed.
+
+(* divides and pi *)
+theorem divides_f_pi_f : \forall f:nat \to nat.\forall n,m,i:nat.
+m \le i \to i \le n+m \to f i \divides pi n f m.
+intros 5.elim n.simplify.
+cut (i = m).rewrite < Hcut.apply divides_n_n.
+apply antisymmetric_le.assumption.assumption.
+simplify.
+cut (i < S n1+m \lor i = S n1 + m).
+elim Hcut.
+apply (transitive_divides ? (pi n1 f m)).
+apply H1.apply le_S_S_to_le. assumption.
+apply (witness ? ? (f (S n1+m))).apply sym_times.
+rewrite > H3.
+apply (witness ? ? (pi n1 f m)).reflexivity.
+apply le_to_or_lt_eq.assumption.
+qed.
+
+(*
+theorem mod_S_pi: \forall f:nat \to nat.\forall n,i:nat.
+i < n \to (S O) < (f i) \to (S (pi n f)) \mod (f i) = (S O).
+intros.cut (pi n f) \mod (f i) = O.
+rewrite < Hcut.
+apply mod_S.apply trans_lt O (S O).apply le_n (S O).assumption.
+rewrite > Hcut.assumption.
+apply divides_to_mod_O.apply trans_lt O (S O).apply le_n (S O).assumption.
+apply divides_f_pi_f.assumption.
+qed.
+*)
+
+(* divides and fact *)
+theorem divides_fact : \forall n,i:nat.
+O < i \to i \le n \to i \divides n!.
+intros 3.elim n.absurd (O<i).assumption.apply (le_n_O_elim i H1).
+apply (not_le_Sn_O O).
+change with (i \divides (S n1)*n1!).
+apply (le_n_Sm_elim i n1 H2).
+intro.
+apply (transitive_divides ? n1!).
+apply H1.apply le_S_S_to_le. assumption.
+apply (witness ? ? (S n1)).apply sym_times.
+intro.
+rewrite > H3.
+apply (witness ? ? n1!).reflexivity.
+qed.
+
+theorem mod_S_fact: \forall n,i:nat.
+(S O) < i \to i \le n \to (S n!) \mod i = (S O).
+intros.cut (n! \mod i = O).
+rewrite < Hcut.
+apply mod_S.apply (trans_lt O (S O)).apply (le_n (S O)).assumption.
+rewrite > Hcut.assumption.
+apply divides_to_mod_O.apply (trans_lt O (S O)).apply (le_n (S O)).assumption.
+apply divides_fact.apply (trans_lt O (S O)).apply (le_n (S O)).assumption.
+assumption.
+qed.
+
+theorem not_divides_S_fact: \forall n,i:nat.
+(S O) < i \to i \le n \to i \ndivides S n!.
+intros.
+apply divides_b_false_to_not_divides.
+apply (trans_lt O (S O)).apply (le_n (S O)).assumption.
+change with ((eqb ((S n!) \mod i) O) = false).
+rewrite > mod_S_fact.simplify.reflexivity.
+assumption.assumption.
+qed.
+
+(* prime *)
+definition prime : nat \to Prop \def
+\lambda n:nat. (S O) < n \land
+(\forall m:nat. m \divides n \to (S O) < m \to m = n).
+
+theorem not_prime_O: \lnot (prime O).
+unfold Not.unfold prime.intro.elim H.apply (not_le_Sn_O (S O) H1).
+qed.
+
+theorem not_prime_SO: \lnot (prime (S O)).
+unfold Not.unfold prime.intro.elim H.apply (not_le_Sn_n (S O) H1).
+qed.
+
+(* smallest factor *)
+definition smallest_factor : nat \to nat \def
+\lambda n:nat.
+match n with
+[ O \Rightarrow O
+| (S p) \Rightarrow
+ match p with
+ [ O \Rightarrow (S O)
+ | (S q) \Rightarrow min_aux q (S(S q)) (\lambda m.(eqb ((S(S q)) \mod m) O))]].
+
+(* it works !
+theorem example1 : smallest_prime_factor (S(S(S O))) = (S(S(S O))).
+normalize.reflexivity.
+qed.
+
+theorem example2: smallest_prime_factor (S(S(S(S O)))) = (S(S O)).
+normalize.reflexivity.
+qed.
+
+theorem example3 : smallest_prime_factor (S(S(S(S(S(S(S O))))))) = (S(S(S(S(S(S(S O))))))).
+simplify.reflexivity.
+qed. *)
+
+theorem lt_SO_smallest_factor:
+\forall n:nat. (S O) < n \to (S O) < (smallest_factor n).
+intro.
+apply (nat_case n).intro.apply False_ind.apply (not_le_Sn_O (S O) H).
+intro.apply (nat_case m).intro. apply False_ind.apply (not_le_Sn_n (S O) H).
+intros.
+change with
+(S O < min_aux m1 (S(S m1)) (\lambda m.(eqb ((S(S m1)) \mod m) O))).
+apply (lt_to_le_to_lt ? (S (S O))).
+apply (le_n (S(S O))).
+cut ((S(S O)) = (S(S m1)) - m1).
+rewrite > Hcut.
+apply le_min_aux.
+apply sym_eq.apply plus_to_minus.
+rewrite < sym_plus.simplify.reflexivity.
+qed.
+
+theorem lt_O_smallest_factor: \forall n:nat. O < n \to O < (smallest_factor n).
+intro.
+apply (nat_case n).intro.apply False_ind.apply (not_le_Sn_n O H).
+intro.apply (nat_case m).intro.
+simplify.unfold lt.apply le_n.
+intros.apply (trans_lt ? (S O)).
+unfold lt.apply le_n.
+apply lt_SO_smallest_factor.unfold lt. apply le_S_S.
+apply le_S_S.apply le_O_n.
+qed.
+
+theorem divides_smallest_factor_n :
+\forall n:nat. O < n \to smallest_factor n \divides n.
+intro.
+apply (nat_case n).intro.apply False_ind.apply (not_le_Sn_O O H).
+intro.apply (nat_case m).intro. simplify.
+apply (witness ? ? (S O)). simplify.reflexivity.
+intros.
+apply divides_b_true_to_divides.
+apply (lt_O_smallest_factor ? H).
+change with
+(eqb ((S(S m1)) \mod (min_aux m1 (S(S m1))
+ (\lambda m.(eqb ((S(S m1)) \mod m) O)))) O = true).
+apply f_min_aux_true.
+apply (ex_intro nat ? (S(S m1))).
+split.split.
+apply le_minus_m.apply le_n.
+rewrite > mod_n_n.reflexivity.
+apply (trans_lt ? (S O)).apply (le_n (S O)).unfold lt.
+apply le_S_S.apply le_S_S.apply le_O_n.
+qed.
+
+theorem le_smallest_factor_n :
+\forall n:nat. smallest_factor n \le n.
+intro.apply (nat_case n).simplify.reflexivity.
+intro.apply (nat_case m).simplify.reflexivity.
+intro.apply divides_to_le.
+unfold lt.apply le_S_S.apply le_O_n.
+apply divides_smallest_factor_n.
+unfold lt.apply le_S_S.apply le_O_n.
+qed.
+
+theorem lt_smallest_factor_to_not_divides: \forall n,i:nat.
+(S O) < n \to (S O) < i \to i < (smallest_factor n) \to i \ndivides n.
+intros 2.
+apply (nat_case n).intro.apply False_ind.apply (not_le_Sn_O (S O) H).
+intro.apply (nat_case m).intro. apply False_ind.apply (not_le_Sn_n (S O) H).
+intros.
+apply divides_b_false_to_not_divides.
+apply (trans_lt O (S O)).apply (le_n (S O)).assumption.
+change with ((eqb ((S(S m1)) \mod i) O) = false).
+apply (lt_min_aux_to_false
+(\lambda i:nat.eqb ((S(S m1)) \mod i) O) (S(S m1)) m1 i).
+cut ((S(S O)) = (S(S m1)-m1)).
+rewrite < Hcut.exact H1.
+apply sym_eq. apply plus_to_minus.
+rewrite < sym_plus.simplify.reflexivity.
+exact H2.
+qed.
+
+theorem prime_smallest_factor_n :
+\forall n:nat. (S O) < n \to prime (smallest_factor n).
+intro. change with ((S(S O)) \le n \to (S O) < (smallest_factor n) \land
+(\forall m:nat. m \divides smallest_factor n \to (S O) < m \to m = (smallest_factor n))).
+intro.split.
+apply lt_SO_smallest_factor.assumption.
+intros.
+cut (le m (smallest_factor n)).
+elim (le_to_or_lt_eq m (smallest_factor n) Hcut).
+absurd (m \divides n).
+apply (transitive_divides m (smallest_factor n)).
+assumption.
+apply divides_smallest_factor_n.
+apply (trans_lt ? (S O)). unfold lt. apply le_n. exact H.
+apply lt_smallest_factor_to_not_divides.
+exact H.assumption.assumption.assumption.
+apply divides_to_le.
+apply (trans_lt O (S O)).
+apply (le_n (S O)).
+apply lt_SO_smallest_factor.
+exact H.
+assumption.
+qed.
+
+theorem prime_to_smallest_factor: \forall n. prime n \to
+smallest_factor n = n.
+intro.apply (nat_case n).intro.apply False_ind.apply (not_prime_O H).
+intro.apply (nat_case m).intro.apply False_ind.apply (not_prime_SO H).
+intro.
+change with
+((S O) < (S(S m1)) \land
+(\forall m:nat. m \divides S(S m1) \to (S O) < m \to m = (S(S m1))) \to
+smallest_factor (S(S m1)) = (S(S m1))).
+intro.elim H.apply H2.
+apply divides_smallest_factor_n.
+apply (trans_lt ? (S O)).unfold lt. apply le_n.assumption.
+apply lt_SO_smallest_factor.
+assumption.
+qed.
+
+(* a number n > O is prime iff its smallest factor is n *)
+definition primeb \def \lambda n:nat.
+match n with
+[ O \Rightarrow false
+| (S p) \Rightarrow
+ match p with
+ [ O \Rightarrow false
+ | (S q) \Rightarrow eqb (smallest_factor (S(S q))) (S(S q))]].
+
+(* it works!
+theorem example4 : primeb (S(S(S O))) = true.
+normalize.reflexivity.
+qed.
+
+theorem example5 : primeb (S(S(S(S(S(S O)))))) = false.
+normalize.reflexivity.
+qed.
+
+theorem example6 : primeb (S(S(S(S((S(S(S(S(S(S(S O)))))))))))) = true.
+normalize.reflexivity.
+qed.
+
+theorem example7 : primeb (S(S(S(S(S(S((S(S(S(S((S(S(S(S(S(S(S O))))))))))))))))))) = true.
+normalize.reflexivity.
+qed. *)
+
+theorem primeb_to_Prop: \forall n.
+match primeb n with
+[ true \Rightarrow prime n
+| false \Rightarrow \lnot (prime n)].
+intro.
+apply (nat_case n).simplify.unfold Not.unfold prime.intro.elim H.apply (not_le_Sn_O (S O) H1).
+intro.apply (nat_case m).simplify.unfold Not.unfold prime.intro.elim H.apply (not_le_Sn_n (S O) H1).
+intro.
+change with
+match eqb (smallest_factor (S(S m1))) (S(S m1)) with
+[ true \Rightarrow prime (S(S m1))
+| false \Rightarrow \lnot (prime (S(S m1)))].
+apply (eqb_elim (smallest_factor (S(S m1))) (S(S m1))).
+intro.change with (prime (S(S m1))).
+rewrite < H.
+apply prime_smallest_factor_n.
+unfold lt.apply le_S_S.apply le_S_S.apply le_O_n.
+intro.change with (\lnot (prime (S(S m1)))).
+change with (prime (S(S m1)) \to False).
+intro.apply H.
+apply prime_to_smallest_factor.
+assumption.
+qed.
+
+theorem primeb_true_to_prime : \forall n:nat.
+primeb n = true \to prime n.
+intros.change with
+match true with
+[ true \Rightarrow prime n
+| false \Rightarrow \lnot (prime n)].
+rewrite < H.
+apply primeb_to_Prop.
+qed.
+
+theorem primeb_false_to_not_prime : \forall n:nat.
+primeb n = false \to \lnot (prime n).
+intros.change with
+match false with
+[ true \Rightarrow prime n
+| false \Rightarrow \lnot (prime n)].
+rewrite < H.
+apply primeb_to_Prop.
+qed.
+
+theorem decidable_prime : \forall n:nat.decidable (prime n).
+intro.change with ((prime n) \lor \lnot (prime n)).
+cut
+(match primeb n with
+[ true \Rightarrow prime n
+| false \Rightarrow \lnot (prime n)] \to (prime n) \lor \lnot (prime n)).
+apply Hcut.apply primeb_to_Prop.
+elim (primeb n).left.apply H.right.apply H.
+qed.
+
+theorem prime_to_primeb_true: \forall n:nat.
+prime n \to primeb n = true.
+intros.
+cut (match (primeb n) with
+[ true \Rightarrow prime n
+| false \Rightarrow \lnot (prime n)] \to ((primeb n) = true)).
+apply Hcut.apply primeb_to_Prop.
+elim (primeb n).reflexivity.
+absurd (prime n).assumption.assumption.
+qed.
+
+theorem not_prime_to_primeb_false: \forall n:nat.
+\lnot(prime n) \to primeb n = false.
+intros.
+cut (match (primeb n) with
+[ true \Rightarrow prime n
+| false \Rightarrow \lnot (prime n)] \to ((primeb n) = false)).
+apply Hcut.apply primeb_to_Prop.
+elim (primeb n).
+absurd (prime n).assumption.assumption.
+reflexivity.
+qed.
+
diff --git a/helm/matita/library/nat/primes1.ma b/helm/matita/library/nat/primes1.ma
new file mode 100644
index 000000000..3ec61ee4a
--- /dev/null
+++ b/helm/matita/library/nat/primes1.ma
@@ -0,0 +1,38 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / Matita is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/primes1".
+
+include "datatypes/constructors.ma".
+include "nat/primes.ma".
+
+(* p is just an upper bound, acc is an accumulator *)
+let rec n_divides_aux p n m acc \def
+ match n \mod m with
+ [ O \Rightarrow
+ match p with
+ [ O \Rightarrow pair nat nat acc n
+ | (S p) \Rightarrow n_divides_aux p (n / m) m (S acc)]
+ | (S a) \Rightarrow pair nat nat acc n].
+
+(* n_divides n m = <q,r> if m divides n q times, with remainder r *)
+definition n_divides \def \lambda n,m:nat.n_divides_aux n n m O.
+
+(*
+theorem n_divides_to_Prop: \forall n,m,p,a.
+ match n_divides_aux p n m a with
+ [ (pair q r) \Rightarrow n = m \sup a *r].
+intros.
+apply nat_case (n \mod m). *)
+
diff --git a/helm/matita/library/nat/relevant_equations.ma b/helm/matita/library/nat/relevant_equations.ma
new file mode 100644
index 000000000..f4cf43775
--- /dev/null
+++ b/helm/matita/library/nat/relevant_equations.ma
@@ -0,0 +1,50 @@
+(**************************************************************************)
+(* __ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/relevant_equations.ma".
+
+include "nat/times.ma".
+include "nat/minus.ma".
+
+theorem times_plus_l: \forall n,m,p:nat. (n+m)*p = n*p + m*p.
+intros.
+apply (trans_eq ? ? (p*(n+m))).
+apply sym_times.
+apply (trans_eq ? ? (p*n+p*m)).
+apply distr_times_plus.
+apply eq_f2.
+apply sym_times.
+apply sym_times.
+qed.
+
+theorem times_minus_l: \forall n,m,p:nat. (n-m)*p = n*p - m*p.
+intros.
+apply (trans_eq ? ? (p*(n-m))).
+apply sym_times.
+apply (trans_eq ? ? (p*n-p*m)).
+apply distr_times_minus.
+apply eq_f2.
+apply sym_times.
+apply sym_times.
+qed.
+
+theorem times_plus_plus: \forall n,m,p,q:nat. (n + m)*(p + q) =
+n*p + n*q + m*p + m*q.
+intros.
+apply (trans_eq nat ? ((n*(p+q) + m*(p+q)))).
+apply times_plus_l.
+rewrite > distr_times_plus.
+rewrite > distr_times_plus.
+rewrite < assoc_plus.reflexivity.
+qed.
diff --git a/helm/matita/library/nat/sigma_and_pi.ma b/helm/matita/library/nat/sigma_and_pi.ma
new file mode 100644
index 000000000..4f5f6cba0
--- /dev/null
+++ b/helm/matita/library/nat/sigma_and_pi.ma
@@ -0,0 +1,79 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / Matita is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/sigma_and_pi".
+
+include "nat/factorial.ma".
+include "nat/lt_arith.ma".
+include "nat/exp.ma".
+
+let rec sigma n f m \def
+ match n with
+ [ O \Rightarrow (f m)
+ | (S p) \Rightarrow (f (S p+m))+(sigma p f m)].
+
+let rec pi n f m \def
+ match n with
+ [ O \Rightarrow f m
+ | (S p) \Rightarrow (f (S p+m))*(pi p f m)].
+
+theorem eq_sigma: \forall f,g:nat \to nat.
+\forall n,m:nat.
+(\forall i:nat. m \le i \to i \le m+n \to f i = g i) \to
+(sigma n f m) = (sigma n g m).
+intros 3.elim n.
+simplify.apply H.apply le_n.rewrite < plus_n_O.apply le_n.
+simplify.
+apply eq_f2.apply H1.
+change with (m \le (S n1)+m).apply le_plus_n.
+rewrite > (sym_plus m).apply le_n.
+apply H.intros.apply H1.assumption.
+rewrite < plus_n_Sm.
+apply le_S.assumption.
+qed.
+
+theorem eq_pi: \forall f,g:nat \to nat.
+\forall n,m:nat.
+(\forall i:nat. m \le i \to i \le m+n \to f i = g i) \to
+(pi n f m) = (pi n g m).
+intros 3.elim n.
+simplify.apply H.apply le_n.rewrite < plus_n_O.apply le_n.
+simplify.
+apply eq_f2.apply H1.
+change with (m \le (S n1)+m).apply le_plus_n.
+rewrite > (sym_plus m).apply le_n.
+apply H.intros.apply H1.assumption.
+rewrite < plus_n_Sm.
+apply le_S.assumption.
+qed.
+
+theorem eq_fact_pi: \forall n. (S n)! = pi n (\lambda m.m) (S O).
+intro.elim n.
+simplify.reflexivity.
+change with ((S(S n1))*(S n1)! = ((S n1)+(S O))*(pi n1 (\lambda m.m) (S O))).
+rewrite < plus_n_Sm.rewrite < plus_n_O.
+apply eq_f.assumption.
+qed.
+
+theorem exp_pi_l: \forall f:nat\to nat.\forall n,m,a:nat.
+(exp a (S n))*pi n f m= pi n (\lambda p.a*(f p)) m.
+intros.elim n.simplify.rewrite < times_n_SO.reflexivity.
+simplify.
+rewrite < H.
+rewrite > assoc_times.
+rewrite > assoc_times in\vdash (? ? ? %).
+apply eq_f.rewrite < assoc_times.
+rewrite < assoc_times.
+apply eq_f2.apply sym_times.reflexivity.
+qed.
diff --git a/helm/matita/library/nat/times.ma b/helm/matita/library/nat/times.ma
new file mode 100644
index 000000000..2ae5ffd74
--- /dev/null
+++ b/helm/matita/library/nat/times.ma
@@ -0,0 +1,87 @@
+(**************************************************************************)
+(* __ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/times".
+
+include "nat/plus.ma".
+
+let rec times n m \def
+ match n with
+ [ O \Rightarrow O
+ | (S p) \Rightarrow m+(times p m) ].
+
+(*CSC: the URI must disappear: there is a bug now *)
+interpretation "natural times" 'times x y = (cic:/matita/nat/times/times.con x y).
+
+theorem times_n_O: \forall n:nat. O = n*O.
+intros.elim n.
+simplify.reflexivity.
+simplify.assumption.
+qed.
+
+theorem times_n_Sm :
+\forall n,m:nat. n+(n*m) = n*(S m).
+intros.elim n.
+simplify.reflexivity.
+simplify.apply eq_f.rewrite < H.
+transitivity ((n1+m)+n1*m).symmetry.apply assoc_plus.
+transitivity ((m+n1)+n1*m).
+apply eq_f2.
+apply sym_plus.
+reflexivity.
+apply assoc_plus.
+qed.
+
+theorem times_n_SO : \forall n:nat. n = n * S O.
+intros.
+rewrite < times_n_Sm.
+rewrite < times_n_O.
+rewrite < plus_n_O.
+reflexivity.
+qed.
+
+theorem symmetric_times : symmetric nat times.
+unfold symmetric.
+intros.elim x.
+simplify.apply times_n_O.
+simplify.rewrite > H.apply times_n_Sm.
+qed.
+
+variant sym_times : \forall n,m:nat. n*m = m*n \def
+symmetric_times.
+
+theorem distributive_times_plus : distributive nat times plus.
+unfold distributive.
+intros.elim x.
+simplify.reflexivity.
+simplify.rewrite > H. rewrite > assoc_plus.rewrite > assoc_plus.
+apply eq_f.rewrite < assoc_plus. rewrite < (sym_plus ? z).
+rewrite > assoc_plus.reflexivity.
+qed.
+
+variant distr_times_plus: \forall n,m,p:nat. n*(m+p) = n*m + n*p
+\def distributive_times_plus.
+
+theorem associative_times: associative nat times.
+unfold associative.intros.
+elim x.simplify.apply refl_eq.
+simplify.rewrite < sym_times.
+rewrite > distr_times_plus.
+rewrite < sym_times.
+rewrite < (sym_times (times n y) z).
+rewrite < H.apply refl_eq.
+qed.
+
+variant assoc_times: \forall n,m,p:nat. (n*m)*p = n*(m*p) \def
+associative_times.
diff --git a/helm/matita/library/nat/totient.ma b/helm/matita/library/nat/totient.ma
new file mode 100644
index 000000000..24c3920ed
--- /dev/null
+++ b/helm/matita/library/nat/totient.ma
@@ -0,0 +1,102 @@
+(**************************************************************************)
+(* __ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| A.Asperti, C.Sacerdoti Coen, *)
+(* ||A|| E.Tassi, S.Zacchiroli *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU Lesser General Public License Version 2.1 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/nat/totient".
+
+include "nat/count.ma".
+include "nat/chinese_reminder.ma".
+
+definition totient : nat \to nat \def
+\lambda n. count n (\lambda m. eqb (gcd m n) (S O)).
+
+theorem totient3: totient (S(S(S O))) = (S(S O)).
+reflexivity.
+qed.
+
+theorem totient6: totient (S(S(S(S(S(S O)))))) = (S(S O)).
+reflexivity.
+qed.
+
+theorem totient_times: \forall n,m:nat. (gcd m n) = (S O) \to
+totient (n*m) = (totient n)*(totient m).
+intro.
+apply (nat_case n).
+intro.simplify.intro.reflexivity.
+intros 2.apply (nat_case m1).
+rewrite < sym_times.
+rewrite < (sym_times (totient O)).
+simplify.intro.reflexivity.
+intros.
+unfold totient.
+apply (count_times m m2 ? ? ?
+(\lambda b,a. cr_pair (S m) (S m2) a b) (\lambda x. x \mod (S m)) (\lambda x. x \mod (S m2))).
+intros.unfold cr_pair.
+apply (le_to_lt_to_lt ? (pred ((S m)*(S m2)))).
+unfold min.
+apply le_min_aux_r.
+change with ((S (pred ((S m)*(S m2)))) \le ((S m)*(S m2))).
+apply (nat_case ((S m)*(S m2))).apply le_n.
+intro.apply le_n.
+intros.
+generalize in match (mod_cr_pair (S m) (S m2) a b H1 H2 H).
+intro.elim H3.
+apply H4.
+intros.
+generalize in match (mod_cr_pair (S m) (S m2) a b H1 H2 H).
+intro.elim H3.
+apply H5.
+intros.
+generalize in match (mod_cr_pair (S m) (S m2) a b H1 H2 H).
+intro.elim H3.
+apply eqb_elim.
+intro.
+rewrite > eq_to_eqb_true.
+rewrite > eq_to_eqb_true.
+reflexivity.
+rewrite < H4.
+rewrite > sym_gcd.
+rewrite > gcd_mod.
+apply (gcd_times_SO_to_gcd_SO ? ? (S m2)).
+unfold lt.apply le_S_S.apply le_O_n.
+unfold lt.apply le_S_S.apply le_O_n.
+assumption.
+unfold lt.apply le_S_S.apply le_O_n.
+rewrite < H5.
+rewrite > sym_gcd.
+rewrite > gcd_mod.
+apply (gcd_times_SO_to_gcd_SO ? ? (S m)).
+unfold lt.apply le_S_S.apply le_O_n.
+unfold lt.apply le_S_S.apply le_O_n.
+rewrite > sym_times.
+assumption.
+unfold lt.apply le_S_S.apply le_O_n.
+intro.
+apply eqb_elim.
+intro.apply eqb_elim.
+intro.apply False_ind.
+apply H6.
+apply eq_gcd_times_SO.
+unfold lt.apply le_S_S.apply le_O_n.
+unfold lt.apply le_S_S.apply le_O_n.
+rewrite < gcd_mod.
+rewrite > H4.
+rewrite > sym_gcd.assumption.
+unfold lt.apply le_S_S.apply le_O_n.
+rewrite < gcd_mod.
+rewrite > H5.
+rewrite > sym_gcd.assumption.
+unfold lt.apply le_S_S.apply le_O_n.
+intro.reflexivity.
+intro.reflexivity.
+qed.
\ No newline at end of file
diff --git a/helm/matita/matita.conf.xml.sample.in b/helm/matita/matita.conf.xml.sample.in
new file mode 100644
index 000000000..ee9aae13b
--- /dev/null
+++ b/helm/matita/matita.conf.xml.sample.in
@@ -0,0 +1,36 @@
+<?xml version="1.0" encoding="utf-8"?>
+<helm_registry>
+ <section name="user">
+ <key name="home">~</key>
+<!-- If not specified here, name of the user executing matita will be used -->
+<!-- <key name="name">foo</key> -->
+ </section>
+ <section name="matita">
+ <key name="auto_disambiguation">true</key>
+ <key name="environment_trust">true</key>
+ <key name="baseuri">cic:/matita/</key>
+ <key name="basedir">$(user.home)/.matita</key>
+ <key name="owner">$(user.name)</key>
+<!-- <key name="font_size">10</key> -->
+ <key name="tactics_bar">false</key>
+ </section>
+ <section name="db">
+ <!-- <key name="host">localhost</key> -->
+ <key name="host">mowgli.cs.unibo.it</key>
+ <key name="user">helm</key>
+ <key name="database">matita</key>
+ </section>
+ <section name="getter">
+ <key name="cache_dir">$(user.home)/.matita/getter/cache</key>
+ <key name="dtd_dir">/projects/helm/xml/dtd</key>
+ <key name="prefix">
+ cic:/
+ file:///projects/helm/library/coq_contribs/
+ legacy
+ </key>
+ <key name="prefix">
+ cic:/matita/
+ file://$(user.home)/.matita/xml/matita/
+ </key>
+ </section>
+</helm_registry>
diff --git a/helm/matita/matita.glade b/helm/matita/matita.glade
new file mode 100644
index 000000000..436dd7b26
--- /dev/null
+++ b/helm/matita/matita.glade
@@ -0,0 +1,3952 @@
+<?xml version="1.0" standalone="no"?> <!--*- mode: xml -*-->
+<!DOCTYPE glade-interface SYSTEM "http://glade.gnome.org/glade-2.0.dtd">
+
+<glade-interface>
+
+<widget class="GtkWindow" id="BrowserWin">
+ <property name="visible">True</property>
+ <property name="title" translatable="yes">Cic browser</property>
+ <property name="type">GTK_WINDOW_TOPLEVEL</property>
+ <property name="window_position">GTK_WIN_POS_CENTER_ON_PARENT</property>
+ <property name="modal">False</property>
+ <property name="default_width">500</property>
+ <property name="default_height">500</property>
+ <property name="resizable">True</property>
+ <property name="destroy_with_parent">False</property>
+ <property name="decorated">True</property>
+ <property name="skip_taskbar_hint">False</property>
+ <property name="skip_pager_hint">False</property>
+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_NORMAL</property>
+ <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>
+ <property name="focus_on_map">True</property>
+
+ <child>
+ <widget class="GtkEventBox" id="BrowserWinEventBox">
+ <property name="visible">True</property>
+ <property name="visible_window">True</property>
+ <property name="above_child">False</property>
+
+ <child>
+ <widget class="GtkVBox" id="BrowserVBox">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkFrame" id="frame2">
+ <property name="visible">True</property>
+ <property name="label_xalign">0</property>
+ <property name="label_yalign">0</property>
+ <property name="shadow_type">GTK_SHADOW_NONE</property>
+
+ <child>
+ <widget class="GtkHBox" id="BrowserHBox">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkButton" id="BrowserNewButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="relief">GTK_RELIEF_NONE</property>
+ <property name="focus_on_click">True</property>
+
+ <child>
+ <widget class="GtkImage" id="image303">
+ <property name="visible">True</property>
+ <property name="stock">gtk-new</property>
+ <property name="icon_size">4</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="BrowserBackButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="relief">GTK_RELIEF_NONE</property>
+ <property name="focus_on_click">True</property>
+
+ <child>
+ <widget class="GtkImage" id="image304">
+ <property name="visible">True</property>
+ <property name="stock">gtk-go-back</property>
+ <property name="icon_size">4</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="BrowserForwardButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="relief">GTK_RELIEF_NONE</property>
+ <property name="focus_on_click">True</property>
+
+ <child>
+ <widget class="GtkImage" id="image305">
+ <property name="visible">True</property>
+ <property name="stock">gtk-go-forward</property>
+ <property name="icon_size">4</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="BrowserRefreshButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">refresh</property>
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="relief">GTK_RELIEF_NONE</property>
+ <property name="focus_on_click">True</property>
+
+ <child>
+ <widget class="GtkImage" id="image229">
+ <property name="visible">True</property>
+ <property name="stock">gtk-refresh</property>
+ <property name="icon_size">4</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="BrowserHomeButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">home</property>
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="relief">GTK_RELIEF_NONE</property>
+ <property name="focus_on_click">True</property>
+
+ <child>
+ <widget class="GtkImage" id="image190">
+ <property name="visible">True</property>
+ <property name="stock">gtk-home</property>
+ <property name="icon_size">4</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkImage" id="image301">
+ <property name="visible">True</property>
+ <property name="stock">gtk-jump-to</property>
+ <property name="icon_size">2</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ <packing>
+ <property name="padding">3</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkHBox" id="UriHBox">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <placeholder/>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkHBox" id="whelpBarBox">
+ <property name="border_width">3</property>
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">6</property>
+
+ <child>
+ <widget class="GtkImage" id="WhelpBarImage">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkEntry" id="queryInputText">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="editable">True</property>
+ <property name="visibility">True</property>
+ <property name="max_length">0</property>
+ <property name="text" translatable="yes"></property>
+ <property name="has_frame">True</property>
+ <property name="invisible_char">*</property>
+ <property name="activates_default">False</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkVBox" id="whelpBarComboVbox">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkAlignment" id="alignment4">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xscale">1</property>
+ <property name="yscale">1</property>
+ <property name="top_padding">0</property>
+ <property name="bottom_padding">0</property>
+ <property name="left_padding">0</property>
+ <property name="right_padding">0</property>
+
+ <child>
+ <placeholder/>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkNotebook" id="mathOrListNotebook">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="show_tabs">True</property>
+ <property name="show_border">True</property>
+ <property name="tab_pos">GTK_POS_TOP</property>
+ <property name="scrollable">False</property>
+ <property name="enable_popup">False</property>
+
+ <child>
+ <widget class="GtkScrolledWindow" id="ScrolledBrowser">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="hscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+ <property name="vscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+ <property name="shadow_type">GTK_SHADOW_NONE</property>
+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>
+
+ <child>
+ <placeholder/>
+ </child>
+ </widget>
+ <packing>
+ <property name="tab_expand">False</property>
+ <property name="tab_fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="mathLabel">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">MathView</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="type">tab</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkScrolledWindow" id="scrolledwindow9">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="hscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+ <property name="vscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+ <property name="shadow_type">GTK_SHADOW_IN</property>
+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>
+
+ <child>
+ <widget class="GtkTreeView" id="whelpResultTreeview">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="headers_visible">False</property>
+ <property name="rules_hint">False</property>
+ <property name="reorderable">False</property>
+ <property name="enable_search">True</property>
+ <property name="fixed_height_mode">False</property>
+ <property name="hover_selection">False</property>
+ <property name="hover_expand">False</property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="tab_expand">False</property>
+ <property name="tab_fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="listLabel">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">WhelpResults</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="type">tab</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkImage" id="EasterEggImage">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ <packing>
+ <property name="tab_expand">False</property>
+ <property name="tab_fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="EasterEggLabel">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">WhelpEasterEgg</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="type">tab</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+</widget>
+
+<widget class="GtkDialog" id="ConfirmationDialog">
+ <property name="title" translatable="yes">DUMMY</property>
+ <property name="type">GTK_WINDOW_TOPLEVEL</property>
+ <property name="window_position">GTK_WIN_POS_CENTER</property>
+ <property name="modal">True</property>
+ <property name="resizable">False</property>
+ <property name="destroy_with_parent">False</property>
+ <property name="decorated">True</property>
+ <property name="skip_taskbar_hint">False</property>
+ <property name="skip_pager_hint">False</property>
+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_DIALOG</property>
+ <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>
+ <property name="focus_on_map">True</property>
+ <property name="has_separator">True</property>
+
+ <child internal-child="vbox">
+ <widget class="GtkVBox" id="dialog-vbox1">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child internal-child="action_area">
+ <widget class="GtkHButtonBox" id="dialog-action_area1">
+ <property name="visible">True</property>
+ <property name="layout_style">GTK_BUTTONBOX_END</property>
+
+ <child>
+ <widget class="GtkButton" id="ConfirmationDialogCancelButton">
+ <property name="visible">True</property>
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-cancel</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ <property name="response_id">-6</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="ConfirmationDialogOkButton">
+ <property name="visible">True</property>
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-ok</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ <property name="response_id">-5</property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="pack_type">GTK_PACK_END</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="ConfirmationDialogLabel">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">DUMMY</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_CENTER</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+</widget>
+
+<widget class="GtkDialog" id="EmptyDialog">
+ <property name="visible">True</property>
+ <property name="title" translatable="yes">DUMMY</property>
+ <property name="type">GTK_WINDOW_TOPLEVEL</property>
+ <property name="window_position">GTK_WIN_POS_NONE</property>
+ <property name="modal">False</property>
+ <property name="resizable">True</property>
+ <property name="destroy_with_parent">False</property>
+ <property name="decorated">True</property>
+ <property name="skip_taskbar_hint">False</property>
+ <property name="skip_pager_hint">False</property>
+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_DIALOG</property>
+ <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>
+ <property name="focus_on_map">True</property>
+ <property name="has_separator">True</property>
+
+ <child internal-child="vbox">
+ <widget class="GtkVBox" id="EmptyDialogVBox">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child internal-child="action_area">
+ <widget class="GtkHButtonBox" id="dialog-action_area5">
+ <property name="visible">True</property>
+ <property name="layout_style">GTK_BUTTONBOX_END</property>
+
+ <child>
+ <widget class="GtkButton" id="EmptyDialogCancelButton">
+ <property name="visible">True</property>
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-cancel</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ <property name="response_id">-6</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="EmptyDialogOkButton">
+ <property name="visible">True</property>
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-ok</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ <property name="response_id">-5</property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="pack_type">GTK_PACK_END</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="EmptyDialogLabel">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">DUMMY</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <placeholder/>
+ </child>
+ </widget>
+ </child>
+</widget>
+
+<widget class="GtkFileSelection" id="FileSelectionWin">
+ <property name="border_width">10</property>
+ <property name="title" translatable="yes">Select File</property>
+ <property name="type">GTK_WINDOW_TOPLEVEL</property>
+ <property name="window_position">GTK_WIN_POS_CENTER</property>
+ <property name="modal">True</property>
+ <property name="resizable">True</property>
+ <property name="destroy_with_parent">False</property>
+ <property name="decorated">True</property>
+ <property name="skip_taskbar_hint">False</property>
+ <property name="skip_pager_hint">False</property>
+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_DIALOG</property>
+ <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>
+ <property name="focus_on_map">True</property>
+ <property name="show_fileops">True</property>
+
+ <child internal-child="cancel_button">
+ <widget class="GtkButton" id="fileSelCancelButton">
+ <property name="visible">True</property>
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ </child>
+
+ <child internal-child="ok_button">
+ <widget class="GtkButton" id="fileSelOkButton">
+ <property name="visible">True</property>
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ </child>
+</widget>
+
+<widget class="GtkDialog" id="RecordChoiceDialog">
+ <property name="width_request">350</property>
+ <property name="height_request">250</property>
+ <property name="title" translatable="yes">title</property>
+ <property name="type">GTK_WINDOW_TOPLEVEL</property>
+ <property name="window_position">GTK_WIN_POS_NONE</property>
+ <property name="modal">True</property>
+ <property name="resizable">True</property>
+ <property name="destroy_with_parent">False</property>
+ <property name="decorated">True</property>
+ <property name="skip_taskbar_hint">False</property>
+ <property name="skip_pager_hint">False</property>
+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_DIALOG</property>
+ <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>
+ <property name="focus_on_map">True</property>
+ <property name="has_separator">True</property>
+
+ <child internal-child="vbox">
+ <widget class="GtkVBox" id="dialog-vbox4">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child internal-child="action_area">
+ <widget class="GtkHButtonBox" id="dialog-action_area4">
+ <property name="visible">True</property>
+ <property name="layout_style">GTK_BUTTONBOX_END</property>
+
+ <child>
+ <widget class="GtkButton" id="RecordChoiceHelpButton">
+ <property name="visible">True</property>
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-help</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ <property name="response_id">-11</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="RecordChoiceCancelButton">
+ <property name="visible">True</property>
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-cancel</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ <property name="response_id">-6</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="RecordChoiceOkButton">
+ <property name="visible">True</property>
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-ok</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ <property name="response_id">-5</property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="pack_type">GTK_PACK_END</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkVBox" id="vbox3">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkLabel" id="RecordChoiceDialogLabel">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">some informative message here ...</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkScrolledWindow" id="scrolledwindow4">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="hscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+ <property name="vscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+ <property name="shadow_type">GTK_SHADOW_IN</property>
+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>
+
+ <child>
+ <widget class="GtkTreeView" id="RecordChoiceTreeView">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="headers_visible">False</property>
+ <property name="rules_hint">False</property>
+ <property name="reorderable">False</property>
+ <property name="enable_search">True</property>
+ <property name="fixed_height_mode">False</property>
+ <property name="hover_selection">False</property>
+ <property name="hover_expand">False</property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+</widget>
+
+<widget class="GtkWindow" id="MainWin">
+ <property name="title" translatable="yes">Matita</property>
+ <property name="type">GTK_WINDOW_TOPLEVEL</property>
+ <property name="window_position">GTK_WIN_POS_NONE</property>
+ <property name="modal">False</property>
+ <property name="resizable">True</property>
+ <property name="destroy_with_parent">False</property>
+ <property name="decorated">True</property>
+ <property name="skip_taskbar_hint">False</property>
+ <property name="skip_pager_hint">False</property>
+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_NORMAL</property>
+ <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>
+ <property name="focus_on_map">True</property>
+
+ <child>
+ <widget class="GtkEventBox" id="MainWinEventBox">
+ <property name="visible">True</property>
+ <property name="visible_window">True</property>
+ <property name="above_child">False</property>
+
+ <child>
+ <widget class="GtkVBox" id="vbox8">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkHandleBox" id="menuBarHandleBox">
+ <property name="visible">True</property>
+ <property name="shadow_type">GTK_SHADOW_OUT</property>
+ <property name="handle_position">GTK_POS_LEFT</property>
+ <property name="snap_edge">GTK_POS_TOP</property>
+
+ <child>
+ <widget class="GtkMenuBar" id="menubar1">
+ <property name="visible">True</property>
+
+ <child>
+ <widget class="GtkMenuItem" id="fileMenu">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_File</property>
+ <property name="use_underline">True</property>
+
+ <child>
+ <widget class="GtkMenu" id="fileMenu_menu">
+
+ <child>
+ <widget class="GtkImageMenuItem" id="newMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_New</property>
+ <property name="use_underline">True</property>
+ <accelerator key="n" modifiers="GDK_CONTROL_MASK" signal="activate"/>
+
+ <child internal-child="image">
+ <widget class="GtkImage" id="image856">
+ <property name="visible">True</property>
+ <property name="stock">gtk-new</property>
+ <property name="icon_size">1</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="openMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_Open...</property>
+ <property name="use_underline">True</property>
+ <accelerator key="o" modifiers="GDK_CONTROL_MASK" signal="activate"/>
+
+ <child internal-child="image">
+ <widget class="GtkImage" id="image857">
+ <property name="visible">True</property>
+ <property name="stock">gtk-open</property>
+ <property name="icon_size">1</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="saveMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_Save</property>
+ <property name="use_underline">True</property>
+ <accelerator key="s" modifiers="GDK_CONTROL_MASK" signal="activate"/>
+
+ <child internal-child="image">
+ <widget class="GtkImage" id="image858">
+ <property name="visible">True</property>
+ <property name="stock">gtk-save</property>
+ <property name="icon_size">1</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="saveAsMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Save _As ...</property>
+ <property name="use_underline">True</property>
+ <accelerator key="s" modifiers="GDK_CONTROL_MASK | GDK_SHIFT_MASK" signal="activate"/>
+
+ <child internal-child="image">
+ <widget class="GtkImage" id="image859">
+ <property name="visible">True</property>
+ <property name="stock">gtk-save-as</property>
+ <property name="icon_size">1</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="developmentsMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_Developments...</property>
+ <property name="use_underline">True</property>
+ <accelerator key="d" modifiers="GDK_CONTROL_MASK" signal="activate"/>
+
+ <child internal-child="image">
+ <widget class="GtkImage" id="image860">
+ <property name="visible">True</property>
+ <property name="stock">gtk-execute</property>
+ <property name="icon_size">1</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkSeparatorMenuItem" id="separator2">
+ <property name="visible">True</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="quitMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_Quit</property>
+ <property name="use_underline">True</property>
+ <accelerator key="q" modifiers="GDK_CONTROL_MASK" signal="activate"/>
+
+ <child internal-child="image">
+ <widget class="GtkImage" id="image861">
+ <property name="visible">True</property>
+ <property name="stock">gtk-quit</property>
+ <property name="icon_size">1</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkMenuItem" id="editMenu">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_Edit</property>
+ <property name="use_underline">True</property>
+
+ <child>
+ <widget class="GtkMenu" id="editMenu_menu">
+
+ <child>
+ <widget class="GtkImageMenuItem" id="undoMenuItem">
+ <property name="visible">True</property>
+ <property name="sensitive">False</property>
+ <property name="label" translatable="yes">_Undo</property>
+ <property name="use_underline">True</property>
+ <accelerator key="z" modifiers="GDK_CONTROL_MASK" signal="activate"/>
+
+ <child internal-child="image">
+ <widget class="GtkImage" id="image862">
+ <property name="visible">True</property>
+ <property name="stock">gtk-undo</property>
+ <property name="icon_size">1</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="redoMenuItem">
+ <property name="visible">True</property>
+ <property name="sensitive">False</property>
+ <property name="label" translatable="yes">_Redo</property>
+ <property name="use_underline">True</property>
+ <accelerator key="z" modifiers="GDK_CONTROL_MASK | GDK_SHIFT_MASK" signal="activate"/>
+
+ <child internal-child="image">
+ <widget class="GtkImage" id="image863">
+ <property name="visible">True</property>
+ <property name="stock">gtk-redo</property>
+ <property name="icon_size">1</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkSeparatorMenuItem" id="separator3">
+ <property name="visible">True</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="cutMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Cu_t</property>
+ <property name="use_underline">True</property>
+ <accelerator key="x" modifiers="GDK_CONTROL_MASK" signal="activate"/>
+
+ <child internal-child="image">
+ <widget class="GtkImage" id="image864">
+ <property name="visible">True</property>
+ <property name="stock">gtk-cut</property>
+ <property name="icon_size">1</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="copyMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_Copy</property>
+ <property name="use_underline">True</property>
+ <accelerator key="c" modifiers="GDK_CONTROL_MASK" signal="activate"/>
+
+ <child internal-child="image">
+ <widget class="GtkImage" id="image865">
+ <property name="visible">True</property>
+ <property name="stock">gtk-copy</property>
+ <property name="icon_size">1</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="pasteMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_Paste</property>
+ <property name="use_underline">True</property>
+ <accelerator key="v" modifiers="GDK_CONTROL_MASK" signal="activate"/>
+
+ <child internal-child="image">
+ <widget class="GtkImage" id="image866">
+ <property name="visible">True</property>
+ <property name="stock">gtk-paste</property>
+ <property name="icon_size">1</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkMenuItem" id="pastePatternMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Paste as pattern</property>
+ <property name="use_underline">True</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="deleteMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_Delete</property>
+ <property name="use_underline">True</property>
+
+ <child internal-child="image">
+ <widget class="GtkImage" id="image867">
+ <property name="visible">True</property>
+ <property name="stock">gtk-delete</property>
+ <property name="icon_size">1</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkSeparatorMenuItem" id="separator4">
+ <property name="visible">True</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkMenuItem" id="selectAllMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Select _All</property>
+ <property name="use_underline">True</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkSeparatorMenuItem" id="separator7">
+ <property name="visible">True</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="findReplMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_Find & Replace ...</property>
+ <property name="use_underline">True</property>
+ <accelerator key="f" modifiers="GDK_CONTROL_MASK" signal="activate"/>
+
+ <child internal-child="image">
+ <widget class="GtkImage" id="image868">
+ <property name="visible">True</property>
+ <property name="stock">gtk-find-and-replace</property>
+ <property name="icon_size">1</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkSeparatorMenuItem" id="separator8">
+ <property name="visible">True</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkMenuItem" id="LigatureButton">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Next ligature</property>
+ <property name="use_underline">True</property>
+ <accelerator key="l" modifiers="GDK_MOD1_MASK" signal="activate"/>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkMenuItem" id="externalEditorMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Edit with E_xternal Editor</property>
+ <property name="use_underline">True</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkMenuItem" id="scriptMenu">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_Script</property>
+ <property name="use_underline">True</property>
+
+ <child>
+ <widget class="GtkMenu" id="scriptMenu_menu">
+
+ <child>
+ <widget class="GtkMenuItem" id="scriptAdvanceMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Execute 1 phrase</property>
+ <property name="use_underline">True</property>
+ <accelerator key="Page_Down" modifiers="GDK_CONTROL_MASK | GDK_MOD1_MASK" signal="activate"/>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkMenuItem" id="scriptRetractMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Retract 1 phrase</property>
+ <property name="use_underline">True</property>
+ <accelerator key="Page_Up" modifiers="GDK_CONTROL_MASK | GDK_MOD1_MASK" signal="activate"/>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkSeparatorMenuItem" id="separator9">
+ <property name="visible">True</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkMenuItem" id="scriptBottomMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Execute all</property>
+ <property name="use_underline">True</property>
+ <accelerator key="End" modifiers="GDK_CONTROL_MASK | GDK_MOD1_MASK" signal="activate"/>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkMenuItem" id="scriptTopMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Restart</property>
+ <property name="use_underline">True</property>
+ <accelerator key="Home" modifiers="GDK_CONTROL_MASK | GDK_MOD1_MASK" signal="activate"/>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkSeparatorMenuItem" id="separator10">
+ <property name="visible">True</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkMenuItem" id="scriptJumpMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Execute until cursor</property>
+ <property name="use_underline">True</property>
+ <accelerator key="period" modifiers="GDK_CONTROL_MASK | GDK_MOD1_MASK" signal="activate"/>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkMenuItem" id="viewMenu">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_View</property>
+ <property name="use_underline">True</property>
+
+ <child>
+ <widget class="GtkMenu" id="viewMenu_menu">
+
+ <child>
+ <widget class="GtkCheckMenuItem" id="tacticsBarMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Show _Tactics Bar</property>
+ <property name="use_underline">True</property>
+ <property name="active">True</property>
+ <accelerator key="F2" modifiers="0" signal="activate"/>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkMenuItem" id="newCicBrowserMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">New Cic _Browser</property>
+ <property name="use_underline">True</property>
+ <accelerator key="F3" modifiers="0" signal="activate"/>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkSeparatorMenuItem" id="separator5">
+ <property name="visible">True</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkCheckMenuItem" id="fullscreenMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_Fullscreen</property>
+ <property name="use_underline">True</property>
+ <property name="active">False</property>
+ <accelerator key="F11" modifiers="0" signal="activate"/>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkSeparatorMenuItem" id="separator1">
+ <property name="visible">True</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="increaseFontSizeMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Zoom _In</property>
+ <property name="use_underline">True</property>
+ <signal name="activate" handler="on_increaseFontSizeMenuItem_activate" last_modification_time="Wed, 15 Jun 2005 15:06:29 GMT"/>
+ <accelerator key="plus" modifiers="GDK_CONTROL_MASK" signal="activate"/>
+
+ <child internal-child="image">
+ <widget class="GtkImage" id="image869">
+ <property name="visible">True</property>
+ <property name="stock">gtk-zoom-in</property>
+ <property name="icon_size">1</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="decreaseFontSizeMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Zoom _Out</property>
+ <property name="use_underline">True</property>
+ <signal name="activate" handler="on_decreaseFontSizeMenuItem_activate" last_modification_time="Wed, 15 Jun 2005 15:06:29 GMT"/>
+ <accelerator key="minus" modifiers="GDK_CONTROL_MASK" signal="activate"/>
+
+ <child internal-child="image">
+ <widget class="GtkImage" id="image870">
+ <property name="visible">True</property>
+ <property name="stock">gtk-zoom-out</property>
+ <property name="icon_size">1</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkImageMenuItem" id="normalFontSizeMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_Normal Size</property>
+ <property name="use_underline">True</property>
+ <accelerator key="equal" modifiers="GDK_CONTROL_MASK" signal="activate"/>
+
+ <child internal-child="image">
+ <widget class="GtkImage" id="image871">
+ <property name="visible">True</property>
+ <property name="stock">gtk-zoom-100</property>
+ <property name="icon_size">1</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkMenuItem" id="debugMenu">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_Debug</property>
+ <property name="use_underline">True</property>
+
+ <child>
+ <widget class="GtkMenu" id="debugMenu_menu">
+
+ <child>
+ <widget class="GtkSeparatorMenuItem" id="separator6">
+ <property name="visible">True</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkMenuItem" id="helpMenu">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_Help</property>
+ <property name="use_underline">True</property>
+
+ <child>
+ <widget class="GtkMenu" id="helpMenu_menu">
+
+ <child>
+ <widget class="GtkImageMenuItem" id="aboutMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_About</property>
+ <property name="use_underline">True</property>
+
+ <child internal-child="image">
+ <widget class="GtkImage" id="image872">
+ <property name="visible">True</property>
+ <property name="stock">gtk-about</property>
+ <property name="icon_size">1</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkHBox" id="hbox9">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkHPaned" id="hpaneScriptSequent">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+
+ <child>
+ <widget class="GtkHBox" id="hbox18">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkHandleBox" id="TacticsButtonsHandlebox">
+ <property name="visible">True</property>
+ <property name="shadow_type">GTK_SHADOW_OUT</property>
+ <property name="handle_position">GTK_POS_TOP</property>
+ <property name="snap_edge">GTK_POS_TOP</property>
+
+ <child>
+ <widget class="GtkTable" id="ToolBarTable">
+ <property name="visible">True</property>
+ <property name="n_rows">17</property>
+ <property name="n_columns">2</property>
+ <property name="homogeneous">False</property>
+ <property name="row_spacing">4</property>
+ <property name="column_spacing">0</property>
+
+ <child>
+ <widget class="GtkButton" id="applyButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Apply</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">apply</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="right_attach">2</property>
+ <property name="top_attach">0</property>
+ <property name="bottom_attach">1</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="introsButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Intros</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">intro</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">0</property>
+ <property name="bottom_attach">1</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="exactButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Exact</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">exact</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">2</property>
+ <property name="bottom_attach">3</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="elimButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Elim</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">elim</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">4</property>
+ <property name="bottom_attach">5</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="reflexivityButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Reflexivity</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">refl</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">8</property>
+ <property name="bottom_attach">9</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="symmetryButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Symmetry</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">sym</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="right_attach">2</property>
+ <property name="top_attach">8</property>
+ <property name="bottom_attach">9</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="transitivityButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Transitivity</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">trans</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">9</property>
+ <property name="bottom_attach">10</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="simplifyButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Simplify</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">simpl</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">11</property>
+ <property name="bottom_attach">12</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="reduceButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Reduce</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">red</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="right_attach">2</property>
+ <property name="top_attach">11</property>
+ <property name="bottom_attach">12</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="whdButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Whd</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">whd</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">12</property>
+ <property name="bottom_attach">13</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="assumptionButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Assumption</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">assum</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">14</property>
+ <property name="bottom_attach">15</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="autoButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Auto</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">auto</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="right_attach">2</property>
+ <property name="top_attach">14</property>
+ <property name="bottom_attach">15</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="cutButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Cut</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">cut</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">16</property>
+ <property name="bottom_attach">17</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="replaceButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Replace</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">repl</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="right_attach">2</property>
+ <property name="top_attach">16</property>
+ <property name="bottom_attach">17</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="elimTypeButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">ElimType</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">elimTy</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="right_attach">2</property>
+ <property name="top_attach">4</property>
+ <property name="bottom_attach">5</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkHBox" id="hbox18">
+ <property name="visible">True</property>
+ <property name="homogeneous">True</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkButton" id="rightButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Right</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">R</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="existsButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Exists</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">â</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="right_attach">2</property>
+ <property name="top_attach">6</property>
+ <property name="bottom_attach">7</property>
+ <property name="x_options">fill</property>
+ <property name="y_options">fill</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkHBox" id="hbox17">
+ <property name="visible">True</property>
+ <property name="homogeneous">True</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkButton" id="splitButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Split</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">â§</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="leftButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Left</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">L</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">6</property>
+ <property name="bottom_attach">7</property>
+ <property name="x_options">fill</property>
+ <property name="y_options">fill</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkAlignment" id="alignment6">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xscale">1</property>
+ <property name="yscale">1</property>
+ <property name="top_padding">0</property>
+ <property name="bottom_padding">0</property>
+ <property name="left_padding">0</property>
+ <property name="right_padding">0</property>
+
+ <child>
+ <placeholder/>
+ </child>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">1</property>
+ <property name="bottom_attach">2</property>
+ <property name="x_options">fill</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkAlignment" id="alignment7">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xscale">1</property>
+ <property name="yscale">1</property>
+ <property name="top_padding">0</property>
+ <property name="bottom_padding">0</property>
+ <property name="left_padding">0</property>
+ <property name="right_padding">0</property>
+
+ <child>
+ <placeholder/>
+ </child>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">3</property>
+ <property name="bottom_attach">4</property>
+ <property name="x_options">fill</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkAlignment" id="alignment8">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xscale">1</property>
+ <property name="yscale">1</property>
+ <property name="top_padding">0</property>
+ <property name="bottom_padding">0</property>
+ <property name="left_padding">0</property>
+ <property name="right_padding">0</property>
+
+ <child>
+ <placeholder/>
+ </child>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">5</property>
+ <property name="bottom_attach">6</property>
+ <property name="x_options">fill</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkAlignment" id="alignment9">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xscale">1</property>
+ <property name="yscale">1</property>
+ <property name="top_padding">0</property>
+ <property name="bottom_padding">0</property>
+ <property name="left_padding">0</property>
+ <property name="right_padding">0</property>
+
+ <child>
+ <placeholder/>
+ </child>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">7</property>
+ <property name="bottom_attach">8</property>
+ <property name="x_options">fill</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkAlignment" id="alignment10">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xscale">1</property>
+ <property name="yscale">1</property>
+ <property name="top_padding">0</property>
+ <property name="bottom_padding">0</property>
+ <property name="left_padding">0</property>
+ <property name="right_padding">0</property>
+
+ <child>
+ <placeholder/>
+ </child>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">10</property>
+ <property name="bottom_attach">11</property>
+ <property name="x_options">fill</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkAlignment" id="alignment11">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xscale">1</property>
+ <property name="yscale">1</property>
+ <property name="top_padding">0</property>
+ <property name="bottom_padding">0</property>
+ <property name="left_padding">0</property>
+ <property name="right_padding">0</property>
+
+ <child>
+ <placeholder/>
+ </child>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">13</property>
+ <property name="bottom_attach">14</property>
+ <property name="x_options">fill</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkAlignment" id="alignment12">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xscale">1</property>
+ <property name="yscale">1</property>
+ <property name="top_padding">0</property>
+ <property name="bottom_padding">0</property>
+ <property name="left_padding">0</property>
+ <property name="right_padding">0</property>
+
+ <child>
+ <placeholder/>
+ </child>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">15</property>
+ <property name="bottom_attach">16</property>
+ <property name="x_options">fill</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkVBox" id="vboxScript">
+ <property name="width_request">400</property>
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkToolbar" id="buttonsToolbar">
+ <property name="visible">True</property>
+ <property name="orientation">GTK_ORIENTATION_HORIZONTAL</property>
+ <property name="toolbar_style">GTK_TOOLBAR_BOTH</property>
+ <property name="tooltips">True</property>
+ <property name="show_arrow">True</property>
+
+ <child>
+ <widget class="GtkToolItem" id="toolitem25">
+ <property name="visible">True</property>
+ <property name="visible_horizontal">True</property>
+ <property name="visible_vertical">True</property>
+ <property name="is_important">False</property>
+
+ <child>
+ <widget class="GtkButton" id="scriptTopButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Restart</property>
+ <property name="can_focus">True</property>
+ <property name="relief">GTK_RELIEF_NONE</property>
+ <property name="focus_on_click">True</property>
+
+ <child>
+ <widget class="GtkImage" id="image253">
+ <property name="visible">True</property>
+ <property name="stock">gtk-goto-top</property>
+ <property name="icon_size">4</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkToolItem" id="toolitem26">
+ <property name="visible">True</property>
+ <property name="visible_horizontal">True</property>
+ <property name="visible_vertical">True</property>
+ <property name="is_important">False</property>
+
+ <child>
+ <widget class="GtkButton" id="scriptRetractButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Retract 1 phrase</property>
+ <property name="can_focus">True</property>
+ <property name="relief">GTK_RELIEF_NONE</property>
+ <property name="focus_on_click">True</property>
+
+ <child>
+ <widget class="GtkImage" id="image254">
+ <property name="visible">True</property>
+ <property name="stock">gtk-go-up</property>
+ <property name="icon_size">4</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkToolItem" id="toolitem27">
+ <property name="visible">True</property>
+ <property name="visible_horizontal">True</property>
+ <property name="visible_vertical">True</property>
+ <property name="is_important">False</property>
+
+ <child>
+ <widget class="GtkButton" id="scriptJumpButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Execute until point</property>
+ <property name="can_focus">True</property>
+ <property name="relief">GTK_RELIEF_NONE</property>
+ <property name="focus_on_click">True</property>
+
+ <child>
+ <widget class="GtkImage" id="image255">
+ <property name="visible">True</property>
+ <property name="stock">gtk-jump-to</property>
+ <property name="icon_size">4</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkToolItem" id="toolitem28">
+ <property name="visible">True</property>
+ <property name="visible_horizontal">True</property>
+ <property name="visible_vertical">True</property>
+ <property name="is_important">False</property>
+
+ <child>
+ <widget class="GtkButton" id="scriptAdvanceButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Execute 1 phrase</property>
+ <property name="can_focus">True</property>
+ <property name="relief">GTK_RELIEF_NONE</property>
+ <property name="focus_on_click">True</property>
+
+ <child>
+ <widget class="GtkImage" id="image256">
+ <property name="visible">True</property>
+ <property name="stock">gtk-go-down</property>
+ <property name="icon_size">4</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkToolItem" id="toolitem29">
+ <property name="visible">True</property>
+ <property name="visible_horizontal">True</property>
+ <property name="visible_vertical">True</property>
+ <property name="is_important">False</property>
+
+ <child>
+ <widget class="GtkButton" id="scriptBottomButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Execute all</property>
+ <property name="can_focus">True</property>
+ <property name="relief">GTK_RELIEF_NONE</property>
+ <property name="focus_on_click">True</property>
+
+ <child>
+ <widget class="GtkImage" id="image257">
+ <property name="visible">True</property>
+ <property name="stock">gtk-goto-bottom</property>
+ <property name="icon_size">4</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="expand">False</property>
+ <property name="homogeneous">False</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkNotebook" id="scriptNotebook">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="show_tabs">True</property>
+ <property name="show_border">True</property>
+ <property name="tab_pos">GTK_POS_BOTTOM</property>
+ <property name="scrollable">False</property>
+ <property name="enable_popup">False</property>
+
+ <child>
+ <widget class="GtkScrolledWindow" id="ScriptScrolledWin">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="hscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+ <property name="vscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+ <property name="shadow_type">GTK_SHADOW_NONE</property>
+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>
+
+ <child>
+ <placeholder/>
+ </child>
+ </widget>
+ <packing>
+ <property name="tab_expand">False</property>
+ <property name="tab_fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="scriptLabel">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">script</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="type">tab</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkScrolledWindow" id="scrolledwindow8">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="hscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+ <property name="vscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+ <property name="shadow_type">GTK_SHADOW_NONE</property>
+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>
+
+ <child>
+ <widget class="GtkTreeView" id="scriptTreeView">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="headers_visible">False</property>
+ <property name="rules_hint">False</property>
+ <property name="reorderable">False</property>
+ <property name="enable_search">True</property>
+ <property name="fixed_height_mode">False</property>
+ <property name="hover_selection">False</property>
+ <property name="hover_expand">False</property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="tab_expand">False</property>
+ <property name="tab_fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="label13">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">outline</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="type">tab</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="shrink">True</property>
+ <property name="resize">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkVPaned" id="vpaned1">
+ <property name="width_request">250</property>
+ <property name="height_request">500</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="position">380</property>
+
+ <child>
+ <widget class="GtkNotebook" id="sequentsNotebook">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="show_tabs">True</property>
+ <property name="show_border">True</property>
+ <property name="tab_pos">GTK_POS_TOP</property>
+ <property name="scrollable">False</property>
+ <property name="enable_popup">False</property>
+ </widget>
+ <packing>
+ <property name="shrink">True</property>
+ <property name="resize">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkHBox" id="hbox9">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkScrolledWindow" id="logScrolledWin">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="hscrollbar_policy">GTK_POLICY_NEVER</property>
+ <property name="vscrollbar_policy">GTK_POLICY_ALWAYS</property>
+ <property name="shadow_type">GTK_SHADOW_IN</property>
+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>
+
+ <child>
+ <widget class="GtkTextView" id="logTextView">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="editable">False</property>
+ <property name="overwrite">False</property>
+ <property name="accepts_tab">True</property>
+ <property name="justification">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap_mode">GTK_WRAP_CHAR</property>
+ <property name="cursor_visible">False</property>
+ <property name="pixels_above_lines">0</property>
+ <property name="pixels_below_lines">0</property>
+ <property name="pixels_inside_wrap">0</property>
+ <property name="left_margin">0</property>
+ <property name="right_margin">0</property>
+ <property name="indent">0</property>
+ <property name="text" translatable="yes"></property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="shrink">True</property>
+ <property name="resize">True</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="shrink">True</property>
+ <property name="resize">True</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkHBox" id="hbox10">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkStatusbar" id="StatusBar">
+ <property name="visible">True</property>
+ <property name="has_resize_grip">False</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkNotebook" id="HintNotebook">
+ <property name="visible">True</property>
+ <property name="show_tabs">False</property>
+ <property name="show_border">True</property>
+ <property name="tab_pos">GTK_POS_TOP</property>
+ <property name="scrollable">False</property>
+ <property name="enable_popup">False</property>
+
+ <child>
+ <widget class="GtkImage" id="HintLowImage">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ <packing>
+ <property name="tab_expand">False</property>
+ <property name="tab_fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="label14">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">label14</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="type">tab</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkImage" id="HintMediumImage">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ <packing>
+ <property name="tab_expand">False</property>
+ <property name="tab_fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="label15">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">label15</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="type">tab</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkImage" id="HintHighImage">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ <packing>
+ <property name="tab_expand">False</property>
+ <property name="tab_fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="label16">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">label16</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="type">tab</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+</widget>
+
+<widget class="GtkDialog" id="TextDialog">
+ <property name="title" translatable="yes">DUMMY</property>
+ <property name="type">GTK_WINDOW_TOPLEVEL</property>
+ <property name="window_position">GTK_WIN_POS_NONE</property>
+ <property name="modal">False</property>
+ <property name="resizable">True</property>
+ <property name="destroy_with_parent">False</property>
+ <property name="decorated">True</property>
+ <property name="skip_taskbar_hint">False</property>
+ <property name="skip_pager_hint">False</property>
+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_DIALOG</property>
+ <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>
+ <property name="focus_on_map">True</property>
+ <property name="has_separator">True</property>
+
+ <child internal-child="vbox">
+ <widget class="GtkVBox" id="vbox5">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child internal-child="action_area">
+ <widget class="GtkHButtonBox" id="hbuttonbox1">
+ <property name="visible">True</property>
+ <property name="layout_style">GTK_BUTTONBOX_END</property>
+
+ <child>
+ <widget class="GtkButton" id="TextDialogCancelButton">
+ <property name="visible">True</property>
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-cancel</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ <property name="response_id">-6</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="TextDialogOkButton">
+ <property name="visible">True</property>
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-ok</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ <property name="response_id">-5</property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="pack_type">GTK_PACK_END</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="TextDialogLabel">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">DUMMY</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkScrolledWindow" id="scrolledwindow2">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="hscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+ <property name="vscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+ <property name="shadow_type">GTK_SHADOW_IN</property>
+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>
+
+ <child>
+ <widget class="GtkTextView" id="TextDialogTextView">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="editable">True</property>
+ <property name="overwrite">False</property>
+ <property name="accepts_tab">True</property>
+ <property name="justification">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap_mode">GTK_WRAP_NONE</property>
+ <property name="cursor_visible">True</property>
+ <property name="pixels_above_lines">0</property>
+ <property name="pixels_below_lines">0</property>
+ <property name="pixels_inside_wrap">0</property>
+ <property name="left_margin">0</property>
+ <property name="right_margin">0</property>
+ <property name="indent">0</property>
+ <property name="text" translatable="yes"></property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+</widget>
+
+<widget class="GtkDialog" id="UriChoiceDialog">
+ <property name="height_request">280</property>
+ <property name="title" translatable="yes">Uri choice</property>
+ <property name="type">GTK_WINDOW_TOPLEVEL</property>
+ <property name="window_position">GTK_WIN_POS_CENTER</property>
+ <property name="modal">True</property>
+ <property name="resizable">True</property>
+ <property name="destroy_with_parent">False</property>
+ <property name="decorated">True</property>
+ <property name="skip_taskbar_hint">False</property>
+ <property name="skip_pager_hint">False</property>
+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_DIALOG</property>
+ <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>
+ <property name="focus_on_map">True</property>
+ <property name="has_separator">True</property>
+
+ <child internal-child="vbox">
+ <widget class="GtkVBox" id="dialog-vbox3">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">4</property>
+
+ <child internal-child="action_area">
+ <widget class="GtkHButtonBox" id="dialog-action_area3">
+ <property name="visible">True</property>
+ <property name="layout_style">GTK_BUTTONBOX_END</property>
+
+ <child>
+ <widget class="GtkButton" id="UriChoiceAbortButton">
+ <property name="visible">True</property>
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-cancel</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ <property name="response_id">-6</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="UriChoiceSelectedButton">
+ <property name="visible">True</property>
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ <property name="response_id">0</property>
+
+ <child>
+ <widget class="GtkAlignment" id="alignment2">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xscale">0</property>
+ <property name="yscale">0</property>
+ <property name="top_padding">0</property>
+ <property name="bottom_padding">0</property>
+ <property name="left_padding">0</property>
+ <property name="right_padding">0</property>
+
+ <child>
+ <widget class="GtkHBox" id="hbox3">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">2</property>
+
+ <child>
+ <widget class="GtkImage" id="image19">
+ <property name="visible">True</property>
+ <property name="stock">gtk-index</property>
+ <property name="icon_size">4</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="label3">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Try _Selected</property>
+ <property name="use_underline">True</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="UriChoiceConstantsButton">
+ <property name="visible">True</property>
+ <property name="sensitive">False</property>
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">Try Constants</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ <property name="response_id">0</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="copyButton">
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-copy</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ <property name="response_id">0</property>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="uriChoiceAutoButton">
+ <property name="visible">True</property>
+ <property name="can_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ <property name="response_id">0</property>
+
+ <child>
+ <widget class="GtkAlignment" id="alignment5">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xscale">0</property>
+ <property name="yscale">0</property>
+ <property name="top_padding">0</property>
+ <property name="bottom_padding">0</property>
+ <property name="left_padding">0</property>
+ <property name="right_padding">0</property>
+
+ <child>
+ <widget class="GtkHBox" id="hbox16">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">2</property>
+
+ <child>
+ <widget class="GtkImage" id="image302">
+ <property name="visible">True</property>
+ <property name="stock">gtk-ok</property>
+ <property name="icon_size">4</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="okLabel">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">bla bla bla</property>
+ <property name="use_underline">True</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="pack_type">GTK_PACK_END</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkVBox" id="vbox2">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">3</property>
+
+ <child>
+ <widget class="GtkLabel" id="UriChoiceLabel">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">some informative message here ...</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkScrolledWindow" id="scrolledwindow1">
+ <property name="width_request">400</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="hscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+ <property name="vscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+ <property name="shadow_type">GTK_SHADOW_NONE</property>
+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>
+
+ <child>
+ <widget class="GtkTreeView" id="UriChoiceTreeView">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="headers_visible">False</property>
+ <property name="rules_hint">False</property>
+ <property name="reorderable">False</property>
+ <property name="enable_search">True</property>
+ <property name="fixed_height_mode">False</property>
+ <property name="hover_selection">False</property>
+ <property name="hover_expand">False</property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkHBox" id="uriEntryHBox">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkLabel" id="label2">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">URI: </property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkEntry" id="entry1">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="editable">True</property>
+ <property name="visibility">True</property>
+ <property name="max_length">0</property>
+ <property name="text" translatable="yes"></property>
+ <property name="has_frame">True</property>
+ <property name="invisible_char">*</property>
+ <property name="activates_default">False</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+</widget>
+
+<widget class="GtkWindow" id="FindReplWin">
+ <property name="border_width">5</property>
+ <property name="title" translatable="yes">Find & Replace</property>
+ <property name="type">GTK_WINDOW_TOPLEVEL</property>
+ <property name="window_position">GTK_WIN_POS_MOUSE</property>
+ <property name="modal">False</property>
+ <property name="resizable">False</property>
+ <property name="destroy_with_parent">False</property>
+ <property name="decorated">True</property>
+ <property name="skip_taskbar_hint">False</property>
+ <property name="skip_pager_hint">False</property>
+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_DIALOG</property>
+ <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>
+ <property name="focus_on_map">True</property>
+
+ <child>
+ <widget class="GtkTable" id="table1">
+ <property name="visible">True</property>
+ <property name="n_rows">3</property>
+ <property name="n_columns">2</property>
+ <property name="homogeneous">False</property>
+ <property name="row_spacing">5</property>
+ <property name="column_spacing">0</property>
+
+ <child>
+ <widget class="GtkLabel" id="label17">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Find:</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">0</property>
+ <property name="bottom_attach">1</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="label18">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Replace with: </property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">1</property>
+ <property name="bottom_attach">2</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkEntry" id="findEntry">
+ <property name="visible">True</property>
+ <property name="can_default">True</property>
+ <property name="has_default">True</property>
+ <property name="can_focus">True</property>
+ <property name="has_focus">True</property>
+ <property name="editable">True</property>
+ <property name="visibility">True</property>
+ <property name="max_length">0</property>
+ <property name="text" translatable="yes"></property>
+ <property name="has_frame">True</property>
+ <property name="invisible_char">*</property>
+ <property name="activates_default">False</property>
+ </widget>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="right_attach">2</property>
+ <property name="top_attach">0</property>
+ <property name="bottom_attach">1</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkEntry" id="replaceEntry">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="editable">True</property>
+ <property name="visibility">True</property>
+ <property name="max_length">0</property>
+ <property name="text" translatable="yes"></property>
+ <property name="has_frame">True</property>
+ <property name="invisible_char">*</property>
+ <property name="activates_default">False</property>
+ </widget>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="right_attach">2</property>
+ <property name="top_attach">1</property>
+ <property name="bottom_attach">2</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkHBox" id="hbox19">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">5</property>
+
+ <child>
+ <widget class="GtkVBox" id="vbox9">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <placeholder/>
+ </child>
+
+ <child>
+ <placeholder/>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="findButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-find</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="findReplButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+
+ <child>
+ <widget class="GtkAlignment" id="alignment13">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xscale">0</property>
+ <property name="yscale">0</property>
+ <property name="top_padding">0</property>
+ <property name="bottom_padding">0</property>
+ <property name="left_padding">0</property>
+ <property name="right_padding">0</property>
+
+ <child>
+ <widget class="GtkHBox" id="hbox20">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">2</property>
+
+ <child>
+ <widget class="GtkImage" id="image357">
+ <property name="visible">True</property>
+ <property name="stock">gtk-find-and-replace</property>
+ <property name="icon_size">4</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="label19">
+ <property name="visible">True</property>
+ <property name="label">_Replace</property>
+ <property name="use_underline">True</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="cancelButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-cancel</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">2</property>
+ <property name="top_attach">2</property>
+ <property name="bottom_attach">3</property>
+ <property name="y_padding">5</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+</widget>
+
+<widget class="GtkWindow" id="NewDevelWin">
+ <property name="title" translatable="yes">Create development</property>
+ <property name="type">GTK_WINDOW_TOPLEVEL</property>
+ <property name="window_position">GTK_WIN_POS_CENTER_ALWAYS</property>
+ <property name="modal">True</property>
+ <property name="resizable">False</property>
+ <property name="destroy_with_parent">False</property>
+ <property name="decorated">True</property>
+ <property name="skip_taskbar_hint">False</property>
+ <property name="skip_pager_hint">False</property>
+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_UTILITY</property>
+ <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>
+ <property name="focus_on_map">True</property>
+
+ <child>
+ <widget class="GtkVBox" id="vbox10">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkTable" id="table2">
+ <property name="border_width">3</property>
+ <property name="visible">True</property>
+ <property name="n_rows">2</property>
+ <property name="n_columns">3</property>
+ <property name="homogeneous">False</property>
+ <property name="row_spacing">5</property>
+ <property name="column_spacing">5</property>
+
+ <child>
+ <widget class="GtkLabel" id="label20">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Name</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">0</property>
+ <property name="bottom_attach">1</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="label21">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Root directory</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">1</property>
+ <property name="bottom_attach">2</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkEntry" id="nameEntry">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="editable">True</property>
+ <property name="visibility">True</property>
+ <property name="max_length">0</property>
+ <property name="text" translatable="yes"></property>
+ <property name="has_frame">True</property>
+ <property name="invisible_char">*</property>
+ <property name="activates_default">False</property>
+ </widget>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="right_attach">2</property>
+ <property name="top_attach">0</property>
+ <property name="bottom_attach">1</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkEntry" id="rootEntry">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="editable">True</property>
+ <property name="visibility">True</property>
+ <property name="max_length">0</property>
+ <property name="text" translatable="yes"></property>
+ <property name="has_frame">True</property>
+ <property name="invisible_char">*</property>
+ <property name="activates_default">False</property>
+ </widget>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="right_attach">2</property>
+ <property name="top_attach">1</property>
+ <property name="bottom_attach">2</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="chooseRootButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">...</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="right_attach">3</property>
+ <property name="top_attach">1</property>
+ <property name="bottom_attach">2</property>
+ <property name="x_options">fill</property>
+ <property name="y_options"></property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkHSeparator" id="hseparator1">
+ <property name="visible">True</property>
+ </widget>
+ <packing>
+ <property name="padding">2</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkHBox" id="hbox21">
+ <property name="border_width">3</property>
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">5</property>
+
+ <child>
+ <widget class="GtkVBox" id="vbox11">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <placeholder/>
+ </child>
+
+ <child>
+ <placeholder/>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="addButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-add</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="cancelButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-cancel</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+</widget>
+
+<widget class="GtkWindow" id="DevelListWin">
+ <property name="title" translatable="yes">Developments</property>
+ <property name="type">GTK_WINDOW_TOPLEVEL</property>
+ <property name="window_position">GTK_WIN_POS_CENTER</property>
+ <property name="modal">False</property>
+ <property name="resizable">True</property>
+ <property name="destroy_with_parent">False</property>
+ <property name="decorated">True</property>
+ <property name="skip_taskbar_hint">False</property>
+ <property name="skip_pager_hint">False</property>
+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_NORMAL</property>
+ <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>
+ <property name="focus_on_map">True</property>
+
+ <child>
+ <widget class="GtkVBox" id="vbox12">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkScrolledWindow" id="scrolledwindow10">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="hscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+ <property name="vscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+ <property name="shadow_type">GTK_SHADOW_IN</property>
+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>
+
+ <child>
+ <widget class="GtkTreeView" id="developmentsTreeview">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="headers_visible">False</property>
+ <property name="rules_hint">False</property>
+ <property name="reorderable">False</property>
+ <property name="enable_search">True</property>
+ <property name="fixed_height_mode">False</property>
+ <property name="hover_selection">False</property>
+ <property name="hover_expand">False</property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkHSeparator" id="hseparator2">
+ <property name="visible">True</property>
+ </widget>
+ <packing>
+ <property name="padding">2</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkHBox" id="buttonsHbox">
+ <property name="border_width">3</property>
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">4</property>
+
+ <child>
+ <widget class="GtkVBox" id="vbox13">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <placeholder/>
+ </child>
+
+ <child>
+ <placeholder/>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="newButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-new</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="deleteButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-delete</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="buildButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+
+ <child>
+ <widget class="GtkAlignment" id="alignment14">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xscale">0</property>
+ <property name="yscale">0</property>
+ <property name="top_padding">0</property>
+ <property name="bottom_padding">0</property>
+ <property name="left_padding">0</property>
+ <property name="right_padding">0</property>
+
+ <child>
+ <widget class="GtkHBox" id="hbox23">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">2</property>
+
+ <child>
+ <widget class="GtkImage" id="image358">
+ <property name="visible">True</property>
+ <property name="stock">gtk-execute</property>
+ <property name="icon_size">4</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="label22">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">_Build</property>
+ <property name="use_underline">True</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="cleanButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+
+ <child>
+ <widget class="GtkAlignment" id="alignment15">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xscale">0</property>
+ <property name="yscale">0</property>
+ <property name="top_padding">0</property>
+ <property name="bottom_padding">0</property>
+ <property name="left_padding">0</property>
+ <property name="right_padding">0</property>
+
+ <child>
+ <widget class="GtkHBox" id="hbox24">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">2</property>
+
+ <child>
+ <widget class="GtkImage" id="image359">
+ <property name="visible">True</property>
+ <property name="stock">gtk-clear</property>
+ <property name="icon_size">4</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="label23">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">C_lean</property>
+ <property name="use_underline">True</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
+ <property name="width_chars">-1</property>
+ <property name="single_line_mode">False</property>
+ <property name="angle">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="closeButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="label">gtk-close</property>
+ <property name="use_stock">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="focus_on_click">True</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+</widget>
+
+</glade-interface>
diff --git a/helm/matita/matita.gtkrc b/helm/matita/matita.gtkrc
new file mode 100644
index 000000000..91081c311
--- /dev/null
+++ b/helm/matita/matita.gtkrc
@@ -0,0 +1,80 @@
+# Based on /usr/share/themes/Emacs/gtk-2.0-key/,
+# modified by Zack for matita
+
+#
+# A keybinding set implementing emacs-like keybindings
+#
+
+#
+# Bindings for GtkTextView and GtkEntry
+#
+binding "gtk-emacs-text-entry"
+{
+ bind "<ctrl>b" { "move-cursor" (logical-positions, -1, 0) }
+ bind "<shift><ctrl>b" { "move-cursor" (logical-positions, -1, 1) }
+ bind "<ctrl>f" { "move-cursor" (logical-positions, 1, 0) }
+ bind "<shift><ctrl>f" { "move-cursor" (logical-positions, 1, 1) }
+
+ bind "<alt>b" { "move-cursor" (words, -1, 0) }
+ bind "<shift><alt>b" { "move-cursor" (words, -1, 1) }
+ bind "<alt>f" { "move-cursor" (words, 1, 0) }
+ bind "<shift><alt>f" { "move-cursor" (words, 1, 1) }
+
+ bind "<ctrl>a" { "move-cursor" (paragraph-ends, -1, 0) }
+ bind "<shift><ctrl>a" { "move-cursor" (paragraph-ends, -1, 1) }
+ bind "<ctrl>e" { "move-cursor" (paragraph-ends, 1, 0) }
+ bind "<shift><ctrl>e" { "move-cursor" (paragraph-ends, 1, 1) }
+
+ bind "<ctrl>w" { "cut-clipboard" () }
+ bind "<ctrl>y" { "paste-clipboard" () }
+
+ bind "<ctrl>d" { "delete-from-cursor" (chars, 1) }
+ bind "<alt>d" { "delete-from-cursor" (word-ends, 1) }
+ bind "<ctrl>k" { "delete-from-cursor" (paragraph-ends, 1) }
+ bind "<alt>backslash" { "delete-from-cursor" (whitespace, 1) }
+
+ bind "<alt>space" { "delete-from-cursor" (whitespace, 1)
+ "insert-at-cursor" (" ") }
+ bind "<alt>KP_Space" { "delete-from-cursor" (whitespace, 1)
+ "insert-at-cursor" (" ") }
+
+ #
+ # Some non-Emacs keybindings people are attached to
+ #
+ bind "<ctrl>u" {
+ "move-cursor" (paragraph-ends, -1, 0)
+ "delete-from-cursor" (paragraph-ends, 1)
+ }
+ bind "<ctrl>h" { "delete-from-cursor" (chars, -1) }
+ bind "<ctrl>w" { "delete-from-cursor" (word-ends, -1) }
+}
+
+#
+# Bindings for GtkTextView
+#
+binding "gtk-emacs-text-view"
+{
+# bind "<ctrl>p" { "move-cursor" (display-lines, -1, 0) }
+ bind "<shift><ctrl>p" { "move-cursor" (display-lines, -1, 1) }
+# bind "<ctrl>n" { "move-cursor" (display-lines, 1, 0) }
+ bind "<shift><ctrl>n" { "move-cursor" (display-lines, 1, 1) }
+
+ bind "<ctrl>space" { "set-anchor" () }
+ bind "<ctrl>KP_Space" { "set-anchor" () }
+}
+
+#
+# Bindings for GtkTreeView
+#
+binding "gtk-emacs-tree-view"
+{
+ bind "<ctrl>s" { "start-interactive-search" () }
+ bind "<ctrl>f" { "move-cursor" (logical-positions, 1) }
+ bind "<ctrl>b" { "move-cursor" (logical-positions, -1) }
+}
+
+class "GtkEntry" binding "gtk-emacs-text-entry"
+class "GtkTextView" binding "gtk-emacs-text-entry"
+class "GtkTextView" binding "gtk-emacs-text-view"
+class "GtkTreeView" binding "gtk-emacs-tree-view"
+
diff --git a/helm/matita/matita.lang b/helm/matita/matita.lang
new file mode 100644
index 000000000..0c181ee44
--- /dev/null
+++ b/helm/matita/matita.lang
@@ -0,0 +1,186 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE language SYSTEM "language.dtd">
+<language _name="grafite" version="1.0" _section="Sources" mimetypes="text/x-matita">
+
+ <escape-char>\</escape-char>
+
+ <block-comment _name = "Block Comment" style = "Comment">
+ <start-regex>\(\*</start-regex>
+ <end-regex>\*\)</end-regex>
+ </block-comment>
+
+ <block-comment _name = "Commented Code" style = "Comment">
+ <start-regex>\(\*\*</start-regex>
+ <end-regex>\*\*\)</end-regex>
+ </block-comment>
+
+ <keyword-list _name = "Theorem Kinds" style = "Keyword" case-sensitive="TRUE">
+ <keyword>theorem</keyword>
+ <keyword>definition</keyword>
+ <keyword>lemma</keyword>
+ <keyword>fact</keyword>
+ <keyword>remark</keyword>
+ <keyword>variant</keyword>
+ </keyword-list>
+
+ <keyword-list _name = "Commands" style = "Keyword" case-sensitive="TRUE">
+ <keyword>alias</keyword>
+ <keyword>and</keyword>
+ <keyword>as</keyword>
+ <keyword>coercion</keyword>
+ <keyword>coinductive</keyword>
+ <keyword>corec</keyword>
+ <keyword>default</keyword>
+ <keyword>for</keyword>
+ <keyword>include</keyword>
+ <keyword>inductive</keyword>
+ <keyword>in</keyword>
+ <keyword>interpretation</keyword>
+ <keyword>let</keyword>
+ <keyword>match</keyword>
+ <keyword>names</keyword>
+ <keyword>notation</keyword>
+ <keyword>on</keyword>
+ <keyword>qed</keyword>
+ <keyword>rec</keyword>
+ <keyword>record</keyword>
+ <keyword>return</keyword>
+ <keyword>to</keyword>
+ <keyword>using</keyword>
+ <keyword>with</keyword>
+ </keyword-list>
+
+ <pattern-item _name = "Command [" style = "Keyword">
+ <regex>\[</regex>
+ </pattern-item>
+ <pattern-item _name = "Command |" style = "Keyword">
+ <regex>\|</regex>
+ </pattern-item>
+ <pattern-item _name = "Command ]" style = "Keyword">
+ <regex>\]</regex>
+ </pattern-item>
+ <pattern-item _name = "Command {" style = "Keyword">
+ <regex>\{</regex>
+ </pattern-item>
+ <pattern-item _name = "Command }" style = "Keyword">
+ <regex>\}</regex>
+ </pattern-item>
+ <pattern-item _name = "Notation ast mark" style = "Keyword">
+ <regex>@</regex>
+ </pattern-item>
+ <pattern-item _name = "Notation meta mark" style = "Keyword">
+ <regex>\$</regex>
+ </pattern-item>
+
+ <keyword-list _name = "Sorts" style = "Data Type" case-sensitive="TRUE">
+ <keyword>Set</keyword>
+ <keyword>Prop</keyword>
+ <keyword>Type</keyword>
+ </keyword-list>
+
+ <keyword-list _name = "Tactics" style = "Others 2" case-sensitive="TRUE">
+ <keyword>absurd</keyword>
+ <keyword>apply</keyword>
+ <keyword>assumption</keyword>
+ <keyword>auto</keyword>
+ <keyword>paramodulation</keyword>
+ <keyword>clear</keyword>
+ <keyword>clearbody</keyword>
+ <keyword>change</keyword>
+ <keyword>compare</keyword>
+ <keyword>constructor</keyword>
+ <keyword>contradiction</keyword>
+ <keyword>cut</keyword>
+ <keyword>decide</keyword> <keyword>equality</keyword> <!-- CSC: ??? -->
+ <keyword>decompose</keyword>
+ <keyword>discriminate</keyword>
+ <keyword>elim</keyword>
+ <keyword>elimType</keyword>
+ <keyword>exact</keyword>
+ <keyword>exists</keyword>
+ <keyword>fail</keyword>
+ <keyword>fold</keyword>
+ <keyword>fourier</keyword>
+ <keyword>fwd</keyword>
+ <keyword>generalize</keyword>
+ <keyword>goal</keyword>
+ <keyword>id</keyword>
+ <keyword>injection</keyword>
+ <keyword>intro</keyword>
+ <keyword>intros</keyword>
+ <keyword>lapply</keyword>
+ <keyword>left</keyword>
+ <keyword>letin</keyword>
+ <keyword>normalize</keyword>
+ <keyword>reduce</keyword>
+ <keyword>reflexivity</keyword>
+ <keyword>replace</keyword>
+ <keyword>rewrite</keyword>
+ <keyword>ring</keyword>
+ <keyword>right</keyword>
+ <keyword>symmetry</keyword>
+ <keyword>simplify</keyword>
+ <keyword>split</keyword>
+ <keyword>to</keyword>
+ <keyword>transitivity</keyword>
+ <keyword>unfold</keyword>
+ <keyword>whd</keyword>
+ </keyword-list>
+
+ <keyword-list _name = "Tacticals" style = "Keyword" case-sensitive="TRUE">
+ <keyword>try</keyword>
+ <keyword>solve</keyword>
+ <keyword>do</keyword>
+ <keyword>repeat</keyword>
+ <keyword>first</keyword>
+ </keyword-list>
+
+
+ <keyword-list _name = "Matita Macro" style = "Others 3" case-sensitive="TRUE">
+ <keyword>print</keyword>
+ <keyword>check</keyword>
+ <keyword>hint</keyword>
+ <keyword>quit</keyword>
+ <keyword>set</keyword>
+ </keyword-list>
+
+ <keyword-list _name = "Whelp Macro" style = "Others 3"
+ case-sensitive="TRUE"
+ beginning-regex="whelp *"
+ match-empty-string-at-beginning="FALSE"
+ match-empty-string-at-end="FALSE" >
+ <keyword>elim</keyword>
+ <keyword>hint</keyword>
+ <keyword>instance</keyword>
+ <keyword>locate</keyword>
+ <keyword>match</keyword>
+ </keyword-list>
+
+ <keyword-list _name = "TeX Macro" style = "Preprocessor"
+ case-sensitive="TRUE"
+ beginning-regex="\\"
+ match-empty-string-at-beginning="FALSE"
+ match-empty-string-at-end="FALSE" >
+ <keyword>def</keyword>
+ <keyword>forall</keyword>
+ <keyword>lambda</keyword>
+ <keyword>to</keyword>
+ <keyword>exists</keyword>
+ <keyword>Rightarrow</keyword>
+ <keyword>Assign</keyword>
+ <keyword>land</keyword>
+ <keyword>lor</keyword>
+ <keyword>lnot</keyword>
+ <keyword>liff</keyword>
+ <keyword>subst</keyword>
+ <keyword>vdash</keyword>
+ <keyword>iforall</keyword>
+ <keyword>iexists</keyword>
+ </keyword-list>
+
+ <string _name = "String" style = "String" >
+ <start-regex>"</start-regex>
+ <end-regex>"</end-regex>
+ </string>
+
+</language>
diff --git a/helm/matita/matita.ma.templ b/helm/matita/matita.ma.templ
new file mode 100644
index 000000000..ec1bc8006
--- /dev/null
+++ b/helm/matita/matita.ma.templ
@@ -0,0 +1,16 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/test/".
+
diff --git a/helm/matita/matita.ml b/helm/matita/matita.ml
new file mode 100644
index 000000000..016d69336
--- /dev/null
+++ b/helm/matita/matita.ml
@@ -0,0 +1,216 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+open MatitaGtkMisc
+open GrafiteTypes
+
+(** {2 Initialization} *)
+
+let _ = MatitaInit.initialize_all ()
+let _ = Paramodulation.Saturation.init () (* ALB to link paramodulation *)
+
+(** {2 GUI callbacks} *)
+
+let gui = MatitaGui.instance ()
+
+let script =
+ let s =
+ MatitaScript.script
+ ~source_view:gui#sourceView
+ ~mathviewer:(MatitaMathView.mathViewer ())
+ ~urichooser:(fun uris ->
+ try
+ MatitaGui.interactive_uri_choice ~selection_mode:`SINGLE
+ ~title:"Matita: URI chooser"
+ ~msg:"Select the URI" ~hide_uri_entry:true
+ ~hide_try:true ~ok_label:"_Apply" ~ok_action:`SELECT
+ ~copy_cb:(fun s -> gui#sourceView#buffer#insert ("\n"^s^"\n"))
+ () ~id:"boh?" uris
+ with MatitaTypes.Cancel -> [])
+ ~set_star:gui#setStar
+ ~ask_confirmation:
+ (fun ~title ~message ->
+ MatitaGtkMisc.ask_confirmation ~title ~message
+ ~parent:gui#main#toplevel ())
+ ~develcreator:gui#createDevelopment
+ ()
+ in
+ gui#sourceView#source_buffer#begin_not_undoable_action ();
+ s#reset ();
+ s#template ();
+ gui#sourceView#source_buffer#end_not_undoable_action ();
+ s
+
+ (* math viewers *)
+let _ =
+ let cic_math_view = MatitaMathView.cicMathView_instance () in
+ let sequents_viewer = MatitaMathView.sequentsViewer_instance () in
+ sequents_viewer#load_logo;
+ cic_math_view#set_href_callback
+ (Some (fun uri -> (MatitaMathView.cicBrowser ())#load
+ (`Uri (UriManager.uri_of_string uri))));
+ let browser_observer _ _ = MatitaMathView.refresh_all_browsers () in
+ let sequents_observer _ grafite_status =
+ sequents_viewer#reset;
+ match grafite_status.proof_status with
+ | Incomplete_proof ({ stack = stack } as incomplete_proof) ->
+ sequents_viewer#load_sequents incomplete_proof;
+ (try
+ script#setGoal (Some (Continuationals.Stack.find_goal stack));
+ let goal =
+ match script#goal with
+ None -> assert false
+ | Some n -> n
+ in
+ sequents_viewer#goto_sequent goal
+ with Failure _ -> script#setGoal None);
+ | Proof proof -> sequents_viewer#load_logo_with_qed
+ | No_proof -> sequents_viewer#load_logo
+ | Intermediate _ -> assert false (* only the engine may be in this state *)
+ in
+ script#addObserver sequents_observer;
+ script#addObserver browser_observer
+
+ (** {{{ Debugging *)
+let _ =
+ if BuildTimeConf.debug then begin
+ gui#main#debugMenu#misc#show ();
+ let addDebugItem ~label callback =
+ let item =
+ GMenu.menu_item ~packing:gui#main#debugMenu_menu#append ~label ()
+ in
+ ignore (item#connect#activate callback)
+ in
+ addDebugItem "dump environment to \"env.dump\"" (fun _ ->
+ let oc = open_out "env.dump" in
+ CicEnvironment.dump_to_channel oc;
+ close_out oc);
+ addDebugItem "load environment from \"env.dump\"" (fun _ ->
+ let ic = open_in "env.dump" in
+ CicEnvironment.restore_from_channel ic;
+ close_in ic);
+ addDebugItem "dump universes" (fun _ ->
+ List.iter (fun (u,_,g) ->
+ prerr_endline (UriManager.string_of_uri u);
+ CicUniv.print_ugraph g) (CicEnvironment.list_obj ())
+ );
+ addDebugItem "dump environment content" (fun _ ->
+ List.iter (fun (u,_,_) ->
+ prerr_endline (UriManager.string_of_uri u))
+ (CicEnvironment.list_obj ()));
+(* addDebugItem "print selections" (fun () ->
+ let cicMathView = MatitaMathView.cicMathView_instance () in
+ List.iter HLog.debug (cicMathView#string_of_selections)); *)
+ addDebugItem "dump script status" script#dump;
+ addDebugItem "dump configuration file to ./foo.conf.xml" (fun _ ->
+ Helm_registry.save_to "./foo.conf.xml");
+ addDebugItem "dump metasenv"
+ (fun _ ->
+ if script#onGoingProof () then
+ HLog.debug (CicMetaSubst.ppmetasenv [] script#proofMetasenv));
+ addDebugItem "dump coercions Db" (fun _ ->
+ List.iter
+ (fun (s,t,u) ->
+ HLog.debug
+ (UriManager.name_of_uri u ^ ":"
+ ^ CoercDb.name_of_carr s ^ " -> " ^ CoercDb.name_of_carr t))
+ (CoercDb.to_list ()));
+ addDebugItem "print top-level grammar entries"
+ CicNotationParser.print_l2_pattern;
+ addDebugItem "dump moo to stderr" (fun _ ->
+ let grafite_status = (MatitaScript.current ())#grafite_status in
+ let moo = grafite_status.moo_content_rev in
+ List.iter
+ (fun cmd ->
+ prerr_endline (GrafiteAstPp.pp_command ~obj_pp:(fun _ -> assert false)
+ cmd))
+ (List.rev moo));
+ addDebugItem "print metasenv goals and stack to stderr"
+ (fun _ ->
+ prerr_endline ("metasenv goals: " ^ String.concat " "
+ (List.map (fun (g, _, _) -> string_of_int g)
+ (MatitaScript.current ())#proofMetasenv));
+ prerr_endline ("stack: " ^ Continuationals.Stack.pp
+ (GrafiteTypes.get_stack (MatitaScript.current ())#grafite_status)));
+(* addDebugItem "ask record choice"
+ (fun _ ->
+ HLog.debug (string_of_int
+ (MatitaGtkMisc.ask_record_choice ~gui ~title:"title" ~message:"msg"
+ ~fields:["a"; "b"; "c"]
+ ~records:[
+ ["0"; "0"; "0"]; ["0"; "0"; "1"]; ["0"; "1"; "0"]; ["0"; "1"; "1"];
+ ["1"; "0"; "0"]; ["1"; "0"; "1"]; ["1"; "1"; "0"]; ["1"; "1"; "1"]]
+ ()))); *)
+ addDebugItem "rotate light bulbs"
+ (fun _ ->
+ let nb = gui#main#hintNotebook in
+ nb#goto_page ((nb#current_page + 1) mod 3));
+ addDebugItem "print runtime dir"
+ (fun _ ->
+ prerr_endline BuildTimeConf.runtime_base_dir);
+ addDebugItem "disable all (pretty printing) notations"
+ (fun _ -> CicNotation.set_active_notations []);
+ addDebugItem "enable all (pretty printing) notations"
+ (fun _ ->
+ CicNotation.set_active_notations
+ (List.map fst (CicNotation.get_all_notations ())));
+ end
+ (** Debugging }}} *)
+
+ (** {2 Command line parsing} *)
+
+let set_matita_mode () =
+ let matita_mode =
+ if Filename.basename Sys.argv.(0) = "cicbrowser" ||
+ Filename.basename Sys.argv.(0) = "cicbrowser.opt"
+ then "cicbrowser"
+ else "matita"
+ in
+ Helm_registry.set "matita.mode" matita_mode
+
+ (** {2 Main} *)
+
+let _ =
+ set_matita_mode ();
+ at_exit (fun () -> print_endline "\nThanks for using Matita!\n");
+ Sys.catch_break true;
+ let args = Helm_registry.get_list Helm_registry.string "matita.args" in
+ if Helm_registry.get "matita.mode" = "cicbrowser" then (* cicbrowser *)
+ let browser = MatitaMathView.cicBrowser () in
+ let uri = match args with [] -> "cic:/" | _ -> String.concat " " args in
+ browser#loadInput uri
+ else begin (* matita *)
+ (try gui#loadScript (List.hd args) with Failure _ -> ());
+ gui#main#mainWin#show ();
+ end;
+ try
+ GtkThread.main ()
+ with Sys.Break -> ()
+
+(* vim:set foldmethod=marker: *)
diff --git a/helm/matita/matita.txt b/helm/matita/matita.txt
new file mode 100644
index 000000000..ce34e404c
--- /dev/null
+++ b/helm/matita/matita.txt
@@ -0,0 +1,426 @@
+ Ferruccio ha cambiato matita.lang:
+ > <keyword>iforall</keyword>
+ > <keyword>iexists</keyword>
+
+TODO
+ NUCLEO
+ - http://mowgli.cs.unibo.it:58084/proofCheck?uri=cic:/Coq/Reals/Rtopology/interior_P3.con
+ - i files di coq non hanno gli universi e hanno Type senza l'id numerico
+ per ora vengono considerati come con grafo vuoto...
+ - limit_mul non compila (usare test_library per testare l'intera libreria)
+ (15:06:07) Zack: http://www.cs.unibo.it/cgi-bin/viewcvs.cgi/helm/gTopLevel/testlibrary.ml?rev=1.20&hideattic=0&content-type=text/vnd.viewcvs-markup
+ - PREOCCUPANTE: per
+ inductive i : Prop := K : True (*-> i*) -> i.
+ noi generiamo i_rec e i_rect con e senza il commento qui sopra; Coq NON
+ genera i_rec e i_rect quando c'e' un argomento ricorsivo.
+ (CSC: manca vincolo aggiuntivo non dipendente dalla sorta per il caso in
+ questione) -> CSC, parzialmente risolto, da finire
+ - Set predicativo
+ - bug universi e tipi induttivi (anche in cicElim.ml!!!)
+
+ TATTICHE
+ - coercions verso sorte:
+ 1. coercere a una sorta in posizione controvariante: andare verso Prop,
+ altrimenti verso {Type,Set,CProp} (indifferentemente?)
+ 2. coercere a una sorta in posizione covariante: la scelta piu' safe e'
+ andare verso Type, poi verso CProp, poi verso Set, poi verso Prop.
+ Unico problema: la scelta piu' safe e' anche quella pessima dal punto
+ di vista dell'estrazione di codice :-(
+ - fare normalize_pattern : pattern -> goal -> pattern e usarla per
+ abilitare fase 2 in fold e rewrite
+ - apply puo' generare termini non ben tipati.
+ Esempio: p = q e fare apply eq_ind' di p!
+ - generazione di principi di co-induzione per co-induttivi
+ - ARGOMENTI IMPLICIT: li vogliamo? come? come disabilitarli localmente?
+ - file elim.ma: vengono creati lambda dummy e referenziati nell'outtype di
+ un case
+ - tattiche e fallimenti: una tattica che non progredisce dovrebbe fallire
+ - comportamento di tutte le tattiche nei confronti dei let-in
+ - elim con pattern
+ - assiomi (manca sintassi concreta e AST).
+ - Dare errore significativo al posto di NotWellTypedInterpreation -> CSC
+ - elim_intros_simpl e rewrite_simpl: ora non viene usata dal
+ ^^^^^^ ^^^^^^
+ toplevel la variante che semplifica. Capire quali sono i problemi
+ e/o cosa fare delle varianti con semplificazione.
+ (con sintassi concreta alla \section*, analogamente cut e similia che fanno
+ intros... ) -> CSC
+ - eta_expand non usata da nessuno? (ask Andrea?)
+ - eliminare eta_fix? (aspettare notazione) (correlato con sopra?)
+ - bug di ferruccio: fare un refresh dei nomi dopo l'applicazione
+ di una tattica. Di quali nomi fare refresh? (Andrea) di quelli
+ veramente ambigui, ovvero dell'ultimo binder tale che sotto di
+ esso un nome viene usato in maniera ambigua. Esempio:
+ \lambda x. \lambda x. (x x) (dove una x e' -2) ==> fare refresh
+ \lambda x. \lambda x. (x x) (dove entrambe sono -1) ==> non fare refresh
+ Capita quando un tipo dall'environment (e.g. \lambda x.T)
+ viene inserito in un contesto (e.g. x:nat) dove le variabili
+ sono gia' state legate in precedenza.
+
+ GUI GRAFICA
+ - cut & paste di pattern profondi nelle ipotesi
+ - cut & paste di inner-types non chiusi non funzionanti
+ - cut & paste di congetture nello script delle prove non funzionante
+ - keybinding globali: CTRL-{su,giu,...} devono fungere anche quando altre
+ finestre hanno il focus (e.g. cicBrowser). C'e' gia' da qualche parte il
+ codice che aggiunge i keybinding a tutte le eventBox, e' da ripristinare
+ - la finestrella per i development ha i pulsanti non sensitive.
+ - l'entry "Save" da menu non e' context sensitive (ti fa salvare anche
+ quando il file non e' stato modificato)
+ - non semplificherebbe le cose fare in modo che matitaScript sia un widget
+ (cosi' come lo e' matitaMathView) che eredita da GtkSourceView e mantiene
+ internamente lo status di matita etc. Appositi segnali permetterebbero di
+ evitare tutte le chiamate al singleton #instance di matitaScript, che
+ verrebbe creato dentro a matitaGui (o forse meglio dentro a matita e passato
+ a matitaGui). Si semplificherebbe forse anche la gestione di script
+ multipli? Forse no, perche' comunque ci puo' essere sempre solamente uno
+ ed un solo matitaScript (da spostare da un tab a un altro).
+ - la barra di stato: c'e' ma non funziona?
+
+ - feedback su hyperlink nei sequenti e nel browser: rendere visibili gli
+ hyperlink (cursore a "manina"? hyperlink evidenziati?). La maction che
+ collassa la prova e' fastidiosa: la prova si chiude se non si clicca
+ correttamente su un hyperlink (anche tooltip sui bottoni)
+
+ - che farne della palette delle tattiche?
+ - script outline, o meglio: modulo per la gestione del testo dello script
+ -> Zack
+ - riattaccare hbugs (brrr...) -> Zack
+
+ - supportare l'apertura di piu' script contemporaneamente in tab/finestre
+ diversi/e
+
+ GUI LOGICA
+ - -nodb non usato da disambiguazione: dopo il primo errore si ottiene
+ un errore di identificatore non trovato (dalla locate?)
+ - generazione di dipendenze verso .moo di Coq (non esistenti!) -> Zack
+ - proposta di Zack: NON calcolare (ed esportare) per default gli inner-types;
+ aggiungere un'opzione per questo a matitac (riduce drasticamente il tempo
+ di qed)
+ - la funzione alias_diff e' lentissima (anche se CSC l'ha accellerata di
+ un fattore 3x) e puo' essere evitata: chi vuole aggiungere alias (la
+ disambiguazione, il comando "alias" e l'add_obj) deve indicare
+ esplicitamente quali sono i nuovi alias, evitando cosi' la diff per
+ scoprirlo
+ - matitac deve fallire quando matita vuole aggiungere un alias!
+ - default equality e famiglia non e' undo-aware
+ - le coercion non sono undo-aware
+ - nuovo pretty-printer testuale: non stampa usando la notazione
+ (e.g. guardare output di matitac)
+ - matitamake foo/a.ma non funziona; bisogna chiamarlo con
+ matitamake /x/y/z/foo/a.ma
+ - notazione per i numeri -> Luca e Zack
+ - non chiudere transitivamente i moo ??
+
+ DEMONI E ALTRO
+ - compilare Whelp
+
+DONE
+- in MatitaEngine unificare/rimuovere eval_string, eval_from_stream e
+ eval_from_stream_greedy -> CSC
+- menu contestuale (tasto dx) nel sequent viewer -> Zack
+- in generale: invece di spiegare gli errori nel momento in cui si sollevano
+ le eccezioni, farlo quando vengono presentate all'utente. Motivo: il calcolo
+ del messaggio di errore puo' essere estremamente costoso (e' gia' successo!)
+ quando poi il messaggio non serve!!! -> CSC
+- matitaclean all (non troglie i moo?) -> Gares
+- matitaclean (e famiglia) non cancellano le directory vuote
+ (e per giunta il cicbrowser le mostra :-) -> Gares
+- missing feature unification: applicazione di teoremi (~A) quando il goal
+ e' False o di teoremi $symmetric R P$ quando il goal e' $P(x,y)$.
+ Fare un passo di delta[-beta?][-iota-etc.] quando da una parte c'e' una
+ testa rigida (che si espande in una freccia)? Ma il punto e' che il bug
+ non e' di unificazione, bensi' nella fase di preparazione del goal per
+ la apply -> CSC, Gares
+- Guardare il commento
+ (*CSC: this code is suspect and/or bugged: we try first without reduction
+ and then using whd. However, the saturate_term always tries with full
+ reduction without delta. *)
+ in primitiveTactics.ml. Potrebbe essere causa di rallentamento della apply
+ oltre che di bug! -> CSC, Gares
+- codice di inizializzazione di matita, matitac, matitatop replicato e non
+ in sync -> Gares
+- tutte gli script che parsano (e.g. matitaclean, matitadep) debbono
+ processare la notazione per evitare errori di parsing (visibili ora
+ che e' stata committata la contrib list)! -> Gares
+- E' possibile fare "Build" senza selezionare nulla, ottenendo un
+ assert false -> Gares
+- disambiguazione: attualmente io (CSC) ho committato la versione di
+ disambiguate.ml che NON ricorda gli alias in caso di disambiguazione
+ univoca (senza scelte per l'utente). [ cercare commento "Experimental" ]
+ Il problema di questa soluzione e' che rallenta in maniera significativa
+ l'esecuzione degli script. DOMANDA: quanto costano le fasi di
+ fetch/decode/execute delle linee dello script?
+ Una possibile alternativa e' avere alias "soft": se la disambiguazione
+ fallisce gli alias soft vengono ripuliti e si riprova.
+ Altra soluzione (Gares): avere alias multipli e provare tutti gli alias
+ multipli. Da combinare con il "ritenta con istanze multiple in caso di
+ fallimento".
+ SOLUZIONE PENSATA CON ANDREA: 1. la interpretate aggiunge un alias
+ implicito; 2. gli alias vengono ricordati come nella soluzione originale
+ (e veloce); 3. se la disambiguazione fallisce, allora gli alias vengono
+ dimenticati (quali? tutti? tutti tranne quelli chiesti all'utente?)
+ e si ritenta; se fallisce ancora si generano
+ istanze differenti e si ritenta; 4. ritentare anche senza e poi con
+ coercions? oppure ordinare preferendo la soluzione che non ha introdotto
+ coercions?; 5. che fare se alla fine restano piu' scelte? se si mettono
+ gli alias nello script viene un paciugo, credo! in particolare quando
+ vengono usate n istanze -> Zack, CSC
+- theorem t: True. elim O. ==> BOOM! unificazione di una testa flessibile con
+ True -> Gares
+- parsing contestuale (tattiche replace, change e forse altre)
+ capire dove fare la select per avere i contesti in cui disambiguare gli
+ altri argomenti. -> Zack
+- tattica unfold su rel a let-in bound variables: c'e' ancora un bug
+ aperto: "unfold x in H:..." la x passata alla unfold vive nel contesto
+ del goal e non in quello del pattern. Pertanto invece di cercare di
+ fare unfolding di x viene fatto unfolding di altro.
+ Soluzione: la funzione ProofEngineHelpers.select deve tornare una
+ funzione per rilocare i termini nel contesto giusto.
+ Esempio:
+ theorem t: let uno \def S O in uno + uno = S uno \to uno=uno.
+ intros. unfold uno in H.
+ NOTA: questo bug e' legato a quello di parsing in presenza di tattiche
+ con pattern, visto che in tal caso e' l'intero parsing a dover essere
+ fatto in un contesto differente. Risolvendo quel bug si risolve
+ automaticamente anche questo.
+ -> Zack
+- Usare il cicbrowser per fare "Whelp instance": lui riscrive la barra
+ con la notazione alla Coq V7.0 che non riesce piu' a riparsare! -> Zack
+- implementare inclusione file di configurazione (perche' ora tutti
+ i demoni scopiazzano venti righe per via del getter embedded :-( -> Zack
+- simplify non debbono zeta-espandere i let-in -> CSC, Gares
+- integrare nuova contrib ferruccio nel bench notturno e rilocarla in
+ contribs o qualcosa del genere -> CSC
+- CRITICO: quando l'environment non e' trusted non compila la library di
+ matita!!! -> Gares, CSC
+- bug di unsharing -> CSC
+- CRITICO (trovato anche da Ferruccio): typechecking di
+ cic:/Coq/ring/Quote/index_eq_prop.con
+ asserzione del nucleo (applicazione senza argomenti). -> CSC
+- verificare se tutte le query sono ora ottimizzate (usando il comando
+ explain) e usano gli indici in maniera ottimale; inoltre migliorare gli
+ indici sulle tabelle hits and count -> CSC
+- ???????????? Perche'?
+ mowgli:~# du -s /var/lib/mysql/mowgli/
+ 250696 /var/lib/mysql/mowgli/
+ mowgli:~# du -s /var/lib/mysql/matita/
+ 455096 /var/lib/mysql/matita/ -> CSC
+- library/nat/primes.ma: ex_prime ci mette un secolo il db (binding) a fare
+ la Mysql.exec che ritorna una lista vuota di risultati. Investigare.
+ Anche peggio in library/nat/minimization/f_max_true. -> CSC
+- integrare il famoso logo mancante (anche nell'About dialog) -> CSC
+- invertibilita' dell'inserimento automatico di alias: quando si torna
+ su bisognerebbe tornare su di un passo e non fare undo degli alias
+ (Zack: nella history ci sono anche gli offset per sapere a che pezzo di
+ script uno stato appartiene) -> CSC
+- bug di refresh del widget quando si avanza ("swap" tra la finestra dei
+ sequenti e la finestra dello script) -> CSC
+- sensitiveness per goto begin/end/etc. (???) -> Gares
+- cut&paste stile "X": rimane la parte blu e lockata! -> CSC
+- highlight degli errori di parsing nello script -> CSC
+- quando si fa una locate nel cicbrowser viene mangiato un pezzo di testo
+ dalla finestra principale!!! -> CSC
+- sensitiveness per copy/paste/cut/delete nel menu Edit -> CSC
+- fare "matita foo" (dove foo non esiste), cambiare qualcosa e uscire senza
+ salvare. In verita' foo e' stato scritto lo stesso! -> CSC
+- matitaclean deve rimuovere anche i .moo; in alternativa il makefile
+ non deve basarsi sui .moo per decidere se qualcosa e' stato compilato o meno
+ -> CSC, Gares
+- matitaclean all (o matitamake cleanall) dovrebbe radere al suolo la
+ directory .matita -> CSC, Gares
+- icone standard per zoom-in/out/= e piu' aderenza alle Gnome Interface
+ Guidelines (e.g. about dialog) -> CSC
+- salvare la parte di testo lockata dagli effetti di undo/redo con
+ (shift-)ctrl-Z e anche usando il menu che si apre con il tasto destro -> CSC
+- fare in modo che il testo caricato inizialmente da matita non sia
+ undoable (usando i metodi begin/end_not_undoable_action di gtk_source_view)
+ -> Gares
+- Implementare menu edit: cut/copy/undo/etc. -> CSC
+- gestione dei path per include: il path deve essere assoluto? da decidere ...
+ ( -I ?? o chiedere a matitamake la root e farci una find? ) -> Gares
+- freeze durante avanzamento -> Gares, CSC
+- tornare indietro (verso il cursore) in matita dovrebbe essere O(1) e non un
+ Undo passo passo (sembra che il collo di bottiglia sia fare iterare su ogni
+ uri da togliere (accorpare almeno il lavoro sul db magari aiuta) -> Gares, CSC
+- quando si sposta il punto di esecuzione dello script cambiare la parte di
+ script visibile nella finestra dello script -> Gares, CSC
+- find & replace -> Gares
+- Bug di cut&paste: se si fa cut&paste di testo lockato si ottiene testo
+ lockato! -> Gares
+- Bug: non disambigua
+ inductive i (x:nat) : bool \to Prop \def K : bool \to (i x true) \to (i x false).
+ perche' non inserisce nat nel domain di disambiguazione. Deve esserci un bug
+ stupido da qualche parte -> CSC
+- Bug vari nella generazione dei principi di eliminazione:
+ 1. generazione nomi (usa ref incrementata localmente) -> Andrea
+ 2. prodotti dipendenti come non-dipendenti (visibili eseguendo passo
+ passo il test inversion.ma) -> CSC, Gares
+ 3. usato trucco outtype non dipendenti per il case -> CSC, Gares
+- controllo per script modificato o meno prima di uscire -> Gares
+- LApply deve prendere in input gli identificatori che va a generare;
+ lascio a Ferruccio la scelta della sintassi concreta -> Ferruccio
+- fare tornare a matitac -1 quando lo stato finale e'
+ diverso da No_proof, non eseguire comandi quando lo
+ stato e' diverso da No_proof -> CSC
+- uri_of_term and term_of_uri: cambiare il tipo per far
+ tornare delle uri!!! -> CSC
+- intro = intros 1 -> Gares
+- timetravel (urimanager) -> Gares
+- implementare macro in matitaScript.ml -> Gares
+- history deve aggiornare anche la whelp bar -> Gares
+- commenti exeguibili (forse devono essere una lista e non
+ un singolo executable e forse devono contenere anche Note
+ e non solo Executable) -> Gares
+- spostare il codice di creazione delle tabelle da
+ MatitaDb, al momento quelle create da matita possono
+ andare out of sync con quelle create dai file .sql -> Gares
+- tree update in background -> Gares
+- update del getter in background -> Zack
+- agganciare href_callback del sequent_viewer -> Zack
+- shortcut varie per script handling -> Zack
+- operazioni rimanenti su script (top, bottom, jump) -> Zack
+- lighting-ls-getter in matita -> Gares
+- riagganciare toolbar -> Zack
+- evitare che n-mila tattiche Goal siano nello script
+ (una per ogni cambio di tab) -> Zack
+- implementazione comandi rimanenti in matitaEngine.ml -> Gares
+- sintassi per gli alias -> Gares
+- implementazione script handling (sopra engine) -> Zack
+- matitaSync all'indietro -> Gares
+- riagganciare GUI -> Zack
+
+(**********************************************************************)
+
+comandi:
+ - interattivi (solo da gui)
+ - Macro/Comandi (check, print, hint, undo, locate, match)
+ potrebbero anche non avere sintassi concreta, del tipo che
+ check e' solo un bottone che apre una finetra in cui puoi
+ scrivere un termine o selezionarlo dalla prova corrente
+ - batch (sono gli unici che stanno nel .ma)
+ - Tattiche, theorem, alias (cambiano la prova)
+
+
+ MOUSE
+-------------------------------------------+
+ gui (macro: hint) | SHELL
+ (disambiguatore) |
+ +-----------------+---------------+-----------------------------------
+ | matita (status) | | matitac
+ | (log) (sync) | but2log | fold ( fun s l -> engine l s) file
+ +-----------------+---------------+-----------------------------------
+ | lingua:/sintassi concreta non ambigua delle tattiche+Qed,Thm,alias/
+ +----------------------------------------------------------
+ | engine: TacticAst (cic) -> status -> status
+ | ma non usa il campo alias dello status
+---------+----------------------------------------------------------
+ ocaml
+--------------------------------------------------------------------
+
+
+engine:
+ - accetta solo linee non ambigue
+ - alias:
+ alias ident nat = "cic:/matita/gares/nat.ind#(1/1)".
+ alias number = (natural|real|positive|integer).
+
+
+
+matita:
+ - mantiene uno stack di stati
+ - mantiene un log sync con gli stati
+ - offre delle api per generare la sintassi concreta che puo' servire
+ alla gui (la gui fa una chiamata a funzione e matita genera "auto."
+ cosi' la sintassi la gui non la vede mai e la tratta al massimo come un
+ testo semplice e basta (insomma, metterei in matita il generatore di
+ sintassi concreta) but2log
+ - ha il controllo... ovvero anche la gui viene usata da matita, o per sapere
+ la prossima azione o per chidere di scegliere il termine tra una lista
+
+ (stato :: tl) (log , (start,end) :: tl)
+
+ +----------+
+ | |
+ +----------+
+
+gui:
+ - step
+ - choose
+
+stato:
+ - alias
+ - proof status option
+ - metadati relativi allo script per il sync
+ - settings "baseuri/url/" eccc
+ -
+
+alias
+ - sintassi concreta
+
+engine prende in input
+ - AST di Cic (tactic ast)
+
+sync:
+ - presi 2 stati fa il diff e lo somma/sottrae al DB
+
+(**********************************************************************)
+
+script handling
+- ad ogni script sul quale l'utente sta lavorando corrispondono
+ - un modello (vedi sotto)
+ - un buffer di testo gtk + attributi (usati principalmente per distinguere la
+ parte di testo immodificabile da quella modificabile)
+ - una lista di observer che vengono notificati ad ogni cambiamento di stato
+- un modello di script e' composto da:
+ - una lista di stringhe (inizialmente vuota) detta "statement list". Ogni
+ elemento della lista corrisponde ad uno statement (nel senso di
+ TacticAst.statement) gia' valutato dall'engine. La parte immodificabile del
+ buffer di testo corrisponde con le stringhe contenute nella lista
+ - una lista di stati (inizialmente contenente lo stato vuoto) detta "state
+ list". Si ha l'invariante che la lunghezza di tale lista e' uguale alla
+ lunghezza della statements list + 1. Lo stato i-esimo della lista di stati
+ e' lo stato di matita _prima_ dell'esecuzione dell i-esimo statement
+ - una stringa, detta "future text", corrispondente alla parte di testo dello
+ script non ancora valutata. L'ultimo stato della state list e' lo stato
+ corrente di matita
+- relazione tra modello e buffer di testo gtk
+ - le modifiche al testo del buffer sono possibili solo nella parta non ancora
+ valutata. Ognuna di esse viene apportata _anche_ al future text
+ - invariante: e' sempre possibile riscrivere ("redraw") l'intero contenuto del
+ buffer di testo a partire dal modello, attributi compresi
+- oggetto script
+ - metodi
+ - new: gtk_text_buffer -> script
+ - redraw: unit (* ridisegna il contenuto del buffer di testo *)
+ - advance: ?statement:string -> unit -> unit
+ (* valuta il primo statement del future text (usando eval_statement
+ (puo' fallire con una eccezione)), rimuove il testo corrispondente dal
+ future text, aggiunge alla statement list una entry per ogni statement
+ ritornato da eval_statement, aggiunge il nuovo stato alla state list,
+ invoka tutti gli observer
+ Se c'e' l'argomento opzionale statement, quello e' il testo che viene
+ passato ad eval_statement, se ha successo nessuna rimozione dal future
+ text viene effettuata *)
+ - retract: unit -> unit
+ (* sposta l'ultimo statement della statement list al future text, toglie
+ l'ultimo stato della state list, MatitaSync.time_travel
+ ~present:ultimo_stato ~past:stato_precedente *)
+ - private eval_statement: string -> MatitaTypes.status * string list
+ (* parsa lo statement
+ - se e' un Command o un Tactical (vedi TacticAst) invoca MatitaEngine
+ passando lo stato corrente
+ - se e' una Macro la gestisce (= tutte le Macro sono implementate qua)
+ Ritorna una lista di coppie <stato, statement>. La proiezione sulla
+ prima componente rappresenta gli stati da aggiungere alla state list;
+ quella sulla seconda gli statement da aggiungere alla statement list.
+ *)
+ (* gestione degli observer *)
+ - add_observer: (MatitaTypes.status -> unit) -> observer_id
+ - remove_observer: observer_id -> unit
+ (* gestione del salvataggio *)
+ - save_to: string -> unit (* ridisegna su file *)
+ - load_from: string -> unit
+ (* retract fino allo stato zero, nuovo stato con future text pari al
+ contenuto del file passato *)
+
diff --git a/helm/matita/matitaEngine.ml b/helm/matita/matitaEngine.ml
new file mode 100644
index 000000000..f0d8ee46c
--- /dev/null
+++ b/helm/matita/matitaEngine.ml
@@ -0,0 +1,142 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+let debug = false ;;
+let debug_print = if debug then prerr_endline else ignore ;;
+
+let disambiguate_tactic lexicon_status_ref grafite_status goal tac =
+ let metasenv,tac =
+ GrafiteDisambiguate.disambiguate_tactic
+ lexicon_status_ref
+ (GrafiteTypes.get_proof_context grafite_status goal)
+ (GrafiteTypes.get_proof_metasenv grafite_status)
+ tac
+ in
+ GrafiteTypes.set_metasenv metasenv grafite_status,tac
+
+let disambiguate_command lexicon_status_ref grafite_status cmd =
+ let lexicon_status,metasenv,cmd =
+ GrafiteDisambiguate.disambiguate_command
+ ~baseuri:(
+ try
+ Some (GrafiteTypes.get_string_option grafite_status "baseuri")
+ with
+ GrafiteTypes.Option_error _ -> None)
+ !lexicon_status_ref (GrafiteTypes.get_proof_metasenv grafite_status) cmd
+ in
+ lexicon_status_ref := lexicon_status;
+ GrafiteTypes.set_metasenv metasenv grafite_status,cmd
+
+let disambiguate_macro lexicon_status_ref grafite_status macro context =
+ let metasenv,macro =
+ GrafiteDisambiguate.disambiguate_macro
+ lexicon_status_ref
+ (GrafiteTypes.get_proof_metasenv grafite_status)
+ context macro
+ in
+ GrafiteTypes.set_metasenv metasenv grafite_status,macro
+
+let eval_ast ?do_heavy_checks ?clean_baseuri lexicon_status
+ grafite_status ast
+=
+ let lexicon_status_ref = ref lexicon_status in
+ let new_grafite_status,new_objs =
+ GrafiteEngine.eval_ast
+ ~disambiguate_tactic:(disambiguate_tactic lexicon_status_ref)
+ ~disambiguate_command:(disambiguate_command lexicon_status_ref)
+ ~disambiguate_macro:(disambiguate_macro lexicon_status_ref)
+ ?do_heavy_checks ?clean_baseuri grafite_status ast in
+ let new_lexicon_status =
+ LexiconSync.add_aliases_for_objs !lexicon_status_ref new_objs in
+ let new_aliases =
+ LexiconSync.alias_diff ~from:lexicon_status new_lexicon_status in
+ let _,intermediate_states =
+ let baseuri = GrafiteTypes.get_string_option new_grafite_status "baseuri" in
+ List.fold_left
+ (fun (lexicon_status,acc) (k,((v,_) as value)) ->
+ let b =
+ try
+ UriManager.buri_of_uri (UriManager.uri_of_string v) = baseuri
+ with
+ UriManager.IllFormedUri _ -> false (* v is a description, not a URI *)
+ in
+ if b then
+ lexicon_status,acc
+ else
+ let new_lexicon_status =
+ LexiconEngine.set_proof_aliases lexicon_status [k,value]
+ in
+ new_lexicon_status,
+ ((new_grafite_status,new_lexicon_status),Some (k,value))::acc
+ ) (lexicon_status,[]) new_aliases
+ in
+ ((new_grafite_status,new_lexicon_status),None)::intermediate_states
+
+let eval_from_stream ~first_statement_only ~include_paths ?(prompt=false)
+ ?do_heavy_checks ?clean_baseuri lexicon_status grafite_status str cb
+=
+ let rec loop lexicon_status grafite_status statuses =
+ let loop =
+ if first_statement_only then
+ fun _ _ _ -> raise End_of_file
+ else
+ loop
+ in
+ if prompt then (print_string "matita> "; flush stdout);
+ try
+ let lexicon_status,ast =
+ GrafiteParser.parse_statement ~include_paths str lexicon_status
+ in
+ (match ast with
+ GrafiteParser.LNone _ ->
+ loop lexicon_status grafite_status
+ (((grafite_status,lexicon_status),None)::statuses)
+ | GrafiteParser.LSome ast ->
+ cb grafite_status ast;
+ let new_statuses =
+ eval_ast ?do_heavy_checks ?clean_baseuri lexicon_status
+ grafite_status ast in
+ let grafite_status,lexicon_status =
+ match new_statuses with
+ [] -> assert false
+ | (s,_)::_ -> s
+ in
+ loop lexicon_status grafite_status (new_statuses @ statuses))
+ with
+ End_of_file -> statuses
+ in
+ loop lexicon_status grafite_status []
+;;
+
+let eval_string ~first_statement_only ~include_paths ?do_heavy_checks
+ ?clean_baseuri lexicon_status status str
+=
+ eval_from_stream ~first_statement_only ~include_paths ?do_heavy_checks
+ ?clean_baseuri lexicon_status status (Ulexing.from_utf8_string str)
+ (fun _ _ -> ())
diff --git a/helm/matita/matitaEngine.mli b/helm/matita/matitaEngine.mli
new file mode 100644
index 000000000..a3c54dea6
--- /dev/null
+++ b/helm/matita/matitaEngine.mli
@@ -0,0 +1,68 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val eval_ast :
+ ?do_heavy_checks:bool ->
+ ?clean_baseuri:bool ->
+ LexiconEngine.status ->
+ GrafiteTypes.status ->
+ (CicNotationPt.term, CicNotationPt.term,
+ CicNotationPt.term GrafiteAst.reduction, CicNotationPt.obj, string)
+ GrafiteAst.statement ->
+ ((GrafiteTypes.status * LexiconEngine.status) *
+ (DisambiguateTypes.domain_item * DisambiguateTypes.codomain_item) option
+ ) list
+
+
+(* heavy checks slow down the compilation process but give you some interesting
+ * infos like if the theorem is a duplicate *)
+val eval_string :
+ first_statement_only:bool ->
+ include_paths:string list ->
+ ?do_heavy_checks:bool ->
+ ?clean_baseuri:bool ->
+ LexiconEngine.status ->
+ GrafiteTypes.status ->
+ string ->
+ ((GrafiteTypes.status * LexiconEngine.status) *
+ (DisambiguateTypes.domain_item * DisambiguateTypes.codomain_item) option
+ ) list
+
+val eval_from_stream :
+ first_statement_only:bool ->
+ include_paths:string list ->
+ ?prompt:bool ->
+ ?do_heavy_checks:bool ->
+ ?clean_baseuri:bool ->
+ LexiconEngine.status ->
+ GrafiteTypes.status ->
+ Ulexing.lexbuf ->
+ (GrafiteTypes.status ->
+ (CicNotationPt.term, CicNotationPt.term,
+ CicNotationPt.term GrafiteAst.reduction, CicNotationPt.obj, string)
+ GrafiteAst.statement -> unit) ->
+ ((GrafiteTypes.status * LexiconEngine.status) *
+ (DisambiguateTypes.domain_item * DisambiguateTypes.codomain_item) option
+ ) list
diff --git a/helm/matita/matitaExcPp.ml b/helm/matita/matitaExcPp.ml
new file mode 100644
index 000000000..28f25fd5c
--- /dev/null
+++ b/helm/matita/matitaExcPp.ml
@@ -0,0 +1,111 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+let rec to_string =
+ function
+ | HExtlib.Localized (floc,exn) ->
+ let _,msg = to_string exn in
+ let (x, y) = HExtlib.loc_of_floc floc in
+ Some floc, sprintf "Error at %d-%d: %s" x y msg
+ | GrafiteTypes.Option_error ("baseuri", "not found" ) ->
+ None,
+ "Baseuri not set for this script. "
+ ^ "Use 'set \"baseuri\" \"<uri>\".' to set it."
+ | GrafiteTypes.Command_error msg -> None, "Error: " ^ msg
+ | CicNotationParser.Parse_error err ->
+ None, sprintf "Parse error: %s" err
+ | UriManager.IllFormedUri uri -> None, sprintf "invalid uri: %s" uri
+ | CicEnvironment.Object_not_found uri ->
+ None, sprintf "object not found: %s" (UriManager.string_of_uri uri)
+ | Unix.Unix_error (code, api, param) ->
+ let err = Unix.error_message code in
+ None, "Unix Error (" ^ api ^ "): " ^ err
+ | HMarshal.Corrupt_file fname -> None, sprintf "file '%s' is corrupt" fname
+ | HMarshal.Format_mismatch fname
+ | HMarshal.Version_mismatch fname ->
+ None,
+ sprintf "format/version mismatch for file '%s', please recompile it'"
+ fname
+ | ProofEngineTypes.Fail msg -> None, "Tactic error: " ^ Lazy.force msg
+ | Continuationals.Error s -> None, "Tactical error: " ^ Lazy.force s
+ | CicTypeChecker.TypeCheckerFailure msg ->
+ None, "Type checking error: " ^ Lazy.force msg
+ | CicTypeChecker.AssertFailure msg ->
+ None, "Type checking assertion failed: " ^ Lazy.force msg
+ | LibrarySync.AlreadyDefined s ->
+ None, "Already defined: " ^ UriManager.string_of_uri s
+ | GrafiteDisambiguator.DisambiguationError (offset,errorll) ->
+ let rec aux n ?(dummy=false) (prev_msg,phases) =
+ function
+ [] -> [prev_msg,phases]
+ | phase::tl ->
+ let msg =
+ String.concat "\n\n\n"
+ (List.map (fun (floc,msg) ->
+ let loc_descr =
+ match floc with
+ None -> ""
+ | Some floc ->
+ let (x, y) = HExtlib.loc_of_floc floc in
+ sprintf " at %d-%d" (x+offset) (y+offset)
+ in
+ "*Error" ^ loc_descr ^ ": " ^ Lazy.force msg) phase)
+ in
+ if msg = prev_msg then
+ aux (n+1) (msg,phases@[n]) tl
+ else
+ (if not dummy then [prev_msg,phases] else []) @
+ (aux (n+1) (msg,[n]) tl) in
+ let loc =
+ match errorll with
+ ((Some floc,_)::_)::_ ->
+ let (x, y) = HExtlib.loc_of_floc floc in
+ let x = x + offset in
+ let y = y + offset in
+ let flocb,floce = floc in
+ let floc =
+ {flocb with Lexing.pos_cnum = x}, {floce with Lexing.pos_cnum = y}
+ in
+ Some floc
+ | _ -> None in
+ let rec explain =
+ function
+ [] -> ""
+ | (msg,phases)::tl ->
+ explain tl ^
+ "***** Errors obtained during phase" ^
+ (if phases = [] then " " else "s ") ^
+ String.concat "," (List.map string_of_int phases) ^": *****\n"^
+ msg ^ "\n\n"
+ in
+ loc,
+ "********** DISAMBIGUATION ERRORS: **********\n" ^
+ explain (aux 1 ~dummy:true ("",[]) errorll)
+ | exn -> None, "Uncaught exception: " ^ Printexc.to_string exn
+
diff --git a/helm/matita/matitaExcPp.mli b/helm/matita/matitaExcPp.mli
new file mode 100644
index 000000000..9d8c7739f
--- /dev/null
+++ b/helm/matita/matitaExcPp.mli
@@ -0,0 +1,27 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val to_string: exn -> Token.flocation option * string
+
diff --git a/helm/matita/matitaGtkMisc.ml b/helm/matita/matitaGtkMisc.ml
new file mode 100644
index 000000000..553406635
--- /dev/null
+++ b/helm/matita/matitaGtkMisc.ml
@@ -0,0 +1,439 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+exception PopupClosed
+open Printf
+
+let wrap_callback f = f
+
+let connect_button (button: #GButton.button) callback =
+ ignore (button#connect#clicked (wrap_callback callback))
+
+let connect_toggle_button (button: #GButton.toggle_button) callback =
+ ignore (button#connect#toggled (wrap_callback callback))
+
+let connect_menu_item (menu_item: #GMenu.menu_item) callback =
+ ignore (menu_item#connect#activate (wrap_callback callback))
+
+let connect_key (ev:GObj.event_ops) ?(modifiers = []) ?(stop = false) key
+ callback
+=
+ ignore (ev#connect#key_press (fun key' ->
+ let modifiers' = GdkEvent.Key.state key' in
+ (match key' with
+ | key' when GdkEvent.Key.keyval key' = key
+ && List.for_all (fun m -> List.mem m modifiers') modifiers ->
+ callback ();
+ stop
+ | _ -> false)))
+
+let toggle_widget_visibility ~(widget: GObj.widget)
+ ~(check: GMenu.check_menu_item)
+=
+ ignore (check#connect#toggled (fun _ ->
+ if check#active then widget#misc#show () else widget#misc#hide ()))
+
+let toggle_window_visibility ~(window: GWindow.window)
+ ~(check: GMenu.check_menu_item)
+=
+ ignore (check#connect#toggled (fun _ ->
+ if check#active then window#show () else window#misc#hide ()));
+ ignore (window#event#connect#delete (fun _ ->
+ window#misc#hide ();
+ check#set_active false;
+ true))
+
+let toggle_win ?(check: GMenu.check_menu_item option) (win: GWindow.window) () =
+ if win#is_active then win#misc#hide () else win#show ();
+ match check with
+ | None -> ()
+ | Some check -> check#set_active (not check#active)
+
+let toggle_callback ~callback ~(check: GMenu.check_menu_item) =
+ ignore (check#connect#toggled (fun _ -> callback check#active))
+
+let add_key_binding key callback (evbox: GBin.event_box) =
+ ignore (evbox#event#connect#key_press (function
+ | key' when GdkEvent.Key.keyval key' = key ->
+ callback ();
+ false
+ | _ -> false))
+
+class multiStringListModel ~cols (tree_view: GTree.view) =
+ let column_list = new GTree.column_list in
+ let text_columns =
+ let rec aux = function
+ | 0 -> []
+ | n -> column_list#add Gobject.Data.string :: aux (n - 1)
+ in
+ aux cols
+ in
+ let list_store = GTree.list_store column_list in
+ let renderers =
+ List.map
+ (fun text_column ->
+ (GTree.cell_renderer_text [], ["text", text_column]))
+ text_columns
+ in
+ let view_columns =
+ List.map
+ (fun renderer -> GTree.view_column ~renderer ())
+ renderers
+ in
+ object (self)
+ val text_columns = text_columns
+
+ initializer
+ tree_view#set_model (Some (list_store :> GTree.model));
+ List.iter
+ (fun view_column -> ignore (tree_view#append_column view_column))
+ view_columns
+
+ method list_store = list_store
+
+ method easy_mappend slist =
+ let tree_iter = list_store#append () in
+ List.iter2
+ (fun s text_column ->
+ list_store#set ~row:tree_iter ~column:text_column s)
+ slist text_columns
+
+ method easy_minsert pos s =
+ let tree_iter = list_store#insert pos in
+ List.iter2
+ (fun s text_column ->
+ list_store#set ~row:tree_iter ~column:text_column s)
+ s text_columns
+
+ method easy_mselection () =
+ List.map
+ (fun tree_path ->
+ let iter = list_store#get_iter tree_path in
+ List.map
+ (fun text_column ->
+ list_store#get ~row:iter ~column:text_column)
+ text_columns)
+ tree_view#selection#get_selected_rows
+ end
+
+class stringListModel (tree_view: GTree.view) =
+ object (self)
+ inherit multiStringListModel ~cols:1 tree_view as multi
+
+ method list_store = multi#list_store
+
+ method easy_append s =
+ multi#easy_mappend [s]
+
+ method easy_insert pos s =
+ multi#easy_minsert pos [s]
+
+ method easy_selection () =
+ let m = List.map
+ (fun tree_path ->
+ let iter = self#list_store#get_iter tree_path in
+ List.map
+ (fun text_column ->
+ self#list_store#get ~row:iter ~column:text_column)
+ text_columns)
+ tree_view#selection#get_selected_rows
+ in
+ List.map (function [x] -> x | _ -> assert false) m
+ end
+
+class taggedStringListModel ~(tags:(string * GdkPixbuf.pixbuf) list)
+ (tree_view: GTree.view)
+=
+ let column_list = new GTree.column_list in
+ let tag_column = column_list#add Gobject.Data.gobject in
+ let text_column = column_list#add Gobject.Data.string in
+ let list_store = GTree.list_store column_list in
+ let text_renderer = (GTree.cell_renderer_text [], ["text", text_column]) in
+ let tag_renderer = (GTree.cell_renderer_pixbuf [], ["pixbuf", tag_column]) in
+ let text_vcolumn = GTree.view_column ~renderer:text_renderer () in
+ let tag_vcolumn = GTree.view_column ~renderer:tag_renderer () in
+ let lookup_pixbuf tag =
+ try List.assoc tag tags with Not_found -> assert false
+ in
+ object (self)
+ initializer
+ tree_view#set_model (Some (list_store :> GTree.model));
+ ignore (tree_view#append_column tag_vcolumn);
+ ignore (tree_view#append_column text_vcolumn)
+
+ method list_store = list_store
+
+ method easy_append ~tag s =
+ let tree_iter = list_store#append () in
+ list_store#set ~row:tree_iter ~column:text_column s;
+ list_store#set ~row:tree_iter ~column:tag_column (lookup_pixbuf tag)
+
+ method easy_insert pos ~tag s =
+ let tree_iter = list_store#insert pos in
+ list_store#set ~row:tree_iter ~column:text_column s;
+ list_store#set ~row:tree_iter ~column:tag_column (lookup_pixbuf tag)
+
+ method easy_selection () =
+ List.map
+ (fun tree_path ->
+ let iter = list_store#get_iter tree_path in
+ list_store#get ~row:iter ~column:text_column)
+ tree_view#selection#get_selected_rows
+ end
+
+class recordModel (tree_view:GTree.view) =
+ let cols_list = new GTree.column_list in
+ let text_col = cols_list#add Gobject.Data.string in
+(* let combo_col = cols_list#add (Gobject.Data.gobject_by_name "GtkListStore") in *)
+ let combo_col = cols_list#add Gobject.Data.int in
+ let toggle_col = cols_list#add Gobject.Data.boolean in
+ let list_store = GTree.list_store cols_list in
+ let text_rend = (GTree.cell_renderer_text [], ["text", text_col]) in
+ let combo_rend = GTree.cell_renderer_combo [] in
+(* let combo_rend = (GTree.cell_renderer_combo [], [|+"model", combo_col+|]) in *)
+ let toggle_rend =
+ (GTree.cell_renderer_toggle [`ACTIVATABLE true], ["active", toggle_col])
+ in
+ let text_vcol = GTree.view_column ~renderer:text_rend () in
+ let combo_vcol = GTree.view_column ~renderer:(combo_rend, []) () in
+ let _ =
+ combo_vcol#set_cell_data_func combo_rend
+ (fun _ _ ->
+ prerr_endline "qui";
+ let model, col =
+ GTree.store_of_list Gobject.Data.string ["a"; "b"; "c"]
+ in
+ combo_rend#set_properties [
+ `MODEL (Some (model :> GTree.model));
+ `TEXT_COLUMN col
+ ])
+ in
+ let toggle_vcol = GTree.view_column ~renderer:toggle_rend () in
+ object (self)
+ initializer
+ tree_view#set_model (Some (list_store :> GTree.model));
+ ignore (tree_view#append_column text_vcol);
+ ignore (tree_view#append_column combo_vcol);
+ ignore (tree_view#append_column toggle_vcol)
+
+ method list_store = list_store
+
+ method easy_append s (combo:int) (toggle:bool) =
+ let tree_iter = list_store#append () in
+ list_store#set ~row:tree_iter ~column:text_col s;
+ list_store#set ~row:tree_iter ~column:combo_col combo;
+ list_store#set ~row:tree_iter ~column:toggle_col toggle
+ end
+
+class type gui =
+ object
+ method newUriDialog: unit -> MatitaGeneratedGui.uriChoiceDialog
+ method newRecordDialog: unit -> MatitaGeneratedGui.recordChoiceDialog
+ method newConfirmationDialog: unit -> MatitaGeneratedGui.confirmationDialog
+ method newEmptyDialog: unit -> MatitaGeneratedGui.emptyDialog
+ end
+
+let popup_message
+ ~title ~message ~buttons ~callback
+ ?(message_type=`QUESTION) ?parent ?(use_markup=true)
+ ?(destroy_with_parent=true) ?(allow_grow=false) ?(allow_shrink=false)
+ ?icon ?(modal=true) ?(resizable=false) ?screen ?type_hint
+ ?(position=`CENTER_ON_PARENT) ?wm_name ?wm_class ?border_width ?width
+ ?height ?(show=true) ()
+=
+ let m =
+ GWindow.message_dialog
+ ~message ~use_markup ~message_type ~buttons ?parent ~destroy_with_parent
+ ~title ~allow_grow ~allow_shrink ?icon ~modal ~resizable ?screen
+ ?type_hint ~position ?wm_name ?wm_class ?border_width ?width ?height
+ ~show ()
+ in
+ ignore(m#connect#response
+ ~callback:(fun a -> GMain.Main.quit ();callback a));
+ ignore(m#connect#close
+ ~callback:(fun _ -> GMain.Main.quit ();raise PopupClosed));
+ GtkThread.main ();
+ m#destroy ()
+
+let popup_message_lowlevel
+ ~title ~message ?(no_separator=true) ~callback ~message_type ~buttons
+ ?parent ?(destroy_with_parent=true) ?(allow_grow=false) ?(allow_shrink=false)
+ ?icon ?(modal=true) ?(resizable=false) ?screen ?type_hint
+ ?(position=`CENTER_ON_PARENT) ?wm_name ?wm_class ?border_width ?width
+ ?height ?(show=true) ()
+=
+ let m =
+ GWindow.dialog
+ ~no_separator
+ ?parent ~destroy_with_parent
+ ~title ~allow_grow ~allow_shrink ?icon ~modal ~resizable ?screen
+ ?type_hint ~position ?wm_name ?wm_class ?border_width ?width ?height
+ ~show:false ()
+ in
+ let stock =
+ match message_type with
+ | `WARNING -> `DIALOG_WARNING
+ | `INFO -> `DIALOG_INFO
+ | `ERROR ->`DIALOG_ERROR
+ | `QUESTION -> `DIALOG_QUESTION
+ in
+ let image = GMisc.image ~stock ~icon_size:`DIALOG () in
+ let label = GMisc.label ~markup:message () in
+ label#set_line_wrap true;
+ let hbox = GPack.hbox ~spacing:10 () in
+ hbox#pack ~from:`START ~expand:true ~fill:true (image:>GObj.widget);
+ hbox#pack ~from:`START ~expand:true ~fill:true (label:>GObj.widget);
+ m#vbox#pack ~from:`START
+ ~padding:20 ~expand:true ~fill:true (hbox:>GObj.widget);
+ List.iter (fun (x, y) ->
+ m#add_button_stock x y;
+ if y = `CANCEL then
+ m#set_default_response y
+ ) buttons;
+ ignore(m#connect#response
+ ~callback:(fun a -> GMain.Main.quit ();callback a));
+ ignore(m#connect#close
+ ~callback:(fun _ -> GMain.Main.quit ();callback `POPUPCLOSED));
+ if show = true then
+ m#show ();
+ GtkThread.main ();
+ m#destroy ()
+
+
+let ask_confirmation ~title ~message ?parent () =
+ let rc = ref `YES in
+ let callback =
+ function
+ | `YES -> rc := `YES
+ | `NO -> rc := `NO
+ | `CANCEL -> rc := `CANCEL
+ | `DELETE_EVENT -> rc := `CANCEL
+ | `POPUPCLOSED -> rc := `CANCEL
+ in
+ let buttons = [`YES,`YES ; `NO,`NO ; `CANCEL,`CANCEL] in
+ popup_message_lowlevel
+ ~title ~message ~message_type:`WARNING ~callback ~buttons ?parent ();
+ !rc
+
+let report_error ~title ~message ?parent () =
+ let callback _ = () in
+ let buttons = GWindow.Buttons.ok in
+ try
+ popup_message
+ ~title ~message ~message_type:`ERROR ~callback ~buttons ?parent ()
+ with
+ | PopupClosed -> ()
+
+
+let ask_text ~(gui:#gui) ?(title = "") ?(message = "") ?(multiline = false)
+ ?default ()
+=
+ let dialog = gui#newEmptyDialog () in
+ dialog#emptyDialog#set_title title;
+ dialog#emptyDialogLabel#set_label message;
+ let result = ref None in
+ let return r =
+ result := r;
+ dialog#emptyDialog#destroy ();
+ GMain.Main.quit ()
+ in
+ ignore (dialog#emptyDialog#event#connect#delete (fun _ -> true));
+ if multiline then begin (* multiline input required: use a TextView widget *)
+ let win =
+ GBin.scrolled_window ~width:400 ~height:150 ~hpolicy:`NEVER
+ ~vpolicy:`ALWAYS ~packing:dialog#emptyDialogVBox#add ()
+ in
+ let view = GText.view ~wrap_mode:`CHAR ~packing:win#add () in
+ let buffer = view#buffer in
+ (match default with
+ | None -> ()
+ | Some text ->
+ buffer#set_text text;
+ buffer#select_range buffer#start_iter buffer#end_iter);
+ view#misc#grab_focus ();
+ connect_button dialog#emptyDialogOkButton (fun _ ->
+ return (Some (buffer#get_text ())))
+ end else begin (* monoline input required: use a TextEntry widget *)
+ let entry = GEdit.entry ~packing:dialog#emptyDialogVBox#add () in
+ (match default with
+ | None -> ()
+ | Some text ->
+ entry#set_text text;
+ entry#select_region ~start:0 ~stop:max_int);
+ entry#misc#grab_focus ();
+ connect_button dialog#emptyDialogOkButton (fun _ ->
+ return (Some entry#text))
+ end;
+ connect_button dialog#emptyDialogCancelButton (fun _ ->return None);
+ dialog#emptyDialog#show ();
+ GtkThread.main ();
+ (match !result with None -> raise MatitaTypes.Cancel | Some r -> r)
+
+let ask_record_choice ~(gui:#gui) ?(title= "") ?(message = "")
+ ~fields ~records ()
+=
+ let fields = Array.of_list fields in
+ let fields_no = Array.length fields in
+ assert (fields_no > 0);
+ let dialog = gui#newRecordDialog () in
+ dialog#recordChoiceDialog#set_title title;
+ dialog#recordChoiceDialogLabel#set_label message;
+ let model = new recordModel dialog#recordChoiceTreeView in
+ dialog#recordChoiceTreeView#set_headers_visible true;
+ let combos =
+ Array.init fields_no
+ (fun _ -> GTree.store_of_list Gobject.Data.string ["a"; "b"; "c"])
+ in
+ let (store, col) = combos.(0) in
+ store#set ~row:(store#append ()) ~column:col "uno";
+ store#set ~row:(store#append ()) ~column:col "due";
+ let toggles = Array.init fields_no (fun _ -> false) in
+ Array.iteri
+ (fun i f -> model#easy_append f i toggles.(i))
+ fields;
+ let record_no = ref None in
+ let return _ =
+ dialog#recordChoiceDialog#destroy ();
+ GMain.Main.quit ()
+ in
+ let fail _ = record_no := None; return () in
+ ignore (dialog#recordChoiceDialog#event#connect#delete (fun _ -> true));
+ connect_button dialog#recordChoiceOkButton (fun _ ->
+ match !record_no with None -> () | Some _ -> return ());
+ connect_button dialog#recordChoiceCancelButton fail;
+(* ignore (dialog#recordChoiceTreeView#connect#row_activated (fun path _ ->
+ interp_no := Some (model#get_interp_no path);
+ return ()));
+ let selection = dialog#recordChoiceTreeView#selection in
+ ignore (selection#connect#changed (fun _ ->
+ match selection#get_selected_rows with
+ | [path] -> interp_no := Some (model#get_interp_no path)
+ | _ -> assert false)); *)
+ dialog#recordChoiceDialog#show ();
+ GtkThread.main ();
+ (match !record_no with Some n -> n | _ -> raise MatitaTypes.Cancel)
+
diff --git a/helm/matita/matitaGtkMisc.mli b/helm/matita/matitaGtkMisc.mli
new file mode 100644
index 000000000..1affd2a39
--- /dev/null
+++ b/helm/matita/matitaGtkMisc.mli
@@ -0,0 +1,157 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** {2 Gtk helpers} *)
+
+ (** given a window and a check menu item it links the two so that the former
+ * is only hidden on delete and the latter toggle show/hide of the former *)
+val toggle_window_visibility:
+ window:GWindow.window -> check:GMenu.check_menu_item -> unit
+
+ (** given a window and a check menu item it links the two so that the former
+ * is only hidden on delete and the latter toggle show/hide of the former *)
+val toggle_widget_visibility:
+ widget:GObj.widget -> check:GMenu.check_menu_item -> unit
+
+val toggle_callback:
+ callback:(bool -> unit) -> check:GMenu.check_menu_item -> unit
+
+val toggle_win:
+ ?check:GMenu.check_menu_item -> GWindow.window -> unit -> unit
+
+val add_key_binding: Gdk.keysym -> (unit -> 'a) -> GBin.event_box -> unit
+
+(** Connect a callback to the clicked signal of a button, ignoring its return
+ * value *)
+val connect_button: #GButton.button -> (unit -> unit) -> unit
+
+
+(** Connect a callback to the toggled signal of a button, ignoring its return
+ * value *)
+val connect_toggle_button: #GButton.toggle_button -> (unit -> unit) -> unit
+
+(** Like connect_button above, but connects a callback to the activate signal of
+ * a menu item *)
+val connect_menu_item: #GMenu.menu_item -> (unit -> unit) -> unit
+
+ (** connect a unit -> unit callback to a particular key press event. Event can
+ * be specified using its keysym and a list of modifiers which must be in
+ * effect for the callback to be executed. Further signal processing of other
+ * key press events remains unchanged; further signal processing of the
+ * specified key press depends on the stop parameter *)
+val connect_key:
+ GObj.event_ops ->
+ ?modifiers:Gdk.Tags.modifier list ->
+ ?stop:bool -> (* stop signal handling when the given key has been pressed?
+ * Defaults to false *)
+ Gdk.keysym -> (* (= int) the key, see GdkKeysyms.ml *)
+ (unit -> unit) -> (* callback *)
+ unit
+
+ (** n-ary string column list *)
+class multiStringListModel:
+ cols:int ->
+ GTree.view ->
+ object
+ method list_store: GTree.list_store (** list_store forwarding *)
+
+ method easy_mappend: string list -> unit (** append + set *)
+ method easy_minsert: int -> string list -> unit (** insert + set *)
+ method easy_mselection: unit -> string list list
+ end
+
+ (** single string column list *)
+class stringListModel:
+ GTree.view ->
+ object
+ inherit multiStringListModel
+
+ method easy_append: string -> unit (** append + set *)
+ method easy_insert: int -> string -> unit (** insert + set *)
+ method easy_selection: unit -> string list
+ end
+
+
+ (** as above with Pixbuf associated to each row. Each time an insert is
+ * performed a string tag should be specified, the corresponding pixbuf in the
+ * tags associative list will be shown on the left of the inserted row *)
+class taggedStringListModel:
+ tags:((string * GdkPixbuf.pixbuf) list) ->
+ GTree.view ->
+ object
+ method list_store: GTree.list_store (** list_store forwarding *)
+
+ method easy_append: tag:string -> string -> unit
+ method easy_insert: int -> tag:string -> string -> unit
+ method easy_selection: unit -> string list
+ end
+
+(** {2 Matita GUI components} *)
+
+class type gui =
+ object (* minimal gui object requirements *)
+ method newUriDialog: unit -> MatitaGeneratedGui.uriChoiceDialog
+ method newRecordDialog: unit -> MatitaGeneratedGui.recordChoiceDialog
+ method newConfirmationDialog: unit -> MatitaGeneratedGui.confirmationDialog
+ method newEmptyDialog: unit -> MatitaGeneratedGui.emptyDialog
+ end
+
+ (** {3 Dialogs}
+ * In functions below:
+ * @param title window title
+ * @param message content of the text label shown to the user *)
+
+ (** @param parent to center the window on it *)
+val ask_confirmation:
+ title:string -> message:string ->
+ ?parent:#GWindow.window_skel ->
+ unit ->
+ [`YES | `NO | `CANCEL]
+
+ (** @param multiline (default: false) if true a TextView widget will be used
+ * for prompting the user otherwise a TextEntry widget will be
+ * @return the string given by the user *)
+val ask_text:
+ gui:#gui ->
+ ?title:string -> ?message:string ->
+ ?multiline:bool -> ?default:string -> unit ->
+ string
+
+ (** @param fields field names
+ * @param records list of records, each record is a list of [fields] strings
+ * @return number of the chosen record, 0 for the first one *)
+val ask_record_choice:
+ gui:#gui ->
+ ?title:string -> ?message:string ->
+ fields:string list -> records:string list list ->
+ unit ->
+ int
+
+val report_error:
+ title:string -> message:string ->
+ ?parent:#GWindow.window_skel ->
+ unit ->
+ unit
+
diff --git a/helm/matita/matitaGui.ml b/helm/matita/matitaGui.ml
new file mode 100644
index 000000000..03e50588f
--- /dev/null
+++ b/helm/matita/matitaGui.ml
@@ -0,0 +1,1278 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+open MatitaGeneratedGui
+open MatitaGtkMisc
+open MatitaMisc
+
+exception Found of int
+
+let gui_instance = ref None
+
+class type browserWin =
+ (* this class exists only because GEdit.combo_box_entry is not supported by
+ * lablgladecc :-(((( *)
+object
+ inherit MatitaGeneratedGui.browserWin
+ method browserUri: GEdit.combo_box_entry
+end
+
+class console ~(buffer: GText.buffer) () =
+ object (self)
+ val error_tag = buffer#create_tag [ `FOREGROUND "red" ]
+ val warning_tag = buffer#create_tag [ `FOREGROUND "orange" ]
+ val message_tag = buffer#create_tag []
+ val debug_tag = buffer#create_tag [ `FOREGROUND "#888888" ]
+ method message s = buffer#insert ~iter:buffer#end_iter ~tags:[message_tag] s
+ method error s = buffer#insert ~iter:buffer#end_iter ~tags:[error_tag] s
+ method warning s = buffer#insert ~iter:buffer#end_iter ~tags:[warning_tag] s
+ method debug s = buffer#insert ~iter:buffer#end_iter ~tags:[debug_tag] s
+ method clear () =
+ buffer#delete ~start:buffer#start_iter ~stop:buffer#end_iter
+ method log_callback (tag: HLog.log_tag) s =
+ match tag with
+ | `Debug -> self#debug (s ^ "\n")
+ | `Error -> self#error (s ^ "\n")
+ | `Message -> self#message (s ^ "\n")
+ | `Warning -> self#warning (s ^ "\n")
+ end
+
+let clean_current_baseuri grafite_status =
+ try
+ let baseuri = GrafiteTypes.get_string_option grafite_status "baseuri" in
+ let basedir = Helm_registry.get "matita.basedir" in
+ LibraryClean.clean_baseuris ~basedir [baseuri]
+ with GrafiteTypes.Option_error _ -> ()
+
+let ask_and_save_moo_if_needed parent fname lexicon_status grafite_status =
+ let basedir = Helm_registry.get "matita.basedir" in
+ let baseuri = DependenciesParser.baseuri_of_script ~include_paths:[] fname in
+ let moo_fname = LibraryMisc.obj_file_of_baseuri ~basedir ~baseuri in
+ let save () =
+ let metadata_fname =
+ LibraryMisc.metadata_file_of_baseuri ~basedir ~baseuri in
+ let lexicon_fname =
+ LibraryMisc.lexicon_file_of_baseuri ~basedir ~baseuri
+ in
+ GrafiteMarshal.save_moo moo_fname
+ grafite_status.GrafiteTypes.moo_content_rev;
+ LibraryNoDb.save_metadata metadata_fname
+ lexicon_status.LexiconEngine.metadata;
+ LexiconMarshal.save_lexicon lexicon_fname
+ lexicon_status.LexiconEngine.lexicon_content_rev
+ in
+ if (MatitaScript.current ())#eos &&
+ grafite_status.GrafiteTypes.proof_status = GrafiteTypes.No_proof
+ then
+ begin
+ let rc =
+ MatitaGtkMisc.ask_confirmation
+ ~title:"A .moo can be generated"
+ ~message:(Printf.sprintf
+ "%s can be generated for %s.\n<i>Should I generate it?</i>"
+ (Filename.basename moo_fname) (Filename.basename fname))
+ ~parent ()
+ in
+ let b =
+ match rc with
+ | `YES -> true
+ | `NO -> false
+ | `CANCEL -> raise MatitaTypes.Cancel
+ in
+ if b then
+ save ()
+ else
+ clean_current_baseuri grafite_status
+ end
+ else
+ clean_current_baseuri grafite_status
+
+let ask_unsaved parent =
+ MatitaGtkMisc.ask_confirmation
+ ~parent ~title:"Unsaved work!"
+ ~message:("Your work is <b>unsaved</b>!\n\n"^
+ "<i>Do you want to save the script before continuing?</i>")
+ ()
+
+(** Selection handling
+ * Two clipboards are used: "clipboard" and "primary".
+ * "primary" is used by X, when you hit the middle button mouse is content is
+ * pasted between applications. In Matita this selection always contain the
+ * textual version of the selected term.
+ * "clipboard" is used inside Matita only and support ATM two different targets:
+ * "TERM" and "PATTERN", in the future other targets like "MATHMLCONTENT" may
+ * be added
+ *)
+
+class gui () =
+ (* creation order _is_ relevant for windows placement *)
+ let main = new mainWin () in
+ let fileSel = new fileSelectionWin () in
+ let findRepl = new findReplWin () in
+ let develList = new develListWin () in
+ let newDevel = new newDevelWin () in
+ let keyBindingBoxes = (* event boxes which should receive global key events *)
+ [ main#mainWinEventBox ]
+ in
+ let console = new console ~buffer:main#logTextView#buffer () in
+ let (source_view: GSourceView.source_view) =
+ GSourceView.source_view
+ ~auto_indent:true
+ ~insert_spaces_instead_of_tabs:true ~tabs_width:2
+ ~margin:80 ~show_margin:true
+ ~smart_home_end:true
+ ~packing:main#scriptScrolledWin#add
+ ()
+ in
+ let default_font_size =
+ Helm_registry.get_opt_default Helm_registry.int
+ ~default:BuildTimeConf.default_font_size "matita.font_size"
+ in
+ let source_buffer = source_view#source_buffer in
+ object (self)
+ val mutable chosen_file = None
+ val mutable _ok_not_exists = false
+ val mutable _only_directory = false
+ val mutable script_fname = None
+ val mutable font_size = default_font_size
+ val mutable next_devel_must_contain = None
+ val mutable next_ligatures = []
+ val clipboard = GData.clipboard Gdk.Atom.clipboard
+ val primary = GData.clipboard Gdk.Atom.primary
+
+ initializer
+ (* glade's check widgets *)
+ List.iter (fun w -> w#check_widgets ())
+ (let c w = (w :> <check_widgets: unit -> unit>) in
+ [ c fileSel; c main; c findRepl]);
+ (* key bindings *)
+ List.iter (* global key bindings *)
+ (fun (key, callback) -> self#addKeyBinding key callback)
+(*
+ [ GdkKeysyms._F3,
+ toggle_win ~check:main#showProofMenuItem proof#proofWin;
+ GdkKeysyms._F4,
+ toggle_win ~check:main#showCheckMenuItem check#checkWin;
+*)
+ [ ];
+ (* about win *)
+ let parse_txt_file file =
+ let ch = open_in (BuildTimeConf.runtime_base_dir ^ "/" ^ file) in
+ let l_rev = ref [] in
+ try
+ while true do
+ l_rev := input_line ch :: !l_rev;
+ done;
+ assert false
+ with
+ End_of_file ->
+ close_in ch;
+ List.rev !l_rev in
+ let about_dialog =
+ GWindow.about_dialog
+ ~authors:(parse_txt_file "AUTHORS")
+ (*~comments:"comments"*)
+ ~copyright:"Copyright (C) 2005, the HELM team"
+ ~license:(String.concat "\n" (parse_txt_file "LICENSE"))
+ ~logo:(GdkPixbuf.from_file (MatitaMisc.image_path "/matita_medium.png"))
+ ~name:"Matita"
+ ~version:BuildTimeConf.version
+ ~website:"http://helm.cs.unibo.it"
+ ()
+ in
+ connect_menu_item main#aboutMenuItem about_dialog#present;
+ (* findRepl win *)
+ let show_find_Repl () =
+ findRepl#toplevel#misc#show ();
+ findRepl#toplevel#misc#grab_focus ()
+ in
+ let hide_find_Repl () = findRepl#toplevel#misc#hide () in
+ let find_forward _ =
+ let highlight start end_ =
+ source_buffer#move_mark `INSERT ~where:start;
+ source_buffer#move_mark `SEL_BOUND ~where:end_;
+ source_view#scroll_mark_onscreen `INSERT
+ in
+ let text = findRepl#findEntry#text in
+ let iter = source_buffer#get_iter `SEL_BOUND in
+ match iter#forward_search text with
+ | None ->
+ (match source_buffer#start_iter#forward_search text with
+ | None -> ()
+ | Some (start,end_) -> highlight start end_)
+ | Some (start,end_) -> highlight start end_
+ in
+ let replace _ =
+ let text = findRepl#replaceEntry#text in
+ let ins = source_buffer#get_iter `INSERT in
+ let sel = source_buffer#get_iter `SEL_BOUND in
+ if ins#compare sel < 0 then
+ begin
+ ignore(source_buffer#delete_selection ());
+ source_buffer#insert text
+ end
+ in
+ connect_button findRepl#findButton find_forward;
+ connect_button findRepl#findReplButton replace;
+ connect_button findRepl#cancelButton (fun _ -> hide_find_Repl ());
+ ignore(findRepl#toplevel#event#connect#delete
+ ~callback:(fun _ -> hide_find_Repl ();true));
+ let safe_undo =
+ fun () ->
+ (* phase 1: we save the actual status of the marks and we undo *)
+ let locked_mark = `MARK ((MatitaScript.current ())#locked_mark) in
+ let locked_iter = source_view#buffer#get_iter_at_mark locked_mark in
+ let locked_iter_offset = locked_iter#offset in
+ let mark2 =
+ `MARK
+ (source_view#buffer#create_mark ~name:"lock_point"
+ ~left_gravity:true locked_iter) in
+ source_view#source_buffer#undo ();
+ (* phase 2: we save the cursor position and we redo, restoring
+ the previous status of all the marks *)
+ let cursor_iter = source_view#buffer#get_iter_at_mark `INSERT in
+ let mark =
+ `MARK
+ (source_view#buffer#create_mark ~name:"undo_point"
+ ~left_gravity:true cursor_iter)
+ in
+ source_view#source_buffer#redo ();
+ let mark_iter = source_view#buffer#get_iter_at_mark mark in
+ let mark2_iter = source_view#buffer#get_iter_at_mark mark2 in
+ let mark2_iter = mark2_iter#set_offset locked_iter_offset in
+ source_view#buffer#move_mark locked_mark ~where:mark2_iter;
+ source_view#buffer#delete_mark mark;
+ source_view#buffer#delete_mark mark2;
+ (* phase 3: if after the undo the cursor was in the locked area,
+ then we move it there again and we perform a goto *)
+ if mark_iter#offset < locked_iter_offset then
+ begin
+ source_view#buffer#move_mark `INSERT ~where:mark_iter;
+ (MatitaScript.current ())#goto `Cursor ();
+ end;
+ (* phase 4: we perform again the undo. This time we are sure that
+ the text to undo is not locked *)
+ source_view#source_buffer#undo ();
+ source_view#misc#grab_focus () in
+ let safe_redo =
+ fun () ->
+ (* phase 1: we save the actual status of the marks, we redo and
+ we undo *)
+ let locked_mark = `MARK ((MatitaScript.current ())#locked_mark) in
+ let locked_iter = source_view#buffer#get_iter_at_mark locked_mark in
+ let locked_iter_offset = locked_iter#offset in
+ let mark2 =
+ `MARK
+ (source_view#buffer#create_mark ~name:"lock_point"
+ ~left_gravity:true locked_iter) in
+ source_view#source_buffer#redo ();
+ source_view#source_buffer#undo ();
+ (* phase 2: we save the cursor position and we restore
+ the previous status of all the marks *)
+ let cursor_iter = source_view#buffer#get_iter_at_mark `INSERT in
+ let mark =
+ `MARK
+ (source_view#buffer#create_mark ~name:"undo_point"
+ ~left_gravity:true cursor_iter)
+ in
+ let mark_iter = source_view#buffer#get_iter_at_mark mark in
+ let mark2_iter = source_view#buffer#get_iter_at_mark mark2 in
+ let mark2_iter = mark2_iter#set_offset locked_iter_offset in
+ source_view#buffer#move_mark locked_mark ~where:mark2_iter;
+ source_view#buffer#delete_mark mark;
+ source_view#buffer#delete_mark mark2;
+ (* phase 3: if after the undo the cursor is in the locked area,
+ then we move it there again and we perform a goto *)
+ if mark_iter#offset < locked_iter_offset then
+ begin
+ source_view#buffer#move_mark `INSERT ~where:mark_iter;
+ (MatitaScript.current ())#goto `Cursor ();
+ end;
+ (* phase 4: we perform again the redo. This time we are sure that
+ the text to redo is not locked *)
+ source_view#source_buffer#redo ();
+ source_view#misc#grab_focus ()
+ in
+ connect_menu_item main#undoMenuItem safe_undo;
+ ignore(source_view#source_buffer#connect#can_undo
+ ~callback:main#undoMenuItem#misc#set_sensitive);
+ connect_menu_item main#redoMenuItem safe_redo;
+ ignore(source_view#source_buffer#connect#can_redo
+ ~callback:main#redoMenuItem#misc#set_sensitive);
+ ignore(source_view#connect#after#populate_popup
+ ~callback:(fun pre_menu ->
+ let menu = new GMenu.menu pre_menu in
+ let menuItems = menu#children in
+ let undoMenuItem, redoMenuItem =
+ match menuItems with
+ [undo;redo;sep1;cut;copy;paste;delete;sep2;
+ selectall;sep3;inputmethod;insertunicodecharacter] ->
+ List.iter menu#remove [ copy; cut; delete; paste ];
+ undo,redo
+ | _ -> assert false in
+ let add_menu_item =
+ let i = ref 2 in (* last occupied position *)
+ fun ?label ?stock () ->
+ incr i;
+ GMenu.image_menu_item ?label ?stock ~packing:(menu#insert ~pos:!i)
+ ()
+ in
+ let copy = add_menu_item ~stock:`COPY () in
+ let cut = add_menu_item ~stock:`CUT () in
+ let delete = add_menu_item ~stock:`DELETE () in
+ let paste = add_menu_item ~stock:`PASTE () in
+ let paste_pattern = add_menu_item ~label:"Paste as pattern" () in
+ copy#misc#set_sensitive self#canCopy;
+ cut#misc#set_sensitive self#canCut;
+ delete#misc#set_sensitive self#canDelete;
+ paste#misc#set_sensitive self#canPaste;
+ paste_pattern#misc#set_sensitive self#canPastePattern;
+ connect_menu_item copy self#copy;
+ connect_menu_item cut self#cut;
+ connect_menu_item delete self#delete;
+ connect_menu_item paste self#paste;
+ connect_menu_item paste_pattern self#pastePattern;
+ let new_undoMenuItem =
+ GMenu.image_menu_item
+ ~image:(GMisc.image ~stock:`UNDO ())
+ ~use_mnemonic:true
+ ~label:"_Undo"
+ ~packing:(menu#insert ~pos:0) () in
+ new_undoMenuItem#misc#set_sensitive
+ (undoMenuItem#misc#get_flag `SENSITIVE);
+ menu#remove (undoMenuItem :> GMenu.menu_item);
+ connect_menu_item new_undoMenuItem safe_undo;
+ let new_redoMenuItem =
+ GMenu.image_menu_item
+ ~image:(GMisc.image ~stock:`REDO ())
+ ~use_mnemonic:true
+ ~label:"_Redo"
+ ~packing:(menu#insert ~pos:1) () in
+ new_redoMenuItem#misc#set_sensitive
+ (redoMenuItem#misc#get_flag `SENSITIVE);
+ menu#remove (redoMenuItem :> GMenu.menu_item);
+ connect_menu_item new_redoMenuItem safe_redo));
+
+ connect_menu_item main#editMenu (fun () ->
+ main#copyMenuItem#misc#set_sensitive self#canCopy;
+ main#cutMenuItem#misc#set_sensitive self#canCut;
+ main#deleteMenuItem#misc#set_sensitive self#canDelete;
+ main#pasteMenuItem#misc#set_sensitive self#canPaste;
+ main#pastePatternMenuItem#misc#set_sensitive self#canPastePattern);
+ connect_menu_item main#copyMenuItem self#copy;
+ connect_menu_item main#cutMenuItem self#cut;
+ connect_menu_item main#deleteMenuItem self#delete;
+ connect_menu_item main#pasteMenuItem self#paste;
+ connect_menu_item main#pastePatternMenuItem self#pastePattern;
+ connect_menu_item main#selectAllMenuItem (fun () ->
+ source_buffer#move_mark `INSERT source_buffer#start_iter;
+ source_buffer#move_mark `SEL_BOUND source_buffer#end_iter);
+ connect_menu_item main#findReplMenuItem show_find_Repl;
+ connect_menu_item main#externalEditorMenuItem self#externalEditor;
+ connect_menu_item main#ligatureButton self#nextLigature;
+ ignore (findRepl#findEntry#connect#activate find_forward);
+ (* interface lockers *)
+ let lock_world _ =
+ main#buttonsToolbar#misc#set_sensitive false;
+ develList#buttonsHbox#misc#set_sensitive false;
+ source_view#set_editable false
+ in
+ let unlock_world _ =
+ main#buttonsToolbar#misc#set_sensitive true;
+ develList#buttonsHbox#misc#set_sensitive true;
+ source_view#set_editable true
+ in
+ let locker f =
+ fun () ->
+ lock_world ();
+ try f ();unlock_world () with exc -> unlock_world (); raise exc in
+ let keep_focus f =
+ fun () ->
+ try
+ f (); source_view#misc#grab_focus ()
+ with
+ exc -> source_view#misc#grab_focus (); raise exc in
+ (* developments win *)
+ let model =
+ new MatitaGtkMisc.multiStringListModel
+ ~cols:2 develList#developmentsTreeview
+ in
+ let refresh_devels_win () =
+ model#list_store#clear ();
+ List.iter
+ (fun (name, root) -> model#easy_mappend [name;root])
+ (MatitamakeLib.list_known_developments ())
+ in
+ let get_devel_selected () =
+ match model#easy_mselection () with
+ | [[name;_]] -> MatitamakeLib.development_for_name name
+ | _ -> None
+ in
+ let refresh () =
+ while Glib.Main.pending () do
+ ignore(Glib.Main.iteration false);
+ done
+ in
+ connect_button develList#newButton
+ (fun () ->
+ next_devel_must_contain <- None;
+ newDevel#toplevel#misc#show());
+ connect_button develList#deleteButton
+ (locker (fun () ->
+ (match get_devel_selected () with
+ | None -> ()
+ | Some d -> MatitamakeLib.destroy_development_in_bg refresh d);
+ refresh_devels_win ()));
+ connect_button develList#buildButton
+ (locker (fun () ->
+ match get_devel_selected () with
+ | None -> ()
+ | Some d ->
+ let build = locker
+ (fun () -> MatitamakeLib.build_development_in_bg refresh d)
+ in
+ ignore(build ())));
+ connect_button develList#cleanButton
+ (locker (fun () ->
+ match get_devel_selected () with
+ | None -> ()
+ | Some d ->
+ let clean = locker
+ (fun () -> MatitamakeLib.clean_development_in_bg refresh d)
+ in
+ ignore(clean ())));
+ connect_button develList#closeButton
+ (fun () -> develList#toplevel#misc#hide());
+ ignore(develList#toplevel#event#connect#delete
+ (fun _ -> develList#toplevel#misc#hide();true));
+ connect_menu_item main#developmentsMenuItem
+ (fun () -> refresh_devels_win ();develList#toplevel#misc#show ());
+
+ (* add development win *)
+ let check_if_root_contains root =
+ match next_devel_must_contain with
+ | None -> true
+ | Some path ->
+ let is_prefix_of d1 d2 =
+ let len1 = String.length d1 in
+ let len2 = String.length d2 in
+ if len2 < len1 then
+ false
+ else
+ let pref = String.sub d2 0 len1 in
+ pref = d1
+ in
+ is_prefix_of root path
+ in
+ connect_button newDevel#addButton
+ (fun () ->
+ let name = newDevel#nameEntry#text in
+ let root = newDevel#rootEntry#text in
+ if check_if_root_contains root then
+ begin
+ ignore (MatitamakeLib.initialize_development name root);
+ refresh_devels_win ();
+ newDevel#nameEntry#set_text "";
+ newDevel#rootEntry#set_text "";
+ newDevel#toplevel#misc#hide()
+ end
+ else
+ HLog.error ("The selected root does not contain " ^
+ match next_devel_must_contain with
+ | Some x -> x
+ | _ -> assert false));
+ connect_button newDevel#chooseRootButton
+ (fun () ->
+ let path = self#chooseDir () in
+ match path with
+ | Some path -> newDevel#rootEntry#set_text path
+ | None -> ());
+ connect_button newDevel#cancelButton
+ (fun () -> newDevel#toplevel#misc#hide ());
+ ignore(newDevel#toplevel#event#connect#delete
+ (fun _ -> newDevel#toplevel#misc#hide();true));
+
+ (* file selection win *)
+ ignore (fileSel#fileSelectionWin#event#connect#delete (fun _ -> true));
+ ignore (fileSel#fileSelectionWin#connect#response (fun event ->
+ let return r =
+ chosen_file <- r;
+ fileSel#fileSelectionWin#misc#hide ();
+ GMain.Main.quit ()
+ in
+ match event with
+ | `OK ->
+ let fname = fileSel#fileSelectionWin#filename in
+ if Sys.file_exists fname then
+ begin
+ if HExtlib.is_regular fname && not (_only_directory) then
+ return (Some fname)
+ else if _only_directory && HExtlib.is_dir fname then
+ return (Some fname)
+ end
+ else
+ begin
+ if _ok_not_exists then
+ return (Some fname)
+ end
+ | `CANCEL -> return None
+ | `HELP -> ()
+ | `DELETE_EVENT -> return None));
+ (* menus *)
+ List.iter (fun w -> w#misc#set_sensitive false) [ main#saveMenuItem ];
+ (* console *)
+ let adj = main#logScrolledWin#vadjustment in
+ ignore (adj#connect#changed
+ (fun _ -> adj#set_value (adj#upper -. adj#page_size)));
+ console#message (sprintf "\tMatita version %s\n" BuildTimeConf.version);
+ (* toolbar *)
+ let module A = GrafiteAst in
+ let hole = CicNotationPt.UserInput in
+ let loc = HExtlib.dummy_floc in
+ let tac ast _ =
+ if (MatitaScript.current ())#onGoingProof () then
+ (MatitaScript.current ())#advance
+ ~statement:("\n"
+ ^ GrafiteAstPp.pp_tactical ~term_pp:CicNotationPp.pp_term
+ ~lazy_term_pp:CicNotationPp.pp_term (A.Tactic (loc, ast)))
+ ()
+ in
+ let tac_w_term ast _ =
+ if (MatitaScript.current ())#onGoingProof () then
+ let buf = source_buffer in
+ buf#insert ~iter:(buf#get_iter_at_mark (`NAME "locked"))
+ ("\n"
+ ^ GrafiteAstPp.pp_tactic ~term_pp:CicNotationPp.pp_term
+ ~lazy_term_pp:CicNotationPp.pp_term ast)
+ in
+ let tbar = main in
+ connect_button tbar#introsButton (tac (A.Intros (loc, None, [])));
+ connect_button tbar#applyButton (tac_w_term (A.Apply (loc, hole)));
+ connect_button tbar#exactButton (tac_w_term (A.Exact (loc, hole)));
+ connect_button tbar#elimButton (tac_w_term
+ (A.Elim (loc, hole, None, None, [])));
+ connect_button tbar#elimTypeButton (tac_w_term
+ (A.ElimType (loc, hole, None, None, [])));
+ connect_button tbar#splitButton (tac (A.Split loc));
+ connect_button tbar#leftButton (tac (A.Left loc));
+ connect_button tbar#rightButton (tac (A.Right loc));
+ connect_button tbar#existsButton (tac (A.Exists loc));
+ connect_button tbar#reflexivityButton (tac (A.Reflexivity loc));
+ connect_button tbar#symmetryButton (tac (A.Symmetry loc));
+ connect_button tbar#transitivityButton
+ (tac_w_term (A.Transitivity (loc, hole)));
+ connect_button tbar#assumptionButton (tac (A.Assumption loc));
+ connect_button tbar#cutButton (tac_w_term (A.Cut (loc, None, hole)));
+ connect_button tbar#autoButton (tac (A.Auto (loc,None,None,None,None)));
+ MatitaGtkMisc.toggle_widget_visibility
+ ~widget:(main#tacticsButtonsHandlebox :> GObj.widget)
+ ~check:main#tacticsBarMenuItem;
+ let module Hr = Helm_registry in
+ if
+ not (Hr.get_opt_default Hr.bool ~default:false "matita.tactics_bar")
+ then
+ main#tacticsBarMenuItem#set_active false;
+ MatitaGtkMisc.toggle_callback
+ ~callback:(function
+ | true -> main#toplevel#fullscreen ()
+ | false -> main#toplevel#unfullscreen ())
+ ~check:main#fullscreenMenuItem;
+ main#fullscreenMenuItem#set_active false;
+ (* log *)
+ HLog.set_log_callback self#console#log_callback;
+ GtkSignal.user_handler :=
+ (fun exn ->
+ if not (Helm_registry.get_bool "matita.debug") then
+ let floc, msg = MatitaExcPp.to_string exn in
+ begin
+ match floc with
+ None -> ()
+ | Some floc ->
+ let (x, y) = HExtlib.loc_of_floc floc in
+ let script = MatitaScript.current () in
+ let locked_mark = script#locked_mark in
+ let error_tag = script#error_tag in
+ let baseoffset =
+ (source_buffer#get_iter_at_mark (`MARK locked_mark))#offset in
+ let x' = baseoffset + x in
+ let y' = baseoffset + y in
+ let x_iter = source_buffer#get_iter (`OFFSET x') in
+ let y_iter = source_buffer#get_iter (`OFFSET y') in
+ source_buffer#apply_tag error_tag ~start:x_iter ~stop:y_iter;
+ let id = ref None in
+ id := Some (source_buffer#connect#changed ~callback:(fun () ->
+ source_buffer#remove_tag error_tag
+ ~start:source_buffer#start_iter
+ ~stop:source_buffer#end_iter;
+ match !id with
+ | None -> assert false (* a race condition occurred *)
+ | Some id ->
+ (new GObj.gobject_ops source_buffer#as_buffer)#disconnect id));
+ source_buffer#place_cursor
+ (source_buffer#get_iter (`OFFSET x'));
+ end;
+ HLog.error msg
+ else raise exn);
+ (* script *)
+ ignore (source_buffer#connect#mark_set (fun _ _ -> next_ligatures <- []));
+ let _ =
+ match GSourceView.source_language_from_file BuildTimeConf.lang_file with
+ | None ->
+ HLog.warn (sprintf "can't load language file %s"
+ BuildTimeConf.lang_file)
+ | Some matita_lang ->
+ source_buffer#set_language matita_lang;
+ source_buffer#set_highlight true
+ in
+ let s () = MatitaScript.current () in
+ let disableSave () =
+ script_fname <- None;
+ main#saveMenuItem#misc#set_sensitive false
+ in
+ let saveAsScript () =
+ let script = s () in
+ match self#chooseFile ~ok_not_exists:true () with
+ | Some f ->
+ script#assignFileName f;
+ script#saveToFile ();
+ console#message ("'"^f^"' saved.\n");
+ self#_enableSaveTo f
+ | None -> ()
+ in
+ let saveScript () =
+ match script_fname with
+ | None -> saveAsScript ()
+ | Some f ->
+ (s ())#assignFileName f;
+ (s ())#saveToFile ();
+ console#message ("'"^f^"' saved.\n");
+ in
+ let abandon_script () =
+ let lexicon_status = (s ())#lexicon_status in
+ let grafite_status = (s ())#grafite_status in
+ if source_view#buffer#modified then
+ (match ask_unsaved main#toplevel with
+ | `YES -> saveScript ()
+ | `NO -> ()
+ | `CANCEL -> raise MatitaTypes.Cancel);
+ (match script_fname with
+ | None -> ()
+ | Some fname ->
+ ask_and_save_moo_if_needed main#toplevel fname
+ lexicon_status grafite_status);
+ in
+ let loadScript () =
+ let script = s () in
+ try
+ match self#chooseFile () with
+ | Some f ->
+ abandon_script ();
+ script#reset ();
+ script#assignFileName f;
+ source_view#source_buffer#begin_not_undoable_action ();
+ script#loadFromFile f;
+ source_view#source_buffer#end_not_undoable_action ();
+ console#message ("'"^f^"' loaded.\n");
+ self#_enableSaveTo f
+ | None -> ()
+ with MatitaTypes.Cancel -> ()
+ in
+ let newScript () =
+ abandon_script ();
+ source_view#source_buffer#begin_not_undoable_action ();
+ (s ())#reset ();
+ (s ())#template ();
+ source_view#source_buffer#end_not_undoable_action ();
+ disableSave ();
+ script_fname <- None
+ in
+ let cursor () =
+ source_buffer#place_cursor
+ (source_buffer#get_iter_at_mark (`NAME "locked")) in
+ let advance _ = (MatitaScript.current ())#advance (); cursor () in
+ let retract _ = (MatitaScript.current ())#retract (); cursor () in
+ let top _ = (MatitaScript.current ())#goto `Top (); cursor () in
+ let bottom _ = (MatitaScript.current ())#goto `Bottom (); cursor () in
+ let jump _ = (MatitaScript.current ())#goto `Cursor (); cursor () in
+ let advance = locker (keep_focus advance) in
+ let retract = locker (keep_focus retract) in
+ let top = locker (keep_focus top) in
+ let bottom = locker (keep_focus bottom) in
+ let jump = locker (keep_focus jump) in
+ (* quit *)
+ self#setQuitCallback (fun () ->
+ let lexicon_status = (MatitaScript.current ())#lexicon_status in
+ let grafite_status = (MatitaScript.current ())#grafite_status in
+ if source_view#buffer#modified then
+ begin
+ let rc = ask_unsaved main#toplevel in
+ try
+ match rc with
+ | `YES -> saveScript ();
+ if not source_view#buffer#modified then
+ begin
+ (match script_fname with
+ | None -> ()
+ | Some fname ->
+ ask_and_save_moo_if_needed main#toplevel
+ fname lexicon_status grafite_status);
+ GMain.Main.quit ()
+ end
+ | `NO -> GMain.Main.quit ()
+ | `CANCEL -> raise MatitaTypes.Cancel
+ with MatitaTypes.Cancel -> ()
+ end
+ else
+ begin
+ (match script_fname with
+ | None -> clean_current_baseuri grafite_status; GMain.Main.quit ()
+ | Some fname ->
+ try
+ ask_and_save_moo_if_needed main#toplevel fname lexicon_status
+ grafite_status;
+ GMain.Main.quit ()
+ with MatitaTypes.Cancel -> ())
+ end);
+ connect_button main#scriptAdvanceButton advance;
+ connect_button main#scriptRetractButton retract;
+ connect_button main#scriptTopButton top;
+ connect_button main#scriptBottomButton bottom;
+ connect_button main#scriptJumpButton jump;
+ connect_menu_item main#scriptAdvanceMenuItem advance;
+ connect_menu_item main#scriptRetractMenuItem retract;
+ connect_menu_item main#scriptTopMenuItem top;
+ connect_menu_item main#scriptBottomMenuItem bottom;
+ connect_menu_item main#scriptJumpMenuItem jump;
+ connect_menu_item main#openMenuItem loadScript;
+ connect_menu_item main#saveMenuItem saveScript;
+ connect_menu_item main#saveAsMenuItem saveAsScript;
+ connect_menu_item main#newMenuItem newScript;
+ (* script monospace font stuff *)
+ self#updateFontSize ();
+ (* debug menu *)
+ main#debugMenu#misc#hide ();
+ (* status bar *)
+ main#hintLowImage#set_file (image_path "matita-bulb-low.png");
+ main#hintMediumImage#set_file (image_path "matita-bulb-medium.png");
+ main#hintHighImage#set_file (image_path "matita-bulb-high.png");
+ (* focus *)
+ self#sourceView#misc#grab_focus ();
+ (* main win dimension *)
+ let width = Gdk.Screen.width () in
+ let height = Gdk.Screen.height () in
+ let main_w = width * 90 / 100 in
+ let main_h = height * 80 / 100 in
+ let script_w = main_w * 6 / 10 in
+ main#toplevel#resize ~width:main_w ~height:main_h;
+ main#hpaneScriptSequent#set_position script_w;
+ (* source_view *)
+ ignore(source_view#connect#after#paste_clipboard
+ ~callback:(fun () -> (MatitaScript.current ())#clean_dirty_lock));
+ (* clean_locked is set to true only "during" a PRIMARY paste
+ operation (i.e. by clicking with the second mouse button) *)
+ let clean_locked = ref false in
+ ignore(source_view#event#connect#button_press
+ ~callback:
+ (fun button ->
+ if GdkEvent.Button.button button = 2 then
+ clean_locked := true;
+ false
+ ));
+ ignore(source_view#event#connect#button_release
+ ~callback:(fun button -> clean_locked := false; false));
+ ignore(source_view#buffer#connect#after#apply_tag
+ ~callback:(
+ fun tag ~start:_ ~stop:_ ->
+ if !clean_locked &&
+ tag#get_oid = (MatitaScript.current ())#locked_tag#get_oid
+ then
+ begin
+ clean_locked := false;
+ (MatitaScript.current ())#clean_dirty_lock;
+ clean_locked := true
+ end));
+ (* math view handling *)
+ connect_menu_item main#newCicBrowserMenuItem (fun () ->
+ ignore (MatitaMathView.cicBrowser ()));
+ connect_menu_item main#increaseFontSizeMenuItem (fun () ->
+ self#increaseFontSize ();
+ MatitaMathView.increase_font_size ();
+ MatitaMathView.update_font_sizes ());
+ connect_menu_item main#decreaseFontSizeMenuItem (fun () ->
+ self#decreaseFontSize ();
+ MatitaMathView.decrease_font_size ();
+ MatitaMathView.update_font_sizes ());
+ connect_menu_item main#normalFontSizeMenuItem (fun () ->
+ self#resetFontSize ();
+ MatitaMathView.reset_font_size ();
+ MatitaMathView.update_font_sizes ());
+ MatitaMathView.reset_font_size ();
+
+ (** selections / clipboards handling *)
+
+ method markupSelected = MatitaMathView.has_selection ()
+ method private textSelected =
+ (source_buffer#get_iter_at_mark `INSERT)#compare
+ (source_buffer#get_iter_at_mark `SEL_BOUND) <> 0
+ method private somethingSelected = self#markupSelected || self#textSelected
+ method private markupStored = MatitaMathView.has_clipboard ()
+ method private textStored = clipboard#text <> None
+ method private somethingStored = self#markupStored || self#textStored
+
+ method canCopy = self#somethingSelected
+ method canCut = self#textSelected
+ method canDelete = self#textSelected
+ method canPaste = self#somethingStored
+ method canPastePattern = self#markupStored
+
+ method copy () =
+ if self#textSelected
+ then begin
+ MatitaMathView.empty_clipboard ();
+ source_view#buffer#copy_clipboard clipboard;
+ end else
+ MatitaMathView.copy_selection ()
+ method cut () =
+ source_view#buffer#cut_clipboard clipboard;
+ MatitaMathView.empty_clipboard ()
+ method delete () = ignore (source_view#buffer#delete_selection ())
+ method paste () =
+ if MatitaMathView.has_clipboard ()
+ then source_view#buffer#insert (MatitaMathView.paste_clipboard `Term)
+ else source_view#buffer#paste_clipboard clipboard;
+ (MatitaScript.current ())#clean_dirty_lock
+ method pastePattern () =
+ source_view#buffer#insert (MatitaMathView.paste_clipboard `Pattern)
+
+ method private nextLigature () =
+ let iter = source_buffer#get_iter_at_mark `INSERT in
+ let write_ligature len s =
+ source_buffer#delete ~start:iter ~stop:(iter#copy#backward_chars len);
+ source_buffer#insert ~iter:(source_buffer#get_iter_at_mark `INSERT) s
+ in
+ let get_ligature word =
+ let len = String.length word in
+ let aux_tex () =
+ try
+ for i = len - 1 downto 0 do
+ if HExtlib.is_alpha word.[i] then ()
+ else
+ (if word.[i] = '\\' then raise (Found i) else raise (Found ~-1))
+ done;
+ None
+ with Found i ->
+ if i = ~-1 then None else Some (String.sub word i (len - i))
+ in
+ let aux_ligature () =
+ try
+ for i = len - 1 downto 0 do
+ if CicNotationLexer.is_ligature_char word.[i] then ()
+ else raise (Found (i+1))
+ done;
+ raise (Found 0)
+ with
+ | Found i ->
+ (try
+ Some (String.sub word i (len - i))
+ with Invalid_argument _ -> None)
+ in
+ match aux_tex () with
+ | Some macro -> macro
+ | None -> (match aux_ligature () with Some l -> l | None -> word)
+ in
+ (match next_ligatures with
+ | [] -> (* find ligatures and fill next_ligatures, then try again *)
+ let last_word =
+ iter#get_slice
+ ~stop:(iter#copy#backward_find_char Glib.Unichar.isspace)
+ in
+ let ligature = get_ligature last_word in
+ (match CicNotationLexer.lookup_ligatures ligature with
+ | [] -> ()
+ | hd :: tl ->
+ write_ligature (String.length ligature) hd;
+ next_ligatures <- tl @ [ hd ])
+ | hd :: tl ->
+ write_ligature 1 hd;
+ next_ligatures <- tl @ [ hd ])
+
+ method private externalEditor () =
+ let cmd = Helm_registry.get "matita.external_editor" in
+(* ZACK uncomment to enable interactive ask of external editor command *)
+(* let cmd =
+ let msg =
+ "External editor command:
+%f will be substitute for the script name,
+%p for the cursor position in bytes,
+%l for the execution point in bytes."
+ in
+ ask_text ~gui:self ~title:"External editor" ~msg ~multiline:false
+ ~default:(Helm_registry.get "matita.external_editor") ()
+ in *)
+ let fname = (MatitaScript.current ())#filename in
+ let slice mark =
+ source_buffer#start_iter#get_slice
+ ~stop:(source_buffer#get_iter_at_mark mark)
+ in
+ let script = MatitaScript.current () in
+ let locked = `MARK script#locked_mark in
+ let string_pos mark = string_of_int (String.length (slice mark)) in
+ let cursor_pos = string_pos `INSERT in
+ let locked_pos = string_pos locked in
+ let cmd =
+ Pcre.replace ~pat:"%f" ~templ:fname
+ (Pcre.replace ~pat:"%p" ~templ:cursor_pos
+ (Pcre.replace ~pat:"%l" ~templ:locked_pos
+ cmd))
+ in
+ let locked_before = slice locked in
+ let locked_offset = (source_buffer#get_iter_at_mark locked)#offset in
+ ignore (Unix.system cmd);
+ source_buffer#set_text (HExtlib.input_file fname);
+ let locked_iter = source_buffer#get_iter (`OFFSET locked_offset) in
+ source_buffer#move_mark locked locked_iter;
+ source_buffer#apply_tag script#locked_tag
+ ~start:source_buffer#start_iter ~stop:locked_iter;
+ let locked_after = slice locked in
+ let line = ref 0 in
+ let col = ref 0 in
+ try
+ for i = 0 to String.length locked_before - 1 do
+ if locked_before.[i] <> locked_after.[i] then begin
+ source_buffer#place_cursor
+ ~where:(source_buffer#get_iter (`LINEBYTE (!line, !col)));
+ script#goto `Cursor ();
+ raise Exit
+ end else if locked_before.[i] = '\n' then begin
+ incr line;
+ col := 0
+ end
+ done
+ with
+ | Exit -> ()
+ | Invalid_argument _ -> script#goto `Bottom ()
+
+ method loadScript file =
+ let script = MatitaScript.current () in
+ script#reset ();
+ script#assignFileName file;
+ let content =
+ if Sys.file_exists file then file
+ else BuildTimeConf.script_template
+ in
+ source_view#source_buffer#begin_not_undoable_action ();
+ script#loadFromFile content;
+ source_view#source_buffer#end_not_undoable_action ();
+ console#message ("'"^file^"' loaded.");
+ self#_enableSaveTo file
+
+ method setStar name b =
+ let l = main#scriptLabel in
+ if b then
+ l#set_text (name ^ " *")
+ else
+ l#set_text (name)
+
+ method private _enableSaveTo file =
+ script_fname <- Some file;
+ self#main#saveMenuItem#misc#set_sensitive true
+
+ method console = console
+ method sourceView: GSourceView.source_view =
+ (source_view: GSourceView.source_view)
+ method fileSel = fileSel
+ method findRepl = findRepl
+ method main = main
+ method develList = develList
+ method newDevel = newDevel
+
+ method newBrowserWin () =
+ object (self)
+ inherit browserWin ()
+ val combo = GEdit.combo_box_entry ()
+ initializer
+ self#check_widgets ();
+ let combo_widget = combo#coerce in
+ uriHBox#pack ~from:`END ~fill:true ~expand:true combo_widget;
+ combo#entry#misc#grab_focus ()
+ method browserUri = combo
+ end
+
+ method newUriDialog () =
+ let dialog = new uriChoiceDialog () in
+ dialog#check_widgets ();
+ dialog
+
+ method newRecordDialog () =
+ let dialog = new recordChoiceDialog () in
+ dialog#check_widgets ();
+ dialog
+
+ method newConfirmationDialog () =
+ let dialog = new confirmationDialog () in
+ dialog#check_widgets ();
+ dialog
+
+ method newEmptyDialog () =
+ let dialog = new emptyDialog () in
+ dialog#check_widgets ();
+ dialog
+
+ method private addKeyBinding key callback =
+ List.iter (fun evbox -> add_key_binding key callback evbox)
+ keyBindingBoxes
+
+ method setQuitCallback callback =
+ connect_menu_item main#quitMenuItem callback;
+ ignore (main#toplevel#event#connect#delete
+ (fun _ -> callback ();true));
+ self#addKeyBinding GdkKeysyms._q callback
+
+ method chooseFile ?(ok_not_exists = false) () =
+ _ok_not_exists <- ok_not_exists;
+ _only_directory <- false;
+ fileSel#fileSelectionWin#show ();
+ GtkThread.main ();
+ chosen_file
+
+ method private chooseDir ?(ok_not_exists = false) () =
+ _ok_not_exists <- ok_not_exists;
+ _only_directory <- true;
+ fileSel#fileSelectionWin#show ();
+ GtkThread.main ();
+ (* we should check that this is a directory *)
+ chosen_file
+
+ method createDevelopment ~containing =
+ next_devel_must_contain <- containing;
+ newDevel#toplevel#misc#show()
+
+ method askText ?(title = "") ?(msg = "") () =
+ let dialog = new textDialog () in
+ dialog#textDialog#set_title title;
+ dialog#textDialogLabel#set_label msg;
+ let text = ref None in
+ let return v =
+ text := v;
+ dialog#textDialog#destroy ();
+ GMain.Main.quit ()
+ in
+ ignore (dialog#textDialog#event#connect#delete (fun _ -> true));
+ connect_button dialog#textDialogCancelButton (fun _ -> return None);
+ connect_button dialog#textDialogOkButton (fun _ ->
+ let text = dialog#textDialogTextView#buffer#get_text () in
+ return (Some text));
+ dialog#textDialog#show ();
+ GtkThread.main ();
+ !text
+
+ method private updateFontSize () =
+ self#sourceView#misc#modify_font_by_name
+ (sprintf "%s %d" BuildTimeConf.script_font font_size)
+
+ method increaseFontSize () =
+ font_size <- font_size + 1;
+ self#updateFontSize ()
+
+ method decreaseFontSize () =
+ font_size <- font_size - 1;
+ self#updateFontSize ()
+
+ method resetFontSize () =
+ font_size <- default_font_size;
+ self#updateFontSize ()
+
+ end
+
+let gui () =
+ let g = new gui () in
+ gui_instance := Some g;
+ MatitaMathView.set_gui g;
+ g
+
+let instance = singleton gui
+
+let non p x = not (p x)
+
+(* this is a shit and should be changed :-{ *)
+let interactive_uri_choice
+ ?(selection_mode:[`SINGLE|`MULTIPLE] = `MULTIPLE) ?(title = "")
+ ?(msg = "") ?(nonvars_button = false) ?(hide_uri_entry=false)
+ ?(hide_try=false) ?(ok_label="_Auto") ?(ok_action:[`SELECT|`AUTO] = `AUTO)
+ ?copy_cb ()
+ ~id uris
+=
+ let gui = instance () in
+ let nonvars_uris = lazy (List.filter (non UriManager.uri_is_var) uris) in
+ if (selection_mode <> `SINGLE) &&
+ (Helm_registry.get_bool "matita.auto_disambiguation")
+ then
+ Lazy.force nonvars_uris
+ else begin
+ let dialog = gui#newUriDialog () in
+ if hide_uri_entry then
+ dialog#uriEntryHBox#misc#hide ();
+ if hide_try then
+ begin
+ dialog#uriChoiceSelectedButton#misc#hide ();
+ dialog#uriChoiceConstantsButton#misc#hide ();
+ end;
+ dialog#okLabel#set_label ok_label;
+ dialog#uriChoiceTreeView#selection#set_mode
+ (selection_mode :> Gtk.Tags.selection_mode);
+ let model = new stringListModel dialog#uriChoiceTreeView in
+ let choices = ref None in
+ (match copy_cb with
+ | None -> ()
+ | Some cb ->
+ dialog#copyButton#misc#show ();
+ connect_button dialog#copyButton
+ (fun _ ->
+ match model#easy_selection () with
+ | [u] -> (cb u)
+ | _ -> ()));
+ dialog#uriChoiceDialog#set_title title;
+ dialog#uriChoiceLabel#set_text msg;
+ List.iter model#easy_append (List.map UriManager.string_of_uri uris);
+ dialog#uriChoiceConstantsButton#misc#set_sensitive nonvars_button;
+ let return v =
+ choices := v;
+ dialog#uriChoiceDialog#destroy ();
+ GMain.Main.quit ()
+ in
+ ignore (dialog#uriChoiceDialog#event#connect#delete (fun _ -> true));
+ connect_button dialog#uriChoiceConstantsButton (fun _ ->
+ return (Some (Lazy.force nonvars_uris)));
+ if ok_action = `AUTO then
+ connect_button dialog#uriChoiceAutoButton (fun _ ->
+ Helm_registry.set_bool "matita.auto_disambiguation" true;
+ return (Some (Lazy.force nonvars_uris)))
+ else
+ connect_button dialog#uriChoiceAutoButton (fun _ ->
+ match model#easy_selection () with
+ | [] -> ()
+ | uris -> return (Some (List.map UriManager.uri_of_string uris)));
+ connect_button dialog#uriChoiceSelectedButton (fun _ ->
+ match model#easy_selection () with
+ | [] -> ()
+ | uris -> return (Some (List.map UriManager.uri_of_string uris)));
+ connect_button dialog#uriChoiceAbortButton (fun _ -> return None);
+ dialog#uriChoiceDialog#show ();
+ GtkThread.main ();
+ (match !choices with
+ | None -> raise MatitaTypes.Cancel
+ | Some uris -> uris)
+ end
+
+class interpModel =
+ let cols = new GTree.column_list in
+ let id_col = cols#add Gobject.Data.string in
+ let dsc_col = cols#add Gobject.Data.string in
+ let interp_no_col = cols#add Gobject.Data.int in
+ let tree_store = GTree.tree_store cols in
+ let id_renderer = GTree.cell_renderer_text [], ["text", id_col] in
+ let dsc_renderer = GTree.cell_renderer_text [], ["text", dsc_col] in
+ let id_view_col = GTree.view_column ~renderer:id_renderer () in
+ let dsc_view_col = GTree.view_column ~renderer:dsc_renderer () in
+ fun tree_view choices ->
+ object
+ initializer
+ tree_view#set_model (Some (tree_store :> GTree.model));
+ ignore (tree_view#append_column id_view_col);
+ ignore (tree_view#append_column dsc_view_col);
+ let name_of_interp =
+ (* try to find a reasonable name for an interpretation *)
+ let idx = ref 0 in
+ fun interp ->
+ try
+ List.assoc "0" interp
+ with Not_found ->
+ incr idx; string_of_int !idx
+ in
+ tree_store#clear ();
+ let idx = ref ~-1 in
+ List.iter
+ (fun interp ->
+ incr idx;
+ let interp_row = tree_store#append () in
+ tree_store#set ~row:interp_row ~column:id_col
+ (name_of_interp interp);
+ tree_store#set ~row:interp_row ~column:interp_no_col !idx;
+ List.iter
+ (fun (id, dsc) ->
+ let row = tree_store#append ~parent:interp_row () in
+ tree_store#set ~row ~column:id_col id;
+ tree_store#set ~row ~column:dsc_col dsc;
+ tree_store#set ~row ~column:interp_no_col !idx)
+ interp)
+ choices
+
+ method get_interp_no tree_path =
+ let iter = tree_store#get_iter tree_path in
+ tree_store#get ~row:iter ~column:interp_no_col
+ end
+
+let interactive_interp_choice () choices =
+ let gui = instance () in
+ assert (choices <> []);
+ let dialog = gui#newRecordDialog () in
+ let model = new interpModel dialog#recordChoiceTreeView choices in
+ dialog#recordChoiceDialog#set_title "Interpretation choice";
+ dialog#recordChoiceDialogLabel#set_label "Choose an interpretation:";
+ let interp_no = ref None in
+ let return _ =
+ dialog#recordChoiceDialog#destroy ();
+ GMain.Main.quit ()
+ in
+ let fail _ = interp_no := None; return () in
+ ignore (dialog#recordChoiceDialog#event#connect#delete (fun _ -> true));
+ connect_button dialog#recordChoiceOkButton (fun _ ->
+ match !interp_no with None -> () | Some _ -> return ());
+ connect_button dialog#recordChoiceCancelButton fail;
+ ignore (dialog#recordChoiceTreeView#connect#row_activated (fun path _ ->
+ interp_no := Some (model#get_interp_no path);
+ return ()));
+ let selection = dialog#recordChoiceTreeView#selection in
+ ignore (selection#connect#changed (fun _ ->
+ match selection#get_selected_rows with
+ | [path] -> interp_no := Some (model#get_interp_no path)
+ | _ -> assert false));
+ dialog#recordChoiceDialog#show ();
+ GtkThread.main ();
+ (match !interp_no with Some row -> [row] | _ -> raise MatitaTypes.Cancel)
+
+let _ =
+ (* disambiguator callbacks *)
+ GrafiteDisambiguator.set_choose_uris_callback (interactive_uri_choice ());
+ GrafiteDisambiguator.set_choose_interp_callback (interactive_interp_choice ());
+ (* gtk initialization *)
+ GtkMain.Rc.add_default_file BuildTimeConf.gtkrc_file; (* loads gtk rc *)
+ GMathView.add_configuration_path BuildTimeConf.gtkmathview_conf;
+ ignore (GMain.Main.init ())
+
diff --git a/helm/matita/matitaGui.mli b/helm/matita/matitaGui.mli
new file mode 100644
index 000000000..8c9064e1d
--- /dev/null
+++ b/helm/matita/matitaGui.mli
@@ -0,0 +1,49 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+ (** singleton instance of the gui *)
+val instance: unit -> MatitaGuiTypes.gui
+
+ (** {2 Disambiguation callbacks}
+ * Use singleton gui instance. *)
+
+ (** @param selection_mode selection mode in uri list, default to `MULTIPLE
+ * @param title window title, defaults to ""
+ * @param msg message for the user, defaults to ""
+ * @param nonvars_button enable button to exclude vars?, defaults to false
+ * @raise MatitaTypes.Cancel *)
+val interactive_uri_choice:
+ ?selection_mode:([`SINGLE|`MULTIPLE]) -> ?title:string ->
+ ?msg:string -> ?nonvars_button:bool ->
+ ?hide_uri_entry:bool -> ?hide_try:bool -> ?ok_label:string ->
+ ?ok_action:[`AUTO|`SELECT] ->
+ ?copy_cb:(string -> unit) -> unit ->
+ GrafiteDisambiguator.choose_uris_callback
+
+ (** @raise MatitaTypes.Cancel *)
+val interactive_interp_choice:
+ unit ->
+ GrafiteDisambiguator.choose_interp_callback
+
diff --git a/helm/matita/matitaGuiTypes.mli b/helm/matita/matitaGuiTypes.mli
new file mode 100644
index 000000000..1b9d17cad
--- /dev/null
+++ b/helm/matita/matitaGuiTypes.mli
@@ -0,0 +1,151 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+class type console =
+object
+ method message: string -> unit
+ method error: string -> unit
+ method warning: string -> unit
+ method debug: string -> unit
+ method clear: unit -> unit
+
+ method log_callback: HLog.log_callback
+end
+
+class type browserWin =
+object
+ inherit MatitaGeneratedGui.browserWin
+ method browserUri: GEdit.combo_box_entry
+end
+
+class type gui =
+object
+ method setQuitCallback : (unit -> unit) -> unit
+
+ (** {2 Access to singleton instances of lower-level GTK widgets} *)
+
+ method fileSel : MatitaGeneratedGui.fileSelectionWin
+ method main : MatitaGeneratedGui.mainWin
+ method findRepl : MatitaGeneratedGui.findReplWin
+ method develList: MatitaGeneratedGui.develListWin
+ method newDevel: MatitaGeneratedGui.newDevelWin
+(* method toolbar : MatitaGeneratedGui.toolBarWin *)
+
+ method console: console
+ method sourceView: GSourceView.source_view
+
+ (** {2 Dialogs instantiation}
+ * methods below create a new window on each invocation. You should
+ * remember to destroy windows after use *)
+
+ method newBrowserWin: unit -> browserWin
+ method newUriDialog: unit -> MatitaGeneratedGui.uriChoiceDialog
+ method newRecordDialog: unit -> MatitaGeneratedGui.recordChoiceDialog
+ method newConfirmationDialog: unit -> MatitaGeneratedGui.confirmationDialog
+ method newEmptyDialog: unit -> MatitaGeneratedGui.emptyDialog
+
+ (** {2 Selections / clipboards handling} *)
+
+ method canCopy: bool
+ method canCut: bool
+ method canDelete: bool
+ method canPaste: bool
+ method canPastePattern: bool
+
+ method markupSelected: bool
+
+ method copy: unit -> unit
+ method cut: unit -> unit
+ method delete: unit -> unit
+ method paste: unit -> unit
+ method pastePattern: unit -> unit
+
+ (** {2 Utility methods} *)
+
+ (** ask the used to choose a file with the file chooser
+ * @param ok_not_exists if set to true returns also non existent files
+ * (useful for save). Defaults to false *)
+ method chooseFile: ?ok_not_exists:bool -> unit -> string option
+ method createDevelopment: containing:string option -> unit
+
+ (** prompt the user for a (multiline) text entry *)
+ method askText: ?title:string -> ?msg:string -> unit -> string option
+
+ method loadScript: string -> unit
+ method setStar: string -> bool -> unit
+
+ (** {3 Fonts} *)
+ method increaseFontSize: unit -> unit
+ method decreaseFontSize: unit -> unit
+ method resetFontSize: unit -> unit
+end
+
+type paste_kind = [ `Term | `Pattern ]
+
+ (** multi selection gtkMathView which handle mactions and hyperlinks. Mactions
+ * are handled internally. Hyperlinks are handled by calling an user provided
+ * callback *)
+class type clickableMathView =
+object
+ inherit GMathViewAux.multi_selection_math_view
+
+ (** set hyperlink callback. None disable hyperlink handling *)
+ method set_href_callback: (string -> unit) option -> unit
+
+ method has_selection: bool
+
+ (** @raise Failure "no selection" *)
+ method strings_of_selection: (paste_kind * string) list
+
+ method update_font_size: unit
+end
+
+class type cicMathView =
+object
+ inherit clickableMathView
+
+ (** load a sequent and render it into parent widget *)
+ method load_sequent: Cic.metasenv -> int -> unit
+
+ method load_object: Cic.obj -> unit
+end
+
+class type sequentsViewer =
+object
+ method reset: unit
+ method load_logo: unit
+ method load_logo_with_qed: unit
+ method load_sequents: GrafiteTypes.incomplete_proof -> unit
+ method goto_sequent: int -> unit (* to be called _after_ load_sequents *)
+end
+
+class type cicBrowser =
+object
+ method load: MatitaTypes.mathViewer_entry -> unit
+ (* method loadList: string list -> MatitaTypes.mathViewer_entry -> unit *)
+ method loadInput: string -> unit
+ method mathView: clickableMathView
+end
+
diff --git a/helm/matita/matitaInit.ml b/helm/matita/matitaInit.ml
new file mode 100644
index 000000000..fec223b00
--- /dev/null
+++ b/helm/matita/matitaInit.ml
@@ -0,0 +1,223 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+type thingsToInitilaize =
+ ConfigurationFile | Db | Environment | Getter | Makelib | CmdLine
+
+exception FailedToInitialize of thingsToInitilaize
+
+let wants s l =
+ List.iter (
+ fun item ->
+ if not (List.exists (fun x -> x = item) l) then
+ raise (FailedToInitialize item))
+ s
+
+let already_configured s l =
+ List.for_all (fun item -> List.exists (fun x -> x = item) l) s
+
+let tilde_expand_key k =
+ try
+ Helm_registry.set k (HExtlib.tilde_expand (Helm_registry.get k))
+ with Helm_registry.Key_not_found _ -> ()
+
+let load_configuration init_status =
+ if not (already_configured [ConfigurationFile] init_status) then
+ begin
+ Helm_registry.load_from BuildTimeConf.matita_conf;
+ if not (Helm_registry.has "user.name") then begin
+ let login = (Unix.getpwuid (Unix.getuid ())).Unix.pw_name in
+ Helm_registry.set "user.name" login
+ end;
+ tilde_expand_key "matita.basedir";
+ tilde_expand_key "user.home";
+ ConfigurationFile::init_status
+ end
+ else
+ init_status
+
+let initialize_db init_status =
+ wants [ ConfigurationFile; CmdLine ] init_status;
+ if not (already_configured [ Db ] init_status) then
+ begin
+ MetadataTypes.ownerize_tables (Helm_registry.get "matita.owner");
+ LibraryDb.create_owner_environment ();
+ Db::init_status
+ end
+ else
+ init_status
+
+let initialize_makelib init_status =
+ wants [ConfigurationFile] init_status;
+ if not (already_configured [Makelib] init_status) then
+ begin
+ MatitamakeLib.initialize ();
+ Makelib::init_status
+ end
+ else
+ init_status
+
+let initialize_environment init_status =
+ wants [ConfigurationFile] init_status;
+ if not (already_configured [Getter;Environment] init_status) then
+ begin
+ Http_getter.init ();
+ CicEnvironment.set_trust (* environment trust *)
+ (let trust = Helm_registry.get_bool "matita.environment_trust" in
+ fun _ -> trust);
+ Getter::Environment::init_status
+ end
+ else
+ init_status
+
+let status = ref []
+
+let usages = Hashtbl.create 11
+let _ =
+ List.iter
+ (fun (name, s) -> Hashtbl.replace usages name s)
+ [ "matitac",
+ sprintf "MatitaC v%s
+Usage: matitac [ OPTION ... ] FILE
+Options:"
+ BuildTimeConf.version;
+ "matita",
+ sprintf "Matita v%s
+Usage: matita [ OPTION ... ] [ FILE ... ]
+Options:"
+ BuildTimeConf.version;
+ "cicbrowser",
+ sprintf
+ "CIC Browser v%s
+Usage: cicbrowser [ URL | WHELP QUERY ]
+Options:"
+ BuildTimeConf.version;
+ "matitadep",
+ sprintf "MatitaDep v%s
+Usage: matitadep [ OPTION ... ] FILE ...
+Options:"
+ BuildTimeConf.version;
+ "matitaclean",
+ sprintf "MatitaClean v%s
+Usage: matitaclean all
+ matitaclean [ (FILE | URI) ... ]
+Options:"
+ BuildTimeConf.version;
+ ]
+let default_usage =
+ sprintf "Matita v%s\nUsage: matita [ ARG ]\nOptions:" BuildTimeConf.version
+
+let usage () =
+ let basename = Filename.basename Sys.argv.(0) in
+ let usage_key =
+ try Filename.chop_extension basename with Invalid_argument _ -> basename
+ in
+ try Hashtbl.find usages usage_key with Not_found -> default_usage
+
+let registry_defaults =
+ [
+ "db.nodb", "false";
+ "matita.debug", "false";
+ "matita.external_editor", "gvim -f -c 'go %p' %f";
+ "matita.preserve", "false";
+ "matita.quiet", "false";
+ "matita.profile", "true";
+ ]
+
+let set_registry_values =
+ List.iter (fun key, value -> Helm_registry.set ~key ~value)
+
+let parse_cmdline init_status =
+ if not (already_configured [CmdLine] init_status) then begin
+ let includes = ref [ BuildTimeConf.stdlib_dir ] in
+ let args = ref [] in
+ let add_l l = fun s -> l := s :: !l in
+ let arg_spec =
+ let std_arg_spec = [
+ "-I", Arg.String (add_l includes),
+ ("<path> Adds path to the list of searched paths for the "
+ ^ "include command");
+ "-q", Arg.Unit (fun () -> Helm_registry.set_bool "matita.quiet" true),
+ "Turn off verbose compilation";
+ "-preserve",
+ Arg.Unit (fun () -> Helm_registry.set_bool "matita.preserve" true),
+ "Turns off automatic baseuri cleaning";
+ "-nodb", Arg.Unit (fun () -> Helm_registry.set_bool "db.nodb" true),
+ ("Avoid using external database connection "
+ ^ "(WARNING: disable many features)");
+ "-noprofile",
+ Arg.Unit (fun () -> Helm_registry.set_bool "matita.profile" false),
+ "Turns off profiling printings";
+ ] in
+ let debug_arg_spec =
+ if BuildTimeConf.debug then
+ [ "-debug",
+ Arg.Unit (fun () -> Helm_registry.set_bool "matita.debug" true),
+ ("Do not catch top-level exception "
+ ^ "(useful for backtrace inspection)");
+ ]
+ else []
+ in
+ std_arg_spec @ debug_arg_spec
+ in
+ let set_list ~key l =
+ Helm_registry.set_list Helm_registry.of_string ~key ~value:(List.rev !l)
+ in
+ set_registry_values registry_defaults;
+ Arg.parse arg_spec (add_l args) (usage ());
+ set_list ~key:"matita.includes" includes;
+ set_list ~key:"matita.args" args;
+ HExtlib.set_profiling_printings
+ (fun () -> Helm_registry.get_bool "matita.profile");
+ CmdLine :: init_status
+ end else
+ init_status
+
+let die_usage () =
+ print_endline (usage ());
+ exit 1
+
+let initialize_all () =
+ status :=
+ List.fold_left (fun s f -> f s) !status
+ [ parse_cmdline; load_configuration; initialize_makelib;
+ initialize_db; initialize_environment ]
+(* initialize_notation
+ (initialize_environment
+ (initialize_db
+ (initialize_makelib
+ (load_configuration
+ (parse_cmdline !status))))) *)
+
+let load_configuration_file () =
+ status := load_configuration !status
+
+let parse_cmdline () =
+ status := parse_cmdline !status
+
diff --git a/helm/matita/matitaInit.mli b/helm/matita/matitaInit.mli
new file mode 100644
index 000000000..9d8671299
--- /dev/null
+++ b/helm/matita/matitaInit.mli
@@ -0,0 +1,37 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+ (** {2 global initialization} *)
+val initialize_all: unit -> unit
+
+ (** {2 per-components initialization} *)
+val parse_cmdline: unit -> unit (** parse cmdline setting registry keys *)
+val load_configuration_file: unit -> unit
+
+ (** {2 Utilities} *)
+
+ (** die nicely: exit with return code 1 printing usage error message *)
+val die_usage: unit -> 'a
+
diff --git a/helm/matita/matitaMathView.ml b/helm/matita/matitaMathView.ml
new file mode 100644
index 000000000..3c4997aec
--- /dev/null
+++ b/helm/matita/matitaMathView.ml
@@ -0,0 +1,1103 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+open GrafiteTypes
+open MatitaGtkMisc
+open MatitaGuiTypes
+
+module Stack = Continuationals.Stack
+
+(** inherit from this class if you want to access current script *)
+class scriptAccessor =
+object (self)
+ method private script = MatitaScript.current ()
+end
+
+let cicBrowsers = ref []
+let gui_instance = ref None
+let set_gui gui = gui_instance := Some gui
+let get_gui () =
+ match !gui_instance with
+ | None -> assert false
+ | Some gui -> gui
+
+let default_font_size () =
+ Helm_registry.get_opt_default Helm_registry.int
+ ~default:BuildTimeConf.default_font_size "matita.font_size"
+let current_font_size = ref ~-1
+let increase_font_size () = incr current_font_size
+let decrease_font_size () = decr current_font_size
+let reset_font_size () = current_font_size := default_font_size ()
+
+ (* is there any lablgtk2 constant corresponding to the various mouse
+ * buttons??? *)
+let left_button = 1
+let middle_button = 2
+let right_button = 3
+
+let near (x1, y1) (x2, y2) =
+ let distance = sqrt (((x2 -. x1) ** 2.) +. ((y2 -. y1) ** 2.)) in
+ (distance < 4.)
+
+let xlink_ns = Gdome.domString "http://www.w3.org/1999/xlink"
+let helm_ns = Gdome.domString "http://www.cs.unibo.it/helm"
+let href_ds = Gdome.domString "href"
+let xref_ds = Gdome.domString "xref"
+
+let domImpl = Gdome.domImplementation ()
+
+ (** Gdome.element of a MathML document whose rendering should be blank. Used
+ * by cicBrowser to render "about:blank" document *)
+let empty_mathml = lazy (
+ domImpl#createDocument ~namespaceURI:(Some DomMisc.mathml_ns)
+ ~qualifiedName:(Gdome.domString "math") ~doctype:None)
+
+let empty_boxml = lazy (
+ domImpl#createDocument ~namespaceURI:(Some DomMisc.boxml_ns)
+ ~qualifiedName:(Gdome.domString "box") ~doctype:None)
+
+ (** shown for goals closed by side effects *)
+let closed_goal_mathml = lazy (
+ domImpl#createDocumentFromURI ~uri:BuildTimeConf.closed_xml ())
+
+(* ids_to_terms should not be passed here, is just for debugging *)
+let find_root_id annobj id ids_to_father_ids ids_to_terms ids_to_inner_types =
+ let find_parent id ids =
+ let rec aux id =
+(* (prerr_endline (sprintf "id %s = %s" id
+ (try
+ CicPp.ppterm (Hashtbl.find ids_to_terms id)
+ with Not_found -> "NONE"))); *)
+ if List.mem id ids then Some id
+ else
+ (match
+ (try Hashtbl.find ids_to_father_ids id with Not_found -> None)
+ with
+ | None -> None
+ | Some id' -> aux id')
+ in
+ aux id
+ in
+ let return_father id ids =
+ match find_parent id ids with
+ | None -> assert false
+ | Some parent_id -> parent_id
+ in
+ let mk_ids terms = List.map CicUtil.id_of_annterm terms in
+ let inner_types =
+ Hashtbl.fold
+ (fun _ types acc ->
+ match types.Cic2acic.annexpected with
+ None -> types.Cic2acic.annsynthesized :: acc
+ | Some ty -> ty :: types.Cic2acic.annsynthesized :: acc
+ ) ids_to_inner_types [] in
+ match annobj with
+ | Cic.AConstant (_, _, _, Some bo, ty, _, _)
+ | Cic.AVariable (_, _, Some bo, ty, _, _)
+ | Cic.ACurrentProof (_, _, _, _, bo, ty, _, _) ->
+ return_father id (mk_ids (ty :: bo :: inner_types))
+ | Cic.AConstant (_, _, _, None, ty, _, _)
+ | Cic.AVariable (_, _, None, ty, _, _) ->
+ return_father id (mk_ids (ty::inner_types))
+ | Cic.AInductiveDefinition _ ->
+ assert false (* TODO *)
+
+ (** @return string content of a dom node having a single text child node, e.g.
+ * <m:mi xlink:href="...">bool</m:mi> *)
+let string_of_dom_node node =
+ match node#get_firstChild with
+ | None -> ""
+ | Some node ->
+ (try
+ let text = new Gdome.text_of_node node in
+ text#get_data#to_string
+ with GdomeInit.DOMCastException _ -> "")
+
+let name_of_hypothesis = function
+ | Some (Cic.Name s, _) -> s
+ | _ -> assert false
+
+let id_of_node (node: Gdome.element) =
+ let xref_attr =
+ node#getAttributeNS ~namespaceURI:helm_ns ~localName:xref_ds in
+ try
+ List.hd (HExtlib.split ~sep:' ' xref_attr#to_string)
+ with Failure _ -> assert false
+
+type selected_term =
+ | SelTerm of Cic.term * string option (* term, parent hypothesis (if any) *)
+ | SelHyp of string * Cic.context (* hypothesis, context *)
+
+class clickableMathView obj =
+let text_width = 80 in
+object (self)
+ inherit GMathViewAux.multi_selection_math_view obj
+
+ val mutable href_callback: (string -> unit) option = None
+ method set_href_callback f = href_callback <- f
+
+ val mutable _cic_info = None
+ method private set_cic_info info = _cic_info <- info
+ method private cic_info = _cic_info
+
+ initializer
+ self#set_font_size !current_font_size;
+ ignore (self#connect#selection_changed self#choose_selection_cb);
+ ignore (self#event#connect#button_press self#button_press_cb);
+ ignore (self#event#connect#button_release self#button_release_cb);
+ ignore (self#event#connect#selection_clear self#selection_clear_cb);
+ ignore (self#coerce#misc#connect#selection_get self#selection_get_cb)
+
+ val mutable button_press_x = -1.
+ val mutable button_press_y = -1.
+ val mutable selection_changed = false
+
+ method private selection_get_cb ctxt ~info ~time =
+ let text =
+ match ctxt#target with
+ | "PATTERN" -> self#text_of_selection `Pattern
+ | "TERM" | _ -> self#text_of_selection `Term
+ in
+ match text with
+ | None -> ()
+ | Some s -> ctxt#return s
+
+ method private text_of_selection fmt =
+ match self#get_selections with
+ | [] -> None
+ | node :: _ -> Some (self#string_of_node ~paste_kind:fmt node)
+
+ method private selection_clear_cb sel_event =
+ self#remove_selections;
+ (GData.clipboard Gdk.Atom.clipboard)#clear ();
+ false
+
+ method private button_press_cb gdk_button =
+ let button = GdkEvent.Button.button gdk_button in
+ if button = left_button then begin
+ button_press_x <- GdkEvent.Button.x gdk_button;
+ button_press_y <- GdkEvent.Button.y gdk_button;
+ selection_changed <- false
+ end else if button = right_button then
+ self#popup_contextual_menu (GdkEvent.Button.time gdk_button);
+ false
+
+ (** @return a pattern structure which contains pretty printed terms *)
+ method private tactic_text_pattern_of_selection =
+ match self#get_selections with
+ | [] -> assert false (* this method is invoked only if there's a sel. *)
+ | node :: _ ->
+ let id = id_of_node node in
+ let cic_info, unsh_sequent = self#get_cic_info id in
+ match self#get_term_by_id cic_info id with
+ | SelTerm (t, father_hyp) ->
+ let sequent = self#sequent_of_id ~paste_kind:`Pattern id in
+ let text = self#string_of_cic_sequent sequent in
+ (match father_hyp with
+ | None -> None, [], Some text
+ | Some hyp_name -> None, [ hyp_name, text ], None)
+ | SelHyp (hyp_name, _ctxt) -> None, [ hyp_name, "%" ], None
+
+ method private popup_contextual_menu time =
+ let menu = GMenu.menu () in
+ let add_menu_item ?(menu = menu) ?stock ?label () =
+ GMenu.image_menu_item ?stock ?label ~packing:menu#append () in
+ let check = add_menu_item ~label:"Check" () in
+ let reductions_menu_item = GMenu.menu_item ~label:"βδιζ-reduce" () in
+ menu#append reductions_menu_item;
+ let reductions = GMenu.menu () in
+ reductions_menu_item#set_submenu reductions;
+ let normalize = add_menu_item ~menu:reductions ~label:"Normalize" () in
+ let reduce = add_menu_item ~menu:reductions ~label:"Reduce" () in
+ let simplify = add_menu_item ~menu:reductions ~label:"Simplify" () in
+ let whd = add_menu_item ~menu:reductions ~label:"Weak head" () in
+ menu#append (GMenu.separator_item ());
+ let copy = add_menu_item ~stock:`COPY () in
+ let gui = get_gui () in
+ List.iter (fun item -> item#misc#set_sensitive gui#canCopy)
+ [ copy; check; normalize; reduce; simplify; whd ];
+ let reduction_action kind () =
+ let pat = self#tactic_text_pattern_of_selection in
+ let statement =
+ let loc = HExtlib.dummy_floc in
+ "\n" ^
+ GrafiteAstPp.pp_executable ~term_pp:(fun s -> s)
+ ~lazy_term_pp:(fun _ -> assert false) ~obj_pp:(fun _ -> assert false)
+ (GrafiteAst.Tactical (loc,
+ GrafiteAst.Tactic (loc, GrafiteAst.Reduce (loc, kind, pat)),
+ Some (GrafiteAst.Semicolon loc))) in
+ (MatitaScript.current ())#advance ~statement () in
+ connect_menu_item copy gui#copy;
+ connect_menu_item normalize (reduction_action `Normalize);
+ connect_menu_item reduce (reduction_action `Reduce);
+ connect_menu_item simplify (reduction_action `Simpl);
+ connect_menu_item whd (reduction_action `Whd);
+ menu#popup ~button:right_button ~time
+
+ method private button_release_cb gdk_button =
+ if GdkEvent.Button.button gdk_button = left_button then begin
+ let button_release_x = GdkEvent.Button.x gdk_button in
+ let button_release_y = GdkEvent.Button.y gdk_button in
+ if selection_changed then
+ ()
+ else (* selection _not_ changed *)
+ if near (button_press_x, button_press_y)
+ (button_release_x, button_release_y)
+ then
+ let x = int_of_float button_press_x in
+ let y = int_of_float button_press_y in
+ (match self#get_element_at x y with
+ | None -> ()
+ | Some elt ->
+ let localName = href_ds in
+ if elt#hasAttributeNS ~namespaceURI:xlink_ns ~localName then
+ self#invoke_href_callback
+ (elt#getAttributeNS ~namespaceURI:xlink_ns
+ ~localName)#to_string
+ gdk_button
+ else
+ ignore (self#action_toggle elt));
+ end;
+ false
+
+ method private invoke_href_callback href_value gdk_button =
+ let button = GdkEvent.Button.button gdk_button in
+ if button = left_button then
+ let time = GdkEvent.Button.time gdk_button in
+ match href_callback with
+ | None -> ()
+ | Some f ->
+ (match HExtlib.split href_value with
+ | [ uri ] -> f uri
+ | uris ->
+ let menu = GMenu.menu () in
+ List.iter
+ (fun uri ->
+ let menu_item =
+ GMenu.menu_item ~label:uri ~packing:menu#append () in
+ connect_menu_item menu_item (fun () -> f uri))
+ uris;
+ menu#popup ~button ~time)
+
+ method private choose_selection_cb gdome_elt =
+ let set_selection elt =
+ let misc = self#coerce#misc in
+ self#set_selection (Some elt);
+ misc#add_selection_target ~target:"STRING" Gdk.Atom.primary;
+ ignore (misc#grab_selection Gdk.Atom.primary);
+ in
+ let rec aux elt =
+ if (elt#getAttributeNS ~namespaceURI:helm_ns
+ ~localName:xref_ds)#to_string <> ""
+ then
+ set_selection elt
+ else
+ try
+ (match elt#get_parentNode with
+ | None -> assert false
+ | Some p -> aux (new Gdome.element_of_node p))
+ with GdomeInit.DOMCastException _ -> ()
+ in
+ (match gdome_elt with
+ | Some elt when (elt#getAttributeNS ~namespaceURI:xlink_ns
+ ~localName:href_ds)#to_string <> "" ->
+ set_selection elt
+ | Some elt -> aux elt
+ | None -> self#set_selection None);
+ selection_changed <- true
+
+ method update_font_size = self#set_font_size !current_font_size
+
+ (** find a term by id from stored CIC infos @return either `Hyp if the id
+ * correspond to an hypothesis or `Term (cic, hyp) if the id correspond to a
+ * term. In the latter case hyp is either None (if the term is a subterm of
+ * the sequent conclusion) or Some hyp_name if the term belongs to an
+ * hypothesis *)
+ method private get_term_by_id cic_info id =
+ let unsh_item, ids_to_terms, ids_to_hypotheses, ids_to_father_ids, _, _ =
+ cic_info in
+ let rec find_father_hyp id =
+ if Hashtbl.mem ids_to_hypotheses id
+ then Some (name_of_hypothesis (Hashtbl.find ids_to_hypotheses id))
+ else
+ let father_id =
+ try Hashtbl.find ids_to_father_ids id
+ with Not_found -> assert false in
+ match father_id with
+ | Some id -> find_father_hyp id
+ | None -> None
+ in
+ try
+ let term = Hashtbl.find ids_to_terms id in
+ let father_hyp = find_father_hyp id in
+ SelTerm (term, father_hyp)
+ with Not_found ->
+ try
+ let hyp = Hashtbl.find ids_to_hypotheses id in
+ let _, context, _ =
+ match unsh_item with Some seq -> seq | None -> assert false in
+ let context' = MatitaMisc.list_tl_at hyp context in
+ SelHyp (name_of_hypothesis hyp, context')
+ with Not_found -> assert false
+
+ method private find_obj_conclusion id =
+ match self#cic_info with
+ | None
+ | Some (_, _, _, _, _, None) -> assert false
+ | Some (_, ids_to_terms, _, ids_to_father_ids, ids_to_inner_types, Some annobj) ->
+ let id =
+ find_root_id annobj id ids_to_father_ids ids_to_terms ids_to_inner_types
+ in
+ (try Hashtbl.find ids_to_terms id with Not_found -> assert false)
+
+ method private string_of_node ~(paste_kind:paste_kind) node =
+ if node#hasAttributeNS ~namespaceURI:helm_ns ~localName:xref_ds
+ then
+ let id = id_of_node node in
+ self#string_of_cic_sequent (self#sequent_of_id ~paste_kind id)
+ else string_of_dom_node node
+
+ method private string_of_cic_sequent cic_sequent =
+ let script = MatitaScript.current () in
+ let metasenv =
+ if script#onGoingProof () then script#proofMetasenv else [] in
+ let _, (acic_sequent, _, _, ids_to_inner_sorts, _) =
+ Cic2acic.asequent_of_sequent metasenv cic_sequent in
+ let _, _, _, annterm = acic_sequent in
+ let ast, ids_to_uris =
+ TermAcicContent.ast_of_acic ids_to_inner_sorts annterm in
+ let pped_ast = TermContentPres.pp_ast ast in
+ let markup = CicNotationPres.render ids_to_uris pped_ast in
+ BoxPp.render_to_string text_width markup
+
+ method private pattern_of term context unsh_sequent =
+ let context_len = List.length context in
+ let _, unsh_context, conclusion = unsh_sequent in
+ try
+ (match
+ List.nth unsh_context (List.length unsh_context - context_len - 1)
+ with
+ | None -> assert false (* can't select a restricted hypothesis *)
+ | Some (name, Cic.Decl ty) ->
+ ProofEngineHelpers.pattern_of ~term:ty [term]
+ | Some (name, Cic.Def (bo, _)) ->
+ ProofEngineHelpers.pattern_of ~term:bo [term])
+ with Failure _ | Invalid_argument _ ->
+ ProofEngineHelpers.pattern_of ~term:conclusion [term]
+
+ method private get_cic_info id =
+ match self#cic_info with
+ | Some ((Some unsh_sequent, _, _, _, _, _) as info) -> info, unsh_sequent
+ | Some ((None, _, _, _, _, _) as info) ->
+ let t = self#find_obj_conclusion id in
+ info, (~-1, [], t) (* dummy sequent for obj *)
+ | None -> assert false
+
+ method private sequent_of_id ~(paste_kind:paste_kind) id =
+ let cic_info, unsh_sequent = self#get_cic_info id in
+ let cic_sequent =
+ match self#get_term_by_id cic_info id with
+ | SelTerm (t, _father_hyp) ->
+ let occurrences =
+ ProofEngineHelpers.locate_in_conjecture t unsh_sequent in
+ (match occurrences with
+ | [ context, _t ] ->
+ (match paste_kind with
+ | `Term -> ~-1, context, t
+ | `Pattern -> ~-1, [], self#pattern_of t context unsh_sequent)
+ | _ ->
+ HLog.error (sprintf "found %d occurrences while 1 was expected"
+ (List.length occurrences));
+ assert false) (* since it uses physical equality *)
+ | SelHyp (_name, context) -> ~-1, context, Cic.Rel 1 in
+ cic_sequent
+
+ method private string_of_selection ~(paste_kind:paste_kind) =
+ match self#get_selections with
+ | [] -> None
+ | node :: _ -> Some (self#string_of_node ~paste_kind node)
+
+ method has_selection = self#get_selections <> []
+
+ (** @return an associative list format -> string with all possible selection
+ * formats. Rationale: in order to convert the selection to TERM or PATTERN
+ * format we need the sequent, the metasenv, ... keeping all of them in a
+ * closure would be more expensive than keeping their already converted
+ * forms *)
+ method strings_of_selection =
+ try
+ let misc = self#coerce#misc in
+ List.iter
+ (fun target -> misc#add_selection_target ~target Gdk.Atom.clipboard)
+ [ "TERM"; "PATTERN"; "STRING" ];
+ ignore (misc#grab_selection Gdk.Atom.clipboard);
+ List.map
+ (fun paste_kind ->
+ paste_kind, HExtlib.unopt (self#string_of_selection ~paste_kind))
+ [ `Term; `Pattern ]
+ with Failure _ -> failwith "no selection"
+
+end
+
+let clickableMathView ?hadjustment ?vadjustment ?font_size ?log_verbosity =
+ GtkBase.Widget.size_params
+ ~cont:(OgtkMathViewProps.pack_return (fun p ->
+ OgtkMathViewProps.set_params
+ (new clickableMathView (GtkMathViewProps.MathView_GMetaDOM.create p))
+ ~font_size:None ~log_verbosity:None))
+ []
+
+class cicMathView obj =
+object (self)
+ inherit clickableMathView obj
+
+ val mutable current_mathml = None
+
+ method load_sequent metasenv metano =
+ let sequent = CicUtil.lookup_meta metano metasenv in
+ let (mathml, unsh_sequent,
+ (_, (ids_to_terms, ids_to_father_ids, ids_to_hypotheses,_ )))
+ =
+ ApplyTransformation.mml_of_cic_sequent metasenv sequent
+ in
+ self#set_cic_info
+ (Some (Some unsh_sequent,
+ ids_to_terms, ids_to_hypotheses, ids_to_father_ids,
+ Hashtbl.create 1, None));
+ let name = "sequent_viewer.xml" in
+ HLog.debug ("load_sequent: dumping MathML to ./" ^ name);
+ ignore (domImpl#saveDocumentToFile ~name ~doc:mathml ());
+ self#load_root ~root:mathml#get_documentElement
+
+ method load_object obj =
+ let use_diff = false in (* ZACK TODO use XmlDiff when re-rendering? *)
+ let (mathml,
+ (annobj, (ids_to_terms, ids_to_father_ids, _, ids_to_hypotheses, _, ids_to_inner_types)))
+ =
+ ApplyTransformation.mml_of_cic_object obj
+ in
+ self#set_cic_info
+ (Some (None, ids_to_terms, ids_to_hypotheses, ids_to_father_ids, ids_to_inner_types, Some annobj));
+ (match current_mathml with
+ | Some current_mathml when use_diff ->
+ self#freeze;
+ XmlDiff.update_dom ~from:current_mathml mathml;
+ self#thaw
+ | _ ->
+ let name = "cic_browser.xml" in
+ HLog.debug ("cic_browser: dumping MathML to ./" ^ name);
+ ignore (domImpl#saveDocumentToFile ~name ~doc:mathml ());
+ self#load_root ~root:mathml#get_documentElement;
+ current_mathml <- Some mathml);
+end
+
+let tab_label meta_markup =
+ let rec aux =
+ function
+ | `Current m -> sprintf "<b>%s</b>" (aux m)
+ | `Closed m -> sprintf "<s>%s</s>" (aux m)
+ | `Shift (pos, m) -> sprintf "|<sub>%d</sub>: %s" pos (aux m)
+ | `Meta n -> sprintf "?%d" n
+ in
+ let markup = aux meta_markup in
+ (GMisc.label ~markup ~show:true ())#coerce
+
+let goal_of_switch = function Stack.Open g | Stack.Closed g -> g
+
+class sequentsViewer ~(notebook:GPack.notebook) ~(cicMathView:cicMathView) () =
+ object (self)
+ inherit scriptAccessor
+
+ val mutable pages = 0
+ val mutable switch_page_callback = None
+ val mutable page2goal = [] (* associative list: page no -> goal no *)
+ val mutable goal2page = [] (* the other way round *)
+ val mutable goal2win = [] (* associative list: goal no -> scrolled win *)
+ val mutable _metasenv = []
+ val mutable scrolledWin: GBin.scrolled_window option = None
+ (* scrolled window to which the sequentViewer is currently attached *)
+ val logo = (GMisc.image
+ ~file:(MatitaMisc.image_path "matita_medium.png") ()
+ :> GObj.widget)
+
+ val logo_with_qed = (GMisc.image
+ ~file:(MatitaMisc.image_path "matita_small.png") ()
+ :> GObj.widget)
+
+ method load_logo =
+ notebook#set_show_tabs false;
+ notebook#append_page logo
+
+ method load_logo_with_qed =
+ notebook#set_show_tabs false;
+ notebook#append_page logo_with_qed
+
+ method reset =
+ cicMathView#remove_selections;
+ (match scrolledWin with
+ | Some w ->
+ (* removing page from the notebook will destroy all contained widget,
+ * we do not want the cicMathView to be destroyed as well *)
+ w#remove cicMathView#coerce;
+ scrolledWin <- None
+ | None -> ());
+ (match switch_page_callback with
+ | Some id ->
+ GtkSignal.disconnect notebook#as_widget id;
+ switch_page_callback <- None
+ | None -> ());
+ for i = 0 to pages do notebook#remove_page 0 done;
+ notebook#set_show_tabs true;
+ pages <- 0;
+ page2goal <- [];
+ goal2page <- [];
+ goal2win <- [];
+ _metasenv <- [];
+ self#script#setGoal None
+
+ method load_sequents { proof = (_,metasenv,_,_) as proof; stack = stack } =
+ _metasenv <- metasenv;
+ pages <- 0;
+ let win goal_switch =
+ let w =
+ GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`ALWAYS
+ ~shadow_type:`IN ~show:true ()
+ in
+ let reparent () =
+ scrolledWin <- Some w;
+ match cicMathView#misc#parent with
+ | None -> w#add cicMathView#coerce
+ | Some parent ->
+ let parent =
+ match cicMathView#misc#parent with
+ None -> assert false
+ | Some p -> GContainer.cast_container p
+ in
+ parent#remove cicMathView#coerce;
+ w#add cicMathView#coerce
+ in
+ goal2win <- (goal_switch, reparent) :: goal2win;
+ w#coerce
+ in
+ assert (
+ let stack_goals = Stack.open_goals stack in
+ let proof_goals = ProofEngineTypes.goals_of_proof proof in
+ if
+ HExtlib.list_uniq (List.sort Pervasives.compare stack_goals)
+ <> List.sort Pervasives.compare proof_goals
+ then begin
+ prerr_endline ("STACK GOALS = " ^ String.concat " " (List.map string_of_int stack_goals));
+ prerr_endline ("PROOF GOALS = " ^ String.concat " " (List.map string_of_int proof_goals));
+ false
+ end
+ else true
+ );
+ let render_switch =
+ function Stack.Open i ->`Meta i | Stack.Closed i ->`Closed (`Meta i)
+ in
+ let page = ref 0 in
+ let added_goals = ref [] in
+ (* goals can be duplicated on the tack due to focus, but we should avoid
+ * multiple labels in the user interface *)
+ let add_tab markup goal_switch =
+ let goal = Stack.goal_of_switch goal_switch in
+ if not (List.mem goal !added_goals) then begin
+ notebook#append_page ~tab_label:(tab_label markup) (win goal_switch);
+ page2goal <- (!page, goal_switch) :: page2goal;
+ goal2page <- (goal_switch, !page) :: goal2page;
+ incr page;
+ pages <- pages + 1;
+ added_goals := goal :: !added_goals
+ end
+ in
+ let add_switch _ _ (_, sw) = add_tab (render_switch sw) sw in
+ Stack.iter (** populate notebook with tabs *)
+ ~env:(fun depth tag (pos, sw) ->
+ let markup =
+ match depth, pos with
+ | 0, _ -> `Current (render_switch sw)
+ | 1, pos when Stack.head_tag stack = `BranchTag ->
+ `Shift (pos, render_switch sw)
+ | _ -> render_switch sw
+ in
+ add_tab markup sw)
+ ~cont:add_switch ~todo:add_switch
+ stack;
+ switch_page_callback <-
+ Some (notebook#connect#switch_page ~callback:(fun page ->
+ let goal_switch =
+ try List.assoc page page2goal with Not_found -> assert false
+ in
+ self#script#setGoal (Some (goal_of_switch goal_switch));
+ self#render_page ~page ~goal_switch))
+
+ method private render_page ~page ~goal_switch =
+ (match goal_switch with
+ | Stack.Open goal -> cicMathView#load_sequent _metasenv goal
+ | Stack.Closed goal ->
+ let doc = Lazy.force closed_goal_mathml in
+ cicMathView#load_root ~root:doc#get_documentElement);
+ (try
+ cicMathView#set_selection None;
+ List.assoc goal_switch goal2win ()
+ with Not_found -> assert false)
+
+ method goto_sequent goal =
+ let goal_switch, page =
+ try
+ List.find
+ (function Stack.Open g, _ | Stack.Closed g, _ -> g = goal)
+ goal2page
+ with Not_found -> assert false
+ in
+ notebook#goto_page page;
+ self#render_page page goal_switch
+
+ end
+
+ (** constructors *)
+
+type 'widget constructor =
+ ?hadjustment:GData.adjustment ->
+ ?vadjustment:GData.adjustment ->
+ ?font_size:int ->
+ ?log_verbosity:int ->
+ ?width:int ->
+ ?height:int ->
+ ?packing:(GObj.widget -> unit) ->
+ ?show:bool ->
+ unit ->
+ 'widget
+
+let cicMathView ?hadjustment ?vadjustment ?font_size ?log_verbosity =
+ GtkBase.Widget.size_params
+ ~cont:(OgtkMathViewProps.pack_return (fun p ->
+ OgtkMathViewProps.set_params
+ (new cicMathView (GtkMathViewProps.MathView_GMetaDOM.create p))
+ ~font_size ~log_verbosity))
+ []
+
+let blank_uri = BuildTimeConf.blank_uri
+let current_proof_uri = BuildTimeConf.current_proof_uri
+
+type term_source =
+ [ `Ast of CicNotationPt.term
+ | `Cic of Cic.term * Cic.metasenv
+ | `String of string
+ ]
+
+class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
+ ()
+=
+ let whelp_RE = Pcre.regexp "^\\s*whelp" in
+ let uri_RE =
+ Pcre.regexp
+ "^cic:/([^/]+/)*[^/]+\\.(con|ind|var)(#xpointer\\(\\d+(/\\d+)+\\))?$"
+ in
+ let dir_RE = Pcre.regexp "^cic:((/([^/]+/)*[^/]+(/)?)|/|)$" in
+ let whelp_query_RE = Pcre.regexp "^\\s*whelp\\s+([^\\s]+)\\s+(.*)$" in
+ let is_whelp txt = Pcre.pmatch ~rex:whelp_RE txt in
+ let is_uri txt = Pcre.pmatch ~rex:uri_RE txt in
+ let is_dir txt = Pcre.pmatch ~rex:dir_RE txt in
+ let gui = get_gui () in
+ let (win: MatitaGuiTypes.browserWin) = gui#newBrowserWin () in
+ let queries = ["Locate";"Hint";"Match";"Elim";"Instance"] in
+ let combo,_ = GEdit.combo_box_text ~strings:queries () in
+ let activate_combo_query input q =
+ let q' = String.lowercase q in
+ let rec aux i = function
+ | [] -> failwith ("Whelp query '" ^ q ^ "' not found")
+ | h::_ when String.lowercase h = q' -> i
+ | _::tl -> aux (i+1) tl
+ in
+ combo#set_active (aux 0 queries);
+ win#queryInputText#set_text input
+ in
+ let set_whelp_query txt =
+ let query, arg =
+ try
+ let q = Pcre.extract ~rex:whelp_query_RE txt in
+ q.(1), q.(2)
+ with Invalid_argument _ -> failwith "Malformed Whelp query"
+ in
+ activate_combo_query arg query
+ in
+ let toplevel = win#toplevel in
+ let mathView = cicMathView ~packing:win#scrolledBrowser#add () in
+ let fail message =
+ MatitaGtkMisc.report_error ~title:"Cic browser" ~message
+ ~parent:toplevel ()
+ in
+ let tags =
+ [ "dir", GdkPixbuf.from_file (MatitaMisc.image_path "matita-folder.png");
+ "obj", GdkPixbuf.from_file (MatitaMisc.image_path "matita-object.png") ]
+ in
+ let handle_error f =
+ try
+ f ()
+ with exn ->
+ if not (Helm_registry.get_bool "matita.debug") then
+ fail (snd (MatitaExcPp.to_string exn))
+ else raise exn
+ in
+ let handle_error' f = (fun () -> handle_error (fun () -> f ())) in
+ let load_easter_egg = lazy (
+ win#easterEggImage#set_file (MatitaMisc.image_path "meegg.png"))
+ in
+ object (self)
+ inherit scriptAccessor
+
+ (* Whelp bar queries *)
+
+ initializer
+ activate_combo_query "" "locate";
+ win#whelpBarComboVbox#add combo#coerce;
+ let start_query () =
+ let query = String.lowercase (List.nth queries combo#active) in
+ let input = win#queryInputText#text in
+ let statement = "whelp " ^ query ^ " " ^ input ^ "." in
+ (MatitaScript.current ())#advance ~statement ()
+ in
+ ignore(win#queryInputText#connect#activate ~callback:start_query);
+ ignore(combo#connect#changed ~callback:start_query);
+ win#whelpBarImage#set_file (MatitaMisc.image_path "whelp.png");
+ win#mathOrListNotebook#set_show_tabs false;
+ win#browserForwardButton#misc#set_sensitive false;
+ win#browserBackButton#misc#set_sensitive false;
+ ignore (win#browserUri#entry#connect#activate (handle_error' (fun () ->
+ self#loadInput win#browserUri#entry#text)));
+ ignore (win#browserHomeButton#connect#clicked (handle_error' (fun () ->
+ self#load (`About `Current_proof))));
+ ignore (win#browserRefreshButton#connect#clicked
+ (handle_error' (self#refresh ~force:true)));
+ ignore (win#browserBackButton#connect#clicked (handle_error' self#back));
+ ignore (win#browserForwardButton#connect#clicked
+ (handle_error' self#forward));
+ ignore (win#toplevel#event#connect#delete (fun _ ->
+ let my_id = Oo.id self in
+ cicBrowsers := List.filter (fun b -> Oo.id b <> my_id) !cicBrowsers;
+ if !cicBrowsers = [] &&
+ Helm_registry.get "matita.mode" = "cicbrowser"
+ then
+ GMain.quit ();
+ false));
+ ignore(win#whelpResultTreeview#connect#row_activated
+ ~callback:(fun _ _ ->
+ handle_error (fun () -> self#loadInput (self#_getSelectedUri ()))));
+ mathView#set_href_callback (Some (fun uri ->
+ handle_error (fun () ->
+ self#load (`Uri (UriManager.uri_of_string uri)))));
+ self#_load (`About `Blank);
+ toplevel#show ()
+
+ val mutable current_entry = `About `Blank
+
+ val model =
+ new MatitaGtkMisc.taggedStringListModel tags win#whelpResultTreeview
+
+ val mutable lastDir = "" (* last loaded "directory" *)
+
+ method mathView = (mathView :> MatitaGuiTypes.clickableMathView)
+
+ method private _getSelectedUri () =
+ match model#easy_selection () with
+ | [sel] when is_uri sel -> sel (* absolute URI selected *)
+(* | [sel] -> win#browserUri#entry#text ^ sel |+ relative URI selected +| *)
+ | [sel] -> lastDir ^ sel
+ | _ -> assert false
+
+ (** history RATIONALE
+ *
+ * All operations about history are done using _historyFoo.
+ * Only toplevel functions (ATM load and loadInput) call _historyAdd.
+ *)
+
+ method private _historyAdd item =
+ history#add item;
+ win#browserBackButton#misc#set_sensitive true;
+ win#browserForwardButton#misc#set_sensitive false
+
+ method private _historyPrev () =
+ let item = history#previous in
+ if history#is_begin then win#browserBackButton#misc#set_sensitive false;
+ win#browserForwardButton#misc#set_sensitive true;
+ item
+
+ method private _historyNext () =
+ let item = history#next in
+ if history#is_end then win#browserForwardButton#misc#set_sensitive false;
+ win#browserBackButton#misc#set_sensitive true;
+ item
+
+ (** notebook RATIONALE
+ *
+ * Use only these functions to switch between the tabs
+ *)
+ method private _showMath = win#mathOrListNotebook#goto_page 0
+ method private _showList = win#mathOrListNotebook#goto_page 1
+
+ method private back () =
+ try
+ self#_load (self#_historyPrev ())
+ with MatitaMisc.History_failure -> ()
+
+ method private forward () =
+ try
+ self#_load (self#_historyNext ())
+ with MatitaMisc.History_failure -> ()
+
+ (* loads a uri which can be a cic uri or an about:* uri
+ * @param uri string *)
+ method private _load ?(force=false) entry =
+ handle_error (fun () ->
+ if entry <> current_entry || entry = `About `Current_proof || force then
+ begin
+ (match entry with
+ | `About `Current_proof -> self#home ()
+ | `About `Blank -> self#blank ()
+ | `About `Us -> self#egg ()
+ | `Check term -> self#_loadCheck term
+ | `Cic (term, metasenv) -> self#_loadTermCic term metasenv
+ | `Dir dir -> self#_loadDir dir
+ | `Uri uri -> self#_loadUriManagerUri uri
+ | `Whelp (query, results) ->
+ set_whelp_query query;
+ self#_loadList (List.map (fun r -> "obj",
+ UriManager.string_of_uri r) results));
+ self#setEntry entry
+ end)
+
+ method private blank () =
+ self#_showMath;
+ mathView#load_root (Lazy.force empty_mathml)#get_documentElement
+
+ method private _loadCheck term =
+ failwith "not implemented _loadCheck";
+(* self#_showMath *)
+
+ method private egg () =
+ win#mathOrListNotebook#goto_page 2;
+ Lazy.force load_easter_egg
+
+ method private home () =
+ self#_showMath;
+ match self#script#grafite_status.proof_status with
+ | Proof (uri, metasenv, bo, ty) ->
+ let name = UriManager.name_of_uri (HExtlib.unopt uri) in
+ let obj = Cic.CurrentProof (name, metasenv, bo, ty, [], []) in
+ self#_loadObj obj
+ | Incomplete_proof { proof = (uri, metasenv, bo, ty) } ->
+ let name = UriManager.name_of_uri (HExtlib.unopt uri) in
+ let obj = Cic.CurrentProof (name, metasenv, bo, ty, [], []) in
+ self#_loadObj obj
+ | _ -> self#blank ()
+
+ (** loads a cic uri from the environment
+ * @param uri UriManager.uri *)
+ method private _loadUriManagerUri uri =
+ let uri = UriManager.strip_xpointer uri in
+ let (obj, _) = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ self#_loadObj obj
+
+ method private _loadDir dir =
+ let content = Http_getter.ls dir in
+ let l =
+ List.fast_sort
+ Pervasives.compare
+ (List.map
+ (function
+ | Http_getter_types.Ls_section s -> "dir", s
+ | Http_getter_types.Ls_object o -> "obj", o.Http_getter_types.uri)
+ content)
+ in
+ lastDir <- dir;
+ self#_loadList l
+
+ method private setEntry entry =
+ win#browserUri#entry#set_text (MatitaTypes.string_of_entry entry);
+ current_entry <- entry
+
+ method private _loadObj obj =
+ (* showMath must be done _before_ loading the document, since if the
+ * widget is not mapped (hidden by the notebook) the document is not
+ * rendered *)
+ self#_showMath;
+ mathView#load_object obj
+
+ method private _loadTermCic term metasenv =
+ let context = self#script#proofContext in
+ let dummyno = CicMkImplicit.new_meta metasenv [] in
+ let sequent = (dummyno, context, term) in
+ mathView#load_sequent (sequent :: metasenv) dummyno;
+ self#_showMath
+
+ method private _loadList l =
+ model#list_store#clear ();
+ List.iter (fun (tag, s) -> model#easy_append ~tag s) l;
+ self#_showList
+
+ (** { public methods, all must call _load!! } *)
+
+ method load entry =
+ handle_error (fun () -> self#_load entry; self#_historyAdd entry)
+
+ (** this is what the browser does when you enter a string an hit enter *)
+ method loadInput txt =
+ let txt = HExtlib.trim_blanks txt in
+ let fix_uri txt =
+ UriManager.string_of_uri
+ (UriManager.strip_xpointer (UriManager.uri_of_string txt))
+ in
+ if is_whelp txt then begin
+ set_whelp_query txt;
+ (MatitaScript.current ())#advance ~statement:(txt ^ ".") ()
+ end else begin
+ let entry =
+ match txt with
+ | txt when is_uri txt -> `Uri (UriManager.uri_of_string (fix_uri txt))
+ | txt when is_dir txt -> `Dir (MatitaMisc.normalize_dir txt)
+ | txt ->
+ (try
+ MatitaTypes.entry_of_string txt
+ with Invalid_argument _ ->
+ raise
+ (GrafiteTypes.Command_error(sprintf "unsupported uri: %s" txt)))
+ in
+ self#_load entry;
+ self#_historyAdd entry
+ end
+
+ (** {2 methods accessing underlying GtkMathView} *)
+
+ method updateFontSize = mathView#set_font_size !current_font_size
+
+ (** {2 methods used by constructor only} *)
+
+ method win = win
+ method history = history
+ method currentEntry = current_entry
+ method refresh ~force () = self#_load ~force current_entry
+
+ end
+
+let sequentsViewer ~(notebook:GPack.notebook) ~(cicMathView:cicMathView) ():
+ MatitaGuiTypes.sequentsViewer
+=
+ new sequentsViewer ~notebook ~cicMathView ()
+
+let cicBrowser () =
+ let size = BuildTimeConf.browser_history_size in
+ let rec aux history =
+ let browser = new cicBrowser_impl ~history () in
+ let win = browser#win in
+ ignore (win#browserNewButton#connect#clicked (fun () ->
+ let history =
+ new MatitaMisc.browser_history ~memento:history#save size
+ (`About `Blank)
+ in
+ let newBrowser = aux history in
+ newBrowser#load browser#currentEntry));
+(*
+ (* attempt (failed) to close windows on CTRL-W ... *)
+ MatitaGtkMisc.connect_key win#browserWinEventBox#event ~modifiers:[`CONTROL]
+ GdkKeysyms._W (fun () -> win#toplevel#destroy ());
+*)
+ cicBrowsers := browser :: !cicBrowsers;
+ (browser :> MatitaGuiTypes.cicBrowser)
+ in
+ let history = new MatitaMisc.browser_history size (`About `Blank) in
+ aux history
+
+let default_cicMathView () = cicMathView ~show:true ()
+let cicMathView_instance = MatitaMisc.singleton default_cicMathView
+
+let default_sequentsViewer () =
+ let gui = get_gui () in
+ let cicMathView = cicMathView_instance () in
+ sequentsViewer ~notebook:gui#main#sequentsNotebook ~cicMathView ()
+let sequentsViewer_instance = MatitaMisc.singleton default_sequentsViewer
+
+let mathViewer () =
+ object(self)
+ method private get_browser reuse =
+ if reuse then
+ (match !cicBrowsers with
+ | [] -> cicBrowser ()
+ | b :: _ -> (b :> MatitaGuiTypes.cicBrowser))
+ else
+ (cicBrowser ())
+
+ method show_entry ?(reuse=false) t = (self#get_browser reuse)#load t
+
+ method show_uri_list ?(reuse=false) ~entry l =
+ (self#get_browser reuse)#load entry
+ end
+
+let refresh_all_browsers () =
+ List.iter (fun b -> b#refresh ~force:false ()) !cicBrowsers
+
+let update_font_sizes () =
+ List.iter (fun b -> b#updateFontSize) !cicBrowsers;
+ (cicMathView_instance ())#update_font_size
+
+let get_math_views () =
+ ((cicMathView_instance ()) :> MatitaGuiTypes.clickableMathView)
+ :: (List.map (fun b -> b#mathView) !cicBrowsers)
+
+let find_selection_owner () =
+ let rec aux =
+ function
+ | [] -> raise Not_found
+ | mv :: tl ->
+ (match mv#get_selections with
+ | [] -> aux tl
+ | sel :: _ -> mv)
+ in
+ aux (get_math_views ())
+
+let has_selection () =
+ try ignore (find_selection_owner ()); true
+ with Not_found -> false
+
+let math_view_clipboard = ref None (* associative list target -> string *)
+let has_clipboard () = !math_view_clipboard <> None
+let empty_clipboard () = math_view_clipboard := None
+
+let copy_selection () =
+ try
+ math_view_clipboard :=
+ Some ((find_selection_owner ())#strings_of_selection)
+ with Not_found -> failwith "no selection"
+
+let paste_clipboard paste_kind =
+ match !math_view_clipboard with
+ | None -> failwith "empty clipboard"
+ | Some cb ->
+ (try List.assoc paste_kind cb with Not_found -> assert false)
+
diff --git a/helm/matita/matitaMathView.mli b/helm/matita/matitaMathView.mli
new file mode 100644
index 000000000..ea0c077d8
--- /dev/null
+++ b/helm/matita/matitaMathView.mli
@@ -0,0 +1,87 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** {2 Constructors} *)
+
+ (** meta constructor *)
+type 'widget constructor =
+ ?hadjustment:GData.adjustment ->
+ ?vadjustment:GData.adjustment ->
+ ?font_size:int ->
+ ?log_verbosity:int ->
+ ?width:int ->
+ ?height:int ->
+ ?packing:(GObj.widget -> unit) ->
+ ?show:bool ->
+ unit ->
+ 'widget
+
+val clickableMathView: MatitaGuiTypes.clickableMathView constructor
+
+val cicMathView: MatitaGuiTypes.cicMathView constructor
+
+val sequentsViewer:
+ notebook:GPack.notebook ->
+ cicMathView:MatitaGuiTypes.cicMathView ->
+ unit ->
+ MatitaGuiTypes.sequentsViewer
+
+val cicBrowser: unit -> MatitaGuiTypes.cicBrowser
+
+(** {2 MathView wide functions} *)
+(* TODO ZACK consider exporting here a single function which return a list of
+ * MatitaGuiTypes.clickableMathView and act on them externally ... *)
+
+val increase_font_size: unit -> unit
+val decrease_font_size: unit -> unit
+val reset_font_size: unit -> unit
+
+val refresh_all_browsers: unit -> unit (** act on all cicBrowsers *)
+val update_font_sizes: unit -> unit
+
+ (** {3 Clipboard & Selection handling} *)
+
+val has_selection: unit -> bool
+
+ (** fills the clipboard with the current selection
+ * @raise Failure "no selection" *)
+val copy_selection: unit -> unit
+val has_clipboard: unit -> bool (** clipboard is not empty *)
+val empty_clipboard: unit -> unit (** empty the clipboard *)
+
+ (** @raise Failure "empty clipboard" *)
+val paste_clipboard: MatitaGuiTypes.paste_kind -> string
+
+(** {2 Singleton instances} *)
+
+val cicMathView_instance: unit -> MatitaGuiTypes.cicMathView
+val sequentsViewer_instance: unit -> MatitaGuiTypes.sequentsViewer
+
+val mathViewer: unit -> MatitaTypes.mathViewer
+
+(** {2 Initialization} *)
+
+val set_gui: MatitaGuiTypes.gui -> unit
+
diff --git a/helm/matita/matitaMisc.ml b/helm/matita/matitaMisc.ml
new file mode 100644
index 000000000..0c4329e55
--- /dev/null
+++ b/helm/matita/matitaMisc.ml
@@ -0,0 +1,152 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+(** Functions "imported" from Http_getter_misc *)
+
+let normalize_dir = Http_getter_misc.normalize_dir
+let strip_suffix = Http_getter_misc.strip_suffix
+
+let absolute_path file =
+ if file.[0] = '/' then file else Unix.getcwd () ^ "/" ^ file
+
+let is_proof_script fname = true (** TODO Zack *)
+let is_proof_object fname = true (** TODO Zack *)
+
+let append_phrase_sep s =
+ if not (Pcre.pmatch ~pat:(sprintf "%s$" BuildTimeConf.phrase_sep) s) then
+ s ^ BuildTimeConf.phrase_sep
+ else
+ s
+
+exception History_failure
+
+type 'a memento = 'a array * int * int * int (* data, hd, tl, cur *)
+
+class type ['a] history =
+ object
+ method add : 'a -> unit
+ method next : 'a
+ method previous : 'a
+ method load: 'a memento -> unit
+ method save: 'a memento
+ method is_begin: bool
+ method is_end: bool
+ end
+
+class basic_history (head, tail, cur) =
+ object
+ val mutable hd = head (* insertion point *)
+ val mutable tl = tail (* oldest inserted item *)
+ val mutable cur = cur (* current item for the history *)
+
+ method is_begin = cur <= tl
+ method is_end = cur >= hd
+ end
+
+
+class shell_history size =
+ let size = size + 1 in
+ let decr x = let x' = x - 1 in if x' < 0 then size + x' else x' in
+ let incr x = (x + 1) mod size in
+ object (self)
+ val data = Array.create size ""
+
+ inherit basic_history (0, -1 , -1)
+
+ method add s =
+ data.(hd) <- s;
+ if tl = -1 then tl <- hd;
+ hd <- incr hd;
+ if hd = tl then tl <- incr tl;
+ cur <- hd
+ method previous =
+ if cur = tl then raise History_failure;
+ cur <- decr cur;
+ data.(cur)
+ method next =
+ if cur = hd then raise History_failure;
+ cur <- incr cur;
+ if cur = hd then "" else data.(cur)
+ method load (data', hd', tl', cur') =
+ assert (Array.length data = Array.length data');
+ hd <- hd'; tl <- tl'; cur <- cur';
+ Array.blit data' 0 data 0 (Array.length data')
+ method save = (Array.copy data, hd, tl, cur)
+ end
+
+class ['a] browser_history ?memento size init =
+ object (self)
+ initializer match memento with Some m -> self#load m | _ -> ()
+ val data = Array.create size init
+
+ inherit basic_history (0, 0, 0)
+
+ method previous =
+ if cur = tl then raise History_failure;
+ cur <- cur - 1;
+ if cur = ~-1 then cur <- size - 1;
+ data.(cur)
+ method next =
+ if cur = hd then raise History_failure;
+ cur <- cur + 1;
+ if cur = size then cur <- 0;
+ data.(cur)
+ method add (e:'a) =
+ if e <> data.(cur) then
+ begin
+ cur <- cur + 1;
+ if cur = size then cur <- 0;
+ if cur = tl then tl <- tl + 1;
+ if tl = size then tl <- 0;
+ hd <- cur;
+ data.(cur) <- e
+ end
+ method load (data', hd', tl', cur') =
+ assert (Array.length data = Array.length data');
+ hd <- hd'; tl <- tl'; cur <- cur';
+ Array.blit data' 0 data 0 (Array.length data')
+ method save = (Array.copy data, hd, tl, cur)
+ end
+
+let singleton f =
+ let instance = lazy (f ()) in
+ fun () -> Lazy.force instance
+
+let image_path n = sprintf "%s/%s" BuildTimeConf.images_dir n
+
+let end_ma_RE = Pcre.regexp "\\.ma$"
+
+let list_tl_at ?(equality=(==)) e l =
+ let rec aux =
+ function
+ | [] -> raise Not_found
+ | hd :: tl as l when equality hd e -> l
+ | hd :: tl -> aux tl
+ in
+ aux l
diff --git a/helm/matita/matitaMisc.mli b/helm/matita/matitaMisc.mli
new file mode 100644
index 000000000..170a87c9b
--- /dev/null
+++ b/helm/matita/matitaMisc.mli
@@ -0,0 +1,75 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val absolute_path: string -> string
+
+ (** @return true if file is a (textual) proof script *)
+val is_proof_script: string -> bool
+
+ (** @return true if file is a (binary) proof object *)
+val is_proof_object: string -> bool
+
+ (** given a phrase, if it doesn't end with BuildTimeConf.phrase_sep, append
+ * it *)
+val append_phrase_sep: string -> string
+
+val normalize_dir: string -> string (** add trailing "/" if missing *)
+val strip_suffix: suffix:string -> string -> string
+
+ (** @return tl tail of a list starting at a given element
+ * @param eq equality to be used, defaults to physical equality (==)
+ * @raise Not_found *)
+val list_tl_at: ?equality:('a -> 'a -> bool) -> 'a -> 'a list -> 'a list
+
+exception History_failure
+
+type 'a memento
+
+class type ['a] history =
+ object ('b)
+ method add : 'a -> unit
+ method next : 'a (** @raise History_failure *)
+ method previous : 'a (** @raise History_failure *)
+ method load: 'a memento -> unit
+ method save: 'a memento
+ method is_begin: bool
+ method is_end: bool
+ end
+
+ (** shell like history: new items added at the end of the history
+ * @param size maximum history size *)
+class shell_history : int -> [string] history
+
+ (** browser like history: new items added at the current point of the history
+ * @param size maximum history size
+ * @param first element in history (this history is never empty) *)
+class ['a] browser_history: ?memento:'a memento -> int -> 'a -> ['a] history
+
+ (** create a singleton from a given function. Given function is invoked the
+ * first time it gets called. Next invocation will return first value *)
+val singleton: (unit -> 'a) -> (unit -> 'a)
+
+ (** given the base name of an image, returns its full path *)
+val image_path: string -> string
diff --git a/helm/matita/matitaScript.ml b/helm/matita/matitaScript.ml
new file mode 100644
index 000000000..4c53f113b
--- /dev/null
+++ b/helm/matita/matitaScript.ml
@@ -0,0 +1,818 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+open GrafiteTypes
+
+module TA = GrafiteAst
+
+let debug = false
+let debug_print = if debug then prerr_endline else ignore
+
+ (** raised when one of the script margins (top or bottom) is reached *)
+exception Margin
+exception NoUnfinishedProof
+
+let safe_substring s i j =
+ try String.sub s i j with Invalid_argument _ -> assert false
+
+let heading_nl_RE = Pcre.regexp "^\\s*\n\\s*"
+let heading_nl_RE' = Pcre.regexp "^(\\s*\n\\s*)((.|\n)*)"
+let only_dust_RE = Pcre.regexp "^(\\s|\n|%%[^\n]*\n)*$"
+let multiline_RE = Pcre.regexp "^\n[^\n]+$"
+let newline_RE = Pcre.regexp "\n"
+
+let comment str =
+ if Pcre.pmatch ~rex:multiline_RE str then
+ "\n(** " ^ (Pcre.replace ~rex:newline_RE str) ^ " *)"
+ else
+ "\n(**\n" ^ str ^ "\n*)"
+
+let first_line s =
+ let s = Pcre.replace ~rex:heading_nl_RE s in
+ try
+ let nl_pos = String.index s '\n' in
+ String.sub s 0 nl_pos
+ with Not_found -> s
+
+ (** creates a statement AST for the Goal tactic, e.g. "goal 7" *)
+let goal_ast n =
+ let module A = GrafiteAst in
+ let loc = HExtlib.dummy_floc in
+ A.Executable (loc, A.Tactical (loc,
+ A.Tactic (loc, A.Goal (loc, n)),
+ Some (A.Dot loc)))
+
+type guistuff = {
+ mathviewer:MatitaTypes.mathViewer;
+ urichooser: UriManager.uri list -> UriManager.uri list;
+ ask_confirmation: title:string -> message:string -> [`YES | `NO | `CANCEL];
+ develcreator: containing:string option -> unit;
+ mutable filenamedata: string option * MatitamakeLib.development option
+}
+
+let eval_with_engine guistuff lexicon_status grafite_status user_goal
+ parsed_text st
+=
+ let module TAPp = GrafiteAstPp in
+ let parsed_text_length = String.length parsed_text in
+ let initial_space,parsed_text =
+ try
+ let pieces = Pcre.extract ~rex:heading_nl_RE' parsed_text in
+ pieces.(1), pieces.(2)
+ with
+ Not_found -> "", parsed_text in
+ let inital_space,new_grafite_status,new_lexicon_status,new_status_and_text_list' =
+ (* the code commented out adds the "select" command if needed *)
+ initial_space,grafite_status,lexicon_status,[] in
+(* let loc, ex =
+ match st with TA.Executable (loc,ex) -> loc, ex | _ -> assert false in
+ match grafite_status.proof_status with
+ | Incomplete_proof { stack = stack }
+ when not (List.mem user_goal (Continuationals.head_goals stack)) ->
+ let grafite_status =
+ MatitaEngine.eval_ast
+ ~do_heavy_checks:true grafite_status (goal_ast user_goal)
+ in
+ let initial_space = if initial_space = "" then "\n" else initial_space
+ in
+ "\n", grafite_status,
+ [ grafite_status,
+ initial_space ^ TAPp.pp_tactical (TA.Select (loc, [user_goal])) ]
+ | _ -> initial_space,grafite_status,[] in *)
+ let enriched_history_fragment =
+ MatitaEngine.eval_ast ~do_heavy_checks:true
+ new_lexicon_status new_grafite_status st
+ in
+ let _,new_text_list_rev =
+ let module DTE = DisambiguateTypes.Environment in
+ let module UM = UriManager in
+ List.fold_right (
+ fun (_,alias) (initial_space,acc) ->
+ match alias with
+ None -> initial_space,initial_space::acc
+ | Some (k,((v,_) as value)) ->
+ let new_text =
+ let initial_space =
+ if initial_space = "" then "\n" else initial_space
+ in
+ initial_space ^
+ DisambiguatePp.pp_environment
+ (DisambiguateTypes.Environment.add k value
+ DisambiguateTypes.Environment.empty)
+ in
+ "\n",new_text::acc
+ ) enriched_history_fragment (initial_space,[]) in
+ let new_text_list_rev =
+ match enriched_history_fragment,new_text_list_rev with
+ (_,None)::_, initial_space::tl -> (initial_space ^ parsed_text)::tl
+ | _,_ -> assert false
+ in
+ let res =
+ try
+ List.combine (fst (List.split enriched_history_fragment)) new_text_list_rev
+ with
+ Invalid_argument _ -> assert false
+ in
+ res,parsed_text_length
+
+let eval_with_engine
+ guistuff lexicon_status grafite_status user_goal parsed_text st
+=
+ try
+ eval_with_engine guistuff lexicon_status grafite_status user_goal parsed_text
+ st
+ with
+ | DependenciesParser.UnableToInclude what
+ | GrafiteEngine.IncludedFileNotCompiled what as exc ->
+ let compile_needed_and_go_on d =
+ let target = what in
+ let refresh_cb () =
+ while Glib.Main.pending () do ignore(Glib.Main.iteration false); done
+ in
+ if not(MatitamakeLib.build_development_in_bg ~target refresh_cb d) then
+ raise exc
+ else
+ eval_with_engine guistuff lexicon_status grafite_status user_goal
+ parsed_text st
+ in
+ let do_nothing () = [], 0 in
+ let handle_with_devel d =
+ let name = MatitamakeLib.name_for_development d in
+ let title = "Unable to include " ^ what in
+ let message =
+ what ^ " is handled by development <b>" ^ name ^ "</b>.\n\n" ^
+ "<i>Should I compile it and Its dependencies?</i>"
+ in
+ (match guistuff.ask_confirmation ~title ~message with
+ | `YES -> compile_needed_and_go_on d
+ | `NO -> raise exc
+ | `CANCEL -> do_nothing ())
+ in
+ let handle_without_devel filename =
+ let title = "Unable to include " ^ what in
+ let message =
+ what ^ " is <b>not</b> handled by a development.\n" ^
+ "All dependencies are automatically solved for a development.\n\n" ^
+ "<i>Do you want to set up a development?</i>"
+ in
+ (match guistuff.ask_confirmation ~title ~message with
+ | `YES ->
+ (match filename with
+ | Some f ->
+ guistuff.develcreator ~containing:(Some (Filename.dirname f))
+ | None -> guistuff.develcreator ~containing:None);
+ do_nothing ()
+ | `NO -> raise exc
+ | `CANCEL -> do_nothing())
+ in
+ match guistuff.filenamedata with
+ | None,None -> handle_without_devel None
+ | None,Some d -> handle_with_devel d
+ | Some f,_ ->
+ match MatitamakeLib.development_for_dir (Filename.dirname f) with
+ | None -> handle_without_devel (Some f)
+ | Some d -> handle_with_devel d
+;;
+
+let pp_eager_statement_ast =
+ GrafiteAstPp.pp_statement ~term_pp:CicNotationPp.pp_term
+ ~lazy_term_pp:(fun _ -> assert false) ~obj_pp:(fun _ -> assert false)
+
+let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status grafite_status user_goal unparsed_text parsed_text script mac =
+ let module TAPp = GrafiteAstPp in
+ let module MQ = MetadataQuery in
+ let module MDB = LibraryDb in
+ let module CTC = CicTypeChecker in
+ let module CU = CicUniv in
+ (* no idea why ocaml wants this *)
+ let parsed_text_length = String.length parsed_text in
+ let dbd = LibraryDb.instance () in
+ (* XXX use a real CIC -> string pretty printer *)
+ let pp_macro = TAPp.pp_macro ~term_pp:CicPp.ppterm in
+ match mac with
+ (* WHELP's stuff *)
+ | TA.WMatch (loc, term) ->
+ let l = Whelp.match_term ~dbd term in
+ let query_url =
+ MatitaMisc.strip_suffix ~suffix:"."
+ (HExtlib.trim_blanks unparsed_text)
+ in
+ let entry = `Whelp (query_url, l) in
+ guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
+ [], parsed_text_length
+ | TA.WInstance (loc, term) ->
+ let l = Whelp.instance ~dbd term in
+ let entry = `Whelp (pp_macro (TA.WInstance (loc, term)), l) in
+ guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
+ [], parsed_text_length
+ | TA.WLocate (loc, s) ->
+ let l = Whelp.locate ~dbd s in
+ let entry = `Whelp (pp_macro (TA.WLocate (loc, s)), l) in
+ guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
+ [], parsed_text_length
+ | TA.WElim (loc, term) ->
+ let uri =
+ match term with
+ | Cic.MutInd (uri,n,_) -> UriManager.uri_of_uriref uri n None
+ | _ -> failwith "Not a MutInd"
+ in
+ let l = Whelp.elim ~dbd uri in
+ let entry = `Whelp (pp_macro (TA.WElim (loc, term)), l) in
+ guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
+ [], parsed_text_length
+ | TA.WHint (loc, term) ->
+ let s = ((None,[0,[],term], Cic.Meta (0,[]) ,term),0) in
+ let l = List.map fst (MQ.experimental_hint ~dbd s) in
+ let entry = `Whelp (pp_macro (TA.WHint (loc, term)), l) in
+ guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
+ [], parsed_text_length
+ (* REAL macro *)
+ | TA.Hint loc ->
+ let user_goal' =
+ match user_goal with
+ Some n -> n
+ | None -> raise NoUnfinishedProof
+ in
+ let proof = GrafiteTypes.get_current_proof grafite_status in
+ let proof_status = proof,user_goal' in
+ let l = List.map fst (MQ.experimental_hint ~dbd proof_status) in
+ let selected = guistuff.urichooser l in
+ (match selected with
+ | [] -> [], parsed_text_length
+ | [uri] ->
+ let suri = UriManager.string_of_uri uri in
+ let ast loc =
+ TA.Executable (loc, (TA.Tactical (loc,
+ TA.Tactic (loc,
+ TA.Apply (loc, CicNotationPt.Uri (suri, None))),
+ Some (TA.Dot loc)))) in
+ let text =
+ comment parsed_text ^ "\n" ^
+ pp_eager_statement_ast (ast HExtlib.dummy_floc) in
+ let text_len = String.length text in
+ let loc = HExtlib.floc_of_loc (0,text_len) in
+ let statement = `Ast (GrafiteParser.LSome (ast loc),text) in
+ let res,_parsed_text_len =
+ eval_statement include_paths buffer guistuff lexicon_status
+ grafite_status user_goal script statement
+ in
+ (* we need to replace all the parsed_text *)
+ res,String.length parsed_text
+ | _ ->
+ HLog.error
+ "The result of the urichooser should be only 1 uri, not:\n";
+ List.iter (
+ fun u -> HLog.error (UriManager.string_of_uri u ^ "\n")
+ ) selected;
+ assert false)
+ | TA.Check (_,term) ->
+ let metasenv = GrafiteTypes.get_proof_metasenv grafite_status in
+ let context =
+ match user_goal with
+ None -> []
+ | Some n -> GrafiteTypes.get_proof_context grafite_status n in
+ let ty,_ = CTC.type_of_aux' metasenv context term CicUniv.empty_ugraph in
+ let t_and_ty = Cic.Cast (term,ty) in
+ guistuff.mathviewer#show_entry (`Cic (t_and_ty,metasenv));
+ [], parsed_text_length
+ (* TODO *)
+ | TA.Quit _ -> failwith "not implemented"
+ | TA.Print (_,kind) -> failwith "not implemented"
+ | TA.Search_pat (_, search_kind, str) -> failwith "not implemented"
+ | TA.Search_term (_, search_kind, term) -> failwith "not implemented"
+
+and eval_executable include_paths (buffer : GText.buffer) guistuff lexicon_status grafite_status user_goal unparsed_text parsed_text script loc ex
+=
+ let module TAPp = GrafiteAstPp in
+ let module MD = GrafiteDisambiguator in
+ let module ML = MatitaMisc in
+ try
+ begin
+ match ex with
+ | TA.Command (_,TA.Set (_,"baseuri",u)) ->
+ if not (GrafiteMisc.is_empty u) then
+ (match
+ guistuff.ask_confirmation
+ ~title:"Baseuri redefinition"
+ ~message:(
+ "Baseuri " ^ u ^ " already exists.\n" ^
+ "Do you want to redefine the corresponding "^
+ "part of the library?")
+ with
+ | `YES ->
+ let basedir = Helm_registry.get "matita.basedir" in
+ LibraryClean.clean_baseuris ~basedir [u]
+ | `NO -> ()
+ | `CANCEL -> raise MatitaTypes.Cancel)
+ | _ -> ()
+ end;
+ eval_with_engine
+ guistuff lexicon_status grafite_status user_goal parsed_text
+ (TA.Executable (loc, ex))
+ with
+ MatitaTypes.Cancel -> [], 0
+ | GrafiteEngine.Macro (_loc,lazy_macro) ->
+ let context =
+ match user_goal with
+ None -> []
+ | Some n -> GrafiteTypes.get_proof_context grafite_status n in
+ let grafite_status,macro = lazy_macro context in
+ eval_macro include_paths buffer guistuff lexicon_status grafite_status
+ user_goal unparsed_text parsed_text script macro
+
+and eval_statement include_paths (buffer : GText.buffer) guistuff lexicon_status
+ grafite_status user_goal script statement
+=
+ let (lexicon_status,st), unparsed_text =
+ match statement with
+ | `Raw text ->
+ if Pcre.pmatch ~rex:only_dust_RE text then raise Margin;
+ GrafiteParser.parse_statement (Ulexing.from_utf8_string text)
+ ~include_paths lexicon_status, text
+ | `Ast (st, text) -> (lexicon_status, st), text
+ in
+ let text_of_loc loc =
+ let parsed_text_length = snd (HExtlib.loc_of_floc loc) in
+ let parsed_text = safe_substring unparsed_text 0 parsed_text_length in
+ parsed_text, parsed_text_length
+ in
+ match st with
+ | GrafiteParser.LNone loc ->
+ let parsed_text, parsed_text_length = text_of_loc loc in
+ [(grafite_status,lexicon_status),parsed_text],
+ parsed_text_length
+ | GrafiteParser.LSome (GrafiteAst.Comment (loc, _)) ->
+ let parsed_text, parsed_text_length = text_of_loc loc in
+ let remain_len = String.length unparsed_text - parsed_text_length in
+ let s = String.sub unparsed_text parsed_text_length remain_len in
+ let s,len =
+ try
+ eval_statement include_paths buffer guistuff lexicon_status
+ grafite_status user_goal script (`Raw s)
+ with
+ HExtlib.Localized (floc, exn) ->
+ HExtlib.raise_localized_exception ~offset:parsed_text_length floc exn
+ | GrafiteDisambiguator.DisambiguationError (offset,errorll) ->
+ raise
+ (GrafiteDisambiguator.DisambiguationError
+ (offset+parsed_text_length, errorll))
+ in
+ (match s with
+ | (statuses,text)::tl ->
+ (statuses,parsed_text ^ text)::tl,parsed_text_length + len
+ | [] -> [], 0)
+ | GrafiteParser.LSome (GrafiteAst.Executable (loc, ex)) ->
+ let parsed_text, parsed_text_length = text_of_loc loc in
+ eval_executable include_paths buffer guistuff lexicon_status
+ grafite_status user_goal unparsed_text parsed_text script loc ex
+
+let fresh_script_id =
+ let i = ref 0 in
+ fun () -> incr i; !i
+
+class script ~(source_view: GSourceView.source_view)
+ ~(mathviewer: MatitaTypes.mathViewer)
+ ~set_star
+ ~ask_confirmation
+ ~urichooser
+ ~develcreator
+ () =
+let buffer = source_view#buffer in
+let source_buffer = source_view#source_buffer in
+let initial_statuses =
+ (* these include_paths are used only to load the initial notation *)
+ let include_paths =
+ Helm_registry.get_list Helm_registry.string "matita.includes" in
+ let lexicon_status =
+ CicNotation2.load_notation ~include_paths
+ BuildTimeConf.core_notation_script in
+ let grafite_status = GrafiteSync.init () in
+ grafite_status,lexicon_status
+in
+object (self)
+ val mutable include_paths =
+ Helm_registry.get_list Helm_registry.string "matita.includes"
+
+ val scriptId = fresh_script_id ()
+
+ val guistuff = {
+ mathviewer = mathviewer;
+ urichooser = urichooser;
+ ask_confirmation = ask_confirmation;
+ develcreator = develcreator;
+ filenamedata = (None, None)}
+
+ method private getFilename =
+ match guistuff.filenamedata with Some f,_ -> f | _ -> assert false
+
+ method filename = self#getFilename
+
+ method private ppFilename =
+ match guistuff.filenamedata with
+ | Some f,_ -> f
+ | None,_ -> sprintf ".unnamed%d.ma" scriptId
+
+ initializer
+ ignore (GMain.Timeout.add ~ms:300000
+ ~callback:(fun _ -> self#_saveToBackupFile ();true));
+ ignore (buffer#connect#modified_changed
+ (fun _ -> set_star (Filename.basename self#ppFilename) buffer#modified))
+
+ val mutable statements = [] (** executed statements *)
+
+ val mutable history = [ initial_statuses ]
+ (** list of states before having executed statements. Head element of this
+ * list is the current state, last element is the state at the beginning of
+ * the script.
+ * Invariant: this list length is 1 + length of statements *)
+
+ (** goal as seen by the user (i.e. metano corresponding to current tab) *)
+ val mutable userGoal = None
+
+ (** text mark and tag representing locked part of a script *)
+ val locked_mark =
+ buffer#create_mark ~name:"locked" ~left_gravity:true buffer#start_iter
+ val locked_tag = buffer#create_tag [`BACKGROUND "lightblue"; `EDITABLE false]
+ val error_tag = buffer#create_tag [`UNDERLINE `SINGLE; `FOREGROUND "red"]
+
+ method locked_mark = locked_mark
+ method locked_tag = locked_tag
+ method error_tag = error_tag
+
+ (* history can't be empty, the invariant above grant that it contains at
+ * least the init grafite_status *)
+ method grafite_status = match history with (s,_)::_ -> s | _ -> assert false
+ method lexicon_status = match history with (_,ss)::_ -> ss | _ -> assert false
+
+ method private _advance ?statement () =
+ let s = match statement with Some s -> s | None -> self#getFuture in
+ HLog.debug ("evaluating: " ^ first_line s ^ " ...");
+ let (entries, parsed_len) =
+ try
+ eval_statement include_paths buffer guistuff self#lexicon_status
+ self#grafite_status userGoal self (`Raw s)
+ with End_of_file -> raise Margin
+ in
+ let new_statuses, new_statements =
+ let statuses, texts = List.split entries in
+ statuses, texts
+ in
+ history <- new_statuses @ history;
+ statements <- new_statements @ statements;
+ let start = buffer#get_iter_at_mark (`MARK locked_mark) in
+ let new_text = String.concat "" (List.rev new_statements) in
+ if statement <> None then
+ buffer#insert ~iter:start new_text
+ else begin
+ if new_text <> String.sub s 0 parsed_len then begin
+ buffer#delete ~start ~stop:(start#copy#forward_chars parsed_len);
+ buffer#insert ~iter:start new_text;
+ end;
+ end;
+ self#moveMark (String.length new_text);
+ (* here we need to set the Goal in case we are going to cursor (or to
+ bottom) and we will face a macro *)
+ match self#grafite_status.proof_status with
+ Incomplete_proof p ->
+ userGoal <- Some (Continuationals.Stack.find_goal p.stack)
+ | _ -> userGoal <- None
+
+ method private _retract offset lexicon_status grafite_status new_statements
+ new_history
+ =
+ let cur_grafite_status,cur_lexicon_status =
+ match history with s::_ -> s | [] -> assert false
+ in
+ LexiconSync.time_travel ~present:cur_lexicon_status ~past:lexicon_status;
+ GrafiteSync.time_travel ~present:cur_grafite_status ~past:grafite_status;
+ statements <- new_statements;
+ history <- new_history;
+ self#moveMark (- offset)
+
+ method advance ?statement () =
+ try
+ self#_advance ?statement ();
+ self#notify
+ with
+ | Margin -> self#notify
+ | exc -> self#notify; raise exc
+
+ method retract () =
+ try
+ let cmp,new_statements,new_history,(grafite_status,lexicon_status) =
+ match statements,history with
+ stat::statements, _::(status::_ as history) ->
+ String.length stat, statements, history, status
+ | [],[_] -> raise Margin
+ | _,_ -> assert false
+ in
+ self#_retract cmp lexicon_status grafite_status new_statements
+ new_history;
+ self#notify
+ with
+ | Margin -> self#notify
+ | exc -> self#notify; raise exc
+
+ method private getFuture =
+ buffer#get_text ~start:(buffer#get_iter_at_mark (`MARK locked_mark))
+ ~stop:buffer#end_iter ()
+
+
+ (** @param rel_offset relative offset from current position of locked_mark *)
+ method private moveMark rel_offset =
+ let mark = `MARK locked_mark in
+ let old_insert = buffer#get_iter_at_mark `INSERT in
+ buffer#remove_tag locked_tag ~start:buffer#start_iter ~stop:buffer#end_iter;
+ let current_mark_pos = buffer#get_iter_at_mark mark in
+ let new_mark_pos =
+ match rel_offset with
+ | 0 -> current_mark_pos
+ | n when n > 0 -> current_mark_pos#forward_chars n
+ | n (* when n < 0 *) -> current_mark_pos#backward_chars (abs n)
+ in
+ buffer#move_mark mark ~where:new_mark_pos;
+ buffer#apply_tag locked_tag ~start:buffer#start_iter ~stop:new_mark_pos;
+ buffer#move_mark `INSERT old_insert;
+ let mark_position = buffer#get_iter_at_mark mark in
+ if source_view#move_mark_onscreen mark then
+ begin
+ buffer#move_mark mark mark_position;
+ source_view#scroll_to_mark ~use_align:true ~xalign:1.0 ~yalign:0.1 mark;
+ end;
+ while Glib.Main.pending () do ignore(Glib.Main.iteration false); done
+
+ method clean_dirty_lock =
+ let lock_mark_iter = buffer#get_iter_at_mark (`MARK locked_mark) in
+ buffer#remove_tag locked_tag ~start:buffer#start_iter ~stop:buffer#end_iter;
+ buffer#apply_tag locked_tag ~start:buffer#start_iter ~stop:lock_mark_iter
+
+ val mutable observers = []
+
+ method addObserver (o: LexiconEngine.status -> GrafiteTypes.status -> unit) =
+ observers <- o :: observers
+
+ method private notify =
+ let lexicon_status = self#lexicon_status in
+ let grafite_status = self#grafite_status in
+ List.iter (fun o -> o lexicon_status grafite_status) observers
+
+ method loadFromFile f =
+ buffer#set_text (HExtlib.input_file f);
+ self#reset_buffer;
+ buffer#set_modified false
+
+ method assignFileName file =
+ let abspath = MatitaMisc.absolute_path file in
+ let dirname = Filename.dirname abspath in
+ let devel = MatitamakeLib.development_for_dir dirname in
+ guistuff.filenamedata <- Some abspath, devel;
+ let include_ =
+ match MatitamakeLib.development_for_dir dirname with
+ None -> []
+ | Some devel -> [MatitamakeLib.root_for_development devel] in
+ let include_ =
+ include_ @ (Helm_registry.get_list Helm_registry.string "matita.includes")
+ in
+ include_paths <- include_
+
+ method saveToFile () =
+ let oc = open_out self#getFilename in
+ output_string oc (buffer#get_text ~start:buffer#start_iter
+ ~stop:buffer#end_iter ());
+ close_out oc;
+ buffer#set_modified false
+
+ method private _saveToBackupFile () =
+ if buffer#modified then
+ begin
+ let f = self#ppFilename ^ "~" in
+ let oc = open_out f in
+ output_string oc (buffer#get_text ~start:buffer#start_iter
+ ~stop:buffer#end_iter ());
+ close_out oc;
+ HLog.debug ("backup " ^ f ^ " saved")
+ end
+
+ method private goto_top =
+ let grafite_status,lexicon_status =
+ let rec last x = function
+ | [] -> x
+ | hd::tl -> last hd tl
+ in
+ last (self#grafite_status,self#lexicon_status) history
+ in
+ (* FIXME: this is not correct since there is no undo for
+ * library_objects.set_default... *)
+ GrafiteSync.time_travel ~present:self#grafite_status ~past:grafite_status;
+ LexiconSync.time_travel ~present:self#lexicon_status ~past:lexicon_status
+
+ method private reset_buffer =
+ statements <- [];
+ history <- [ initial_statuses ];
+ userGoal <- None;
+ self#notify;
+ buffer#remove_tag locked_tag ~start:buffer#start_iter ~stop:buffer#end_iter;
+ buffer#move_mark (`MARK locked_mark) ~where:buffer#start_iter
+
+ method reset () =
+ self#reset_buffer;
+ source_buffer#begin_not_undoable_action ();
+ buffer#delete ~start:buffer#start_iter ~stop:buffer#end_iter;
+ source_buffer#end_not_undoable_action ();
+ buffer#set_modified false;
+
+ method template () =
+ let template = HExtlib.input_file BuildTimeConf.script_template in
+ buffer#insert ~iter:(buffer#get_iter `START) template;
+ let development = MatitamakeLib.development_for_dir (Unix.getcwd ()) in
+ guistuff.filenamedata <- (None,development);
+ let include_ =
+ match development with
+ None -> []
+ | Some devel -> [MatitamakeLib.root_for_development devel ]
+ in
+ let include_ =
+ include_ @ (Helm_registry.get_list Helm_registry.string "matita.includes")
+ in
+ include_paths <- include_ ;
+ buffer#set_modified false;
+ set_star (Filename.basename self#ppFilename) false
+
+ method goto (pos: [`Top | `Bottom | `Cursor]) () =
+ let old_locked_mark =
+ `MARK
+ (buffer#create_mark ~name:"old_locked_mark"
+ ~left_gravity:true (buffer#get_iter_at_mark (`MARK locked_mark))) in
+ let getpos _ = buffer#get_iter_at_mark (`MARK locked_mark) in
+ let getoldpos _ = buffer#get_iter_at_mark old_locked_mark in
+ let dispose_old_locked_mark () = buffer#delete_mark old_locked_mark in
+ match pos with
+ | `Top ->
+ dispose_old_locked_mark ();
+ self#goto_top;
+ self#reset_buffer;
+ self#notify
+ | `Bottom ->
+ (try
+ let rec dowhile () =
+ self#_advance ();
+ let newpos = getpos () in
+ if (getoldpos ())#compare newpos < 0 then
+ begin
+ buffer#move_mark old_locked_mark newpos;
+ dowhile ()
+ end
+ in
+ dowhile ();
+ dispose_old_locked_mark ();
+ self#notify
+ with
+ | Margin -> dispose_old_locked_mark (); self#notify
+ | exc -> dispose_old_locked_mark (); self#notify; raise exc)
+ | `Cursor ->
+ let locked_iter () = buffer#get_iter_at_mark (`NAME "locked") in
+ let cursor_iter () = buffer#get_iter_at_mark `INSERT in
+ let remember =
+ `MARK
+ (buffer#create_mark ~name:"initial_insert"
+ ~left_gravity:true (cursor_iter ())) in
+ let dispose_remember () = buffer#delete_mark remember in
+ let remember_iter () =
+ buffer#get_iter_at_mark (`NAME "initial_insert") in
+ let cmp () = (locked_iter ())#offset - (remember_iter ())#offset in
+ let icmp = cmp () in
+ let forward_until_cursor () = (* go forward until locked > cursor *)
+ let rec aux () =
+ self#_advance ();
+ if cmp () < 0 && (getoldpos ())#compare (getpos ()) < 0
+ then
+ begin
+ buffer#move_mark old_locked_mark (getpos ());
+ aux ()
+ end
+ in
+ aux ()
+ in
+ let rec back_until_cursor len = (* go backward until locked < cursor *)
+ function
+ statements, ((grafite_status,lexicon_status)::_ as history)
+ when len <= 0 ->
+ self#_retract (icmp - len) lexicon_status grafite_status statements
+ history
+ | statement::tl1, _::tl2 ->
+ back_until_cursor (len - String.length statement) (tl1,tl2)
+ | _,_ -> assert false
+ in
+ (try
+ begin
+ if icmp < 0 then (* locked < cursor *)
+ (forward_until_cursor (); self#notify)
+ else if icmp > 0 then (* locked > cursor *)
+ (back_until_cursor icmp (statements,history); self#notify)
+ else (* cursor = locked *)
+ ()
+ end ;
+ dispose_remember ();
+ dispose_old_locked_mark ();
+ with
+ | Margin -> dispose_remember (); dispose_old_locked_mark (); self#notify
+ | exc -> dispose_remember (); dispose_old_locked_mark ();
+ self#notify; raise exc)
+
+ method onGoingProof () =
+ match self#grafite_status.proof_status with
+ | No_proof | Proof _ -> false
+ | Incomplete_proof _ -> true
+ | Intermediate _ -> assert false
+
+(* method proofStatus = MatitaTypes.get_proof_status self#status *)
+ method proofMetasenv = GrafiteTypes.get_proof_metasenv self#grafite_status
+
+ method proofContext =
+ match userGoal with
+ None -> []
+ | Some n -> GrafiteTypes.get_proof_context self#grafite_status n
+
+ method proofConclusion =
+ match userGoal with
+ None -> assert false
+ | Some n ->
+ GrafiteTypes.get_proof_conclusion self#grafite_status n
+
+ method stack = GrafiteTypes.get_stack self#grafite_status
+ method setGoal n = userGoal <- n
+ method goal = userGoal
+
+ method eos =
+ let s = self#getFuture in
+ let rec is_there_and_executable lexicon_status s =
+ if Pcre.pmatch ~rex:only_dust_RE s then raise Margin;
+ let lexicon_status,st =
+ GrafiteParser.parse_statement (Ulexing.from_utf8_string s)
+ ~include_paths lexicon_status
+ in
+ match st with
+ GrafiteParser.LNone loc
+ | GrafiteParser.LSome (GrafiteAst.Comment (loc,_)) ->
+ let parsed_text_length = snd (HExtlib.loc_of_floc loc) in
+ let remain_len = String.length s - parsed_text_length in
+ let next = String.sub s parsed_text_length remain_len in
+ is_there_and_executable lexicon_status next
+ | GrafiteParser.LSome (GrafiteAst.Executable (loc, ex)) -> false
+ in
+ try
+ is_there_and_executable self#lexicon_status s
+ with
+ | CicNotationParser.Parse_error _ -> false
+ | Margin | End_of_file -> true
+
+ (* debug *)
+ method dump () =
+ HLog.debug "script status:";
+ HLog.debug ("history size: " ^ string_of_int (List.length history));
+ HLog.debug (sprintf "%d statements:" (List.length statements));
+ List.iter HLog.debug statements;
+ HLog.debug ("Current file name: " ^
+ (match guistuff.filenamedata with
+ |None,_ -> "[ no name ]"
+ | Some f,_ -> f));
+
+end
+
+let _script = ref None
+
+let script ~source_view ~mathviewer ~urichooser ~develcreator ~ask_confirmation ~set_star ()
+=
+ let s = new script
+ ~source_view ~mathviewer ~ask_confirmation ~urichooser ~develcreator ~set_star ()
+ in
+ _script := Some s;
+ s
+
+let current () = match !_script with None -> assert false | Some s -> s
+
diff --git a/helm/matita/matitaScript.mli b/helm/matita/matitaScript.mli
new file mode 100644
index 000000000..8eb6d8dd9
--- /dev/null
+++ b/helm/matita/matitaScript.mli
@@ -0,0 +1,102 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+exception NoUnfinishedProof
+
+class type script =
+object
+
+ method locked_mark : Gtk.text_mark
+ method locked_tag : GText.tag
+ method error_tag : GText.tag
+
+ (** @return current status *)
+ method lexicon_status: LexiconEngine.status
+ method grafite_status: GrafiteTypes.status
+
+ (** {2 Observers} *)
+
+ method addObserver :
+ (LexiconEngine.status -> GrafiteTypes.status -> unit) -> unit
+
+ (** {2 History} *)
+
+ method advance : ?statement:string -> unit -> unit
+ method retract : unit -> unit
+ method goto: [`Top | `Bottom | `Cursor] -> unit -> unit
+ method reset: unit -> unit
+ method template: unit -> unit
+
+ (** {2 Load/save} *)
+
+ method assignFileName : string -> unit (* to the current active file *)
+ method loadFromFile : string -> unit
+ method saveToFile : unit -> unit
+ method filename : string
+
+ (** {2 Current proof} (if any) *)
+
+ (** @return true if there is an ongoing proof, false otherise *)
+ method onGoingProof: unit -> bool
+
+(* method proofStatus: ProofEngineTypes.status |+* @raise Statement_error +| *)
+ method proofMetasenv: Cic.metasenv (** @raise Statement_error *)
+ method proofContext: Cic.context (** @raise Statement_error *)
+ method proofConclusion: Cic.term (** @raise Statement_error *)
+ method stack: Continuationals.Stack.t (** @raise Statement_error *)
+
+ method setGoal: int option -> unit
+ method goal: int option
+
+ (** end of script, true if the whole script has been executed *)
+ method eos: bool
+
+ (** misc *)
+ method clean_dirty_lock: unit
+
+ (* debug *)
+ method dump : unit -> unit
+
+end
+
+ (** @param set_star callback used to set the modified symbol (usually a star
+ * "*") on the side of a script name *)
+val script:
+ source_view:GSourceView.source_view ->
+ mathviewer: MatitaTypes.mathViewer->
+ urichooser: (UriManager.uri list -> UriManager.uri list) ->
+ develcreator: (containing:string option -> unit) ->
+ ask_confirmation:
+ (title:string -> message:string -> [`YES | `NO | `CANCEL]) ->
+ set_star: (string -> bool -> unit) ->
+ unit ->
+ script
+
+(* each time script above is called an internal ref is set, instance will return
+ * the value of this ref *)
+(* TODO Zack: orrible solution until we found a better one for having a single
+ * access point for the script *)
+val current: unit -> script
+
diff --git a/helm/matita/matitaTypes.ml b/helm/matita/matitaTypes.ml
new file mode 100644
index 000000000..13543dbb6
--- /dev/null
+++ b/helm/matita/matitaTypes.ml
@@ -0,0 +1,74 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+open GrafiteTypes
+
+ (** user hit the cancel button *)
+exception Cancel
+
+type abouts =
+ [ `Blank
+ | `Current_proof
+ | `Us
+ ]
+
+type mathViewer_entry =
+ [ `About of abouts (* current proof *)
+ | `Check of string (* term *)
+ | `Cic of Cic.term * Cic.metasenv
+ | `Dir of string (* "directory" in cic uris namespace *)
+ | `Uri of UriManager.uri (* cic object uri *)
+ | `Whelp of string * UriManager.uri list (* query and results *)
+ ]
+
+let string_of_entry = function
+ | `About `Blank -> "about:blank"
+ | `About `Current_proof -> "about:proof"
+ | `About `Us -> "about:us"
+ | `Check _ -> "check:"
+ | `Cic (_, _) -> "term:"
+ | `Dir uri -> uri
+ | `Uri uri -> UriManager.string_of_uri uri
+ | `Whelp (query, _) -> query
+
+let entry_of_string = function
+ | "about:blank" -> `About `Blank
+ | "about:proof" -> `About `Current_proof
+ | "about:us" -> `About `Us
+ | _ -> (* only about entries supported ATM *)
+ raise (Invalid_argument "entry_of_string")
+
+class type mathViewer =
+ object
+ (** @param reuse if set reused last opened cic browser otherwise
+ * opens a new one. default is false
+ *)
+ method show_entry: ?reuse:bool -> mathViewer_entry -> unit
+ method show_uri_list:
+ ?reuse:bool -> entry:mathViewer_entry -> UriManager.uri list -> unit
+ end
diff --git a/helm/matita/matitaTypes.mli b/helm/matita/matitaTypes.mli
new file mode 100644
index 000000000..be77c4435
--- /dev/null
+++ b/helm/matita/matitaTypes.mli
@@ -0,0 +1,46 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+exception Cancel
+
+type abouts = [ `Blank | `Current_proof | `Us ]
+
+type mathViewer_entry =
+ [ `About of abouts
+ | `Check of string
+ | `Cic of Cic.term * Cic.metasenv
+ | `Dir of string
+ | `Uri of UriManager.uri
+ | `Whelp of string * UriManager.uri list ]
+
+val string_of_entry : mathViewer_entry -> string
+val entry_of_string : string -> mathViewer_entry
+
+class type mathViewer =
+ object
+ method show_entry : ?reuse:bool -> mathViewer_entry -> unit
+ method show_uri_list :
+ ?reuse:bool -> entry:mathViewer_entry -> UriManager.uri list -> unit
+ end
diff --git a/helm/matita/matitac.ml b/helm/matita/matitac.ml
new file mode 100644
index 000000000..5599ba646
--- /dev/null
+++ b/helm/matita/matitac.ml
@@ -0,0 +1,39 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let main () =
+ match Filename.basename Sys.argv.(0) with
+ | "matitadep" | "matitadep.opt" -> Matitadep.main ()
+ | "matitaclean" | "matitaclean.opt" -> Matitaclean.main ()
+ | "matitamake" | "matitamake.opt" -> Matitamake.main ()
+ | _ ->
+ let _ = Paramodulation.Saturation.init () in (* ALB to link paramodulation *)
+ let _ = MatitacLib.main `COMPILER in
+ ()
+
+let _ = main ()
+
diff --git a/helm/matita/matitacLib.ml b/helm/matita/matitacLib.ml
new file mode 100644
index 000000000..3567c33f0
--- /dev/null
+++ b/helm/matita/matitacLib.ml
@@ -0,0 +1,265 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+open GrafiteTypes
+
+exception AttemptToInsertAnAlias
+
+let pp_ast_statement =
+ GrafiteAstPp.pp_statement ~term_pp:CicNotationPp.pp_term
+ ~lazy_term_pp:CicNotationPp.pp_term ~obj_pp:CicNotationPp.pp_obj
+
+(** {2 Initialization} *)
+
+let grafite_status = (ref None : GrafiteTypes.status option ref)
+let lexicon_status = (ref None : LexiconEngine.status option ref)
+
+let run_script is eval_function =
+ let lexicon_status',grafite_status' =
+ match !lexicon_status,!grafite_status with
+ | Some ss, Some s -> ss,s
+ | _,_ -> assert false
+ in
+ let slash_n_RE = Pcre.regexp "\\n" in
+ let cb =
+ if Helm_registry.get_bool "matita.quiet" then
+ (fun _ _ -> ())
+ else
+ (fun grafite_status stm ->
+ (* dump_status grafite_status; *)
+ let stm = pp_ast_statement stm in
+ let stm = Pcre.replace ~rex:slash_n_RE stm in
+ let stm =
+ if String.length stm > 50 then
+ String.sub stm 0 50 ^ " ..."
+ else
+ stm
+ in
+ HLog.debug ("Executing: ``" ^ stm ^ "''"))
+ in
+ try
+ let grafite_status'', lexicon_status'' =
+ match eval_function lexicon_status' grafite_status' is cb with
+ [] -> assert false
+ | (s,None)::_ -> s
+ | (s,Some _)::_ -> raise AttemptToInsertAnAlias
+ in
+ lexicon_status := Some lexicon_status'';
+ grafite_status := Some grafite_status''
+ with
+ | GrafiteEngine.Drop
+ | End_of_file
+ | CicNotationParser.Parse_error _ as exn -> raise exn
+ | exn ->
+ HLog.error (snd (MatitaExcPp.to_string exn));
+ raise exn
+
+let fname () =
+ match Helm_registry.get_list Helm_registry.string "matita.args" with
+ | [x] -> x
+ | _ -> MatitaInit.die_usage ()
+
+let pp_ocaml_mode () =
+ HLog.message "";
+ HLog.message " ** Entering Ocaml mode ** ";
+ HLog.message "";
+ HLog.message "Type 'go ();;' to enter an interactive matitac";
+ HLog.message ""
+
+let clean_exit n =
+ let opt_exit =
+ function
+ None -> ()
+ | Some n -> exit n
+ in
+ match !grafite_status with
+ None -> opt_exit n
+ | Some grafite_status ->
+ try
+ let baseuri = GrafiteTypes.get_string_option grafite_status "baseuri" in
+ let basedir = Helm_registry.get "matita.basedir" in
+ LibraryClean.clean_baseuris ~basedir ~verbose:false [baseuri];
+ opt_exit n
+ with GrafiteTypes.Option_error("baseuri", "not found") ->
+ (* no baseuri ==> nothing to clean yet *)
+ opt_exit n
+
+let rec interactive_loop () =
+ let str = Ulexing.from_utf8_channel stdin in
+ try
+ run_script str
+ (MatitaEngine.eval_from_stream ~first_statement_only:false ~prompt:true
+ ~include_paths:(Helm_registry.get_list Helm_registry.string
+ "matita.includes"))
+ with
+ | GrafiteEngine.Drop -> pp_ocaml_mode ()
+ | GrafiteEngine.Macro (floc,_) ->
+ let x, y = HExtlib.loc_of_floc floc in
+ HLog.error
+ (sprintf "A macro has been found in a script at %d-%d" x y);
+ interactive_loop ()
+ | Sys.Break -> HLog.error "user break!"; interactive_loop ()
+ | GrafiteTypes.Command_error _ -> interactive_loop ()
+ | End_of_file ->
+ print_newline ();
+ clean_exit (Some 0)
+ | HExtlib.Localized (floc,CicNotationParser.Parse_error err) ->
+ let x, y = HExtlib.loc_of_floc floc in
+ HLog.error (sprintf "Parse error at %d-%d: %s" x y err);
+ interactive_loop ()
+ | exn -> HLog.error (Printexc.to_string exn); interactive_loop ()
+
+let go () =
+ Helm_registry.load_from BuildTimeConf.matita_conf;
+ Http_getter.init ();
+ MetadataTypes.ownerize_tables (Helm_registry.get "matita.owner");
+ LibraryDb.create_owner_environment ();
+ CicEnvironment.set_trust (* environment trust *)
+ (let trust = Helm_registry.get_bool "matita.environment_trust" in
+ fun _ -> trust);
+ let include_paths =
+ Helm_registry.get_list Helm_registry.string "matita.includes" in
+ grafite_status := Some (GrafiteSync.init ());
+ lexicon_status :=
+ Some (CicNotation2.load_notation ~include_paths
+ BuildTimeConf.core_notation_script);
+ Sys.catch_break true;
+ interactive_loop ()
+
+let main ~mode =
+ MatitaInit.initialize_all ();
+ (* must be called after init since args are set by cmdline parsing *)
+ let fname = fname () in
+ let include_paths =
+ Helm_registry.get_list Helm_registry.string "matita.includes" in
+ grafite_status := Some (GrafiteSync.init ());
+ lexicon_status :=
+ Some (CicNotation2.load_notation ~include_paths
+ BuildTimeConf.core_notation_script);
+ Sys.catch_break true;
+ let origcb = HLog.get_log_callback () in
+ let newcb tag s =
+ match tag with
+ | `Debug | `Message -> ()
+ | `Warning | `Error -> origcb tag s
+ in
+ if Helm_registry.get_bool "matita.quiet" then
+ HLog.set_log_callback newcb;
+ let matita_debug = Helm_registry.get_bool "matita.debug" in
+ try
+ let time = Unix.time () in
+ if Helm_registry.get_bool "matita.quiet" then
+ origcb `Message ("compiling " ^ Filename.basename fname ^ "...")
+ else
+ HLog.message (sprintf "execution of %s started:" fname);
+ let is =
+ Ulexing.from_utf8_channel
+ (match fname with
+ | "stdin" -> stdin
+ | fname -> open_in fname) in
+ let include_paths =
+ Helm_registry.get_list Helm_registry.string "matita.includes" in
+ (try
+ run_script is
+ (MatitaEngine.eval_from_stream ~first_statement_only:false ~include_paths
+ ~clean_baseuri:(not (Helm_registry.get_bool "matita.preserve")))
+ with End_of_file -> ());
+ let elapsed = Unix.time () -. time in
+ let tm = Unix.gmtime elapsed in
+ let sec = string_of_int tm.Unix.tm_sec ^ "''" in
+ let min =
+ if tm.Unix.tm_min > 0 then (string_of_int tm.Unix.tm_min ^ "' ") else ""
+ in
+ let hou =
+ if tm.Unix.tm_hour > 0 then (string_of_int tm.Unix.tm_hour ^ "h ") else ""
+ in
+ let proof_status,moo_content_rev,metadata,lexicon_content_rev =
+ match !lexicon_status,!grafite_status with
+ | Some ss, Some s ->
+ s.proof_status, s.moo_content_rev, ss.LexiconEngine.metadata,
+ ss.LexiconEngine.lexicon_content_rev
+ | _,_ -> assert false
+ in
+ if proof_status <> GrafiteTypes.No_proof then
+ begin
+ HLog.error
+ "there are still incomplete proofs at the end of the script";
+ clean_exit (Some 2)
+ end
+ else
+ begin
+ let basedir = Helm_registry.get "matita.basedir" in
+ let baseuri =
+ DependenciesParser.baseuri_of_script ~include_paths fname in
+ let moo_fname = LibraryMisc.obj_file_of_baseuri ~basedir ~baseuri in
+ let lexicon_fname= LibraryMisc.lexicon_file_of_baseuri ~basedir ~baseuri in
+ let metadata_fname =
+ LibraryMisc.metadata_file_of_baseuri ~basedir ~baseuri
+ in
+ GrafiteMarshal.save_moo moo_fname moo_content_rev;
+ LibraryNoDb.save_metadata metadata_fname metadata;
+ LexiconMarshal.save_lexicon lexicon_fname lexicon_content_rev;
+ HLog.message
+ (sprintf "execution of %s completed in %s." fname (hou^min^sec));
+ exit 0
+ end
+ with
+ | Sys.Break ->
+ HLog.error "user break!";
+ if mode = `COMPILER then
+ clean_exit (Some ~-1)
+ else
+ pp_ocaml_mode ()
+ | GrafiteEngine.Drop ->
+ if mode = `COMPILER then
+ clean_exit (Some 1)
+ else
+ pp_ocaml_mode ()
+ | GrafiteEngine.Macro (floc,_) ->
+ let x, y = HExtlib.loc_of_floc floc in
+ HLog.error
+ (sprintf "A macro has been found in a script at %d-%d" x y);
+ if mode = `COMPILER then
+ clean_exit (Some 1)
+ else
+ pp_ocaml_mode ()
+ | HExtlib.Localized (floc,CicNotationParser.Parse_error err) ->
+ let (x, y) = HExtlib.loc_of_floc floc in
+ HLog.error (sprintf "Parse error at %d-%d: %s" x y err);
+ if mode = `COMPILER then
+ clean_exit (Some 1)
+ else
+ pp_ocaml_mode ()
+ | exn ->
+ if matita_debug then raise exn;
+ if mode = `COMPILER then
+ clean_exit (Some 3)
+ else
+ pp_ocaml_mode ()
+
diff --git a/helm/matita/matitacLib.mli b/helm/matita/matitacLib.mli
new file mode 100644
index 000000000..636c51d57
--- /dev/null
+++ b/helm/matita/matitacLib.mli
@@ -0,0 +1,37 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val interactive_loop : unit -> unit
+
+(** go initializes the status and calls interactive_loop *)
+val go : unit -> unit
+val main : mode:[ `COMPILER | `TOPLEVEL ] -> unit
+
+(** clean_exit n
+ if n = Some n it performs an exit [n] after a complete clean-up of what was
+ partially compiled
+ otherwise it performs the clean-up without exiting
+*)
+val clean_exit : int option -> unit
diff --git a/helm/matita/matitaclean.ml b/helm/matita/matitaclean.ml
new file mode 100644
index 000000000..826a4a282
--- /dev/null
+++ b/helm/matita/matitaclean.ml
@@ -0,0 +1,73 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+module UM = UriManager
+module TA = GrafiteAst
+
+let clean_suffixes = [ ".moo"; ".lexicon"; ".metadata"; ".xml.gz" ]
+
+let main () =
+ let _ = MatitaInit.initialize_all () in
+ let basedir = Helm_registry.get "matita.basedir" in
+ match Helm_registry.get_list Helm_registry.string "matita.args" with
+ | [ "all" ] ->
+ LibraryDb.clean_owner_environment ();
+ let xmldir = basedir ^ "/xml" in
+ let clean_pat =
+ String.concat " -o "
+ (List.map (fun suf -> "-name \\*" ^ suf) clean_suffixes) in
+ let clean_cmd =
+ sprintf "find %s \\( %s \\) -exec rm \\{\\} \\; 2> /dev/null"
+ xmldir clean_pat in
+ ignore (Sys.command clean_cmd);
+ ignore
+ (Sys.command ("find " ^ xmldir ^
+ " -type d -exec rmdir -p {} \\; 2> /dev/null"));
+ exit 0
+ | [] -> MatitaInit.die_usage ()
+ | files ->
+ let uris_to_remove =
+ List.fold_left
+ (fun uris_to_remove suri ->
+ let uri =
+ try
+ UM.buri_of_uri (UM.uri_of_string suri)
+ with UM.IllFormedUri _ ->
+ let u =
+ DependenciesParser.baseuri_of_script ~include_paths:[] suri in
+ if String.length u < 5 || String.sub u 0 5 <> "cic:/" then begin
+ HLog.error (sprintf "File %s defines a bad baseuri: %s"
+ suri u);
+ exit 1
+ end else
+ u
+ in
+ uri::uris_to_remove) [] files
+ in
+ LibraryClean.clean_baseuris ~basedir uris_to_remove
diff --git a/helm/matita/matitaclean.mli b/helm/matita/matitaclean.mli
new file mode 100644
index 000000000..45d57a886
--- /dev/null
+++ b/helm/matita/matitaclean.mli
@@ -0,0 +1,27 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val main: unit -> unit
+
diff --git a/helm/matita/matitadep.ml b/helm/matita/matitadep.ml
new file mode 100644
index 000000000..48011c0b5
--- /dev/null
+++ b/helm/matita/matitadep.ml
@@ -0,0 +1,93 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+module GA = GrafiteAst
+module U = UriManager
+
+let main () =
+ (* all are maps from "file" to "something" *)
+ let include_deps = Hashtbl.create (Array.length Sys.argv) in
+ let baseuri_of = Hashtbl.create (Array.length Sys.argv) in
+ let uri_deps = Hashtbl.create (Array.length Sys.argv) in
+ let buri alias = U.buri_of_uri (U.uri_of_string alias) in
+ let resolve alias current_buri =
+ let buri = buri alias in
+ if buri <> current_buri then Some buri else None in
+ MatitaInit.load_configuration_file ();
+ MatitaInit.parse_cmdline ();
+ let include_paths =
+ Helm_registry.get_list Helm_registry.string "matita.includes" in
+ let basedir = Helm_registry.get "matita.basedir" in
+ List.iter
+ (fun ma_file ->
+ let ic = open_in ma_file in
+ let istream = Ulexing.from_utf8_channel ic in
+ let dependencies = DependenciesParser.parse_dependencies istream in
+ close_in ic;
+ List.iter
+ (function
+ | DependenciesParser.UriDep uri ->
+ let uri = UriManager.string_of_uri uri in
+ if not (Http_getter_storage.is_legacy uri) then
+ Hashtbl.add uri_deps ma_file uri
+ | DependenciesParser.BaseuriDep uri ->
+ let uri = Http_getter_misc.strip_trailing_slash uri in
+ Hashtbl.add baseuri_of ma_file uri
+ | DependenciesParser.IncludeDep path ->
+ try
+ let baseuri =
+ DependenciesParser.baseuri_of_script ~include_paths path in
+ if not (Http_getter_storage.is_legacy baseuri) then
+ let moo_file =
+ LibraryMisc.obj_file_of_baseuri ~basedir ~baseuri in
+ Hashtbl.add include_deps ma_file moo_file
+ with Sys_error _ ->
+ HLog.warn
+ ("Unable to find " ^ path ^ " that is included in " ^ ma_file)
+ ) dependencies
+ ) (Helm_registry.get_list Helm_registry.string "matita.args");
+ Hashtbl.iter
+ (fun file alias ->
+ let dep = resolve alias (Hashtbl.find baseuri_of file) in
+ match dep with
+ | None -> ()
+ | Some u ->
+ Hashtbl.add include_deps file
+ (LibraryMisc.obj_file_of_baseuri ~basedir ~baseuri:u))
+ uri_deps;
+ List.iter
+ (fun ma_file ->
+ let deps = Hashtbl.find_all include_deps ma_file in
+ let deps = List.fast_sort Pervasives.compare deps in
+ let deps = HExtlib.list_uniq deps in
+ let deps = ma_file :: deps in
+ let baseuri = Hashtbl.find baseuri_of ma_file in
+ let moo = LibraryMisc.obj_file_of_baseuri ~basedir ~baseuri in
+ Printf.printf "%s: %s\n" moo (String.concat " " deps);
+ Printf.printf "%s: %s\n" (Pcre.replace ~pat:"ma$" ~templ:"mo" ma_file) moo)
+ (Helm_registry.get_list Helm_registry.string "matita.args")
+
diff --git a/helm/matita/matitadep.mli b/helm/matita/matitadep.mli
new file mode 100644
index 000000000..45d57a886
--- /dev/null
+++ b/helm/matita/matitadep.mli
@@ -0,0 +1,27 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val main: unit -> unit
+
diff --git a/helm/matita/matitamake.ml b/helm/matita/matitamake.ml
new file mode 100644
index 000000000..9eab0f6d8
--- /dev/null
+++ b/helm/matita/matitamake.ml
@@ -0,0 +1,162 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+module MK = MatitamakeLib ;;
+
+let main () =
+ MatitaInit.load_configuration_file ();
+ MK.initialize ();
+ let usage = ref (fun () -> ()) in
+ let dev_of_name name =
+ match MK.development_for_name name with
+ | None ->
+ prerr_endline ("Unable to find a development called " ^ name);
+ exit 1
+ | Some d -> d
+ in
+ let dev_for_dir dir =
+ match MK.development_for_dir dir with
+ | None ->
+ prerr_endline ("Unable to find a development holding directory: "^ dir);
+ exit 1
+ | Some d -> d
+ in
+ let init_dev_doc = "
+\tParameters: name (the name of the development, required)
+\tDescription: tells matitamake that a new development radicated
+\t\tin the current working directory should be handled."
+ in
+ let init_dev args =
+ if List.length args <> 1 then !usage ();
+ match MK.initialize_development (List.hd args) (Unix.getcwd ()) with
+ | None -> exit 2
+ | Some _ -> exit 0
+ in
+ let list_dev_doc = "
+\tParameters:
+\tDescription: lists the known developments and their roots."
+ in
+ let list_dev args =
+ if List.length args <> 0 then !usage ();
+ match MK.list_known_developments () with
+ | [] -> print_string "No developments found.\n"; exit 0
+ | l ->
+ List.iter
+ (fun (name, root) ->
+ print_string (Printf.sprintf "%-10s\trooted in %s\n" name root))
+ l;
+ exit 0
+ in
+ let destroy_dev_doc = "
+\tParameters: name (the name of the development to destroy, required)
+\tDescription: deletes a development (only from matitamake metadat, no
+\t\t.ma files will be deleted)."
+ in
+ let destroy_dev args =
+ if List.length args <> 1 then !usage ();
+ let name = (List.hd args) in
+ let dev = dev_of_name name in
+ MK.destroy_development dev;
+ exit 0
+ in
+ let clean_dev_doc = "
+\tParameters: name (the name of the development to destroy, optional)
+\t\tIf omitted the development that holds the current working
+\t\tdirectory is used (if any).
+\tDescription: clean the develpoment."
+ in
+ let clean_dev args =
+ let dev =
+ match args with
+ | [] -> dev_for_dir (Unix.getcwd ())
+ | [name] -> dev_of_name name
+ | _ -> !usage (); exit 1
+ in
+ match MK.clean_development dev with
+ | true -> exit 0
+ | false -> exit 1
+ in
+ let build_dev_doc = "
+\tParameters: name (the name of the development to build, required)
+\tDescription: completely builds the develpoment."
+ in
+ let build_dev args =
+ if List.length args <> 1 then !usage ();
+ let name = (List.hd args) in
+ let dev = dev_of_name name in
+ match MK.build_development dev with
+ | true -> exit 0
+ | false -> exit 1
+ in
+ let nodb_doc = "
+\tParameters:
+\tDescription: avoid using external database connection."
+ in
+ let nodb _ = Helm_registry.set_bool "db.nodb" true in
+ let target args =
+ if List.length args < 1 then !usage ();
+ let dev = dev_for_dir (Unix.getcwd ()) in
+ List.iter
+ (fun t ->
+ ignore(MK.build_development ~target:t dev))
+ args
+ in
+ let params = [
+ "-init", init_dev, init_dev_doc;
+ "-clean", clean_dev, clean_dev_doc;
+ "-list", list_dev, list_dev_doc;
+ "-destroy", destroy_dev, destroy_dev_doc;
+ "-build", build_dev, build_dev_doc;
+ "-nodb", nodb, nodb_doc;
+ "-h", (fun _ -> !usage()), "print this help screen";
+ "-help", (fun _ -> !usage()), "print this help screen";
+ ]
+ in
+ usage := (fun () ->
+ let p = prerr_endline in
+ p "\nusage:";
+ p "\tmatitamake(.opt) [command [options]]\n";
+ p "\tmatitamake(.opt) [target]\n";
+ p "commands:";
+ List.iter (fun (n,_,d) -> p (Printf.sprintf " %-10s%s" n d)) params;
+ p "\nIf target is omitted a 'all' will be used as the default.";
+ p "With -build you can build a development wherever it is.";
+ p "If you specify a target it implicitly refers to the development that";
+ p "holds the current working directory (if any).\n";
+ exit 1);
+ let rec parse args =
+ match args with
+ | [] -> target ["all"]
+ | s::tl ->
+ try
+ let _,f,_ = List.find (fun (n,_,_) -> n = s) params in
+ f tl;
+ parse tl
+ with Not_found -> if s.[0] = '-' then !usage () else target args
+ in
+ parse (List.tl (Array.to_list Sys.argv))
+
diff --git a/helm/matita/matitamakeLib.ml b/helm/matita/matitamakeLib.ml
new file mode 100644
index 000000000..8eba26fb0
--- /dev/null
+++ b/helm/matita/matitamakeLib.ml
@@ -0,0 +1,299 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let logger = fun mark ->
+ match mark with
+ | `Error -> HLog.error
+ | `Warning -> HLog.warn
+ | `Debug -> HLog.debug
+ | `Message -> HLog.message
+;;
+
+type development =
+ { root: string ; name: string }
+
+let developments = ref []
+
+let pool () = Helm_registry.get "matita.basedir" ^ "/matitamake/" ;;
+let rootfile = "/root" ;;
+
+let ls_dir dir =
+ try
+ let d = Unix.opendir dir in
+ let content = ref [] in
+ try
+ while true do
+ let name = Unix.readdir d in
+ if name <> "." && name <> ".." then
+ content := name :: !content
+ done;
+ Some []
+ with End_of_file -> Unix.closedir d; Some !content
+ with Unix.Unix_error _ -> None
+
+let initialize () =
+ (* create a base env if none *)
+ HExtlib.mkdir (pool ());
+ (* load developments *)
+ match ls_dir (pool ()) with
+ | None -> logger `Error ("Unable to list directory " ^ pool ())
+ | Some l ->
+ List.iter
+ (fun name ->
+ let root =
+ try
+ Some (HExtlib.input_file (pool () ^ name ^ rootfile))
+ with Unix.Unix_error _ ->
+ logger `Warning ("Malformed development " ^ name);
+ None
+ in
+ match root with
+ | None -> ()
+ | Some root ->
+ developments := {root = root ; name = name} :: !developments)
+ l
+
+(* finds the makefile path for development devel *)
+let makefile_for_development devel =
+ let develdir = pool () ^ devel.name in
+ develdir ^ "/makefile"
+;;
+
+(* given a dir finds a development that is radicated in it or below *)
+let development_for_dir dir =
+ let is_prefix_of d1 d2 =
+ let len1 = String.length d1 in
+ let len2 = String.length d2 in
+ if len2 < len1 then
+ false
+ else
+ let pref = String.sub d2 0 len1 in
+ pref = d1
+ in
+ (* it must be unique *)
+ try
+ Some (List.find (fun d -> is_prefix_of d.root dir) !developments)
+ with Not_found -> None
+;;
+
+let development_for_name name =
+ try
+ Some (List.find (fun d -> d.name = name) !developments)
+ with Not_found -> None
+
+(* dumps the deveopment to disk *)
+let dump_development devel =
+ let devel_dir = pool () ^ devel.name in
+ HExtlib.mkdir devel_dir;
+ HExtlib.output_file ~filename:(devel_dir ^ rootfile) ~text:devel.root
+;;
+
+let list_known_developments () =
+ List.map (fun r -> r.name,r.root) !developments
+
+let am_i_opt () =
+ if Pcre.pmatch ~pat:"\\.opt$" Sys.argv.(0) then ".opt" else ""
+
+let rebuild_makefile development =
+ let makefilepath = makefile_for_development development in
+ let template =
+ HExtlib.input_file BuildTimeConf.matitamake_makefile_template
+ in
+ let cc = BuildTimeConf.runtime_base_dir ^ "/matitac" ^ am_i_opt () in
+ let rm = BuildTimeConf.runtime_base_dir ^ "/matitaclean" ^ am_i_opt () in
+ let mm = BuildTimeConf.runtime_base_dir ^ "/matitadep" ^ am_i_opt () in
+ let df = pool () ^ development.name ^ "/depend" in
+ let template = Pcre.replace ~pat:"@ROOT@" ~templ:development.root template in
+ let template = Pcre.replace ~pat:"@CC@" ~templ:cc template in
+ let template = Pcre.replace ~pat:"@DEP@" ~templ:mm template in
+ let template = Pcre.replace ~pat:"@DEPFILE@" ~templ:df template in
+ let template = Pcre.replace ~pat:"@CLEAN@" ~templ:rm template in
+ HExtlib.output_file ~filename:makefilepath ~text:template
+
+(* creates a new development if possible *)
+let initialize_development name dir =
+ let name = Pcre.replace ~pat:" " ~templ:"_" name in
+ let dev = {name = name ; root = dir} in
+ match development_for_dir dir with
+ | Some d ->
+ logger `Error
+ ("Directory " ^ dir ^ " is already handled by development " ^ d.name);
+ logger `Error
+ ("Development " ^ d.name ^ " is rooted in " ^ d.root);
+ logger `Error
+ (dir ^ " is a subdir of " ^ d.root);
+ None
+ | None ->
+ dump_development dev;
+ rebuild_makefile dev;
+ developments := dev :: !developments;
+ Some dev
+
+let make chdir args =
+ let old = Unix.getcwd () in
+ try
+ Unix.chdir chdir;
+ let rc =
+ Unix.system
+ (String.concat " " ("make"::(List.map Filename.quote args)))
+ in
+ Unix.chdir old;
+ match rc with
+ | Unix.WEXITED 0 -> true
+ | Unix.WEXITED i -> logger `Error ("make returned " ^ string_of_int i);false
+ | _ -> logger `Error "make STOPPED or SIGNALED!";false
+ with Unix.Unix_error (_,cmd,err) ->
+ logger `Warning ("Unix Error: " ^ cmd ^ ": " ^ err);
+ false
+
+let call_make development target make =
+ rebuild_makefile development;
+ let makefile = makefile_for_development development in
+ let nodb =
+ Helm_registry.get_opt_default Helm_registry.bool ~default:false "db.nodb"
+ in
+ let flags = if nodb then ["NODB=true"] else [] in
+ make development.root
+ (["--no-print-directory"; "-s"; "-k"; "-f"; makefile; target]
+ @ flags)
+
+let build_development ?(target="all") development =
+ call_make development target make
+
+(* not really good vt100 *)
+let vt100 s =
+ let rex = Pcre.regexp "\\[[0-9;]+m" in
+ let rex_i = Pcre.regexp "^Info" in
+ let rex_w = Pcre.regexp "^Warning" in
+ let rex_e = Pcre.regexp "^Error" in
+ let rex_d = Pcre.regexp "^Debug" in
+ let rex_noendline = Pcre.regexp "\\n" in
+ let s = Pcre.replace ~rex:rex_noendline s in
+ let tokens = Pcre.split ~rex s in
+ let logger = ref HLog.message in
+ let rec aux =
+ function
+ | [] -> ()
+ | s::tl ->
+ (if Pcre.pmatch ~rex:rex_i s then
+ logger := HLog.message
+ else if Pcre.pmatch ~rex:rex_w s then
+ logger := HLog.warn
+ else if Pcre.pmatch ~rex:rex_e s then
+ logger := HLog.error
+ else if Pcre.pmatch ~rex:rex_d s then
+ logger := HLog.debug
+ else
+ !logger s);
+ aux tl
+ in
+ aux tokens
+
+
+let mk_maker refresh_cb =
+ (fun chdir args ->
+ let out_r,out_w = Unix.pipe () in
+ let err_r,err_w = Unix.pipe () in
+ let pid = ref ~-1 in
+ ignore(Sys.signal Sys.sigchld (Sys.Signal_ignore));
+ try
+ let argv = Array.of_list ("make"::args) in
+ pid := Unix.create_process "make" argv Unix.stdin out_w err_w;
+ Unix.close out_w;
+ Unix.close err_w;
+ let buf = String.create 1024 in
+ let rec aux = function
+ | f::tl ->
+ let len = Unix.read f buf 0 1024 in
+ if len = 0 then
+ raise
+ (Unix.Unix_error
+ (Unix.EPIPE,"read","len = 0 (matita internal)"));
+ vt100 (String.sub buf 0 len);
+ aux tl
+ | _ -> ()
+ in
+ while true do
+ let r,_,_ = Unix.select [out_r; err_r] [] [] (-. 1.) in
+ aux r;
+ refresh_cb ()
+ done;
+ true
+ with
+ | Unix.Unix_error (_,"read",_)
+ | Unix.Unix_error (_,"select",_) -> true)
+
+let build_development_in_bg ?(target="all") refresh_cb development =
+ call_make development target (mk_maker refresh_cb)
+;;
+
+let clean_development development =
+ call_make development "clean" make
+
+let clean_development_in_bg refresh_cb development =
+ call_make development "clean" (mk_maker refresh_cb)
+
+let destroy_development_aux development clean_development =
+ let delete_development development =
+ let unlink file =
+ try
+ Unix.unlink file
+ with Unix.Unix_error _ -> logger `Debug ("Unable to delete " ^ file)
+ in
+ let rmdir dir =
+ try
+ Unix.rmdir dir
+ with Unix.Unix_error _ ->
+ logger `Warning ("Unable to remove dir " ^ dir);
+ match ls_dir dir with
+ | None -> logger `Error ("Unable to list directory " ^ dir)
+ | Some [] -> ()
+ | Some l -> logger `Error ("The directory is not empty")
+ in
+ unlink (makefile_for_development development);
+ unlink (pool () ^ development.name ^ rootfile);
+ unlink (pool () ^ development.name ^ "/depend");
+ rmdir (pool () ^ development.name);
+ developments :=
+ List.filter (fun d -> d.name <> development.name) !developments
+ in
+ if not(clean_development development) then
+ begin
+ logger `Warning "Unable to clean the development problerly.";
+ logger `Warning "This may cause garbage."
+ end;
+ delete_development development
+
+let destroy_development development =
+ destroy_development_aux development clean_development
+
+let destroy_development_in_bg refresh development =
+ destroy_development_aux development (clean_development_in_bg refresh)
+
+let root_for_development development = development.root
+let name_for_development development = development.name
+
diff --git a/helm/matita/matitamakeLib.mli b/helm/matita/matitamakeLib.mli
new file mode 100644
index 000000000..4aaab47b1
--- /dev/null
+++ b/helm/matita/matitamakeLib.mli
@@ -0,0 +1,54 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+type development
+
+(* initialize_development [name] [dir]
+ * ask matitamake to recorder [dir] as the root for thedevelopment [name] *)
+val initialize_development: string -> string -> development option
+(* make target [default all] *)
+val build_development: ?target:string -> development -> bool
+(* make target [default all], the refresh cb is called after every output *)
+val build_development_in_bg:
+ ?target:string -> (unit -> unit) -> development -> bool
+(* make clean *)
+val clean_development: development -> bool
+val clean_development_in_bg: (unit -> unit) -> development -> bool
+(* return the development that handles dir *)
+val development_for_dir: string -> development option
+(* return the development *)
+val development_for_name: string -> development option
+(* return the known list of name, development_root *)
+val list_known_developments: unit -> (string * string ) list
+(* cleans the development, forgetting about it *)
+val destroy_development: development -> unit
+val destroy_development_in_bg: (unit -> unit) -> development -> unit
+(* initiale internal data structures *)
+val initialize : unit -> unit
+(* gives back the root *)
+val root_for_development : development -> string
+(* gives back the name *)
+val name_for_development : development -> string
+
diff --git a/helm/matita/matitatop.ml b/helm/matita/matitatop.ml
new file mode 100644
index 000000000..0aba1e9b5
--- /dev/null
+++ b/helm/matita/matitatop.ml
@@ -0,0 +1,31 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let _ =
+ let _ = Topdirs.dir_quit in
+ Toploop.loop Format.std_formatter;
+ assert false
diff --git a/helm/matita/scripts/README b/helm/matita/scripts/README
new file mode 100644
index 000000000..d48449056
--- /dev/null
+++ b/helm/matita/scripts/README
@@ -0,0 +1,20 @@
+bench.sql
+ the SQL code to generate the bench table
+
+crontab
+ install this crontab (may need tweaking) to have cron run the whole
+ stuff for you
+
+crontab.sh
+ the script crontab should run (includes a "pretty" report)
+
+do_tests.sh
+ script used by ../Makefile to run matitac[.opt] on some tests. supports some
+ options and prints out some informations neded my insert
+
+insert.awk
+ creates the SQL INSERT statements for the output of profile_cvs.sh
+
+profile_svn.sh
+ SVN co, compilation, run
+
diff --git a/helm/matita/scripts/bench.sql b/helm/matita/scripts/bench.sql
new file mode 100644
index 000000000..a45508548
--- /dev/null
+++ b/helm/matita/scripts/bench.sql
@@ -0,0 +1,13 @@
+DROP TABLE bench;
+
+CREATE TABLE bench (
+ mark VARCHAR(100) NOT NULL,
+ time VARCHAR(8) NOT NULL,
+ timeuser VARCHAR(8) NOT NULL,
+ compilation ENUM('byte','opt') NOT NULL,
+ test VARCHAR(100) NOT NULL,
+ result ENUM('ok','fail') NOT NULL,
+ options SET('gc-off','gc-on')
+);
+
+DESCRIBE bench;
diff --git a/helm/matita/scripts/crontab b/helm/matita/scripts/crontab
new file mode 100644
index 000000000..4b4c1e80a
--- /dev/null
+++ b/helm/matita/scripts/crontab
@@ -0,0 +1,4 @@
+MAILTO=helm@cs.unibo.it
+HOME=/home/tassi/
+#SVNOPTIONS='-r {2006-01-09}'
+10 5 * * * sh /home/tassi/helm/matita/scripts/crontab.sh
diff --git a/helm/matita/scripts/crontab.sh b/helm/matita/scripts/crontab.sh
new file mode 100644
index 000000000..5ad50de5e
--- /dev/null
+++ b/helm/matita/scripts/crontab.sh
@@ -0,0 +1,78 @@
+#!/bin/bash
+TODAY=`date +%Y%m%d`
+YESTERDAY=`date -d yesterday +%Y%m%d`
+TMPDIRNAME=$HOME/__${TODAY}_crontab
+TMPDIRNAMEOLD=$HOME/__${YESTERDAY}_crontab
+SVNROOT="svn+ssh://mowgli.cs.unibo.it/local/svn/helm/trunk/"
+SHELLTIME2CENTSPHP=scripts/shell_time2cents.php
+SHELLADDERPHP=scripts/shell_adder.php
+COMMONPHP=scripts/public_html/common.php
+
+
+OLD=$PWD
+mkdir -p $TMPDIRNAME
+rm -rf $TMPDIRNAMEOLD
+cd $TMPDIRNAME
+rm -rf helm
+svn co ${SVNROOT}helm/matita/scripts/ > LOG.svn 2>&1
+scripts/profile_svn.sh 2> LOG
+
+MARK=`echo "select distinct mark from bench where mark like '$TODAY%' order by mark" | mysql -u helm matita | tail -n 1`
+LASTMARK=`echo "select distinct mark from bench where mark like '$YESTERDAY%' order by mark" | mysql -u helm matita | tail -n 1`
+
+if [ -z "$MARK" ]; then
+ echo "No benchmark records for $TODAY"
+ exit 1
+fi
+
+if [ -z "$LASTMARK" ]; then
+ echo "No benchmark records for $YESTERDAY"
+ exit 1
+fi
+
+CUR_TIME=`/usr/bin/php4 -c /etc/php4/apache/php.ini -f $SHELLADDERPHP -- $COMMONPHP "select SEC_TO_TIME(SUM(TIME_TO_SEC(time))) from bench where mark = \"$MARK\" group by mark;"`
+OLD_TIME=`/usr/bin/php4 -c /etc/php4/apache/php.ini -f $SHELLADDERPHP -- $COMMONPHP "select SEC_TO_TIME(SUM(TIME_TO_SEC(time))) from bench where mark = \"$LASTMARK\" group by mark;"`
+
+CUR_CENTS=`/usr/bin/php4 -c /etc/php4/apache/php.ini -f $SHELLTIME2CENTSPHP -- $COMMONPHP $CUR_TIME`
+OLD_CENTS=`/usr/bin/php4 -c /etc/php4/apache/php.ini -f $SHELLTIME2CENTSPHP -- $COMMONPHP $OLD_TIME`
+
+((DELTA=$CUR_CENTS-$OLD_CENTS))
+if [ $DELTA -lt 0 ]; then
+ PERC=0
+else
+ ((PERC=100 * $DELTA))
+ ((PERC=$PERC / $OLD_CENTS))
+fi
+if [ $PERC -ge 5 ]; then
+ cat <<EOT
+ REPORT FOR `date`
+ http://mowgli.cs.unibo.it/~tassi/bench.php
+
+ PERFORMANCE LOSS DETECTED (MARK $MARK vs MARK $LASTMARK)
+ is $CUR_TIME sec
+ was $OLD_TIME sec
+
+EOT
+fi
+
+CUR_FAIL=`/usr/bin/php4 -c /etc/php4/apache/php.ini -f $SHELLADDERPHP -- $COMMONPHP "select count(distinct test) from bench where mark = \"$MARK\" and result = 'fail';"`
+OLD_FAIL=`/usr/bin/php4 -c /etc/php4/apache/php.ini -f $SHELLADDERPHP -- $COMMONPHP "select count(distinct test) from bench where mark = \"$LASTMARK\" and result = 'fail';"`
+
+if [ $CUR_FAIL -gt $OLD_FAIL ]; then
+ cat <<EOT
+ REPORT FOR `date`
+ http://mowgli.cs.unibo.it/~tassi/bench.php
+
+ MORE BROKEN TESTS DETECTED (MARK $MARK vs MARK $LASTMARK)
+ now broken:
+ `echo "select distinct test from bench where mark = \"$MARK\" and result = 'fail';" | mysql -u helm -h mowgli.cs.unibo.it matita`
+ were broken:
+ `echo "select distinct test from bench where mark = \"$LASTMARK\" and result = 'fail';" | mysql -u helm -h mowgli.cs.unibo.it matita`
+
+EOT
+
+fi
+
+cd $OLD
+#rm -rf $TMPDIRNAME
+
diff --git a/helm/matita/scripts/do_tests.sh b/helm/matita/scripts/do_tests.sh
new file mode 100755
index 000000000..687b7f8c0
--- /dev/null
+++ b/helm/matita/scripts/do_tests.sh
@@ -0,0 +1,85 @@
+#!/bin/bash
+
+OK="\e[32mOK\e[0m"
+FAIL="\e[31mFAIL\e[0m"
+
+if [ "$1" = "-no-color" ]; then
+ shift
+ OK="OK"
+ FAIL="FAIL"
+fi
+if [ "$1" = "-twice" ]; then
+ shift
+ TWICE=1
+fi
+if [ "$1" = "-keep-logs" ]; then
+ shift
+ KEEP=1
+fi
+
+COMPILER=$1
+shift
+CLEANCOMPILER=`echo $COMPILER | cut -d ' ' -f 1`
+CLEANER=$1
+shift
+LOGFILE=$1
+shift
+EXPECTED=$1
+shift
+TODO="$@"
+
+if [ -z "$COMPILER" -o -z "$CLEANER" -o -z "$LOGFILE" -o -z "$EXPECTED" -o -z "$TODO" ]; then
+ echo
+ echo "usage: "
+ echo " do_tests.sh [-no-color] [-twice] [-keep-logs] ./compiler ./cleaner logfile expected_result test.ma ..."
+ echo
+ echo "options: "
+ echo " -no-color Do not use vt100 colors"
+ echo " -twice Run each test twice but show only the second run times"
+ echo " -keep-logs Do not dele __* files"
+ echo
+ echo "If expected_result is OK the result will be OK if the test compiles."
+ echo "Otherwise if expected_result is FAIL the result will be OK if the test"
+ echo "does not compile and the generated output is equal to test.log."
+ echo "The value of the DO_TESTS_EXTRA evironment variable"
+ echo "will be appended to each line."
+ exit 1
+fi
+
+
+export TIMEFORMAT="%2lR %2lU %2lS"
+for T in $TODO; do
+ TT=`echo $T | sed s?/?.?`.not_for_matita
+ LOG=__log_$TT
+ DIFF=__diff_$TT
+ printf "$CLEANCOMPILER\t%-30s " $T
+ if [ "$TWICE" = "1" ]; then
+ $CLEANER $T 1>/dev/null 2>/dev/null
+ $COMPILER $T 1>/dev/null 2>/dev/null
+ fi
+ $CLEANER $T 1>/dev/null 2>/dev/null
+ TIMES=`(time $COMPILER $T > $LOG 2>&1) 2>&1`
+ RC=$?;
+ cat $LOG >> $LOGFILE
+ touch $DIFF
+ if [ $EXPECTED = "FAIL" ]; then
+ if [ $RC = 0 ]; then
+ echo "The test was successful but it should have failed!" > $DIFF
+ RC=1;
+ else
+ diff $LOG `basename $T .ma`.log > $DIFF
+ RC=$?
+ fi
+ fi
+ if [ $RC = 0 ]; then
+ printf "$OK\t$TIMES\t$DO_TESTS_EXTRA\n"
+ else
+ printf "$FAIL\t$TIMES\t$DO_TESTS_EXTRA\n";
+ cat $DIFF
+ fi
+ if [ "$KEEP" != "1" ]; then
+ rm -f $LOG
+ rm -f $DIFF
+ fi
+ exit $RC
+done
diff --git a/helm/matita/scripts/insert.awk b/helm/matita/scripts/insert.awk
new file mode 100644
index 000000000..d62a6a3ec
--- /dev/null
+++ b/helm/matita/scripts/insert.awk
@@ -0,0 +1,17 @@
+ {
+ result=tolower($3);
+ if( $1 ~ ".opt$" )
+ compilation="opt"
+ else
+ compilation="byte"
+ test=$2
+ time=$4
+ timeuser=$5
+ mark=$7
+ if ( $8 ~ "^gc-off$")
+ options="'gc-off'";
+ if ( $8 ~ "^gc-on$")
+ options="'gc-on'"
+
+ printf "INSERT bench (result, compilation, test, time, timeuser, mark, options) VALUES ('%s', '%s', '%s', '%s', '%s', '%s', %s);\n", result, compilation, test, time, timeuser, mark, options;
+ }
diff --git a/helm/matita/scripts/profile_svn.sh b/helm/matita/scripts/profile_svn.sh
new file mode 100755
index 000000000..eca457ecc
--- /dev/null
+++ b/helm/matita/scripts/profile_svn.sh
@@ -0,0 +1,70 @@
+#!/bin/bash
+MARK=`date +%Y%m%d%H%M`
+TMPDIRNAME=__${MARK}_compilation
+SVNROOT="svn+ssh://mowgli.cs.unibo.it/local/svn/helm/trunk/"
+
+function testit {
+ LOGTOOPT=/dev/null
+ LOGTOBYTE=/dev/null
+ export DO_TESTS_EXTRA="$MARK\t$@"
+ make tests DO_TESTS_OPTS="-no-color -twice -keep-logs"
+ make tests.opt DO_TESTS_OPTS="-no-color -twice -keep-logs"
+}
+
+function compile {
+ LOCALOLD=$PWD
+ cd $1
+ autoconf 1>/dev/null
+ ./configure 1>/dev/null
+ make all opt 1>/dev/null
+ cd $2
+ autoconf 1>/dev/null
+ ./configure 1>/dev/null
+ cp matita.conf.xml.sample matita.conf.xml
+ make all opt 1>/dev/null
+ cd $LOCALOLD
+}
+
+function run_tests {
+ LOCALOLD=$PWD
+ cd $1
+ ./matitaclean all
+ mkdir .matita
+ export OCAMLRUNPARAM='o=1000000'
+ testit "gc-off"
+ export OCAMLRUNPARAM=''
+ testit "gc-on"
+ cd $LOCALOLD
+}
+
+OLD=$PWD
+rm -rf $TMPDIRNAME
+mkdir $TMPDIRNAME
+mkdir $TMPDIRNAME.HOME
+cd $TMPDIRNAME
+SVNLOG=`pwd`/LOG.svn
+
+#svn
+svn co -N $SVNROOT > $SVNLOG 2>&1
+cd trunk
+svn update -N helm >> $SVNLOG 2>&1
+cd helm
+svn update $SVNOPTIONS ocaml >> $SVNLOG 2>&1
+svn update $SVNOPTIONS matita >> $SVNLOG 2>&1
+cd ..
+cd ..
+ln -s trunk/helm .
+
+#compile
+export HOME="`pwd`/../$TMPDIRNAME.HOME"
+compile $PWD/helm/ocaml $PWD/helm/matita
+
+#run
+run_tests $PWD/helm/matita > LOG 2>/dev/null
+
+cat LOG | grep "\(OK\|FAIL\)" | grep "\(gc-on\|gc-off\)" | awk -f $PWD/helm/matita/scripts/insert.awk > INSERT.sql
+cat INSERT.sql | mysql -u helm -h mowgli.cs.unibo.it matita
+SVNREVISION=`cat $SVNLOG | grep revision | tail -n 1 | sed "s/.*revision \(\w\+\)./\1/"`
+echo "INSERT INTO bench_svn VALUES ('$MARK','$SVNREVISION')" | mysql -u helm -h mowgli.cs.unibo.it matita
+cd $OLD
+#rm -rf $TMPDIRNAME
diff --git a/helm/matita/scripts/public_html/bench.php b/helm/matita/scripts/public_html/bench.php
new file mode 100644
index 000000000..2ee540825
--- /dev/null
+++ b/helm/matita/scripts/public_html/bench.php
@@ -0,0 +1,147 @@
+<?php require("common.php");
+
+// syntax
+//
+// queries ::= query | query "###" queries
+// query ::= name "@@@" sql
+//
+$limits = array("20","50","100");
+
+$quey_all = urlencode("Whole content:@@@select * from bench order by mark desc***");
+$query_fail = urlencode(
+ "Number of failures@@@" .
+ "select mark, count(distinct test) as fail_no from bench where result = 'fail' group by mark order by mark desc***"
+ . "###" .
+ "Tests failed@@@" .
+ "select distinct mark, test, result from bench where result = 'fail' order by mark desc***"
+);
+$query_gc = urlencode(
+ "GC usage @@@" .
+ "select bench.mark, SEC_TO_TIME(SUM(TIME_TO_SEC(bench.time)) - SUM(TIME_TO_SEC(bench1.time))) as gc_hoverhead from bench, bench as bench1 where bench.mark = bench1.mark and bench.test = bench1.test and bench.options = 'gc-on' and bench1.options = 'gc-off' and bench.compilation = bench1.compilation group by mark***"
+ . "###" .
+ "GC usage (opt)@@@" .
+ "select bench.mark, SEC_TO_TIME(SUM(TIME_TO_SEC(bench.time)) - SUM(TIME_TO_SEC(bench1.time))) as gc_hoverhead from bench, bench as bench1 where bench.mark = bench1.mark and bench.test = bench1.test and bench.options = 'gc-on' and bench1.options = 'gc-off' and bench.compilation = bench1.compilation and bench.compilation = 'opt' group by mark***"
+ . "###" .
+ "GC usage (byte)@@@" .
+ "select bench.mark, SEC_TO_TIME(SUM(TIME_TO_SEC(bench.time)) - SUM(TIME_TO_SEC(bench1.time))) as gc_hoverhead from bench, bench as bench1 where bench.mark = bench1.mark and bench.test = bench1.test and bench.options = 'gc-on' and bench1.options = 'gc-off' and bench.compilation = bench1.compilation and bench.compilation = 'byte' group by mark***"
+
+);
+$query_auto = urlencode(
+ "Auto (with GC)@@@select mark, SEC_TO_TIME(SUM(TIME_TO_SEC(bench.time))) as time from bench where test='auto.ma' and options = 'gc-on' group by mark order by mark desc***"
+ . "###" .
+ "Auto (without GC)@@@select mark, SEC_TO_TIME(SUM(TIME_TO_SEC(bench.time))) as time from bench where test='auto.ma' and options = 'gc-off' group by mark order by mark desc***"
+ # . "###" .
+ # "GC overhead@@@select bench.mark, SEC_TO_TIME(SUM(TIME_TO_SEC(bench.time)) - SUM(TIME_TO_SEC(bench1.time))) as gc_hoverhead from bench, bench as bench1 where bench.mark = bench1.mark and bench.test = bench1.test and bench.options = 'gc-on' and bench1.options = 'gc-off' and bench.compilation = bench1.compilation and bench.test = 'auto.ma' group by mark"
+);
+
+$query_csc = urlencode("Performances (byte and GC) per mark@@@select bench.mark ,bench_svn.revision as revision, SEC_TO_TIME(SUM(TIME_TO_SEC(bench.time))) as sum_time, SEC_TO_TIME(SUM(TIME_TO_SEC(bench.timeuser))) as sum_timeuser from bench, bench_svn where bench.options = 'gc-on' and bench.compilation = 'byte' and bench_svn.mark = bench.mark group by bench.mark order by bench.mark desc"
+);
+
+$query_csc_opt = urlencode("Performances (opt and GC) per mark@@@select bench.mark,bench_svn.revision as revision, SEC_TO_TIME(SUM(TIME_TO_SEC(bench.time))) as sum_time, SEC_TO_TIME(SUM(TIME_TO_SEC(bench.timeuser))) as sum_timeuser from bench, bench_svn where bench.options = 'gc-on' and bench.compilation = 'opt' and bench_svn.mark = bench.mark group by bench.mark order by bench.mark desc"
+);
+
+$query_total = urlencode(
+
+"Max N@@@select COUNT(DISTINCT test) as MAX from bench group by mark order by MAX desc LIMIT 0,1;"
+ . "###" .
+ "Number of compiled tests@@@select mark, COUNT(DISTINCT test) as N from bench group by mark order by mark desc***"
+);
+
+function minus1_to_all($s){
+ if ($s == "-1")
+ return "all";
+ else
+ return $s;
+}
+
+function links_of($name,$q,$limits){
+ echo "<li>$name : ";
+ if (strpos($q, urlencode("***")) === false) {
+ echo "<a href=\"showquery.php?query=$q;\">all</a>";
+ } else {
+ foreach($limits as $l) {
+ $q1 = str_replace(urlencode("***"), " LIMIT 0,$l", $q);
+ echo "<a href=\"showquery.php?query=$q1;\">" .
+ minus1_to_all($l) . "</a> ";
+ }
+ $q1 = str_replace(urlencode("***"), " ", $q);
+ echo "<a href=\"showquery.php?query=$q1;\">" .
+ minus1_to_all("-1") . "</a> ";
+ }
+ echo "</li>";
+}
+
+?>
+
+<html>
+ <head>
+ <link type="text/css" rel="stylesheet" href="style.css"/>
+ </head>
+ <body>
+ <h1>QUERY the benchmark system</h1>
+ <h2>Common Queries</h2>
+ <p>
+ <ul>
+ <? links_of("Broken tests",$query_fail,$limits) ?>
+ <? links_of("Garbage collector killer",$query_gc,$limits) ?>
+ <? links_of("Auto performances",$query_auto,$limits) ?>
+ <? links_of("Global performances (bytecode)",$query_csc,$limits) ?>
+ <? links_of("Global performances (nativecode)",$query_csc_opt,$limits) ?>
+ <? links_of("Number of compiled tests",$query_total,$limits) ?>
+ <? links_of("All table contents",$quey_all,$limits) ?>
+ </ul>
+ </p>
+ <h2>Custom Query</h2>
+ <form action="composequery.php" method="get">
+ <table>
+ <tr>
+ <td>Marks:</td>
+ <td>
+ <? array_to_combo("mark",
+ query("select distinct mark from bench order by mark desc;")); ?>
+ </td>
+ </tr>
+ <tr>
+ <td>Compilations:</td>
+ <td>
+ <? array_to_combo("compilation",
+ query("select distinct compilation from bench;")); ?>
+ </td>
+ </tr>
+ <tr>
+ <td>Options:</td>
+ <td>
+ <?array_to_combo("options",query("select distinct options from bench;"));?>
+ </td>
+ </tr>
+ <tr>
+ <td>Tests:</td>
+ <td>
+ <? array_to_combo("test",query("select distinct test from bench;")); ?>
+ </td>
+ </tr>
+ <tr>
+ <td>Test results:</td>
+ <td>
+ <? array_to_combo("result",query("select distinct result from bench;")); ?>
+ </td>
+ </tr>
+ <tr>
+ <td>Group By: </td>
+ <td>
+ <? array_to_combo("groupby",array(array("mark","options"))); ?>
+ </td>
+ </tr>
+ <tr>
+ <td>Limit: </td>
+ <td>
+ <? array_to_combo("limit",array($limits)); ?>
+ </td>
+ </tr>
+ <tr>
+ <td><input type="submit" value="Submit" class="button" /></td>
+ </tr>
+ </table>
+</form>
+</body>
+</html>
diff --git a/helm/matita/scripts/public_html/common.php b/helm/matita/scripts/public_html/common.php
new file mode 100644
index 000000000..f2a9be030
--- /dev/null
+++ b/helm/matita/scripts/public_html/common.php
@@ -0,0 +1,89 @@
+<?php
+
+function query($q) {
+ $db = mysql_pconnect("localhost","helm");
+ mysql_select_db("matita");
+ if (preg_match("/TIME_TO_SEC/",$q)) {
+ $group_by = true;
+ $q = preg_replace("/group by bench.mark/","",$q);
+ $q = preg_replace("/SEC_TO_TIME\(SUM\(TIME_TO_SEC\(([^)]+)\)\)\)/","$1",$q);
+ }
+ $rc = mysql_query($q,$db);
+ if(!$rc) {
+ die("Query failed: " . mysql_error());
+ }
+ $result = array();
+ while( $row = mysql_fetch_array($rc, MYSQL_ASSOC)){
+ $result[] = $row;
+ }
+ mysql_free_result($rc);
+ mysql_close($db);
+ if ($group_by){
+ return group_array_by_mark($result);
+ } else {
+ return $result;
+ }
+}
+
+function time_2_cents($t) {
+ $matches = array();
+ $rex = "/^(\d+)m(\d\d?)\.(\d{2})s$/";
+ $m = preg_match($rex,$t,$matches);
+ if ( $m == 0 ) exit(1);
+ $t_minutes = $matches[1];
+ $t_secs = $matches[2];
+ $t_cents = $matches[3];
+ return ((int) $t_cents) + ((int) $t_secs) * 100 + ((int)$t_minutes) * 6000 ;
+}
+
+function sum_time($t1, $t2) {
+ $matches1 = array();
+ $matches2 = array();
+ $rex = "/^(\d+)m(\d\d?)\.(\d{2})s$/";
+ $m1 = preg_match($rex,$t1,$matches1);
+ $m2 = preg_match($rex,$t2,$matches2);
+ if ($m1 != 0 && $m2 != 0) {
+ $t1_minutes = $matches1[1];
+ $t2_minutes = $matches2[1];
+ $t1_secs = $matches1[2];
+ $t2_secs = $matches2[2];
+ $t1_cents = $matches1[3];
+ $t2_cents = $matches2[3];
+ $time1 = ((int) $t1_cents) + ((int) $t1_secs) * 100 + ((int)$t1_minutes) * 6000 ;
+ $time2 = ((int) $t2_cents) + ((int) $t2_secs) * 100 + ((int)$t2_minutes) * 6000 ;
+ $sum = $time1 + $time2;
+ $min = $sum / 6000;
+ $sec = ($sum % 6000) / 100;
+ $cent = ($sum % 6000) % 100;
+ return sprintf("%dm%02d.%02ds",$min,$sec,$cent);
+ } else {
+ return $t1;
+ }
+}
+
+function group_array_by_mark($a) {
+ $rc = array();
+ foreach ($a as $x) {
+ if ($rc[$x['mark']] == NULL) {
+ $rc[$x['mark']] = $x;
+ } else {
+ foreach ($rc[$x['mark']] as $k => $v) {
+ $rc[$x['mark']][$k] = sum_time($v, $x[$k]);
+ }
+ }
+ }
+ return array_values($rc);
+}
+
+function array_to_combo($l,$a) {
+ echo "<select name=\"$l\">";
+ echo "<option value=\"--\">--</option>";
+ foreach ($a as $k => $v) {
+ foreach( array_keys($v) as $k1 => $i) {
+ echo "<option value=\"{$v[$i]}\">{$v[$i]}</option>";
+ }
+ }
+ echo "</select>";
+}
+
+?>
diff --git a/helm/matita/scripts/public_html/composequery.php b/helm/matita/scripts/public_html/composequery.php
new file mode 100644
index 000000000..49a943e47
--- /dev/null
+++ b/helm/matita/scripts/public_html/composequery.php
@@ -0,0 +1,46 @@
+<?php require("common.php");
+
+ $c = array("mark", "options", "test", "result", "compilation");
+
+ function clause_for($c) {
+ $fst = true;
+ $rc = "";
+ foreach($c as $fake => $x) {
+ $v = $_GET[$x];
+ if($v != "--") {
+ if($fst == false) {
+ $rc = $rc . " and ";
+ } else {
+ $rc = $rc . " ";
+ }
+ $fst = false;
+ $rc = $rc . $x . " = '" . $v . "'";
+ }
+ }
+ return $rc;
+ }
+
+ $gb = $_GET['groupby'];
+ $limit = $_GET['limit'];
+ if($gb != "--")
+ $what = "mark, SEC_TO_TIME(SUM(TIME_TO_SEC(time))) as sum_time, SEC_TO_TIME(SUM(TIME_TO_SEC(timeuser))) as sum_timeuser";
+ else
+ $what = "mark, time, timeuser, compilation, test, result, options";
+ $clause = clause_for($c);
+ if($clause != "")
+ $query = "select $what from bench where " . clause_for($c);
+ else
+ $query = "select $what from bench ";
+ if( $gb != "--"){
+ $query = $query. "group by $gb";
+ }
+
+ if($limit != "--") {
+ $query = $query. " LIMIT 0,$limit";
+ }
+
+ $query = $query. ";";
+
+ header("Location: showquery.php?query=".urlencode("Custom:@@@" . $query));
+ exit;
+?>
diff --git a/helm/matita/scripts/public_html/index.html b/helm/matita/scripts/public_html/index.html
new file mode 100644
index 000000000..12fd7be9f
--- /dev/null
+++ b/helm/matita/scripts/public_html/index.html
@@ -0,0 +1,15 @@
+<?php require("common.php"); ?>
+
+<html>
+ <head>
+ <link type="text/css" rel="stylesheet" href="style.css"/>
+ </head>
+ <body>
+ <h1>MATITA BENCHMARKING SYSTEM</h1>
+ <p>
+ <center> <!-- Yes, It sucks! :P -->
+ <a href="bench.php">Go to the benchmark query page</a>
+ </center>
+ </p>
+ </body>
+</html>
diff --git a/helm/matita/scripts/public_html/showquery.php b/helm/matita/scripts/public_html/showquery.php
new file mode 100644
index 000000000..e7db764d8
--- /dev/null
+++ b/helm/matita/scripts/public_html/showquery.php
@@ -0,0 +1,62 @@
+<?php require("common.php");
+
+ $query = stripslashes($_GET['query']);
+
+ $nqs = explode('###',$query);
+
+ $qs = array();
+ foreach($nqs as $v){
+ $x = explode("@@@",$v);
+ $qs[$x[0]] = $x[1];
+ }
+
+function prettify($s) {
+ if (preg_match("/^[0-9]{12}$/",$s)) {
+ $year = substr($s,0,4);
+ $month = substr($s,4,2);
+ $day = substr($s,6,2);
+ $hour = substr($s,8,2);
+ $minute = substr($s,10,2);
+ return $day . "/" . $month . "/" . $year . " " . $hour . ":" . $minute;
+ } else
+ return $s;
+}
+
+?>
+<html>
+ <head>
+ <link type="text/css" rel="stylesheet" href="style.css"/>
+ </head>
+ <body>
+ <h1>QUERY results</h1>
+<? foreach( $qs as $name => $q) { ?>
+ <h2><? echo $name; ?></h2>
+ <p>
+ <tt><? print $q; ?></tt>
+ </p>
+ <table border=1>
+ <?
+ $q = query($q);
+ echo "<tr>";
+ foreach( $q[0] as $name => $txt) {
+ echo "<th>$name</th>";
+ }
+ echo "</tr>\n";
+ $i=0;
+ foreach ($q as $k => $v) {
+ $i = $i + 1;
+ if ( $i%2 == 0)
+ echo "<tr class=\"even\">";
+ else
+ echo "<tr class=\"odd\">";
+ foreach( $v as $name => $txt) {
+ echo "<td>" . prettify($txt) . "</td>";
+ }
+ echo "</tr>\n";
+ }
+ ?>
+ </table>
+<? } ?>
+ <p><a href="bench.php">BACK to the query page</a></p>
+ </body>
+</html>
diff --git a/helm/matita/scripts/public_html/style.css b/helm/matita/scripts/public_html/style.css
new file mode 100644
index 000000000..dc2df470d
--- /dev/null
+++ b/helm/matita/scripts/public_html/style.css
@@ -0,0 +1,55 @@
+body {
+ font-family: sans-serif;
+ font-size: 12pt;
+}
+
+h1 {
+ text-align: center;
+ background-color: #87CEFA;
+}
+
+h2 {
+ margin-right: auto;
+ border-bottom-color: #87CEFA;
+ border-bottom-style: solid;
+ border-bottom-width: 2px;
+}
+
+a, .button {
+ border: 1px outset;
+ text-decoration: none;
+ background-color: #e9e9e9;
+ color: black;
+ cursor:pointer;
+ font-size: small;
+ padding-left:4px;
+ padding-right:4px;
+}
+
+li {
+ margin-bottom: 10pt;
+}
+
+ul {
+ list-style-type: upper-roman;
+}
+
+table, td {
+ border-style:none;
+ padding: 2px 6px 2px 6px;
+}
+
+tr.odd {
+ background-color:#EEEEEE;
+}
+tr.even {
+ background-color:#CECECE;
+}
+
+th {
+ border-style:solid;
+ border-width:0px 0px 1px 0px;
+ border-color: gray;
+}
+
+
diff --git a/helm/matita/scripts/shell_adder.php b/helm/matita/scripts/shell_adder.php
new file mode 100755
index 000000000..a13005e55
--- /dev/null
+++ b/helm/matita/scripts/shell_adder.php
@@ -0,0 +1,6 @@
+<?php
+ require($argv[1]);
+ $rc = query($argv[2]);
+ $a = array_values($rc[0]);
+ print($a[0]);
+?>
diff --git a/helm/matita/scripts/shell_time2cents.php b/helm/matita/scripts/shell_time2cents.php
new file mode 100755
index 000000000..4914fc24f
--- /dev/null
+++ b/helm/matita/scripts/shell_time2cents.php
@@ -0,0 +1,4 @@
+<?php
+ require($argv[1]);
+ print(time_2_cents($argv[2]));
+?>
diff --git a/helm/matita/template_makefile.in b/helm/matita/template_makefile.in
new file mode 100644
index 000000000..8cbef1fd1
--- /dev/null
+++ b/helm/matita/template_makefile.in
@@ -0,0 +1,28 @@
+SRC=$(shell find @ROOT@ -name "*.ma" -a -type f)
+TODO=$(SRC:%.ma=%.mo)
+
+MATITA_FLAGS=-noprofile
+NODB=false
+ifeq ($(NODB),true)
+ MATITA_FLAGS += -nodb
+endif
+
+MATITAC=@CC@
+MATITACLEAN=@CLEAN@
+MATITADEP=@DEP@
+
+all: $(TODO)
+
+clean:
+ $(MATITACLEAN) $(MATITA_FLAGS) $(SRC)
+ rm -f $(TODO)
+
+%.moo:
+ ($(MATITAC) $(MATITA_FLAGS) -q -I @ROOT@ $< | (grep -v "^make" || true))
+
+@DEPFILE@ : $(SRC)
+ $(MATITADEP) $(MATITA_FLAGS) -I '@ROOT@' $^ 1> @DEPFILE@
+
+# this is the depend for full targets like:
+# dir/dir/name.moo: dir/dir/name.ma dir/dep.moo
+-include @DEPFILE@
diff --git a/helm/matita/tests/Makefile b/helm/matita/tests/Makefile
new file mode 100644
index 000000000..34d4d120c
--- /dev/null
+++ b/helm/matita/tests/Makefile
@@ -0,0 +1,57 @@
+SRC=$(wildcard *.ma)
+
+MATITA_FLAGS = -I ..
+NODB=false
+ifeq ($(NODB),true)
+ MATITA_FLAGS += -nodb
+endif
+
+MATITAC=../scripts/do_tests.sh $(DO_TESTS_OPTS) "../matitac $(MATITA_FLAGS)" "../matitaclean $(MATITA_FLAGS)" /dev/null OK
+MATITACOPT=../scripts/do_tests.sh $(DO_TESTS_OPTS) "../matitac.opt $(MATITA_FLAGS)" "../matitaclean.opt $(MATITA_FLAGS)" /dev/null OK
+VERBOSEMATITAC=../matitac $(MATITA_FLAGS)
+VERBOSEMATITACOPT=../matitac.opt $(MATITA_FLAGS)
+
+MATITACLEAN=../matitaclean $(MATITA_FLAGS)
+MATITACLEANOPT=../matitaclean.opt $(MATITA_FLAGS)
+
+MATITADEP=../matitadep $(MATITA_FLAGS)
+MATITADEPOPT=../matitadep.opt $(MATITA_FLAGS)
+
+DEPEND_NAME=.depend
+
+H=@
+
+all: $(SRC:%.ma=%.mo)
+
+opt:
+ $(H)$(MAKE) MATITAC='$(MATITACOPT)' MATITACLEAN='$(MATITACLEANOPT)' MATITADEP='$(MATITADEPOPT)' all
+
+verbose:
+ $(H)$(MAKE) MATITAC='$(VERBOSEMATITAC)' MATITACLEAN='$(MATITACLEAN)' MATITADEP='$(MATITADEP)' all
+
+%.opt:
+ $(H)$(MAKE) MATITAC='$(MATITACOPT)' MATITACLEAN='$(MATITACLEANOPT)' MATITADEP='$(MATITADEPOPT)' $(@:%.opt=%)
+
+clean_:
+ $(H)rm -f __*not_for_matita
+
+clean: clean_
+ $(H)$(MATITACLEAN) $(SRC)
+
+cleanall: clean_
+ $(H)rm -f $(SRC:%.ma=%.moo)
+ $(H)$(MATITACLEAN) all
+
+depend:
+ $(H)rm -f $(DEPEND_NAME)
+ $(H)$(MAKE) $(DEPEND_NAME)
+.PHONY: depend
+
+%.moo:
+ $(H)$(MATITAC) $<
+
+$(DEPEND_NAME): $(SRC)
+ $(H)$(MATITADEP) $(SRC) > $@ || rm -f $@
+
+#include $(DEPEND_NAME)
+include .depend
diff --git a/helm/matita/tests/absurd.ma b/helm/matita/tests/absurd.ma
new file mode 100644
index 000000000..fe789a00f
--- /dev/null
+++ b/helm/matita/tests/absurd.ma
@@ -0,0 +1,26 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/absurd/".
+include "legacy/coq.ma".
+alias num (instance 0) = "natural number".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+alias id "not" = "cic:/Coq/Init/Logic/not.con".
+
+theorem stupid : \forall a:Prop. a \to not a \to 0 = 1.
+intros.
+absurd a.
+assumption.
+assumption.
+qed.
diff --git a/helm/matita/tests/apply.ma b/helm/matita/tests/apply.ma
new file mode 100644
index 000000000..abd4a9407
--- /dev/null
+++ b/helm/matita/tests/apply.ma
@@ -0,0 +1,57 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+(* test _with_ the WHD on the apply argument *)
+set "baseuri" "cic:/matita/tests/apply/".
+include "legacy/coq.ma".
+
+alias id "not" = "cic:/Coq/Init/Logic/not.con".
+alias id "False" = "cic:/Coq/Init/Logic/False.ind#xpointer(1/1)".
+
+theorem b:
+ \forall x:Prop.
+ (not x) \to x \to False.
+intros.
+apply H.
+assumption.
+qed.
+
+(* test _without_ the WHD on the apply argument *)
+
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+
+theorem a:
+ \forall A:Set.
+ \forall x: A.
+ not (x=x) \to not (x=x).
+intros.
+apply H.
+qed.
+
+
+(* this test shows what happens when a term of type A -> ? is applied to
+ a goal of type A' -> B: if A unifies with A' the unifier becomes ? := B
+ and no goal is opened; otherwise the unifier becomes ? := A' -> B and a
+ new goal of type A is created. *)
+theorem c:
+ \forall A,B:Prop.
+ A \to (\forall P: Prop. A \to P) \to (A \to B) \land (B \to B).
+ intros 4; split; [ apply H1 | apply H1; exact H ].
+qed.
+
+(* this test requires the delta-expansion of not in the type of the applied
+ term (to reveal a product) *)
+theorem d: \forall A: Prop. \lnot A \to A \to False.
+ intros. apply H. assumption.
+qed.
diff --git a/helm/matita/tests/assumption.ma b/helm/matita/tests/assumption.ma
new file mode 100644
index 000000000..ef84002ac
--- /dev/null
+++ b/helm/matita/tests/assumption.ma
@@ -0,0 +1,39 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/assumption".
+include "legacy/coq.ma".
+
+alias id "nat" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1)".
+alias num (instance 0) = "natural number".
+alias symbol "and" (instance 0) = "Coq's logical and".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+alias symbol "plus" (instance 0) = "Coq's natural plus".
+
+
+theorem stupid:
+ \forall a: 0 = 0.
+ \forall b: 3 + 2 = 5.
+ \forall c: (\lambda x:nat.x) 3 = 3.
+ 0=0 \land 3 + 2 = 5 \land 3 = 3.
+intros.
+split.
+split.
+clear H2. clear H1.
+assumption.
+clear H.
+assumption.
+assumption.
+qed.
+
diff --git a/helm/matita/tests/bad_tests/Makefile b/helm/matita/tests/bad_tests/Makefile
new file mode 100644
index 000000000..7620894f2
--- /dev/null
+++ b/helm/matita/tests/bad_tests/Makefile
@@ -0,0 +1,57 @@
+SRC=$(wildcard *.ma)
+
+MATITA_FLAGS = -I ../..
+NODB=false
+ifeq ($(NODB),true)
+ MATITA_FLAGS += -nodb
+endif
+
+MATITAC=../../scripts/do_tests.sh $(DO_TESTS_OPTS) "../../matitac $(MATITA_FLAGS) -noprofile" "../../matitaclean $(MATITA_FLAGS)" /dev/null FAIL
+MATITACOPT=../../scripts/do_tests.sh $(DO_TESTS_OPTS) "../../matitac.opt $(MATITA_FLAGS) -noprofile" "../../matitaclean.opt $(MATITA_FLAGS)" /dev/null FAIL
+VERBOSEMATITAC=../../matitac $(MATITA_FLAGS)
+VERBOSEMATITACOPT=../../matitac.opt $(MATITA_FLAGS)
+
+MATITACLEAN=../../matitaclean $(MATITA_FLAGS)
+MATITACLEANOPT=../../matitaclean.opt $(MATITA_FLAGS)
+
+MATITADEP=../../matitadep $(MATITA_FLAGS)
+MATITADEPOPT=../../matitadep.opt $(MATITA_FLAGS)
+
+DEPEND_NAME=.depend
+
+H=@
+
+all: $(SRC:%.ma=%.mo)
+
+opt:
+ $(H)$(MAKE) MATITAC='$(MATITACOPT)' MATITACLEAN='$(MATITACLEANOPT)' MATITADEP='$(MATITADEPOPT)' all
+
+verbose:
+ $(H)$(MAKE) MATITAC='$(VERBOSEMATITAC)' MATITACLEAN='$(MATITACLEAN)' MATITADEP='$(MATITADEP)' all
+
+%.opt:
+ $(H)$(MAKE) MATITAC='$(MATITACOPT)' MATITACLEAN='$(MATITACLEANOPT)' MATITADEP='$(MATITADEPOPT)' $(@:%.opt=%)
+
+clean_:
+ $(H)rm -f __*not_for_matita
+
+clean: clean_
+ $(H)$(MATITACLEAN) $(SRC)
+
+cleanall: clean_
+ $(H)rm -f $(SRC:%.ma=%.moo)
+ $(H)$(MATITACLEAN) all
+
+depend:
+ $(H)rm -f $(DEPEND_NAME)
+ $(H)$(MAKE) $(DEPEND_NAME)
+.PHONY: depend
+
+%.moo:
+ $(H)$(MATITAC) $<
+
+$(DEPEND_NAME): $(SRC)
+ $(H)$(MATITADEP) $(SRC) > $@ || rm -f $@
+
+#include $(DEPEND_NAME)
+include .depend
diff --git a/helm/matita/tests/bad_tests/auto.log b/helm/matita/tests/bad_tests/auto.log
new file mode 100644
index 000000000..a66efc52d
--- /dev/null
+++ b/helm/matita/tests/bad_tests/auto.log
@@ -0,0 +1,100 @@
+[0;32mInfo: [0mexecution of auto.ma started:
+[0;34mDebug: [0mExecuting: ``set "baseuri" "cic:/matita/tests/auto/"''
+[0;34mDebug: [0mExecuting: ``include cic:/Coq''
+[0;34mDebug: [0mExecuting: ``Theorem a: @[\forall ((x): (@[nat])).(\forall ((y) ...''
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Datatypes/nat.ind
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Logic/eq.ind
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Peano/minus.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Peano/plus.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Peano/mult.con
+[0;31mError: [0mBad name: a
+[0;34mDebug: [0mExecuting: ``intro.''
+[0;34mDebug: [0mExecuting: ``auto.''
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Logic/trans_eq.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Logic/Logic_lemmas/equality/A.var
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Logic/Logic_lemmas/equality/x.var
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Logic/Logic_lemmas/equality/y.var
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Logic/Logic_lemmas/equality/z.var
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Logic/f_equal3.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Logic/f_equal2.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Logic/f_equal.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Logic/Logic_lemmas/equality/B.var
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Logic/Logic_lemmas/equality/f.var
+WE HAVE NO UNIVERSE FILE FOR cic:/Nijmegen/QArith/sqrt2/add_sub_square_identity.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Peano/mult_n_Sm.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Rocq/TreeAutomata/semantics/conservation_0_0.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Sophia-Antipolis/MATHS/Z/Nat_complements/technical_lemma.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Rocq/ARITH/Chinese/Nat_complements/technical_lemma.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Minus/plus_minus.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Minus/minus_plus_simpl_l_reverse.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Minus/minus_plus.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Nijmegen/QArith/sqrt2/minus_minus.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Mult/mult_plus_distr_r.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Mult/mult_plus_distr_l.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Rocq/SUBST/comparith/mult_plus_distr_r.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Sophia-Antipolis/HARDWARE/GENE/Arith_compl/mult_plus_distr2.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Minus/minus_n_n.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Minus/minus_n_O.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Sophia-Antipolis/HARDWARE/GENE/Arith_compl/minus_minus_lem1.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Cachan/SMC/mu/Splus_nm.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Peano/plus_n_Sm.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Peano/plus_Sn_m.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Plus/plus_Snm_nSm.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Rocq/TreeAutomata/bases/S_plus_l.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Nijmegen/QArith/Qpositive/mult_reg_l.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Plus/plus_reg_l.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Plus/plus_permute_2_in_4.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Plus/plus_permute.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Plus/plus_comm.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Plus/plus_assoc_reverse.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Plus/plus_assoc.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Rocq/SUBST/comparith/eq_plus_reg_r.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Rocq/SUBST/comparith/eq_plus_reg_l.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Sophia-Antipolis/Rsa/MiscRsa/plus_eq.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Sophia-Antipolis/HARDWARE/GENE/Arith_compl/plus_permute2.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Nijmegen/QArith/sqrt2/minus_eq_decompose.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Nijmegen/QArith/Qpositive/minus_decompose.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Sophia-Antipolis/Rsa/MiscRsa/minus_eq.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Peano/eq_add_S.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Nijmegen/QArith/sqrt2/expand_mult2.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Rocq/SUBST/comparith/mult_n_2.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/ring/ArithRing/S_to_plus_one.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/ZArith/BinInt/ZL0.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Rocq/SUBST/comparith/S_plus.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Sophia-Antipolis/HARDWARE/GENE/Arith_compl/plus_n_SO.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Peano/plus_n_O.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Plus/plus_0_r.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Plus/plus_0_l.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Marseille/GC/lib_arith/lib_plus/plus_O_O.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Sophia-Antipolis/Rsa/MiscRsa/plus_eqO.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Sophia-Antipolis/HARDWARE/GENE/Arith_compl/plus_O_O.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Sophia-Antipolis/Bertrand/Misc/plus_eqO.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Rocq/DEMOS/Demo_AutoRewrite/g0.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Rocq/DEMOS/Demo_AutoRewrite/McCarthy/g.var
+WE HAVE NO UNIVERSE FILE FOR cic:/Sophia-Antipolis/Rsa/MiscRsa/mult_SO.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Sophia-Antipolis/Bertrand/Misc/mult_SO.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Rocq/DEMOS/Demo_AutoRewrite/Ack1.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Rocq/DEMOS/Demo_AutoRewrite/Ackermann/Ack.var
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Mult/mult_1_r.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Mult/mult_1_l.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Nijmegen/QArith/sqrt2/mult2_recompose.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Rocq/SUBST/comparith/mult_n_1.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Init/Peano/mult_n_O.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Mult/mult_0_r.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Mult/mult_0_l.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Mult/mult_comm.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Mult/mult_assoc_reverse.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Mult/mult_assoc.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Nijmegen/QArith/sqrt2/square_recompose.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Rocq/SUBST/comparith/mult_sym.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Rocq/SUBST/comparith/mult_permut.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Rocq/SUBST/comparith/mult_assoc_l.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Rocq/SUBST/comparith/eq_mult_reg_r.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Rocq/SUBST/comparith/eq_mult_reg_l.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Sophia-Antipolis/Rsa/MiscRsa/mult_eq.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Sophia-Antipolis/HARDWARE/GENE/Arith_compl/mult_sym.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Sophia-Antipolis/HARDWARE/GENE/Arith_compl/mult_permute.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Sophia-Antipolis/Float/Faux/minus_inv_lt_aux.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Coq/Arith/Mult/mult_minus_distr_r.con
+WE HAVE NO UNIVERSE FILE FOR cic:/Nijmegen/QArith/sqrt2/mult_minus_distr_l.con
+[0;31mError: [0mTactic error: No Applicable theorem
diff --git a/helm/matita/tests/bad_tests/auto.ma b/helm/matita/tests/bad_tests/auto.ma
new file mode 100755
index 000000000..c7bd62492
--- /dev/null
+++ b/helm/matita/tests/bad_tests/auto.ma
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/auto/".
+include "legacy/coq.ma".
+
+alias id "O" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1/1)".
+alias id "S" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1/2)".
+alias id "nat" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1)".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+alias symbol "minus" (instance 0) = "Coq's natural minus".
+alias symbol "plus" (instance 0) = "Coq's natural plus".
+alias symbol "times" (instance 0) = "Coq's natural times".
+theorem a : \forall x,y:nat. x*x+(S y) = O - x.
+intros.
+auto depth = 3.
diff --git a/helm/matita/tests/bad_tests/baseuri.log b/helm/matita/tests/bad_tests/baseuri.log
new file mode 100644
index 000000000..9185479df
--- /dev/null
+++ b/helm/matita/tests/bad_tests/baseuri.log
@@ -0,0 +1,4 @@
+[0;32mInfo: [0mexecution of baseuri.ma started:
+[0;34mDebug: [0mExecuting: ``set "baseuri" "cic:/matita/tests/baseuri/"''
+[0;34mDebug: [0mExecuting: ``set "baseuri" "cic:/matita/tests/baseuri/"''
+[0;31mError: [0mError: Redefinition of 'baseuri' is forbidden.
diff --git a/helm/matita/tests/bad_tests/baseuri.ma b/helm/matita/tests/bad_tests/baseuri.ma
new file mode 100644
index 000000000..0e06223fa
--- /dev/null
+++ b/helm/matita/tests/bad_tests/baseuri.ma
@@ -0,0 +1,16 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/baseuri/".
+set "baseuri" "cic:/matita/tests/baseuri/".
diff --git a/helm/matita/tests/change.ma b/helm/matita/tests/change.ma
new file mode 100644
index 000000000..b2ae3b7a0
--- /dev/null
+++ b/helm/matita/tests/change.ma
@@ -0,0 +1,40 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/change/".
+include "legacy/coq.ma".
+alias num (instance 0) = "natural number".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+alias symbol "plus" (instance 0) = "Coq's natural plus".
+alias id "nat" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1)".
+
+theorem stupid:
+ \forall a:nat.
+ a = 5 \to
+ (3 + 2) = a.
+intros.
+change in \vdash (? ? % ?) with 5.
+rewrite < H in \vdash (? ? % ?).
+reflexivity.
+qed.
+
+(* tests changing a term under a binder *)
+alias id "True" = "cic:/Coq/Init/Logic/True.ind#xpointer(1/1)".
+theorem t: (\forall x:nat. x=x) \to True.
+ intro H.
+ change in match x in H : (\forall _.%) with (0+x).
+ change in H: (\forall _.(? ? ? (? % ?))) with 0.
+ constructor 1.
+qed.
+
diff --git a/helm/matita/tests/clear.ma b/helm/matita/tests/clear.ma
new file mode 100644
index 000000000..5aaf6c0d6
--- /dev/null
+++ b/helm/matita/tests/clear.ma
@@ -0,0 +1,30 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/clear".
+include "legacy/coq.ma".
+alias num (instance 0) = "natural number".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+alias id "True" = "cic:/Coq/Init/Logic/True.ind#xpointer(1/1)".
+
+theorem stupid:
+ \forall a: True.
+ \forall b: 0 = 0.
+ 0 = 0.
+intros 1 (H).
+clear H.
+intros 1 (H).
+exact H.
+qed.
+
diff --git a/helm/matita/tests/clearbody.ma b/helm/matita/tests/clearbody.ma
new file mode 100644
index 000000000..ca4b9316e
--- /dev/null
+++ b/helm/matita/tests/clearbody.ma
@@ -0,0 +1,31 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/clearbody".
+include "legacy/coq.ma".
+alias num (instance 0) = "natural number".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+alias symbol "plus" (instance 0) = "Coq's natural plus".
+
+
+theorem stupid :
+ let x \def 0 + 1 in x + 2 = x + 2.
+ intros.
+ clearbody x.
+ simplify.
+ generalize in \vdash (? ? (? % ?) (? % ?)).
+ intros.
+ reflexivity.
+ qed.
+
diff --git a/helm/matita/tests/coercions.ma b/helm/matita/tests/coercions.ma
new file mode 100644
index 000000000..20b15cd26
--- /dev/null
+++ b/helm/matita/tests/coercions.ma
@@ -0,0 +1,64 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/coercions/".
+include "legacy/coq.ma".
+
+inductive pos: Set \def
+| one : pos
+| next : pos \to pos.
+
+inductive nat:Set \def
+| O : nat
+| S : nat \to nat.
+
+inductive int: Set \def
+| positive: nat \to int
+| negative : nat \to int.
+
+inductive empty : Set \def .
+
+let rec pos2nat x \def
+ match x with
+ [ one \Rightarrow (S O)
+ | (next z) \Rightarrow S (pos2nat z)].
+
+definition nat2int \def \lambda x. positive x.
+
+coercion cic:/matita/tests/coercions/pos2nat.con.
+
+coercion cic:/matita/tests/coercions/nat2int.con.
+
+definition fst \def \lambda x,y:int.x.
+
+theorem a: fst O one = fst (positive O) (next one).
+reflexivity.
+qed.
+
+definition double:
+ \forall f:int \to int. pos \to int
+\def
+ \lambda f:int \to int. \lambda x : pos .f (nat2int x).
+
+definition double1:
+ \forall f:int \to int. pos \to int
+\def
+ \lambda f:int \to int. \lambda x : pos .f (pos2nat x).
+
+definition double2:
+ \forall f:int \to int. pos \to int
+\def
+ \lambda f:int \to int. \lambda x : pos .f (nat2int (pos2nat x)).
+
+
diff --git a/helm/matita/tests/comments.ma b/helm/matita/tests/comments.ma
new file mode 100644
index 000000000..41e8e9bb3
--- /dev/null
+++ b/helm/matita/tests/comments.ma
@@ -0,0 +1,36 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/comments/".
+include "legacy/coq.ma".
+
+(* commento che va nell'ast, ma non viene contato
+ come step perche' non e' un executable
+*)
+
+alias num (instance 0) = "natural number".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+theorem a:0=0.
+
+(* nota *)
+(**
+
+
+apply Prop.
+*)
+reflexivity.
+(* commenti che non devono essere colorati perche'
+ non c'e' nulla di eseguibile dopo di loro
+*)
+qed.
diff --git a/helm/matita/tests/constructor.ma b/helm/matita/tests/constructor.ma
new file mode 100644
index 000000000..7ea26d43c
--- /dev/null
+++ b/helm/matita/tests/constructor.ma
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/constructor".
+include "legacy/coq.ma".
+alias num (instance 0) = "natural number".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+
+
+theorem stupid: 1 = 1.
+constructor 1.
+qed.
diff --git a/helm/matita/tests/continuationals.ma b/helm/matita/tests/continuationals.ma
new file mode 100644
index 000000000..f45061bad
--- /dev/null
+++ b/helm/matita/tests/continuationals.ma
@@ -0,0 +1,80 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/test/continuationals/".
+include "legacy/coq.ma".
+
+alias id "nat" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1)".
+alias id "S" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1/2)".
+alias id "trans_equal" = "cic:/Coq/Init/Logic/trans_equal.con".
+alias id "refl_equal" = "cic:/Coq/Init/Logic/eq.ind#xpointer(1/1/1)".
+alias id "Z" = "cic:/Coq/ZArith/BinInt/Z.ind#xpointer(1/1)".
+
+theorem semicolon: \forall p:Prop.p\to p\land p.
+intros (p); split; assumption.
+qed.
+
+theorem branch:\forall x:nat.x=x.
+intros (n);
+elim n
+[ reflexivity;
+| reflexivity ].
+qed.
+
+theorem pos:\forall x:Z.x=x.
+intros (n);
+elim n;
+[ 3: reflexivity;
+| 2: reflexivity;
+| reflexivity ]
+qed.
+
+theorem dot:\forall x:Z.x=x.
+intros (x).
+elim x.
+reflexivity. reflexivity. reflexivity.
+qed.
+
+theorem dot_slice:\forall x:Z.x=x.
+intros (x).
+elim x;
+[ elim x. reflexivity. reflexivity. reflexivity;
+| reflexivity
+| reflexivity ];
+qed.
+
+theorem focus:\forall x:Z.x=x.
+intros (x); elim x.
+focus 16 17;
+ reflexivity;
+unfocus.
+reflexivity.
+qed.
+
+theorem skip:\forall x:nat.x=x.
+intros (x).
+apply trans_equal;
+[ 2: apply (refl_equal nat x);
+| skip
+| reflexivity
+]
+qed.
+
+theorem skip_focus:\forall x:nat.x=x.
+intros (x).
+apply trans_equal;
+[ focus 18; apply (refl_equal nat x); unfocus;
+| skip
+| reflexivity ]
+qed.
diff --git a/helm/matita/tests/contradiction.ma b/helm/matita/tests/contradiction.ma
new file mode 100644
index 000000000..305a862cf
--- /dev/null
+++ b/helm/matita/tests/contradiction.ma
@@ -0,0 +1,31 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/contradiction".
+include "legacy/coq.ma".
+alias id "True" = "cic:/Coq/Init/Logic/True.ind#xpointer(1/1)".
+alias id "not" = "cic:/Coq/Init/Logic/not.con".
+alias num (instance 0) = "natural number".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+
+
+
+theorem stupid: \forall a:Prop. a \to not a \to 0 = 2.
+intros.
+letin H \def (H1 H).
+contradiction.
+qed.
+
+
+
diff --git a/helm/matita/tests/cut.ma b/helm/matita/tests/cut.ma
new file mode 100644
index 000000000..a30fe2fab
--- /dev/null
+++ b/helm/matita/tests/cut.ma
@@ -0,0 +1,25 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/cut".
+include "legacy/coq.ma".
+alias num (instance 0) = "natural number".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+
+theorem stupid: 3 = 3.
+ cut (3 = 3).
+ assumption.
+ reflexivity.
+qed.
+
diff --git a/helm/matita/tests/decompose.ma b/helm/matita/tests/decompose.ma
new file mode 100644
index 000000000..fe72f710a
--- /dev/null
+++ b/helm/matita/tests/decompose.ma
@@ -0,0 +1,28 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/decompose".
+include "legacy/coq.ma".
+alias symbol "and" (instance 0) = "Coq's logical and".
+alias symbol "or" (instance 0) = "Coq's logical or".
+
+
+
+theorem stupid:
+ \forall a,b,c:Prop.
+ (a \land c \lor b \land c) \to (c \land (b \lor a)).
+ intros.decompose H.split.assumption.right.assumption.
+ split.assumption.left.assumption.qed.
+
+
diff --git a/helm/matita/tests/discriminate.ma b/helm/matita/tests/discriminate.ma
new file mode 100644
index 000000000..d8e4bf2e2
--- /dev/null
+++ b/helm/matita/tests/discriminate.ma
@@ -0,0 +1,40 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/discriminate".
+include "legacy/coq.ma".
+alias id "not" = "cic:/Coq/Init/Logic/not.con".
+alias num (instance 0) = "natural number".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+
+inductive foo: Prop \def I_foo: foo.
+
+theorem stupid:
+ 1 = 0 \to (\forall p:Prop. p \to not p).
+ intros.
+ generalize in match I_foo.
+ discriminate H.
+qed.
+
+inductive bar_list (A:Set): Set \def
+ | bar_nil: bar_list A
+ | bar_cons: A \to bar_list A \to bar_list A.
+
+alias id "False" = "cic:/Coq/Init/Logic/False.ind#xpointer(1/1)".
+theorem stupid2:
+ \forall A:Set.\forall x:A.\forall l:bar_list A.
+ bar_nil A = bar_cons A x l \to False.
+ intros.
+ discriminate H.
+qed.
diff --git a/helm/matita/tests/elim.ma b/helm/matita/tests/elim.ma
new file mode 100644
index 000000000..67d7fada1
--- /dev/null
+++ b/helm/matita/tests/elim.ma
@@ -0,0 +1,80 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/elim".
+include "legacy/coq.ma".
+
+inductive stupidtype: Set \def
+ | Base : stupidtype
+ | Next : stupidtype \to stupidtype
+ | Pair : stupidtype \to stupidtype \to stupidtype.
+
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+alias symbol "exists" (instance 0) = "Coq's exists".
+alias symbol "or" (instance 0) = "Coq's logical or".
+alias num (instance 0) = "natural number".
+alias id "True" = "cic:/Coq/Init/Logic/True.ind#xpointer(1/1)".
+alias id "refl_equal" = "cic:/Coq/Init/Logic/eq.ind#xpointer(1/1/1)".
+
+theorem serious:
+ \forall a:stupidtype.
+ a = Base
+ \lor
+ (\exists b:stupidtype.a = Next b)
+ \lor
+ (\exists c,d:stupidtype.a = Pair c d).
+intros.
+elim a.
+clear a.left.left.
+ reflexivity.
+clear H.clear a.left.right.
+ exists.exact s.reflexivity.
+clear H.clear H1.clear a.right.
+ exists.exact s.exists.exact s1.reflexivity.
+qed.
+
+theorem t: 0=0 \to stupidtype.
+ intros; constructor 1.
+qed.
+
+(* In this test "elim t" should open a new goal 0=0 and put it in the *)
+(* goallist so that the THEN tactical closes it using reflexivity. *)
+theorem foo: let ax \def refl_equal ? 0 in t ax = t ax.
+ elim t; reflexivity.
+qed.
+
+(* This test shows a bug where elim opens a new unus{ed,eful} goal *)
+
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+alias id "O" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1/1)".
+
+inductive sum (n:nat) : nat \to nat \to Set \def
+ k: \forall x,y. n = x + y \to sum n x y.
+
+theorem t': \forall x,y. \forall H: sum x y O.
+ match H with [ (k a b p) \Rightarrow a ] = x.
+ intros.
+ cut (y = y \to O = O \to match H with [ (k a b p) \Rightarrow a] = x).
+ apply Hcut; reflexivity.
+ apply
+ (sum_ind ?
+ (\lambda a,b,K. y=a \to O=b \to
+ match K with [ (k a b p) \Rightarrow a ] = x)
+ ? ? ? H).
+ goal 16.
+ simplify. intros.
+ generalize in match H1.
+ rewrite < H2; rewrite < H3.intro.
+ rewrite > H4.auto.
+qed.
diff --git a/helm/matita/tests/fguidi.ma b/helm/matita/tests/fguidi.ma
new file mode 100644
index 000000000..c6eb2a9d8
--- /dev/null
+++ b/helm/matita/tests/fguidi.ma
@@ -0,0 +1,114 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/fguidi/".
+include "legacy/coq.ma".
+
+alias id "O" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1/1)".
+alias id "nat" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1)".
+alias id "S" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1/2)".
+alias id "le" = "cic:/matita/fguidi/le.ind#xpointer(1/1)".
+alias id "False_ind" = "cic:/Coq/Init/Logic/False_ind.con".
+alias id "I" = "cic:/Coq/Init/Logic/True.ind#xpointer(1/1/1)".
+alias id "ex_intro" = "cic:/Coq/Init/Logic/ex.ind#xpointer(1/1/1)".
+alias id "False" = "cic:/Coq/Init/Logic/False.ind#xpointer(1/1)".
+alias id "True" = "cic:/Coq/Init/Logic/True.ind#xpointer(1/1)".
+
+alias symbol "and" (instance 0) = "Coq's logical and".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+alias symbol "exists" (instance 0) = "Coq's exists".
+
+definition is_S: nat \to Prop \def
+ \lambda n. match n with
+ [ O \Rightarrow False
+ | (S n) \Rightarrow True
+ ].
+
+definition pred: nat \to nat \def
+ \lambda n. match n with
+ [ O \Rightarrow O
+ | (S n) \Rightarrow n
+ ].
+
+theorem eq_gen_S_O: \forall x. (S x = O) \to \forall P:Prop. P.
+intros. apply False_ind. cut (is_S O). auto paramodulation. elim H. exact I.
+qed.
+
+theorem eq_gen_S_O_cc: (\forall P:Prop. P) \to \forall x. (S x = O).
+intros. auto.
+qed.
+
+theorem eq_gen_S_S: \forall m,n. (S m) = (S n) \to m = n.
+intros. cut ((pred (S m)) = (pred (S n))).
+assumption. elim H. auto paramodulation.
+qed.
+
+theorem eq_gen_S_S_cc: \forall m,n. m = n \to (S m) = (S n).
+intros. elim H. auto paramodulation.
+qed.
+
+inductive le: nat \to nat \to Prop \def
+ le_zero: \forall n. (le O n)
+ | le_succ: \forall m, n. (le m n) \to (le (S m) (S n)).
+
+theorem le_refl: \forall x. (le x x).
+intros. elim x. auto paramodulation. auto paramodulation.
+qed.
+
+theorem le_gen_x_O_aux: \forall x, y. (le x y) \to (y =O) \to
+ (x = O).
+intros 3. elim H. auto paramodulation. apply eq_gen_S_O. exact n1. auto paramodulation.
+qed.
+
+theorem le_gen_x_O: \forall x. (le x O) \to (x = O).
+intros. apply le_gen_x_O_aux. exact O. auto paramodulation. auto paramodulation.
+qed.
+
+theorem le_gen_x_O_cc: \forall x. (x = O) \to (le x O).
+intros. elim H. auto paramodulation.
+qed.
+
+theorem le_gen_S_x_aux: \forall m,x,y. (le y x) \to (y = S m) \to
+ (\exists n. x = (S n) \land (le m n)).
+intros 4. elim H.
+apply eq_gen_S_O. exact m. elim H1. auto paramodulation.
+cut (n = m). elim Hcut. apply ex_intro. exact n1. auto paramodulation. auto. (* paramodulation non trova la prova *)
+qed.
+
+theorem le_gen_S_x: \forall m,x. (le (S m) x) \to
+ (\exists n. x = (S n) \land (le m n)).
+intros. apply le_gen_S_x_aux. exact (S m). auto paramodulation. auto paramodulation.
+qed.
+
+theorem le_gen_S_x_cc: \forall m,x. (\exists n. x = (S n) \land (le m n)) \to
+ (le (S m) x).
+intros. elim H. elim H1. cut ((S x1) = x). elim Hcut. auto paramodulation. elim H2. auto paramodulation.
+qed.
+
+theorem le_gen_S_S: \forall m,n. (le (S m) (S n)) \to (le m n).
+intros.
+lapply le_gen_S_x to H using H0. elim H0. elim H1.
+lapply eq_gen_S_S to H2 using H4. rewrite > H4. assumption.
+qed.
+
+theorem le_gen_S_S_cc: \forall m,n. (le m n) \to (le (S m) (S n)).
+intros. auto paramodulation.
+qed.
+
+(*
+theorem le_trans: \forall x,y. (le x y) \to \forall z. (le y z) \to (le x z).
+intros 1. elim x; clear H. clear x.
+auto paramodulation.
+fwd H1 [H]. decompose H.
+*)
diff --git a/helm/matita/tests/first.ma b/helm/matita/tests/first.ma
new file mode 100644
index 000000000..4fca7b199
--- /dev/null
+++ b/helm/matita/tests/first.ma
@@ -0,0 +1,37 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/first/".
+
+inductive nat : Set \def
+ | O : nat
+ | S : nat \to nat.
+
+inductive eq (A:Set): A \to A \to Prop \def
+ refl: \forall x:A.eq A x x.
+
+inductive list (A:Set) : Set \def
+ | nil : list A
+ | cons : A \to list A \to list A.
+
+let rec list_len (A:Set) (l:list A) on l \def
+ match l with
+ [ nil \Rightarrow O
+ | (cons a tl) \Rightarrow S (list_len A tl)].
+
+theorem stupid: \forall A:Set.eq ? (list_len A (nil ?)) O.
+intros.
+normalize.
+apply refl.
+qed.
diff --git a/helm/matita/tests/fix_betareduction.ma b/helm/matita/tests/fix_betareduction.ma
new file mode 100644
index 000000000..82f0b1cf6
--- /dev/null
+++ b/helm/matita/tests/fix_betareduction.ma
@@ -0,0 +1,26 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/fix_betareduction/".
+
+alias id "eq" = "cic:/Coq/Init/Logic/eq.ind#xpointer(1/1)".
+alias id "n" = "cic:/Suresnes/BDD/canonicite/Canonicity_BDT/n.con".
+alias id "nat" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1)".
+theorem a:
+ (\forall p: nat \to Prop.
+ \forall n: nat. p n \to p n ) \to (eq nat n n).
+intro.
+apply (H (\lambda n:nat.(eq nat n n))).
+reflexivity.
+qed.
diff --git a/helm/matita/tests/fold.ma b/helm/matita/tests/fold.ma
new file mode 100644
index 000000000..a8cee1021
--- /dev/null
+++ b/helm/matita/tests/fold.ma
@@ -0,0 +1,26 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/fold".
+include "legacy/coq.ma".
+alias id "nat" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1)".
+alias num (instance 0) = "natural number".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+alias symbol "plus" (instance 0) = "Coq's natural plus".
+theorem t: \forall x:nat. 0+x=x.
+ intro.
+ simplify in match (0+x) in \vdash (? ? % ?).
+ fold simplify (0 + x) in \vdash (? ? % ?).
+ reflexivity.
+qed.
diff --git a/helm/matita/tests/generalize.ma b/helm/matita/tests/generalize.ma
new file mode 100644
index 000000000..68492baa3
--- /dev/null
+++ b/helm/matita/tests/generalize.ma
@@ -0,0 +1,37 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/generalize".
+include "legacy/coq.ma".
+
+alias num (instance 0) = "natural number".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+alias symbol "plus" (instance 0) = "Coq's natural plus".
+alias id "plus_comm" = "cic:/Coq/Arith/Plus/plus_comm.con".
+alias id "S" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1/2)".
+
+(* This tests is for the case of a pattern that contains metavariables *)
+theorem t: \forall x. x + 4 = 4 + x.
+ intro.
+ generalize in match (S ?).
+ intro; apply plus_comm.
+qed.
+
+(* This test used to fail because x was used in the wrong context *)
+(* Once this was fixed it still did not work since apply is not *)
+(* able to solve a goal that ends in a product. *)
+theorem test2: \forall x. 4 + x = x + 4.
+ generalize in match 4.
+ exact plus_comm.
+qed.
diff --git a/helm/matita/tests/interactive/automatic_insertion.ma b/helm/matita/tests/interactive/automatic_insertion.ma
new file mode 100644
index 000000000..56212bdc5
--- /dev/null
+++ b/helm/matita/tests/interactive/automatic_insertion.ma
@@ -0,0 +1,17 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/xxx".
+
+theorem t: And True (eq nat O O). split. exact (refl_equal nat O). exact I. qed.
\ No newline at end of file
diff --git a/helm/matita/tests/interactive/drop.ma b/helm/matita/tests/interactive/drop.ma
new file mode 100644
index 000000000..b8718cdb8
--- /dev/null
+++ b/helm/matita/tests/interactive/drop.ma
@@ -0,0 +1,8 @@
+set "baseuri" "cic:/matita/tests/drop".
+
+alias id "O" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1/1)".
+alias num (instance 0) = "natural number".
+alias symbol "eq" (instance 0) = "leibnitz's equality".
+alias symbol "plus" (instance 0) = "natural plus".
+theorem a : O + 1 = 1.
+drop.
diff --git a/helm/matita/tests/interactive/grafite.ma b/helm/matita/tests/interactive/grafite.ma
new file mode 100644
index 000000000..aaf570091
--- /dev/null
+++ b/helm/matita/tests/interactive/grafite.ma
@@ -0,0 +1,34 @@
+set "baseuri" "cic:/matita/tests/grafite/".
+
+(* commento *)
+(** hint. *)
+
+inductive pippo : Type \def
+ | a : Type \to pippo
+ | b : Prop \to pippo
+ | c : Set \to pippo.
+
+definition pollo : Set \to Set \def
+ \lambda a:Set.a.
+
+inductive paolo : Prop \def t:paolo.
+
+theorem comeno : \forall p:pippo.pippo.
+intros.assumption.
+qed.
+
+definition f : pippo \to paolo \def
+ \lambda x:pippo.
+ match x with
+ [ (a z) \Rightarrow t
+ | (b z) \Rightarrow t
+ | (c z) \Rightarrow t ].
+
+record w : Type \def {
+ mario : Prop;
+ pippo : Set
+}.
+
+whelp locate pippo.
+
+print "coercions".
diff --git a/helm/matita/tests/interactive/test5.ma b/helm/matita/tests/interactive/test5.ma
new file mode 100644
index 000000000..e48cc827e
--- /dev/null
+++ b/helm/matita/tests/interactive/test5.ma
@@ -0,0 +1,7 @@
+set "baseuri" "cic:/matita/tests/interactive/test5/".
+
+whelp instance
+ \lambda A:Set.
+ \lambda f: A \to A \to A.
+ \forall x,y : A.
+ f x y = f y x.
diff --git a/helm/matita/tests/interactive/test6.ma b/helm/matita/tests/interactive/test6.ma
new file mode 100644
index 000000000..4afdd3741
--- /dev/null
+++ b/helm/matita/tests/interactive/test6.ma
@@ -0,0 +1,7 @@
+set "baseuri" "cic:/matita/tests/interactive/test6/".
+
+whelp instance
+ \lambda A:Set.
+ \lambda f:A \to A \to A.
+ \forall x,y,z:A.
+ f x (f y z) = f (f x y) z.
diff --git a/helm/matita/tests/interactive/test7.ma b/helm/matita/tests/interactive/test7.ma
new file mode 100644
index 000000000..d7347ed9f
--- /dev/null
+++ b/helm/matita/tests/interactive/test7.ma
@@ -0,0 +1,7 @@
+set "baseuri" "cic:/matita/tests/interactive/test7/".
+
+whelp instance
+ \lambda A:Set.
+ \lambda r:A \to A \to Prop.
+ \forall x:A.
+ r x x.
diff --git a/helm/matita/tests/interactive/test_instance.ma b/helm/matita/tests/interactive/test_instance.ma
new file mode 100644
index 000000000..7e02c0fff
--- /dev/null
+++ b/helm/matita/tests/interactive/test_instance.ma
@@ -0,0 +1,16 @@
+set "baseuri" "cic:/matita/tests/interactive/instance/".
+
+whelp instance \lambda A:Set.\lambda P:A \to A \to Prop.\forall x:A. P x x.
+whelp instance \lambda A:Set.\lambda P:A \to A \to Prop.\forall x,y:A. P x y \to P y x.
+whelp instance \lambda A:Set.\lambda P:A \to A \to Prop.\forall x,y,z:A. P x y \to P y z \to P y z.
+whelp instance \lambda A:Set.\lambda f:A \to A \to A. \forall x,y:A. f x y = f y x.
+whelp instance \lambda A:Set.\lambda r : A \to A \to Prop. \forall x,y,z:A. r x y \to r y z \to r x z.
+
+
+whelp instance \lambda A:Set.\lambda R:A \to A \to Prop.\forall x:A.\forall y:A.(R x y) \to \forall z:A.(R x z) \to \exists u:A.(R y u) \land (R z u).
+
+whelp instance λA:Set.λR:AâAâProp.âx:A.ây:A.(R x y)ââz:A.(R x z)ââu:A.(R y u)â§(R z u).
+
+whelp instance \lambda A:Set. \lambda R:A\to A\to Prop. confluence A R.
+
+whelp instance \lambda A:Set. \lambda f:A\to A\to A. \lambda g:A\to A\to A. \forall x,y,z : A . f x (g y z) = g (f x y ) (f x z).
diff --git a/helm/matita/tests/inversion.ma b/helm/matita/tests/inversion.ma
new file mode 100644
index 000000000..3e49e0668
--- /dev/null
+++ b/helm/matita/tests/inversion.ma
@@ -0,0 +1,61 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/inversion_sum/".
+include "legacy/coq.ma".
+
+
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+alias id "O" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1/1)".
+
+inductive sum (n:nat) : nat \to nat \to Set \def
+ k: \forall x,y. n = x + y \to sum n x y.
+
+
+
+
+theorem t: \forall x,y. \forall H: sum x y O.
+ match H with [ (k a b p) \Rightarrow a ] = x.
+ intros.
+ inversion H.
+
+ (*
+ cut (y = y \to O = O \to match H with [ (k a b p) \Rightarrow a] = x).
+ apply Hcut; reflexivity.
+ apply
+ (sum_ind ?
+ (\lambda a,b,K. y=a \to O=b \to
+ match K with [ (k a b p) \Rightarrow a ] = x)
+ ? ? ? H).
+ goal 16.*)
+ simplify. intros.
+ generalize in match H1.
+ rewrite < H2; rewrite < H3.intro.
+ rewrite > H4.auto.
+qed.
+
+theorem t1: \forall x,y. sum x y O \to x = y.
+intros.
+
+(*
+cut y=y \to O=O \to x = y.
+apply Hcut.reflexivity. reflexivity.
+apply (sum_ind ? (\lambda a,b,K. y=a \to O=b \to x=a) ? ? ? s).*)
+
+(*apply (sum_ind ? (\lambda a,b,K. y = a \to O = b \to x = a) ? ? ? s).*)
+inversion s.
+intros.simplify.
+intros.
+rewrite > H. rewrite < H2. auto.
+qed.
diff --git a/helm/matita/tests/inversion2.ma b/helm/matita/tests/inversion2.ma
new file mode 100644
index 000000000..65dc75d40
--- /dev/null
+++ b/helm/matita/tests/inversion2.ma
@@ -0,0 +1,63 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/inversion/".
+include "legacy/coq.ma".
+
+inductive nat : Set \def
+ O : nat
+ | S : nat \to nat.
+
+
+inductive le (n:nat) : nat \to Prop \def
+ leO : le n n
+ | leS : \forall m. le n m \to le n (S m).
+
+theorem le_inv:
+ \forall n,m.
+ \forall P: nat -> nat -> Prop.
+ ? -> ? -> le n m -> P n m.
+[7:
+ intros;
+ inversion H;
+ [ apply x
+ | simplify;
+ apply x1
+ ]
+| skip
+| skip
+| skip
+| skip
+| skip
+| skip
+]
+qed.
+
+inductive ledx : nat \to nat \to Prop \def
+ ledxO : \forall n. ledx n n
+ | ledxS : \forall m.\forall n. ledx n m \to ledx n (S m).
+
+
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+
+theorem test_inversion: \forall n. le n O \to n=O.
+ intros.
+ inversion H.
+ (* cut n=n \to O=O \to n=O.
+ apply Hcut; reflexivity. *)
+ (* elim H. BUG DI UNSHARING *)
+ (*apply (ledx_ind (\lambda x.\lambda y. n=x \to O=y \to x=y) ? ? ? ? H).*)
+ simplify. intros. reflexivity.
+ simplify. intros. discriminate H3.
+qed.
diff --git a/helm/matita/tests/letrec.ma b/helm/matita/tests/letrec.ma
new file mode 100644
index 000000000..55933cd31
--- /dev/null
+++ b/helm/matita/tests/letrec.ma
@@ -0,0 +1,25 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/letrec/".
+
+
+alias id "O" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1/1)".
+alias id "S" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1/2)".
+alias id "nat" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1)".
+
+let rec plus n m \def
+ match n with
+ [ O \Rightarrow m
+ | (S x) \Rightarrow S (plus x m) ].
diff --git a/helm/matita/tests/match_inference.ma b/helm/matita/tests/match_inference.ma
new file mode 100644
index 000000000..0e27ce409
--- /dev/null
+++ b/helm/matita/tests/match_inference.ma
@@ -0,0 +1,52 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/match_inference/".
+
+inductive pos: Set \def
+| one : pos
+| next : pos \to pos.
+
+inductive nat:Set \def
+| O : nat
+| S : nat \to nat.
+
+definition pos2nat : pos \to nat \def
+ \lambda x:pos . match x with
+ [ one \Rightarrow O
+ | (next z) \Rightarrow O].
+
+inductive empty (x:nat) : nat \to Set \def .
+
+definition empty2nat : (empty O O) \to nat \def
+ \lambda x : (empty O O). S (match x in empty with []).
+
+inductive le (n:nat) : nat \to Prop \def
+ | le_n : le n n
+ | le_S : \forall m:nat. le n m \to le n (S m).
+
+inductive True : Prop \def
+ I : True.
+
+definition r : True \def
+ match (le_n O) with
+ [ le_n \Rightarrow I
+ | (le_S y p') \Rightarrow I ].
+
+inductive Prod (A,B:Set): Set \def
+pair : A \to B \to Prod A B.
+
+definition fst : \forall A,B:Set. (Prod A B) \to A \def
+\lambda A,B:Set. \lambda p:(Prod A B). match p with
+[(pair a b) \Rightarrow a].
diff --git a/helm/matita/tests/metasenv_ordering.ma b/helm/matita/tests/metasenv_ordering.ma
new file mode 100644
index 000000000..fc354e6ae
--- /dev/null
+++ b/helm/matita/tests/metasenv_ordering.ma
@@ -0,0 +1,139 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/metasenv_ordering".
+
+include "legacy/coq.ma".
+
+alias num (instance 0) = "natural number".
+alias id "nat" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1)".
+
+(* REWRITE *)
+
+theorem th1 :
+ \forall P:Prop.
+ \forall H:(\forall G1: Set. \forall G2:Prop. \forall G3 : Type. 1 = 0).
+ 1 = 1 \land 1 = 0 \land 2 = 2.
+ intros. split; split;
+ [ reflexivity
+ | rewrite > H;
+ [ reflexivity | exact nat | exact (0=0) | exact Type ]
+ ]
+qed.
+
+theorem th2 :
+ \forall P:Prop.
+ \forall H:(\forall G1: Set. \forall G2:Prop. \forall G3 : Type. 1 = 0).
+ 1 = 1 \land 1 = 0 \land 3 = 3.
+ intros. split. split.
+ focus 13.
+ rewrite > (H ?); [reflexivity | exact nat | exact (0=0) | exact Type].
+ unfocus.
+ reflexivity.
+ reflexivity.
+qed.
+
+theorem th3 :
+ \forall P:Prop.
+ \forall H:(\forall G1: Set. \forall G2:Prop. \forall G3 : Type. 1 = 0).
+ 1 = 1 \land 1 = 0 \land 4 = 4.
+ intros. split. split.
+ focus 13.
+ rewrite > (H ? ?); [reflexivity | exact nat | exact (0=0) | exact Type].
+ unfocus.
+ reflexivity.
+ reflexivity.
+qed.
+
+theorem th4 :
+ \forall P:Prop.
+ \forall H:(\forall G1: Set. \forall G2:Prop. \forall G3 : Type. 1 = 0).
+ 1 = 1 \land 1 = 0 \land 5 = 5.
+ intros. split. split.
+ focus 13.
+ rewrite > (H ? ? ?); [reflexivity | exact nat | exact (0=0) | exact Type].
+ unfocus.
+ reflexivity.
+ reflexivity.
+qed.
+
+(* APPLY *)
+
+theorem th5 :
+ \forall P:Prop.
+ \forall H:(\forall G1: Set. \forall G2:Prop. \forall G3 : Type. 1 = 0).
+ 1 = 1 \land 1 = 0 \land 6 = 6.
+ intros. split. split.
+ focus 13.
+ apply H; [exact nat | exact (0=0) | exact Type].
+ unfocus.
+ reflexivity.
+ reflexivity.
+qed.
+
+theorem th6 :
+ \forall P:Prop.
+ \forall H:(\forall G1: Set. \forall G2:Prop. \forall G3 : Type. 1 = 0).
+ 1 = 1 \land 1 = 0 \land 7 = 7.
+ intros. split. split.
+ focus 13.
+ apply (H ?); [exact nat | exact (0=0) | exact Type].
+ unfocus.
+ reflexivity.
+ reflexivity.
+qed.
+
+theorem th7 :
+ \forall P:Prop.
+ \forall H:(\forall G1: Set. \forall G2:Prop. \forall G3 : Type. 1 = 0).
+ 1 = 1 \land 1 = 0 \land 8 = 8.
+ intros. split. split.
+ focus 13.
+ apply (H ? ?); [exact nat | exact (0=0) | exact Type].
+ unfocus.
+ reflexivity.
+ reflexivity.
+qed.
+
+theorem th8 :
+ \forall P:Prop.
+ \forall H:(\forall G1: Set. \forall G2:Prop. \forall G3 : Type. 1 = 0).
+ 1 = 1 \land 1 = 0 \land 9 = 9.
+ intros. split. split.
+ focus 13.
+ apply (H ? ? ?); [exact nat | exact (0=0) | exact Type].
+ unfocus.
+ reflexivity.
+ reflexivity.
+qed.
+
+(* ELIM *)
+
+theorem th9:
+ \forall P,Q,R,S : Prop. R \to S \to \forall E:(R \to S \to P \land Q). P \land Q.
+ intros (P Q R S r s H).
+ elim (H ? ?); [split; assumption | exact r | exact s].
+ qed.
+
+theorem th10:
+ \forall P,Q,R,S : Prop. R \to S \to \forall E:(R \to S \to P \land Q). P \land Q.
+ intros (P Q R S r s H).
+ elim (H ?); [split; assumption | exact r | exact s].
+ qed.
+
+theorem th11:
+ \forall P,Q,R,S : Prop. R \to S \to \forall E:(R \to S \to P \land Q). P \land Q.
+ intros (P Q R S r s H).
+ elim H; [split; assumption | exact r | exact s].
+ qed.
diff --git a/helm/matita/tests/mysql_escaping.ma b/helm/matita/tests/mysql_escaping.ma
new file mode 100644
index 000000000..bd0eb8d5a
--- /dev/null
+++ b/helm/matita/tests/mysql_escaping.ma
@@ -0,0 +1,17 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/mysql_escaping/".
+
+theorem a' : Prop \to Prop.intros.assumption.qed.
diff --git a/helm/matita/tests/paramodulation.ma b/helm/matita/tests/paramodulation.ma
new file mode 100644
index 000000000..311b9455a
--- /dev/null
+++ b/helm/matita/tests/paramodulation.ma
@@ -0,0 +1,32 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/paramodulation".
+include "legacy/coq.ma".
+alias id "nat" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1)".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+alias symbol "plus" (instance 0) = "Coq's natural plus".
+alias num (instance 0) = "natural number".
+alias symbol "times" (instance 0) = "Coq's natural times".
+
+theorem para1:
+ \forall n,m,n1,m1:nat.
+ n=m \to n1 = m1 \to (n + n1) = (m + m1).
+intros. auto paramodulation.
+qed.
+
+theorem para2:
+ \forall n:nat. n + n = 2 * n.
+intros. auto paramodulation.
+qed.
diff --git a/helm/matita/tests/record.ma b/helm/matita/tests/record.ma
new file mode 100644
index 000000000..ed9ecfed8
--- /dev/null
+++ b/helm/matita/tests/record.ma
@@ -0,0 +1,39 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/record/".
+
+record empty : Type \def {}.
+
+inductive True : Prop \def I: True.
+
+record pippo : Type \def
+{
+a: Set ;
+b: a \to Prop;
+c: \forall x:a.(b x) \to a \to Type
+}.
+
+record pluto (A, B:Set) : Type \def {
+d: A \to B \to Prop;
+e: \forall y:A.\forall z:B. (d y z) \to A \to B;
+mario: \forall y:A.\forall z:B. \forall h:(d y z). \forall i : B \to Prop.
+ i (e y z h y)
+}.
+
+record paperino: Prop \def {
+ paolo : Type;
+ pippo : paolo \to paolo;
+ piero : True
+}.
diff --git a/helm/matita/tests/replace.ma b/helm/matita/tests/replace.ma
new file mode 100644
index 000000000..2b174af64
--- /dev/null
+++ b/helm/matita/tests/replace.ma
@@ -0,0 +1,39 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/replace/".
+include "legacy/coq.ma".
+alias id "nat" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1)".
+alias num (instance 0) = "natural number".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+alias symbol "plus" (instance 0) = "Coq's natural plus".
+alias symbol "times" (instance 0) = "Coq's natural times".
+alias id "mult_n_O" = "cic:/Coq/Init/Peano/mult_n_O.con".
+alias id "plus_n_O" = "cic:/Coq/Init/Peano/plus_n_O.con".
+
+theorem t: \forall x:nat. x * (x + 0) = (0 + x) * (x + x * 0).
+ intro.
+ replace in \vdash (? ? (? ? %) (? % %)) with x.
+ reflexivity.
+ rewrite < (mult_n_O x).
+ rewrite < (plus_n_O x).
+ reflexivity.
+ reflexivity.
+ auto.
+qed.
+
+(* This test tests "replace in match t" where t contains some metavariables *)
+theorem t2: 2 + (3 * 4) = (5 + 5) + 2 * 2.
+ replace in match (5+?) with (6 + 4); [reflexivity | reflexivity].
+qed.
diff --git a/helm/matita/tests/rewrite.ma b/helm/matita/tests/rewrite.ma
new file mode 100644
index 000000000..580ad13ed
--- /dev/null
+++ b/helm/matita/tests/rewrite.ma
@@ -0,0 +1,64 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/rewrite/".
+include "legacy/coq.ma".
+
+alias id "nat" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1)".
+alias num (instance 0) = "natural number".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+alias symbol "plus" (instance 0) = "Coq's natural plus".
+alias id "plus_n_O" = "cic:/Coq/Init/Peano/plus_n_O.con".
+
+theorem a:
+ \forall a,b:nat.
+ a = b \to b + a + b + a= (\lambda j.((\lambda w.((\lambda x.x + b + w + j) a)) b)) a.
+intros.
+rewrite < H in \vdash (? ? ? ((\lambda j.((\lambda w.%) ?)) ?)).
+
+rewrite < H in \vdash (? ? % ?).
+
+simplify in \vdash (? ? ? ((\lambda _.((\lambda _.%) ?)) ?)).
+
+rewrite < H in \vdash (? ? ? (% ?)).
+simplify.
+reflexivity.
+qed.
+
+theorem t: \forall n. 0=0 \to n = n + 0.
+ intros.
+ apply plus_n_O.
+qed.
+
+(* In this test "rewrite < t" should open a new goal 0=0 and put it in *)
+(* the goallist so that the THEN tactical closes it using reflexivity. *)
+theorem foo: \forall n. n = n + 0.
+ intros.
+ rewrite < t; reflexivity.
+qed.
+
+theorem test_rewrite_in_hyp:
+ \forall n,m. n + 0 = m \to m = n + 0 \to n=m \land m+0=n+0.
+ intros.
+ rewrite < plus_n_O in H.
+ rewrite > plus_n_O in H1.
+ split; [ exact H | exact H1].
+qed.
+
+theorem test_rewrite_in_hyp2:
+ \forall n,m. n + 0 = m \to n + 0 = m \to n=m \land n+0=m.
+ intros.
+ rewrite < plus_n_O in H H1 \vdash (? ? %).
+ split; [ exact H | exact H1].
+qed.
diff --git a/helm/matita/tests/second.ma b/helm/matita/tests/second.ma
new file mode 100644
index 000000000..450c67671
--- /dev/null
+++ b/helm/matita/tests/second.ma
@@ -0,0 +1,24 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/second/".
+alias id "nat" = "cic:/matita/tests/first/nat.ind#xpointer(1/1)".
+alias id "O" = "cic:/matita/tests/first/nat.ind#xpointer(1/1/1)".
+alias id "eq" = "cic:/matita/tests/first/eq.ind#xpointer(1/1)".
+alias id "refl" = "cic:/matita/tests/first/eq.ind#xpointer(1/1/1)".
+
+theorem ultrastupid : eq nat O O.
+apply refl.
+qed.
+
diff --git a/helm/matita/tests/simpl.ma b/helm/matita/tests/simpl.ma
new file mode 100644
index 000000000..65e9d48a4
--- /dev/null
+++ b/helm/matita/tests/simpl.ma
@@ -0,0 +1,51 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/simpl/".
+include "legacy/coq.ma".
+
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+alias id "plus" = "cic:/Coq/Init/Peano/plus.con".
+alias id "S" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1/2)".
+alias id "O" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1/1)".
+alias id "not" = "cic:/Coq/Init/Logic/not.con".
+alias id "nat" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1)".
+alias id "plus_comm" = "cic:/Coq/Arith/Plus/plus_comm.con".
+
+theorem a :
+ \forall A:Set.
+ \forall x,y : A.
+ not (x = y) \to not(y = x).
+intros.
+unfold not. (* simplify. *)
+intro. apply H.
+symmetry.
+exact H1.
+qed.
+
+theorem t: let f \def \lambda x,y. x y in f (\lambda x.S x) O = S O.
+ intros. simplify. change in \vdash (? ? (? %) ?) with O.
+ reflexivity. qed.
+
+
+theorem X: \forall x:nat. let myplus \def plus x in myplus (S O) = S x.
+ intros. simplify. change in \vdash (? ? (% ?) ?) with (plus x).
+
+rewrite > plus_comm. reflexivity. qed.
+
+theorem R: \forall x:nat. let uno \def x + O in S O + uno = 1 + x.
+ intros. simplify.
+ change in \vdash (? ? (? %) ?) with (x + O).
+ rewrite > plus_comm. reflexivity. qed.
+
diff --git a/helm/matita/tests/test2.ma b/helm/matita/tests/test2.ma
new file mode 100644
index 000000000..92d9a5330
--- /dev/null
+++ b/helm/matita/tests/test2.ma
@@ -0,0 +1,26 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/test2/".
+include "legacy/coq.ma".
+
+alias id "nat" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1)".
+alias symbol "and" (instance 0) = "Coq's logical and".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+theorem a:\forall x:nat.x=x\land x=x.
+intro.
+split.
+reflexivity.
+reflexivity.
+qed.
diff --git a/helm/matita/tests/test3.ma b/helm/matita/tests/test3.ma
new file mode 100644
index 000000000..cdf54906d
--- /dev/null
+++ b/helm/matita/tests/test3.ma
@@ -0,0 +1,31 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/test3/".
+include "legacy/coq.ma".
+
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+theorem a:\forall x.x=x.
+alias id "nat" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1)".
+[ exact nat.
+| intro. reflexivity.
+]
+qed.
+alias num (instance 0) = "natural number".
+alias symbol "times" (instance 0) = "Coq's natural times".
+
+theorem b:\forall p:nat. p * 0=0.
+intro.
+auto.
+qed.
diff --git a/helm/matita/tests/test4.ma b/helm/matita/tests/test4.ma
new file mode 100644
index 000000000..6c3b7ec6f
--- /dev/null
+++ b/helm/matita/tests/test4.ma
@@ -0,0 +1,38 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/test4/".
+include "legacy/coq.ma".
+
+
+(* commento che va nell'ast, ma non viene contato
+ come step perche' non e' un executable
+*)
+
+alias num (instance 0) = "natural number".
+alias symbol "eq" (instance 0) = "Coq's leibnitz's equality".
+theorem a:0=0.
+
+(* nota *)
+(**
+
+
+apply Prop.
+*)
+apply cic:/Coq/Init/Logic/eq.ind#xpointer(1/1/1).
+
+(* commenti che non devono essere colorati perche'
+ non c'e' nulla di eseguibile dopo di loro
+*)
+qed.
diff --git a/helm/matita/tests/third.ma b/helm/matita/tests/third.ma
new file mode 100644
index 000000000..124cdc121
--- /dev/null
+++ b/helm/matita/tests/third.ma
@@ -0,0 +1,24 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/tests/third/".
+alias id "nat" = "cic:/matita/tests/first/nat.ind#xpointer(1/1)".
+alias id "O" = "cic:/matita/tests/first/nat.ind#xpointer(1/1/1)".
+alias id "eq" = "cic:/matita/tests/first/eq.ind#xpointer(1/1)".
+alias id "ultrastupid" = "cic:/matita/tests/second/ultrastupid.con".
+
+theorem iperstupid : eq nat O O.
+exact ultrastupid.
+qed.
+
diff --git a/helm/matita/tests/unfold.ma b/helm/matita/tests/unfold.ma
new file mode 100644
index 000000000..99f3931c2
--- /dev/null
+++ b/helm/matita/tests/unfold.ma
@@ -0,0 +1,41 @@
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+set "baseuri" "cic:/matita/unfold".
+
+include "legacy/coq.ma".
+
+alias symbol "plus" (instance 0) = "Coq's natural plus".
+definition myplus \def \lambda x,y. x+y.
+
+alias id "S" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1/2)".
+lemma lem: \forall n. S (n + n) = (S n) + n.
+ intro; reflexivity.
+qed.
+
+theorem trivial: \forall n. S (myplus n n) = myplus (S n) n.
+ unfold myplus in \vdash (\forall _.(? ? ? %)).
+ intro.
+ unfold myplus.
+ rewrite > lem.
+ reflexivity.
+qed.
+
+(* This test needs to parse "uno" in the context of the hypothesis H,
+ not in the context of the goal. *)
+alias id "O" = "cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1/1)".
+theorem t: let uno \def S O in uno + uno = S uno \to uno=uno.
+ intros. unfold uno in H.
+ reflexivity.
+qed.
diff --git a/helm/ocaml/METAS/meta.helm-acic_content.src b/helm/ocaml/METAS/meta.helm-acic_content.src
new file mode 100644
index 000000000..2ffa1551b
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-acic_content.src
@@ -0,0 +1,4 @@
+requires="helm-cic_acic"
+version="0.0.1"
+archive(byte)="acic_content.cma"
+archive(native)="acic_content.cmxa"
diff --git a/helm/ocaml/METAS/meta.helm-cic.src b/helm/ocaml/METAS/meta.helm-cic.src
new file mode 100644
index 000000000..525cc9c22
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-cic.src
@@ -0,0 +1,5 @@
+requires="helm-urimanager helm-xml expat"
+version="0.0.1"
+archive(byte)="cic.cma"
+archive(native)="cic.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-cic_acic.src b/helm/ocaml/METAS/meta.helm-cic_acic.src
new file mode 100644
index 000000000..51afe1bda
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-cic_acic.src
@@ -0,0 +1,4 @@
+requires="helm-cic_proof_checking"
+version="0.0.1"
+archive(byte)="cic_acic.cma"
+archive(native)="cic_acic.cmxa"
diff --git a/helm/ocaml/METAS/meta.helm-cic_annotations.src b/helm/ocaml/METAS/meta.helm-cic_annotations.src
new file mode 100644
index 000000000..829efba0d
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-cic_annotations.src
@@ -0,0 +1,5 @@
+requires="helm-cic helm-xml"
+version="0.0.1"
+archive(byte)="cic_annotations.cma"
+archive(native)="cic_annotations.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-cic_annotations_cache.src b/helm/ocaml/METAS/meta.helm-cic_annotations_cache.src
new file mode 100644
index 000000000..f21ea6d02
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-cic_annotations_cache.src
@@ -0,0 +1,5 @@
+requires="helm-cic_annotations helm-getter"
+version="0.0.1"
+archive(byte)="cic_annotations_cache.cma"
+archive(native)="cic_annotations_cache.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-cic_cache.src b/helm/ocaml/METAS/meta.helm-cic_cache.src
new file mode 100644
index 000000000..6aacb1ae2
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-cic_cache.src
@@ -0,0 +1,5 @@
+requires="helm-cic helm-getter"
+version="0.0.1"
+archive(byte)="cic_cache.cma"
+archive(native)="cic_cache.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-cic_disambiguation.src b/helm/ocaml/METAS/meta.helm-cic_disambiguation.src
new file mode 100644
index 000000000..d2e467aae
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-cic_disambiguation.src
@@ -0,0 +1,4 @@
+requires="helm-whelp helm-acic_content helm-cic_unification"
+version="0.0.1"
+archive(byte)="cic_disambiguation.cma"
+archive(native)="cic_disambiguation.cmxa"
diff --git a/helm/ocaml/METAS/meta.helm-cic_proof_checking.src b/helm/ocaml/METAS/meta.helm-cic_proof_checking.src
new file mode 100644
index 000000000..223a182a9
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-cic_proof_checking.src
@@ -0,0 +1,7 @@
+requires="helm-cic helm-logger helm-getter"
+version="0.0.1"
+archive(byte)="cic_proof_checking.cma"
+archive(native)="cic_proof_checking.cmxa"
+archive(byte,miniReduction)="cicSubstitution.cmo cicMiniReduction.cmo"
+archive(native,miniReduction)="cicSubstitution.cmx cicMiniReduction.cmx"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-cic_textual_parser.src b/helm/ocaml/METAS/meta.helm-cic_textual_parser.src
new file mode 100644
index 000000000..bc4f2fcd4
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-cic_textual_parser.src
@@ -0,0 +1,5 @@
+requires="helm-cic"
+version="0.0.1"
+archive(byte)="cic_textual_parser.cma"
+archive(native)="cic_textual_parser.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-cic_unification.src b/helm/ocaml/METAS/meta.helm-cic_unification.src
new file mode 100644
index 000000000..75e2d4d31
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-cic_unification.src
@@ -0,0 +1,5 @@
+requires="helm-cic_proof_checking helm-library"
+version="0.0.1"
+archive(byte)="cic_unification.cma"
+archive(native)="cic_unification.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-content_pres.src b/helm/ocaml/METAS/meta.helm-content_pres.src
new file mode 100644
index 000000000..cd3d36854
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-content_pres.src
@@ -0,0 +1,4 @@
+requires="helm-acic_content helm-utf8_macros camlp4.gramlib ulex"
+version="0.0.1"
+archive(byte)="content_pres.cma"
+archive(native)="content_pres.cmxa"
diff --git a/helm/ocaml/METAS/meta.helm-extlib.src b/helm/ocaml/METAS/meta.helm-extlib.src
new file mode 100644
index 000000000..bfee89e3d
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-extlib.src
@@ -0,0 +1,5 @@
+requires="unix camlp4.gramlib"
+version="0.0.1"
+archive(byte)="extlib.cma"
+archive(native)="extlib.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-getter.src b/helm/ocaml/METAS/meta.helm-getter.src
new file mode 100644
index 000000000..8a7badf74
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-getter.src
@@ -0,0 +1,5 @@
+requires="http unix pcre zip helm-xml helm-logger helm-urimanager helm-registry"
+version="0.0.1"
+archive(byte)="getter.cma"
+archive(native)="getter.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-grafite.src b/helm/ocaml/METAS/meta.helm-grafite.src
new file mode 100644
index 000000000..0ae4a09d3
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-grafite.src
@@ -0,0 +1,4 @@
+requires="helm-cic"
+version="0.0.1"
+archive(byte)="grafite.cma"
+archive(native)="grafite.cmxa"
diff --git a/helm/ocaml/METAS/meta.helm-grafite_engine.src b/helm/ocaml/METAS/meta.helm-grafite_engine.src
new file mode 100644
index 000000000..c7203724c
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-grafite_engine.src
@@ -0,0 +1,5 @@
+requires="helm-library helm-grafite helm-tactics"
+version="0.0.1"
+archive(byte)="grafite_engine.cma"
+archive(native)="grafite_engine.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-grafite_parser.src b/helm/ocaml/METAS/meta.helm-grafite_parser.src
new file mode 100644
index 000000000..d921b5588
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-grafite_parser.src
@@ -0,0 +1,5 @@
+requires="helm-lexicon helm-grafite ulex"
+version="0.0.1"
+archive(byte)="grafite_parser.cma"
+archive(native)="grafite_parser.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-hbugs.src b/helm/ocaml/METAS/meta.helm-hbugs.src
new file mode 100644
index 000000000..3c79fd96f
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-hbugs.src
@@ -0,0 +1,4 @@
+requires="pcre http lablgtk2.glade helm-thread helm-xml helm-pxp helm-tactics"
+version="0.0.1"
+archive(byte)="hbugs.cma"
+archive(native)="hbugs.cmxa"
diff --git a/helm/ocaml/METAS/meta.helm-hgdome.src b/helm/ocaml/METAS/meta.helm-hgdome.src
new file mode 100644
index 000000000..d06666f43
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-hgdome.src
@@ -0,0 +1,4 @@
+requires="helm-xml gdome2"
+version="0.0.1"
+archive(byte)="hgdome.cma"
+archive(native)="hgdome.cmxa"
diff --git a/helm/ocaml/METAS/meta.helm-hmysql.src b/helm/ocaml/METAS/meta.helm-hmysql.src
new file mode 100644
index 000000000..144141e28
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-hmysql.src
@@ -0,0 +1,4 @@
+requires="helm-registry mysql helm-extlib"
+version="0.0.1"
+archive(byte)="hmysql.cma"
+archive(native)="hmysql.cmxa"
diff --git a/helm/ocaml/METAS/meta.helm-lexicon.src b/helm/ocaml/METAS/meta.helm-lexicon.src
new file mode 100644
index 000000000..35ab5dd36
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-lexicon.src
@@ -0,0 +1,4 @@
+requires="helm-content_pres helm-cic_disambiguation camlp4.gramlib"
+version="0.0.1"
+archive(byte)="lexicon.cma"
+archive(native)="lexicon.cmxa"
diff --git a/helm/ocaml/METAS/meta.helm-library.src b/helm/ocaml/METAS/meta.helm-library.src
new file mode 100644
index 000000000..d4955e05d
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-library.src
@@ -0,0 +1,5 @@
+requires="helm-cic_acic helm-metadata"
+version="0.0.1"
+archive(byte)="library.cma"
+archive(native)="library.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-logger.src b/helm/ocaml/METAS/meta.helm-logger.src
new file mode 100644
index 000000000..5b2e8d8ff
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-logger.src
@@ -0,0 +1,5 @@
+requires=""
+version="0.0.1"
+archive(byte)="logger.cma"
+archive(native)="logger.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-mathql.src b/helm/ocaml/METAS/meta.helm-mathql.src
new file mode 100644
index 000000000..df553d7d5
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-mathql.src
@@ -0,0 +1,5 @@
+requires="helm-urimanager"
+version="1.3"
+archive(byte)="mathql.cma"
+archive(native)="mathql.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-mathql_generator.src b/helm/ocaml/METAS/meta.helm-mathql_generator.src
new file mode 100644
index 000000000..c4168201b
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-mathql_generator.src
@@ -0,0 +1,5 @@
+requires="helm-cic helm-cic_proof_checking helm-mathql"
+version="1.3"
+archive(byte)="mathql_generator.cma"
+archive(native)="mathql_generator.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-mathql_interpreter.src b/helm/ocaml/METAS/meta.helm-mathql_interpreter.src
new file mode 100644
index 000000000..42275abf6
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-mathql_interpreter.src
@@ -0,0 +1,6 @@
+requires="helm-cic postgres mysql helm-mathql helm-registry"
+#natile-galax
+version="1.3"
+archive(byte)="mathql_interpreter.cma"
+archive(native)="mathql_interpreter.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-metadata.src b/helm/ocaml/METAS/meta.helm-metadata.src
new file mode 100644
index 000000000..a5b138301
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-metadata.src
@@ -0,0 +1,4 @@
+requires="helm-hmysql helm-cic_proof_checking"
+version="0.0.1"
+archive(byte)="metadata.cma"
+archive(native)="metadata.cmxa"
diff --git a/helm/ocaml/METAS/meta.helm-paramodulation.src b/helm/ocaml/METAS/meta.helm-paramodulation.src
new file mode 100644
index 000000000..34a25fef0
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-paramodulation.src
@@ -0,0 +1,5 @@
+requires="helm-registry helm-tactics"
+version="0.0.1"
+archive(byte)="paramodulation.cma"
+archive(native)="paramodulation.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-pxp.src b/helm/ocaml/METAS/meta.helm-pxp.src
new file mode 100644
index 000000000..6949a5712
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-pxp.src
@@ -0,0 +1,5 @@
+requires="pxp-engine pxp-lex-utf8 pxp-lex-iso88591 pxp-lex-iso885915 http"
+version="0.0.1"
+archive(byte)="pxp.cma"
+archive(native)="pxp.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-registry.src b/helm/ocaml/METAS/meta.helm-registry.src
new file mode 100644
index 000000000..82d364016
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-registry.src
@@ -0,0 +1,4 @@
+requires="str netstring helm-xml"
+version="0.0.1"
+archive(byte)="registry.cma"
+archive(native)="registry.cmxa"
diff --git a/helm/ocaml/METAS/meta.helm-tactics.src b/helm/ocaml/METAS/meta.helm-tactics.src
new file mode 100644
index 000000000..6e704ba06
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-tactics.src
@@ -0,0 +1,4 @@
+requires="helm-cic_proof_checking helm-cic_unification helm-whelp"
+version="0.0.1"
+archive(byte)="tactics.cma"
+archive(native)="tactics.cmxa"
diff --git a/helm/ocaml/METAS/meta.helm-tex_cic_textual_parser.src b/helm/ocaml/METAS/meta.helm-tex_cic_textual_parser.src
new file mode 100644
index 000000000..dec21eebd
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-tex_cic_textual_parser.src
@@ -0,0 +1,5 @@
+requires="helm-cic"
+version="0.0.1"
+archive(byte)="tex_cic_textual_parser.cma"
+archive(native)="tex_cic_textual_parser.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-thread.src b/helm/ocaml/METAS/meta.helm-thread.src
new file mode 100644
index 000000000..5253060d2
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-thread.src
@@ -0,0 +1,7 @@
+requires=""
+version="0.0.1"
+archive(byte,mt)="thread.cma"
+archive(native,mt)="thread.cmxa"
+archive(byte)="thread_fake.cma"
+archive(native)="thread_fake.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-urimanager.src b/helm/ocaml/METAS/meta.helm-urimanager.src
new file mode 100644
index 000000000..ff1874688
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-urimanager.src
@@ -0,0 +1,5 @@
+requires="str"
+version="0.0.1"
+archive(byte)="urimanager.cma"
+archive(native)="urimanager.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-utf8_macros.src b/helm/ocaml/METAS/meta.helm-utf8_macros.src
new file mode 100644
index 000000000..c2da77649
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-utf8_macros.src
@@ -0,0 +1,7 @@
+requires=""
+version="0.0.1"
+archive(byte)="utf8_macros.cma"
+archive(native)="utf8_macros.cmxa"
+requires(syntax,preprocessor)="camlp4"
+archive(syntax,preprocessor)="pa_extend.cmo pa_unicode_macro.cma"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-whelp.src b/helm/ocaml/METAS/meta.helm-whelp.src
new file mode 100644
index 000000000..20ea84329
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-whelp.src
@@ -0,0 +1,4 @@
+requires="helm-metadata"
+version="0.0.1"
+archive(byte)="whelp.cma"
+archive(native)="whelp.cmxa"
diff --git a/helm/ocaml/METAS/meta.helm-xml.src b/helm/ocaml/METAS/meta.helm-xml.src
new file mode 100644
index 000000000..626e644fc
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-xml.src
@@ -0,0 +1,5 @@
+requires="zip expat helm-extlib"
+version="0.0.1"
+archive(byte)="xml.cma"
+archive(native)="xml.cmxa"
+linkopts=""
diff --git a/helm/ocaml/METAS/meta.helm-xmldiff.src b/helm/ocaml/METAS/meta.helm-xmldiff.src
new file mode 100644
index 000000000..9cc918307
--- /dev/null
+++ b/helm/ocaml/METAS/meta.helm-xmldiff.src
@@ -0,0 +1,4 @@
+requires="gdome2"
+version="0.0.1"
+archive(byte)="xmldiff.cma"
+archive(native)="xmldiff.cmxa"
diff --git a/helm/ocaml/Makefile.common.in b/helm/ocaml/Makefile.common.in
new file mode 100644
index 000000000..af5ecab86
--- /dev/null
+++ b/helm/ocaml/Makefile.common.in
@@ -0,0 +1,124 @@
+# This Makefile must be included by another one defining:
+# $PACKAGE
+# $PREDICATES
+# $INTERFACE_FILES
+# $IMPLEMENTATION_FILES
+# $EXTRA_OBJECTS_TO_INSTALL
+# $EXTRA_OBJECTS_TO_CLEAN
+# and put in a directory where there is a .depend file.
+
+OCAMLFIND_DEST_DIR = @OCAMLFIND_DEST_DIR@
+OCAMLPATH = @OCAMLFIND_META_DIR@
+
+PREPROCOPTIONS = -pp camlp4o
+SYNTAXOPTIONS = -syntax camlp4o
+PREREQ =
+OCAMLOPTIONS = -package "$(REQUIRES)" -predicates "$(PREDICATES)" -thread
+OCAMLDEBUGOPTIONS = -g
+OCAMLARCHIVEOPTIONS =
+OCAMLFIND = OCAMLPATH=$(OCAMLPATH):$$OCAMLPATH @OCAMLFIND@
+REQUIRES := $(shell $(OCAMLFIND) -query -format '%(requires)' helm-$(PACKAGE))
+OCAMLC = $(OCAMLFIND) ocamlc $(OCAMLDEBUGOPTIONS) $(OCAMLOPTIONS) $(PREPROCOPTIONS)
+OCAMLOPT = $(OCAMLFIND) opt $(OCAMLOPTIONS) $(PREPROCOPTIONS)
+OCAMLDEP = $(OCAMLFIND) ocamldep -package "camlp4,$(REQUIRES)" $(SYNTAXOPTIONS)
+OCAMLLEX = ocamllex
+OCAMLYACC = ocamlyacc
+
+OCAMLC_P4 = $(OCAMLFIND) ocamlc $(OCAMLDEBUGOPTIONS) $(OCAMLOPTIONS) $(SYNTAXOPTIONS)
+OCAMLOPT_P4 = $(OCAMLFIND) opt $(OCAMLOPTIONS) $(SYNTAXOPTIONS)
+
+LIBRARIES = $(shell $(OCAMLFIND) query -recursive -predicates "byte $(PREDICATES)" -format "%d/%a" $(REQUIRES))
+LIBRARIES_OPT = $(shell $(OCAMLFIND) query -recursive -predicates "native $(PREDICATES)" -format "%d/%a" $(REQUIRES))
+
+
+ARCHIVE = $(PACKAGE).cma
+ARCHIVE_OPT = $(PACKAGE).cmxa
+OBJECTS_TO_INSTALL = $(ARCHIVE) $(ARCHIVE_OPT) $(ARCHIVE_OPT:%.cmxa=%.a) \
+ $(INTERFACE_FILES) $(INTERFACE_FILES:%.mli=%.cmi) \
+ $(EXTRA_OBJECTS_TO_INSTALL)
+DEPEND_FILES = $(INTERFACE_FILES) $(IMPLEMENTATION_FILES)
+
+$(ARCHIVE): $(IMPLEMENTATION_FILES:%.ml=%.cmo) $(LIBRARIES)
+ $(OCAMLC) $(OCAMLARCHIVEOPTIONS) -a -o $@ \
+ $(IMPLEMENTATION_FILES:%.ml=%.cmo)
+
+$(ARCHIVE_OPT): $(IMPLEMENTATION_FILES:%.ml=%.cmx) $(LIBRARIES_OPT)
+ $(OCAMLOPT) $(OCAMLARCHIVEOPTIONS) -a -o $@ \
+ $(IMPLEMENTATION_FILES:%.ml=%.cmx)
+
+prereq: $(PREREQ)
+all: prereq $(IMPLEMENTATION_FILES:%.ml=%.cmo) $(ARCHIVE)
+opt: prereq $(IMPLEMENTATION_FILES:%.ml=%.cmx) $(ARCHIVE_OPT)
+world: all opt
+test: test.ml $(ARCHIVE)
+ $(OCAMLC) $(ARCHIVE) -linkpkg -o $@ $<
+test.opt: test.ml $(ARCHIVE_OPT)
+ $(OCAMLOPT) $(ARCHIVE_OPT) -linkpkg -o $@ $<
+
+depend: $(DEPEND_FILES)
+ $(OCAMLDEP) $(INTERFACE_FILES) $(IMPLEMENTATION_FILES) > .depend
+
+$(PACKAGE).ps: .dep.dot
+ dot -Tps -o $@ $<
+
+.dep.dot: .depend
+ ocamldot < .depend > $@
+
+%.cmi: %.mli
+ $(OCAMLC) -c $<
+%.cmo %.cmi: %.ml
+ $(OCAMLC) -c $<
+%.cmx: %.ml
+ $(OCAMLOPT) -c $<
+%.annot: %.ml
+ $(OCAMLC) -dtypes $(PKGS) -c $<
+%.ml %.mli: %.mly
+ $(OCAMLYACC) $<
+%.ml: %.mll
+ $(OCAMLLEX) $<
+
+$(IMPLEMENTATION_FILES:%.ml=%.cmo): $(LIBRARIES)
+$(IMPLEMENTATION_FILES:%.ml=%.cmx): $(LIBRARIES_OPT)
+
+clean:
+ rm -f *.cm[ioax] *.cmxa *.o *.a *.annot $(EXTRA_OBJECTS_TO_CLEAN)
+ if [ -f test ]; then rm -f test; else true; fi
+ if [ -f test.opt ]; then rm -f test.opt; else true; fi
+
+install:
+ mkdir $(OCAMLFIND_DEST_DIR)/$(PACKAGE)
+ cp $(OBJECTS_TO_INSTALL) $(OCAMLFIND_DEST_DIR)/$(PACKAGE)
+
+uninstall:
+ cd $(OCAMLFIND_DEST_DIR)/$(PACKAGE) && rm -f $(OBJECTS_TO_INSTALL)
+ rmdir $(OCAMLFIND_DEST_DIR)/$(PACKAGE)
+
+backup:
+ cd ..; tar cvzf $(PACKAGE)_$(shell date +%s).tar.gz $(PACKAGE)
+
+ocamlinit:
+ echo "#use \"topfind\";;" > .ocamlinit
+ echo "#thread;;" >> .ocamlinit
+ for p in $(REQUIRES); do echo "#require \"$$p\";;" >> .ocamlinit; done
+ echo "#load \"$(PACKAGE).cma\";;" >> .ocamlinit
+
+.PHONY: all opt world backup depend install uninstall clean ocamlinit
+
+ifneq ($(MAKECMDGOALS), depend)
+ include .depend
+endif
+
+ifeq ($(MAKECMDGOALS), all)
+ $(IMPLEMENTATION_FILES:%.ml=%.cmi): $(LIBRARIES)
+endif
+
+ifeq ($(MAKECMDGOALS), opt)
+ $(IMPLEMENTATION_FILES:%.ml=%.cmi): $(LIBRARIES_OPT)
+endif
+
+ifeq ($(MAKECMDGOALS),)
+ $(IMPLEMENTATION_FILES:%.ml=%.cmi): $(LIBRARIES)
+endif
+
+NULL =
+
diff --git a/helm/ocaml/Makefile.in b/helm/ocaml/Makefile.in
new file mode 100644
index 000000000..0c2d49411
--- /dev/null
+++ b/helm/ocaml/Makefile.in
@@ -0,0 +1,111 @@
+# Warning: the modules must be in compilation order
+NULL =
+MODULES = \
+ extlib \
+ xml \
+ hgdome \
+ registry \
+ hmysql \
+ utf8_macros \
+ thread \
+ xmldiff \
+ urimanager \
+ logger \
+ getter \
+ cic \
+ cic_proof_checking \
+ cic_acic \
+ acic_content \
+ content_pres \
+ grafite \
+ metadata \
+ library \
+ cic_unification \
+ whelp \
+ tactics \
+ paramodulation \
+ cic_disambiguation \
+ lexicon \
+ grafite_engine \
+ grafite_parser \
+ $(NULL)
+
+OCAMLFIND_DEST_DIR = @OCAMLFIND_DEST_DIR@
+OCAMLPATH = @OCAMLFIND_META_DIR@
+OCAMLFIND = OCAMLPATH=$(OCAMLPATH):$$OCAMLPATH @OCAMLFIND@
+
+METAS = $(MODULES:%=METAS/META.helm-%) METAS/META.helm-cic_disambiguation
+
+all: metas $(MODULES:%=%.all)
+opt: metas $(MODULES:%=%.opt)
+world: all opt
+metas: $(METAS)
+depend: $(MODULES:%=%.depend)
+install: $(MODULES:%=%.install)
+uninstall: $(MODULES:%=%.uninstall)
+clean: $(MODULES:%=%.clean)
+clean_metas:
+ rm -f $(METAS)
+distclean: clean clean_metas
+ rm -f Makefile Makefile.common configure config.log config.cache config.status
+
+.PHONY: all opt world metas depend install uninstall clean clean_metas distclean
+
+%.all:
+ OCAMLPATH=$(OCAMLPATH):$$OCAMLPATH $(MAKE) -C $* all
+%.opt:
+ OCAMLPATH=$(OCAMLPATH):$$OCAMLPATH $(MAKE) -C $* opt
+%.clean:
+ OCAMLPATH=$(OCAMLPATH):$$OCAMLPATH $(MAKE) -C $* clean
+%.depend:
+ OCAMLPATH=$(OCAMLPATH):$$OCAMLPATH $(MAKE) -C $* depend
+
+$(MODULES:%=%.install):
+ cd $(@:%.install=%) && make install
+ export TARGET=$(OCAMLFIND_META_DIR)/$(@:%.install=META.helm-%) ; \
+ cp METAS/$(@:%.install=meta.helm-%.src) $$TARGET && \
+ echo "directory=\"$(OCAMLFIND_DEST_DIR)/$(@:%.install=%)\"" >> $$TARGET
+$(MODULES:%=%.uninstall):
+ cd $(@:%.uninstall=%) && make uninstall
+ rm -f $(OCAMLFIND_META_DIR)/$(@:%.uninstall=META.helm-%)
+METAS/META.helm-%: METAS/meta.helm-%.src
+ cp $< $@ && echo "directory=\"$(shell pwd)/$*\"" >> $@
+
+.PHONY: .dep.dot
+.dep.dot:
+ echo "digraph G {" > $@
+ echo " rankdir = TB ;" >> $@
+ for i in $(MODULES); do $(OCAMLFIND) query helm-$$i -recursive -p-format | grep helm | sed "s/^helm-/ \"$$i\" -> \"/g" | sed "s/$$/\";/g" >> $@ ; done
+ mv $@ $@.old ; ./simplify_deps/simplify_deps.opt < $@.old > $@ ; rm $@.old
+ echo "}" >> $@
+
+.PHONY: .alldep.dot
+.alldep.dot:
+ echo "digraph G {" > $@
+ echo " rankdir = TB ;" >> $@
+ for i in $(MODULES); do $(OCAMLFIND) query helm-$$i -recursive -p-format | grep -v "pxp-" | sed "s/^pxp/pxp[-*]/g" | sed "s/^/ \"helm-$$i\" -> \"/g" | sed "s/$$/\";/g" >> $@ ; done
+ mv $@ $@.old ; ./simplify_deps/simplify_deps.opt < $@.old > $@ ; rm $@.old
+ for i in $(MODULES); do echo "\"helm-$$i\" [shape=box,style=filled,fillcolor=yellow];" >> $@ ; done
+ echo "}" >> $@
+
+.extdep.dot: .dep.dot
+ ./patch_deps.sh $< $@
+.clustersdep.dot: .dep.dot
+ USE_CLUSTERS=yes ./patch_deps.sh $< $@
+
+libraries.ps: .dep.dot
+ dot -Tps -o $@ $<
+libraries-ext.ps: .extdep.dot
+ dot -Tps -o $@ $<
+libraries-clusters.ps: .clustersdep.dot
+ dot -Tps -o $@ $<
+libraries-complete.ps: .alldep.dot
+ dot -Tps -o $@ $<
+
+ps: libraries.ps libraries-ext.ps libraries-clusters.ps
+
+tags: TAGS
+.PHONY: TAGS
+TAGS:
+ otags -vi -r .
+
diff --git a/helm/ocaml/TODO b/helm/ocaml/TODO
new file mode 100644
index 000000000..e69de29bb
diff --git a/helm/ocaml/acic_content/.depend b/helm/ocaml/acic_content/.depend
new file mode 100644
index 000000000..f6399321e
--- /dev/null
+++ b/helm/ocaml/acic_content/.depend
@@ -0,0 +1,30 @@
+contentPp.cmi: content.cmi
+acic2content.cmi: content.cmi
+content2cic.cmi: content.cmi
+cicNotationUtil.cmi: cicNotationPt.cmo
+cicNotationEnv.cmi: cicNotationPt.cmo
+cicNotationPp.cmi: cicNotationPt.cmo cicNotationEnv.cmi
+acic2astMatcher.cmi: cicNotationPt.cmo
+termAcicContent.cmi: cicNotationPt.cmo
+content.cmo: content.cmi
+content.cmx: content.cmi
+contentPp.cmo: content.cmi contentPp.cmi
+contentPp.cmx: content.cmx contentPp.cmi
+acic2content.cmo: content.cmi acic2content.cmi
+acic2content.cmx: content.cmx acic2content.cmi
+content2cic.cmo: content.cmi content2cic.cmi
+content2cic.cmx: content.cmx content2cic.cmi
+cicNotationUtil.cmo: cicNotationPt.cmo cicNotationUtil.cmi
+cicNotationUtil.cmx: cicNotationPt.cmx cicNotationUtil.cmi
+cicNotationEnv.cmo: cicNotationUtil.cmi cicNotationPt.cmo cicNotationEnv.cmi
+cicNotationEnv.cmx: cicNotationUtil.cmx cicNotationPt.cmx cicNotationEnv.cmi
+cicNotationPp.cmo: cicNotationPt.cmo cicNotationEnv.cmi cicNotationPp.cmi
+cicNotationPp.cmx: cicNotationPt.cmx cicNotationEnv.cmx cicNotationPp.cmi
+acic2astMatcher.cmo: cicNotationUtil.cmi cicNotationPt.cmo cicNotationPp.cmi \
+ acic2astMatcher.cmi
+acic2astMatcher.cmx: cicNotationUtil.cmx cicNotationPt.cmx cicNotationPp.cmx \
+ acic2astMatcher.cmi
+termAcicContent.cmo: cicNotationUtil.cmi cicNotationPt.cmo cicNotationPp.cmi \
+ acic2astMatcher.cmi termAcicContent.cmi
+termAcicContent.cmx: cicNotationUtil.cmx cicNotationPt.cmx cicNotationPp.cmx \
+ acic2astMatcher.cmx termAcicContent.cmi
diff --git a/helm/ocaml/acic_content/Makefile b/helm/ocaml/acic_content/Makefile
new file mode 100644
index 000000000..cc4da3781
--- /dev/null
+++ b/helm/ocaml/acic_content/Makefile
@@ -0,0 +1,19 @@
+PACKAGE = acic_content
+PREDICATES =
+
+INTERFACE_FILES = \
+ content.mli \
+ contentPp.mli \
+ acic2content.mli \
+ content2cic.mli \
+ cicNotationUtil.mli \
+ cicNotationEnv.mli \
+ cicNotationPp.mli \
+ acic2astMatcher.mli \
+ termAcicContent.mli \
+ $(NULL)
+IMPLEMENTATION_FILES = \
+ cicNotationPt.ml \
+ $(INTERFACE_FILES:%.mli=%.ml)
+
+include ../Makefile.common
diff --git a/helm/ocaml/acic_content/acic2astMatcher.ml b/helm/ocaml/acic_content/acic2astMatcher.ml
new file mode 100644
index 000000000..d62786cc7
--- /dev/null
+++ b/helm/ocaml/acic_content/acic2astMatcher.ml
@@ -0,0 +1,98 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+module Ast = CicNotationPt
+module Util = CicNotationUtil
+
+module Matcher32 =
+struct
+ module Pattern32 =
+ struct
+ type cic_mask_t =
+ Blob
+ | Uri of UriManager.uri
+ | Appl of cic_mask_t list
+
+ let uri_of_term t = CicUtil.uri_of_term (Deannotate.deannotate_term t)
+
+ let mask_of_cic = function
+ | Cic.AAppl (_, tl) -> Appl (List.map (fun _ -> Blob) tl), tl
+ | Cic.AConst (_, _, [])
+ | Cic.AVar (_, _, [])
+ | Cic.AMutInd (_, _, _, [])
+ | Cic.AMutConstruct (_, _, _, _, []) as t -> Uri (uri_of_term t), []
+ | _ -> Blob, []
+
+ let tag_of_term t =
+ let mask, tl = mask_of_cic t in
+ Hashtbl.hash mask, tl
+
+ let mask_of_appl_pattern = function
+ | Ast.UriPattern uri -> Uri uri, []
+ | Ast.ImplicitPattern
+ | Ast.VarPattern _ -> Blob, []
+ | Ast.ApplPattern pl -> Appl (List.map (fun _ -> Blob) pl), pl
+
+ let tag_of_pattern p =
+ let mask, pl = mask_of_appl_pattern p in
+ Hashtbl.hash mask, pl
+
+ type pattern_t = Ast.cic_appl_pattern
+ type term_t = Cic.annterm
+
+ let string_of_pattern = CicNotationPp.pp_cic_appl_pattern
+ let string_of_term t = CicPp.ppterm (Deannotate.deannotate_term t)
+
+ let classify = function
+ | Ast.ImplicitPattern
+ | Ast.VarPattern _ -> PatternMatcher.Variable
+ | Ast.UriPattern _
+ | Ast.ApplPattern _ -> PatternMatcher.Constructor
+ end
+
+ module M = PatternMatcher.Matcher (Pattern32)
+
+ let compiler rows =
+ let match_cb rows =
+ let pl, pid = try List.hd rows with Not_found -> assert false in
+ (fun matched_terms constructors ->
+ let env =
+ try
+ List.map2
+ (fun p t ->
+ match p with
+ | Ast.ImplicitPattern -> Util.fresh_name (), t
+ | Ast.VarPattern name -> name, t
+ | _ -> assert false)
+ pl matched_terms
+ with Invalid_argument _ -> assert false
+ in
+ Some (env, constructors, pid))
+ in
+ M.compiler rows match_cb (fun () -> None)
+end
+
diff --git a/helm/ocaml/acic_content/acic2astMatcher.mli b/helm/ocaml/acic_content/acic2astMatcher.mli
new file mode 100644
index 000000000..0a9ec6a6b
--- /dev/null
+++ b/helm/ocaml/acic_content/acic2astMatcher.mli
@@ -0,0 +1,34 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+module Matcher32:
+sig
+ (** @param l3_patterns level 3 (CIC) patterns (AKA cic_appl_pattern) *)
+ val compiler :
+ (CicNotationPt.cic_appl_pattern * int) list ->
+ (Cic.annterm ->
+ ((string * Cic.annterm) list * Cic.annterm list * int) option)
+end
+
diff --git a/helm/ocaml/acic_content/acic2content.ml b/helm/ocaml/acic_content/acic2content.ml
new file mode 100644
index 000000000..8f3b13cfd
--- /dev/null
+++ b/helm/ocaml/acic_content/acic2content.ml
@@ -0,0 +1,994 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(**************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Andrea Asperti <asperti@cs.unibo.it> *)
+(* 16/6/2003 *)
+(* *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+let object_prefix = "obj:";;
+let declaration_prefix = "decl:";;
+let definition_prefix = "def:";;
+let inductive_prefix = "ind:";;
+let joint_prefix = "joint:";;
+let proof_prefix = "proof:";;
+let conclude_prefix = "concl:";;
+let premise_prefix = "prem:";;
+let lemma_prefix = "lemma:";;
+
+(* e se mettessi la conversione di BY nell'apply_context ? *)
+(* sarebbe carino avere l'invariante che la proof2pres
+generasse sempre prove con contesto vuoto *)
+
+let gen_id prefix seed =
+ let res = prefix ^ string_of_int !seed in
+ incr seed ;
+ res
+;;
+
+let name_of = function
+ Cic.Anonymous -> None
+ | Cic.Name b -> Some b;;
+
+exception Not_a_proof;;
+exception NotImplemented;;
+exception NotApplicable;;
+
+(* we do not care for positivity, here, that in any case is enforced by
+ well typing. Just a brutal search *)
+
+let rec occur uri =
+ let module C = Cic in
+ function
+ C.Rel _ -> false
+ | C.Var _ -> false
+ | C.Meta _ -> false
+ | C.Sort _ -> false
+ | C.Implicit _ -> assert false
+ | C.Prod (_,s,t) -> (occur uri s) or (occur uri t)
+ | C.Cast (te,ty) -> (occur uri te)
+ | C.Lambda (_,s,t) -> (occur uri s) or (occur uri t) (* or false ?? *)
+ | C.LetIn (_,s,t) -> (occur uri s) or (occur uri t)
+ | C.Appl l ->
+ List.fold_left
+ (fun b a ->
+ if b then b
+ else (occur uri a)) false l
+ | C.Const (_,_) -> false
+ | C.MutInd (uri1,_,_) -> if uri = uri1 then true else false
+ | C.MutConstruct (_,_,_,_) -> false
+ | C.MutCase _ -> false (* presuming too much?? *)
+ | C.Fix _ -> false (* presuming too much?? *)
+ | C.CoFix (_,_) -> false (* presuming too much?? *)
+;;
+
+let get_id =
+ let module C = Cic in
+ function
+ C.ARel (id,_,_,_) -> id
+ | C.AVar (id,_,_) -> id
+ | C.AMeta (id,_,_) -> id
+ | C.ASort (id,_) -> id
+ | C.AImplicit _ -> raise NotImplemented
+ | C.AProd (id,_,_,_) -> id
+ | C.ACast (id,_,_) -> id
+ | C.ALambda (id,_,_,_) -> id
+ | C.ALetIn (id,_,_,_) -> id
+ | C.AAppl (id,_) -> id
+ | C.AConst (id,_,_) -> id
+ | C.AMutInd (id,_,_,_) -> id
+ | C.AMutConstruct (id,_,_,_,_) -> id
+ | C.AMutCase (id,_,_,_,_,_) -> id
+ | C.AFix (id,_,_) -> id
+ | C.ACoFix (id,_,_) -> id
+;;
+
+let test_for_lifting ~ids_to_inner_types ~ids_to_inner_sorts=
+ let module C = Cic in
+ let module C2A = Cic2acic in
+ (* atomic terms are never lifted, according to my policy *)
+ function
+ C.ARel (id,_,_,_) -> false
+ | C.AVar (id,_,_) ->
+ (try
+ ignore (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized;
+ true;
+ with Not_found -> false)
+ | C.AMeta (id,_,_) ->
+ (try
+ Hashtbl.find ids_to_inner_sorts id = `Prop
+ with Not_found -> assert false)
+ | C.ASort (id,_) -> false
+ | C.AImplicit _ -> raise NotImplemented
+ | C.AProd (id,_,_,_) -> false
+ | C.ACast (id,_,_) ->
+ (try
+ ignore (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized;
+ true;
+ with Not_found -> false)
+ | C.ALambda (id,_,_,_) ->
+ (try
+ ignore (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized;
+ true;
+ with Not_found -> false)
+ | C.ALetIn (id,_,_,_) ->
+ (try
+ ignore (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized;
+ true;
+ with Not_found -> false)
+ | C.AAppl (id,_) ->
+ (try
+ ignore (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized;
+ true;
+ with Not_found -> false)
+ | C.AConst (id,_,_) ->
+ (try
+ ignore (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized;
+ true;
+ with Not_found -> false)
+ | C.AMutInd (id,_,_,_) -> false
+ | C.AMutConstruct (id,_,_,_,_) ->
+ (try
+ ignore (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized;
+ true;
+ with Not_found -> false)
+ (* oppure: false *)
+ | C.AMutCase (id,_,_,_,_,_) ->
+ (try
+ ignore (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized;
+ true;
+ with Not_found -> false)
+ | C.AFix (id,_,_) ->
+ (try
+ ignore (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized;
+ true;
+ with Not_found -> false)
+ | C.ACoFix (id,_,_) ->
+ (try
+ ignore (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized;
+ true;
+ with Not_found -> false)
+;;
+
+(* transform a proof p into a proof list, concatenating the last
+conclude element to the apply_context list, in case context is
+empty. Otherwise, it just returns [p] *)
+
+let flat seed p =
+ let module K = Content in
+ if (p.K.proof_context = []) then
+ if p.K.proof_apply_context = [] then [p]
+ else
+ let p1 =
+ { p with
+ K.proof_context = [];
+ K.proof_apply_context = []
+ } in
+ p.K.proof_apply_context@[p1]
+ else
+ [p]
+;;
+
+let rec serialize seed =
+ function
+ [] -> []
+ | a::l -> (flat seed a)@(serialize seed l)
+;;
+
+(* top_down = true if the term is a LAMBDA or a decl *)
+let generate_conversion seed top_down id inner_proof ~ids_to_inner_types =
+ let module C2A = Cic2acic in
+ let module K = Content in
+ let exp = (try ((Hashtbl.find ids_to_inner_types id).C2A.annexpected)
+ with Not_found -> None)
+ in
+ match exp with
+ None -> inner_proof
+ | Some expty ->
+ if inner_proof.K.proof_conclude.K.conclude_method = "Intros+LetTac" then
+ { K.proof_name = inner_proof.K.proof_name;
+ K.proof_id = gen_id proof_prefix seed;
+ K.proof_context = [] ;
+ K.proof_apply_context = [];
+ K.proof_conclude =
+ { K.conclude_id = gen_id conclude_prefix seed;
+ K.conclude_aref = id;
+ K.conclude_method = "TD_Conversion";
+ K.conclude_args =
+ [K.ArgProof {inner_proof with K.proof_name = None}];
+ K.conclude_conclusion = Some expty
+ };
+ }
+ else
+ { K.proof_name = inner_proof.K.proof_name;
+ K.proof_id = gen_id proof_prefix seed;
+ K.proof_context = [] ;
+ K.proof_apply_context = [{inner_proof with K.proof_name = None}];
+ K.proof_conclude =
+ { K.conclude_id = gen_id conclude_prefix seed;
+ K.conclude_aref = id;
+ K.conclude_method = "BU_Conversion";
+ K.conclude_args =
+ [K.Premise
+ { K.premise_id = gen_id premise_prefix seed;
+ K.premise_xref = inner_proof.K.proof_id;
+ K.premise_binder = None;
+ K.premise_n = None
+ }
+ ];
+ K.conclude_conclusion = Some expty
+ };
+ }
+;;
+
+let generate_exact seed t id name ~ids_to_inner_types =
+ let module C2A = Cic2acic in
+ let module K = Content in
+ { K.proof_name = name;
+ K.proof_id = gen_id proof_prefix seed ;
+ K.proof_context = [] ;
+ K.proof_apply_context = [];
+ K.proof_conclude =
+ { K.conclude_id = gen_id conclude_prefix seed;
+ K.conclude_aref = id;
+ K.conclude_method = "Exact";
+ K.conclude_args = [K.Term t];
+ K.conclude_conclusion =
+ try Some (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized
+ with Not_found -> None
+ };
+ }
+;;
+
+let generate_intros_let_tac seed id n s is_intro inner_proof name ~ids_to_inner_types =
+ let module C2A = Cic2acic in
+ let module C = Cic in
+ let module K = Content in
+ { K.proof_name = name;
+ K.proof_id = gen_id proof_prefix seed ;
+ K.proof_context = [] ;
+ K.proof_apply_context = [];
+ K.proof_conclude =
+ { K.conclude_id = gen_id conclude_prefix seed;
+ K.conclude_aref = id;
+ K.conclude_method = "Intros+LetTac";
+ K.conclude_args = [K.ArgProof inner_proof];
+ K.conclude_conclusion =
+ try Some
+ (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized
+ with Not_found ->
+ (match inner_proof.K.proof_conclude.K.conclude_conclusion with
+ None -> None
+ | Some t ->
+ if is_intro then Some (C.AProd ("gen"^id,n,s,t))
+ else Some (C.ALetIn ("gen"^id,n,s,t)))
+ };
+ }
+;;
+
+let build_decl_item seed id n s ~ids_to_inner_sorts =
+ let module K = Content in
+ let sort =
+ try
+ Some (Hashtbl.find ids_to_inner_sorts (Cic2acic.source_id_of_id id))
+ with Not_found -> None
+ in
+ match sort with
+ | Some `Prop ->
+ `Hypothesis
+ { K.dec_name = name_of n;
+ K.dec_id = gen_id declaration_prefix seed;
+ K.dec_inductive = false;
+ K.dec_aref = id;
+ K.dec_type = s
+ }
+ | _ ->
+ `Declaration
+ { K.dec_name = name_of n;
+ K.dec_id = gen_id declaration_prefix seed;
+ K.dec_inductive = false;
+ K.dec_aref = id;
+ K.dec_type = s
+ }
+;;
+
+let rec build_subproofs_and_args seed l ~ids_to_inner_types ~ids_to_inner_sorts =
+ let module C = Cic in
+ let module K = Content in
+ let rec aux =
+ function
+ [] -> [],[]
+ | t::l1 ->
+ let subproofs,args = aux l1 in
+ if (test_for_lifting t ~ids_to_inner_types ~ids_to_inner_sorts) then
+ let new_subproof =
+ acic2content
+ seed ~name:"H" ~ids_to_inner_types ~ids_to_inner_sorts t in
+ let new_arg =
+ K.Premise
+ { K.premise_id = gen_id premise_prefix seed;
+ K.premise_xref = new_subproof.K.proof_id;
+ K.premise_binder = new_subproof.K.proof_name;
+ K.premise_n = None
+ } in
+ new_subproof::subproofs,new_arg::args
+ else
+ let hd =
+ (match t with
+ C.ARel (idr,idref,n,b) ->
+ let sort =
+ (try
+ Hashtbl.find ids_to_inner_sorts idr
+ with Not_found -> `Type (CicUniv.fresh())) in
+ if sort = `Prop then
+ K.Premise
+ { K.premise_id = gen_id premise_prefix seed;
+ K.premise_xref = idr;
+ K.premise_binder = Some b;
+ K.premise_n = Some n
+ }
+ else (K.Term t)
+ | C.AConst(id,uri,[]) ->
+ let sort =
+ (try
+ Hashtbl.find ids_to_inner_sorts id
+ with Not_found -> `Type (CicUniv.fresh())) in
+ if sort = `Prop then
+ K.Lemma
+ { K.lemma_id = gen_id lemma_prefix seed;
+ K.lemma_name = UriManager.name_of_uri uri;
+ K.lemma_uri = UriManager.string_of_uri uri
+ }
+ else (K.Term t)
+ | C.AMutConstruct(id,uri,tyno,consno,[]) ->
+ let sort =
+ (try
+ Hashtbl.find ids_to_inner_sorts id
+ with Not_found -> `Type (CicUniv.fresh())) in
+ if sort = `Prop then
+ let inductive_types =
+ (let o,_ =
+ CicEnvironment.get_obj CicUniv.empty_ugraph uri
+ in
+ match o with
+ | Cic.InductiveDefinition (l,_,_,_) -> l
+ | _ -> assert false
+ ) in
+ let (_,_,_,constructors) =
+ List.nth inductive_types tyno in
+ let name,_ = List.nth constructors (consno - 1) in
+ K.Lemma
+ { K.lemma_id = gen_id lemma_prefix seed;
+ K.lemma_name = name;
+ K.lemma_uri =
+ UriManager.string_of_uri uri ^ "#xpointer(1/" ^
+ string_of_int (tyno+1) ^ "/" ^ string_of_int consno ^
+ ")"
+ }
+ else (K.Term t)
+ | _ -> (K.Term t)) in
+ subproofs,hd::args
+ in
+ match (aux l) with
+ [p],args ->
+ [{p with K.proof_name = None}],
+ List.map
+ (function
+ K.Premise prem when prem.K.premise_xref = p.K.proof_id ->
+ K.Premise {prem with K.premise_binder = None}
+ | i -> i) args
+ | p,a as c -> c
+
+and
+
+build_def_item seed id n t ~ids_to_inner_sorts ~ids_to_inner_types =
+ let module K = Content in
+ try
+ let sort = Hashtbl.find ids_to_inner_sorts id in
+ if sort = `Prop then
+ (let p =
+ (acic2content seed ?name:(name_of n) ~ids_to_inner_sorts ~ids_to_inner_types t)
+ in
+ `Proof p;)
+ else
+ `Definition
+ { K.def_name = name_of n;
+ K.def_id = gen_id definition_prefix seed;
+ K.def_aref = id;
+ K.def_term = t
+ }
+ with
+ Not_found -> assert false
+
+(* the following function must be called with an object of sort
+Prop. For debugging purposes this is tested again, possibly raising an
+Not_a_proof exception *)
+
+and acic2content seed ?name ~ids_to_inner_sorts ~ids_to_inner_types t =
+ let rec aux ?name t =
+ let module C = Cic in
+ let module K = Content in
+ let module C2A = Cic2acic in
+ let t1 =
+ match t with
+ C.ARel (id,idref,n,b) as t ->
+ let sort = Hashtbl.find ids_to_inner_sorts id in
+ if sort = `Prop then
+ generate_exact seed t id name ~ids_to_inner_types
+ else raise Not_a_proof
+ | C.AVar (id,uri,exp_named_subst) as t ->
+ let sort = Hashtbl.find ids_to_inner_sorts id in
+ if sort = `Prop then
+ generate_exact seed t id name ~ids_to_inner_types
+ else raise Not_a_proof
+ | C.AMeta (id,n,l) as t ->
+ let sort = Hashtbl.find ids_to_inner_sorts id in
+ if sort = `Prop then
+ generate_exact seed t id name ~ids_to_inner_types
+ else raise Not_a_proof
+ | C.ASort (id,s) -> raise Not_a_proof
+ | C.AImplicit _ -> raise NotImplemented
+ | C.AProd (_,_,_,_) -> raise Not_a_proof
+ | C.ACast (id,v,t) -> aux v
+ | C.ALambda (id,n,s,t) ->
+ let sort = Hashtbl.find ids_to_inner_sorts id in
+ if sort = `Prop then
+ let proof = aux t in
+ let proof' =
+ if proof.K.proof_conclude.K.conclude_method = "Intros+LetTac" then
+ match proof.K.proof_conclude.K.conclude_args with
+ [K.ArgProof p] -> p
+ | _ -> assert false
+ else proof in
+ let proof'' =
+ { proof' with
+ K.proof_name = None;
+ K.proof_context =
+ (build_decl_item seed id n s ids_to_inner_sorts)::
+ proof'.K.proof_context
+ }
+ in
+ generate_intros_let_tac seed id n s true proof'' name ~ids_to_inner_types
+ else raise Not_a_proof
+ | C.ALetIn (id,n,s,t) ->
+ let sort = Hashtbl.find ids_to_inner_sorts id in
+ if sort = `Prop then
+ let proof = aux t in
+ let proof' =
+ if proof.K.proof_conclude.K.conclude_method = "Intros+LetTac" then
+ match proof.K.proof_conclude.K.conclude_args with
+ [K.ArgProof p] -> p
+ | _ -> assert false
+ else proof in
+ let proof'' =
+ { proof' with
+ K.proof_name = None;
+ K.proof_context =
+ ((build_def_item seed id n s ids_to_inner_sorts
+ ids_to_inner_types):> Cic.annterm K.in_proof_context_element)
+ ::proof'.K.proof_context;
+ }
+ in
+ generate_intros_let_tac seed id n s false proof'' name ~ids_to_inner_types
+ else raise Not_a_proof
+ | C.AAppl (id,li) ->
+ (try rewrite
+ seed name id li ~ids_to_inner_types ~ids_to_inner_sorts
+ with NotApplicable ->
+ try inductive
+ seed name id li ~ids_to_inner_types ~ids_to_inner_sorts
+ with NotApplicable ->
+ let subproofs, args =
+ build_subproofs_and_args
+ seed li ~ids_to_inner_types ~ids_to_inner_sorts in
+(*
+ let args_to_lift =
+ List.filter (test_for_lifting ~ids_to_inner_types) li in
+ let subproofs =
+ match args_to_lift with
+ [_] -> List.map aux args_to_lift
+ | _ -> List.map (aux ~name:"H") args_to_lift in
+ let args = build_args seed li subproofs
+ ~ids_to_inner_types ~ids_to_inner_sorts in *)
+ { K.proof_name = name;
+ K.proof_id = gen_id proof_prefix seed;
+ K.proof_context = [];
+ K.proof_apply_context = serialize seed subproofs;
+ K.proof_conclude =
+ { K.conclude_id = gen_id conclude_prefix seed;
+ K.conclude_aref = id;
+ K.conclude_method = "Apply";
+ K.conclude_args = args;
+ K.conclude_conclusion =
+ try Some
+ (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized
+ with Not_found -> None
+ };
+ })
+ | C.AConst (id,uri,exp_named_subst) as t ->
+ let sort = Hashtbl.find ids_to_inner_sorts id in
+ if sort = `Prop then
+ generate_exact seed t id name ~ids_to_inner_types
+ else raise Not_a_proof
+ | C.AMutInd (id,uri,i,exp_named_subst) -> raise Not_a_proof
+ | C.AMutConstruct (id,uri,i,j,exp_named_subst) as t ->
+ let sort = Hashtbl.find ids_to_inner_sorts id in
+ if sort = `Prop then
+ generate_exact seed t id name ~ids_to_inner_types
+ else raise Not_a_proof
+ | C.AMutCase (id,uri,typeno,ty,te,patterns) ->
+ let inductive_types,noparams =
+ (let o, _ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ Cic.Constant _ -> assert false
+ | Cic.Variable _ -> assert false
+ | Cic.CurrentProof _ -> assert false
+ | Cic.InductiveDefinition (l,_,n,_) -> l,n
+ ) in
+ let (_,_,_,constructors) = List.nth inductive_types typeno in
+ let name_and_arities =
+ let rec count_prods =
+ function
+ C.Prod (_,_,t) -> 1 + count_prods t
+ | _ -> 0 in
+ List.map
+ (function (n,t) -> Some n,((count_prods t) - noparams)) constructors in
+ let pp =
+ let build_proof p (name,arity) =
+ let rec make_context_and_body c p n =
+ if n = 0 then c,(aux p)
+ else
+ (match p with
+ Cic.ALambda(idl,vname,s1,t1) ->
+ let ce =
+ build_decl_item seed idl vname s1 ~ids_to_inner_sorts in
+ make_context_and_body (ce::c) t1 (n-1)
+ | _ -> assert false) in
+ let context,body = make_context_and_body [] p arity in
+ K.ArgProof
+ {body with K.proof_name = name; K.proof_context=context} in
+ List.map2 build_proof patterns name_and_arities in
+ let teid = get_id te in
+ let context,term =
+ (match
+ build_subproofs_and_args
+ seed ~ids_to_inner_types ~ids_to_inner_sorts [te]
+ with
+ l,[t] -> l,t
+ | _ -> assert false) in
+ { K.proof_name = name;
+ K.proof_id = gen_id proof_prefix seed;
+ K.proof_context = [];
+ K.proof_apply_context = serialize seed context;
+ K.proof_conclude =
+ { K.conclude_id = gen_id conclude_prefix seed;
+ K.conclude_aref = id;
+ K.conclude_method = "Case";
+ K.conclude_args =
+ (K.Aux (UriManager.string_of_uri uri))::
+ (K.Aux (string_of_int typeno))::(K.Term ty)::term::pp;
+ K.conclude_conclusion =
+ try Some
+ (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized
+ with Not_found -> None
+ }
+ }
+ | C.AFix (id, no, funs) ->
+ let proofs =
+ List.map
+ (function (_,name,_,_,bo) -> `Proof (aux ~name bo)) funs in
+ let fun_name =
+ List.nth (List.map (fun (_,name,_,_,_) -> name) funs) no
+ in
+ let decreasing_args =
+ List.map (function (_,_,n,_,_) -> n) funs in
+ let jo =
+ { K.joint_id = gen_id joint_prefix seed;
+ K.joint_kind = `Recursive decreasing_args;
+ K.joint_defs = proofs
+ }
+ in
+ { K.proof_name = name;
+ K.proof_id = gen_id proof_prefix seed;
+ K.proof_context = [`Joint jo];
+ K.proof_apply_context = [];
+ K.proof_conclude =
+ { K.conclude_id = gen_id conclude_prefix seed;
+ K.conclude_aref = id;
+ K.conclude_method = "Exact";
+ K.conclude_args =
+ [ K.Premise
+ { K.premise_id = gen_id premise_prefix seed;
+ K.premise_xref = jo.K.joint_id;
+ K.premise_binder = Some fun_name;
+ K.premise_n = Some no;
+ }
+ ];
+ K.conclude_conclusion =
+ try Some
+ (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized
+ with Not_found -> None
+ }
+ }
+ | C.ACoFix (id,no,funs) ->
+ let proofs =
+ List.map
+ (function (_,name,_,bo) -> `Proof (aux ~name bo)) funs in
+ let jo =
+ { K.joint_id = gen_id joint_prefix seed;
+ K.joint_kind = `CoRecursive;
+ K.joint_defs = proofs
+ }
+ in
+ { K.proof_name = name;
+ K.proof_id = gen_id proof_prefix seed;
+ K.proof_context = [`Joint jo];
+ K.proof_apply_context = [];
+ K.proof_conclude =
+ { K.conclude_id = gen_id conclude_prefix seed;
+ K.conclude_aref = id;
+ K.conclude_method = "Exact";
+ K.conclude_args =
+ [ K.Premise
+ { K.premise_id = gen_id premise_prefix seed;
+ K.premise_xref = jo.K.joint_id;
+ K.premise_binder = Some "tiralo fuori";
+ K.premise_n = Some no;
+ }
+ ];
+ K.conclude_conclusion =
+ try Some
+ (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized
+ with Not_found -> None
+ };
+ }
+ in
+ let id = get_id t in
+ generate_conversion seed false id t1 ~ids_to_inner_types
+in aux ?name t
+
+and inductive seed name id li ~ids_to_inner_types ~ids_to_inner_sorts =
+ let aux ?name = acic2content seed ~ids_to_inner_types ~ids_to_inner_sorts in
+ let module C2A = Cic2acic in
+ let module K = Content in
+ let module C = Cic in
+ match li with
+ C.AConst (idc,uri,exp_named_subst)::args ->
+ let uri_str = UriManager.string_of_uri uri in
+ let suffix = Str.regexp_string "_ind.con" in
+ let len = String.length uri_str in
+ let n = (try (Str.search_backward suffix uri_str len)
+ with Not_found -> -1) in
+ if n<0 then raise NotApplicable
+ else
+ let method_name =
+ if UriManager.eq uri HelmLibraryObjects.Logic.ex_ind_URI then "Exists"
+ else if UriManager.eq uri HelmLibraryObjects.Logic.and_ind_URI then "AndInd"
+ else if UriManager.eq uri HelmLibraryObjects.Logic.false_ind_URI then "FalseInd"
+ else "ByInduction" in
+ let prefix = String.sub uri_str 0 n in
+ let ind_str = (prefix ^ ".ind") in
+ let ind_uri = UriManager.uri_of_string ind_str in
+ let inductive_types,noparams =
+ (let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph ind_uri in
+ match o with
+ | Cic.InductiveDefinition (l,_,n,_) -> (l,n)
+ | _ -> assert false
+ ) in
+ let rec split n l =
+ if n = 0 then ([],l) else
+ let p,a = split (n-1) (List.tl l) in
+ ((List.hd l::p),a) in
+ let params_and_IP,tail_args = split (noparams+1) args in
+ let constructors =
+ (match inductive_types with
+ [(_,_,_,l)] -> l
+ | _ -> raise NotApplicable) (* don't care for mutual ind *) in
+ let constructors1 =
+ let rec clean_up n t =
+ if n = 0 then t else
+ (match t with
+ (label,Cic.Prod (_,_,t)) -> clean_up (n-1) (label,t)
+ | _ -> assert false) in
+ List.map (clean_up noparams) constructors in
+ let no_constructors= List.length constructors in
+ let args_for_cases, other_args =
+ split no_constructors tail_args in
+ let subproofs,other_method_args =
+ build_subproofs_and_args seed other_args
+ ~ids_to_inner_types ~ids_to_inner_sorts in
+ let method_args=
+ let rec build_method_args =
+ function
+ [],_-> [] (* extra args are ignored ???? *)
+ | (name,ty)::tlc,arg::tla ->
+ let idarg = get_id arg in
+ let sortarg =
+ (try (Hashtbl.find ids_to_inner_sorts idarg)
+ with Not_found -> `Type (CicUniv.fresh())) in
+ let hdarg =
+ if sortarg = `Prop then
+ let (co,bo) =
+ let rec bc =
+ function
+ Cic.Prod (_,s,t),Cic.ALambda(idl,n,s1,t1) ->
+ let ce =
+ build_decl_item
+ seed idl n s1 ~ids_to_inner_sorts in
+ if (occur ind_uri s) then
+ ( match t1 with
+ Cic.ALambda(id2,n2,s2,t2) ->
+ let inductive_hyp =
+ `Hypothesis
+ { K.dec_name = name_of n2;
+ K.dec_id =
+ gen_id declaration_prefix seed;
+ K.dec_inductive = true;
+ K.dec_aref = id2;
+ K.dec_type = s2
+ } in
+ let (context,body) = bc (t,t2) in
+ (ce::inductive_hyp::context,body)
+ | _ -> assert false)
+ else
+ (
+ let (context,body) = bc (t,t1) in
+ (ce::context,body))
+ | _ , t -> ([],aux t) in
+ bc (ty,arg) in
+ K.ArgProof
+ { bo with
+ K.proof_name = Some name;
+ K.proof_context = co;
+ };
+ else (K.Term arg) in
+ hdarg::(build_method_args (tlc,tla))
+ | _ -> assert false in
+ build_method_args (constructors1,args_for_cases) in
+ { K.proof_name = name;
+ K.proof_id = gen_id proof_prefix seed;
+ K.proof_context = [];
+ K.proof_apply_context = serialize seed subproofs;
+ K.proof_conclude =
+ { K.conclude_id = gen_id conclude_prefix seed;
+ K.conclude_aref = id;
+ K.conclude_method = method_name;
+ K.conclude_args =
+ K.Aux (string_of_int no_constructors)
+ ::K.Term (C.AAppl(id,((C.AConst(idc,uri,exp_named_subst))::params_and_IP)))
+ ::method_args@other_method_args;
+ K.conclude_conclusion =
+ try Some
+ (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized
+ with Not_found -> None
+ }
+ }
+ | _ -> raise NotApplicable
+
+and rewrite seed name id li ~ids_to_inner_types ~ids_to_inner_sorts =
+ let aux ?name = acic2content seed ~ids_to_inner_types ~ids_to_inner_sorts in
+ let module C2A = Cic2acic in
+ let module K = Content in
+ let module C = Cic in
+ match li with
+ C.AConst (sid,uri,exp_named_subst)::args ->
+ if UriManager.eq uri HelmLibraryObjects.Logic.eq_ind_URI or
+ UriManager.eq uri HelmLibraryObjects.Logic.eq_ind_r_URI then
+ let subproofs,arg =
+ (match
+ build_subproofs_and_args
+ seed ~ids_to_inner_types ~ids_to_inner_sorts [List.nth args 3]
+ with
+ l,[p] -> l,p
+ | _,_ -> assert false) in
+ let method_args =
+ let rec ma_aux n = function
+ [] -> []
+ | a::tl ->
+ let hd =
+ if n = 0 then arg
+ else
+ let aid = get_id a in
+ let asort = (try (Hashtbl.find ids_to_inner_sorts aid)
+ with Not_found -> `Type (CicUniv.fresh())) in
+ if asort = `Prop then
+ K.ArgProof (aux a)
+ else K.Term a in
+ hd::(ma_aux (n-1) tl) in
+ (ma_aux 3 args) in
+ { K.proof_name = name;
+ K.proof_id = gen_id proof_prefix seed;
+ K.proof_context = [];
+ K.proof_apply_context = serialize seed subproofs;
+ K.proof_conclude =
+ { K.conclude_id = gen_id conclude_prefix seed;
+ K.conclude_aref = id;
+ K.conclude_method = "Rewrite";
+ K.conclude_args =
+ K.Term (C.AConst (sid,uri,exp_named_subst))::method_args;
+ K.conclude_conclusion =
+ try Some
+ (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized
+ with Not_found -> None
+ }
+ }
+ else raise NotApplicable
+ | _ -> raise NotApplicable
+;;
+
+let map_conjectures
+ seed ~ids_to_inner_sorts ~ids_to_inner_types (id,n,context,ty)
+=
+ let module K = Content in
+ let context' =
+ List.map
+ (function
+ (id,None) -> None
+ | (id,Some (name,Cic.ADecl t)) ->
+ Some
+ (* We should call build_decl_item, but we have not computed *)
+ (* the inner-types ==> we always produce a declaration *)
+ (`Declaration
+ { K.dec_name = name_of name;
+ K.dec_id = gen_id declaration_prefix seed;
+ K.dec_inductive = false;
+ K.dec_aref = get_id t;
+ K.dec_type = t
+ })
+ | (id,Some (name,Cic.ADef t)) ->
+ Some
+ (* We should call build_def_item, but we have not computed *)
+ (* the inner-types ==> we always produce a declaration *)
+ (`Definition
+ { K.def_name = name_of name;
+ K.def_id = gen_id definition_prefix seed;
+ K.def_aref = get_id t;
+ K.def_term = t
+ })
+ ) context
+ in
+ (id,n,context',ty)
+;;
+
+(* map_sequent is similar to map_conjectures, but the for the hid
+of the hypothesis, which are preserved instead of generating
+fresh ones. We shall have to adopt a uniform policy, soon or later *)
+
+let map_sequent ((id,n,context,ty):Cic.annconjecture) =
+ let module K = Content in
+ let context' =
+ List.map
+ (function
+ (id,None) -> None
+ | (id,Some (name,Cic.ADecl t)) ->
+ Some
+ (* We should call build_decl_item, but we have not computed *)
+ (* the inner-types ==> we always produce a declaration *)
+ (`Declaration
+ { K.dec_name = name_of name;
+ K.dec_id = id;
+ K.dec_inductive = false;
+ K.dec_aref = get_id t;
+ K.dec_type = t
+ })
+ | (id,Some (name,Cic.ADef t)) ->
+ Some
+ (* We should call build_def_item, but we have not computed *)
+ (* the inner-types ==> we always produce a declaration *)
+ (`Definition
+ { K.def_name = name_of name;
+ K.def_id = id;
+ K.def_aref = get_id t;
+ K.def_term = t
+ })
+ ) context
+ in
+ (id,n,context',ty)
+;;
+
+let rec annobj2content ~ids_to_inner_sorts ~ids_to_inner_types =
+ let module C = Cic in
+ let module K = Content in
+ let module C2A = Cic2acic in
+ let seed = ref 0 in
+ function
+ C.ACurrentProof (_,_,n,conjectures,bo,ty,params,_) ->
+ (gen_id object_prefix seed, params,
+ Some
+ (List.map
+ (map_conjectures seed ~ids_to_inner_sorts ~ids_to_inner_types)
+ conjectures),
+ `Def (K.Const,ty,
+ build_def_item seed (get_id bo) (C.Name n) bo
+ ~ids_to_inner_sorts ~ids_to_inner_types))
+ | C.AConstant (_,_,n,Some bo,ty,params,_) ->
+ (gen_id object_prefix seed, params, None,
+ `Def (K.Const,ty,
+ build_def_item seed (get_id bo) (C.Name n) bo
+ ~ids_to_inner_sorts ~ids_to_inner_types))
+ | C.AConstant (id,_,n,None,ty,params,_) ->
+ (gen_id object_prefix seed, params, None,
+ `Decl (K.Const,
+ build_decl_item seed id (C.Name n) ty
+ ~ids_to_inner_sorts))
+ | C.AVariable (_,n,Some bo,ty,params,_) ->
+ (gen_id object_prefix seed, params, None,
+ `Def (K.Var,ty,
+ build_def_item seed (get_id bo) (C.Name n) bo
+ ~ids_to_inner_sorts ~ids_to_inner_types))
+ | C.AVariable (id,n,None,ty,params,_) ->
+ (gen_id object_prefix seed, params, None,
+ `Decl (K.Var,
+ build_decl_item seed id (C.Name n) ty
+ ~ids_to_inner_sorts))
+ | C.AInductiveDefinition (id,l,params,nparams,_) ->
+ (gen_id object_prefix seed, params, None,
+ `Joint
+ { K.joint_id = gen_id joint_prefix seed;
+ K.joint_kind = `Inductive nparams;
+ K.joint_defs = List.map (build_inductive seed) l
+ })
+
+and
+ build_inductive seed =
+ let module K = Content in
+ fun (_,n,b,ty,l) ->
+ `Inductive
+ { K.inductive_id = gen_id inductive_prefix seed;
+ K.inductive_name = n;
+ K.inductive_kind = b;
+ K.inductive_type = ty;
+ K.inductive_constructors = build_constructors seed l
+ }
+
+and
+ build_constructors seed l =
+ let module K = Content in
+ List.map
+ (fun (n,t) ->
+ { K.dec_name = Some n;
+ K.dec_id = gen_id declaration_prefix seed;
+ K.dec_inductive = false;
+ K.dec_aref = "";
+ K.dec_type = t
+ }) l
+;;
+
+(*
+and 'term cinductiveType =
+ id * string * bool * 'term * (* typename, inductive, arity *)
+ 'term cconstructor list (* constructors *)
+
+and 'term cconstructor =
+ string * 'term
+*)
+
+
diff --git a/helm/ocaml/acic_content/acic2content.mli b/helm/ocaml/acic_content/acic2content.mli
new file mode 100644
index 000000000..e1dfb82de
--- /dev/null
+++ b/helm/ocaml/acic_content/acic2content.mli
@@ -0,0 +1,33 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val annobj2content :
+ ids_to_inner_sorts:(Cic.id, Cic2acic.sort_kind) Hashtbl.t ->
+ ids_to_inner_types:(Cic.id, Cic2acic.anntypes) Hashtbl.t ->
+ Cic.annobj ->
+ Cic.annterm Content.cobj
+
+val map_sequent :
+ Cic.annconjecture -> Cic.annterm Content.conjecture
diff --git a/helm/ocaml/acic_content/cicNotationEnv.ml b/helm/ocaml/acic_content/cicNotationEnv.ml
new file mode 100644
index 000000000..32d4f0df5
--- /dev/null
+++ b/helm/ocaml/acic_content/cicNotationEnv.ml
@@ -0,0 +1,153 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+module Ast = CicNotationPt
+
+type value =
+ | TermValue of Ast.term
+ | StringValue of string
+ | NumValue of string
+ | OptValue of value option
+ | ListValue of value list
+
+type value_type =
+ | TermType
+ | StringType
+ | NumType
+ | OptType of value_type
+ | ListType of value_type
+
+exception Value_not_found of string
+exception Type_mismatch of string * value_type
+
+type declaration = string * value_type
+type binding = string * (value_type * value)
+type t = binding list
+
+let lookup env name =
+ try
+ List.assoc name env
+ with Not_found -> raise (Value_not_found name)
+
+let lookup_value env name =
+ try
+ snd (List.assoc name env)
+ with Not_found -> raise (Value_not_found name)
+
+let remove_name env name = List.remove_assoc name env
+
+let remove_names env names =
+ List.filter (fun name, _ -> not (List.mem name names)) env
+
+let lookup_term env name =
+ match lookup env name with
+ | _, TermValue x -> x
+ | ty, _ -> raise (Type_mismatch (name, ty))
+
+let lookup_num env name =
+ match lookup env name with
+ | _, NumValue x -> x
+ | ty, _ -> raise (Type_mismatch (name, ty))
+
+let lookup_string env name =
+ match lookup env name with
+ | _, StringValue x -> x
+ | ty, _ -> raise (Type_mismatch (name, ty))
+
+let lookup_opt env name =
+ match lookup env name with
+ | _, OptValue x -> x
+ | ty, _ -> raise (Type_mismatch (name, ty))
+
+let lookup_list env name =
+ match lookup env name with
+ | _, ListValue x -> x
+ | ty, _ -> raise (Type_mismatch (name, ty))
+
+let opt_binding_some (n, (ty, v)) = (n, (OptType ty, OptValue (Some v)))
+let opt_binding_none (n, (ty, v)) = (n, (OptType ty, OptValue None))
+let opt_binding_of_name (n, ty) = (n, (OptType ty, OptValue None))
+let list_binding_of_name (n, ty) = (n, (ListType ty, ListValue []))
+let opt_declaration (n, ty) = (n, OptType ty)
+let list_declaration (n, ty) = (n, ListType ty)
+
+let declaration_of_var = function
+ | Ast.NumVar s -> s, NumType
+ | Ast.IdentVar s -> s, StringType
+ | Ast.TermVar s -> s, TermType
+ | _ -> assert false
+
+let value_of_term = function
+ | Ast.Num (s, _) -> NumValue s
+ | Ast.Ident (s, None) -> StringValue s
+ | t -> TermValue t
+
+let term_of_value = function
+ | NumValue s -> Ast.Num (s, 0)
+ | StringValue s -> Ast.Ident (s, None)
+ | TermValue t -> t
+ | _ -> assert false (* TO BE UNDERSTOOD *)
+
+let rec well_typed ty value =
+ match ty, value with
+ | TermType, TermValue _
+ | StringType, StringValue _
+ | OptType _, OptValue None
+ | NumType, NumValue _ -> true
+ | OptType ty', OptValue (Some value') -> well_typed ty' value'
+ | ListType ty', ListValue vl ->
+ List.for_all (fun value' -> well_typed ty' value') vl
+ | _ -> false
+
+let declarations_of_env = List.map (fun (name, (ty, _)) -> (name, ty))
+let declarations_of_term p =
+ List.map declaration_of_var (CicNotationUtil.variables_of_term p)
+
+let rec combine decls values =
+ match decls, values with
+ | [], [] -> []
+ | (name, ty) :: decls, v :: values ->
+ (name, (ty, v)) :: (combine decls values)
+ | _ -> assert false
+
+let coalesce_env declarations env_list =
+ let env0 = List.map list_binding_of_name declarations in
+ let grow_env_entry env n v =
+ List.map
+ (function
+ | (n', (ty, ListValue vl)) as entry ->
+ if n' = n then n', (ty, ListValue (v :: vl)) else entry
+ | _ -> assert false)
+ env
+ in
+ let grow_env env_i env =
+ List.fold_left
+ (fun env (n, (_, v)) -> grow_env_entry env n v)
+ env env_i
+ in
+ List.fold_right grow_env env_list env0
+
diff --git a/helm/ocaml/acic_content/cicNotationEnv.mli b/helm/ocaml/acic_content/cicNotationEnv.mli
new file mode 100644
index 000000000..d4f87097e
--- /dev/null
+++ b/helm/ocaml/acic_content/cicNotationEnv.mli
@@ -0,0 +1,92 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** {2 Types} *)
+
+type value =
+ | TermValue of CicNotationPt.term
+ | StringValue of string
+ | NumValue of string
+ | OptValue of value option
+ | ListValue of value list
+
+type value_type =
+ | TermType
+ | StringType
+ | NumType
+ | OptType of value_type
+ | ListType of value_type
+
+ (** looked up value not found in environment *)
+exception Value_not_found of string
+
+ (** looked up value has the wrong type
+ * parameters are value name and value type in environment *)
+exception Type_mismatch of string * value_type
+
+type declaration = string * value_type
+type binding = string * (value_type * value)
+type t = binding list
+
+val declaration_of_var: CicNotationPt.pattern_variable -> declaration
+val value_of_term: CicNotationPt.term -> value
+val term_of_value: value -> CicNotationPt.term
+val well_typed: value_type -> value -> bool
+
+val declarations_of_env: t -> declaration list
+val declarations_of_term: CicNotationPt.term -> declaration list
+val combine: declaration list -> value list -> t (** @raise Invalid_argument *)
+
+(** {2 Environment lookup} *)
+
+val lookup_value: t -> string -> value (** @raise Value_not_found *)
+
+(** lookup_* functions below may raise Value_not_found and Type_mismatch *)
+
+val lookup_term: t -> string -> CicNotationPt.term
+val lookup_string: t -> string -> string
+val lookup_num: t -> string -> string
+val lookup_opt: t -> string -> value option
+val lookup_list: t -> string -> value list
+
+val remove_name: t -> string -> t
+val remove_names: t -> string list -> t
+
+(** {2 Bindings mangling} *)
+
+val opt_binding_some: binding -> binding (* v -> Some v *)
+val opt_binding_none: binding -> binding (* v -> None *)
+
+val opt_binding_of_name: declaration -> binding (* None binding *)
+val list_binding_of_name: declaration -> binding (* [] binding *)
+
+val opt_declaration: declaration -> declaration (* t -> OptType t *)
+val list_declaration: declaration -> declaration (* t -> ListType t *)
+
+(** given a list of environments bindings a set of names n_1, ..., n_k, returns
+ * a single environment where n_i is bound to the list of values bound in the
+ * starting environments *)
+val coalesce_env: declaration list -> t list -> t
+
diff --git a/helm/ocaml/acic_content/cicNotationPp.ml b/helm/ocaml/acic_content/cicNotationPp.ml
new file mode 100644
index 000000000..5dc6fd821
--- /dev/null
+++ b/helm/ocaml/acic_content/cicNotationPp.ml
@@ -0,0 +1,325 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+module Ast = CicNotationPt
+module Env = CicNotationEnv
+
+ (* when set to true debugging information, not in sync with input syntax, will
+ * be added to the output of pp_term.
+ * set to false if you need, for example, cut and paste from matitac output to
+ * matitatop *)
+let debug_printing = true
+
+let pp_binder = function
+ | `Lambda -> "lambda"
+ | `Pi -> "Pi"
+ | `Exists -> "exists"
+ | `Forall -> "forall"
+
+let pp_literal =
+ if debug_printing then
+ (function (* debugging version *)
+ | `Symbol s -> sprintf "symbol(%s)" s
+ | `Keyword s -> sprintf "keyword(%s)" s
+ | `Number s -> sprintf "number(%s)" s)
+ else
+ (function
+ | `Symbol s
+ | `Keyword s
+ | `Number s -> s)
+
+let pp_assoc =
+ function
+ | Gramext.NonA -> "NonA"
+ | Gramext.LeftA -> "LeftA"
+ | Gramext.RightA -> "RightA"
+
+let pp_pos =
+ function
+(* `None -> "`None" *)
+ | `Left -> "`Left"
+ | `Right -> "`Right"
+ | `Inner -> "`Inner"
+
+let pp_attribute =
+ function
+ | `IdRef id -> sprintf "x(%s)" id
+ | `XmlAttrs attrs ->
+ sprintf "X(%s)"
+ (String.concat ";"
+ (List.map (fun (_, n, v) -> sprintf "%s=%s" n v) attrs))
+ | `Level (prec, assoc) -> sprintf "L(%d%s)" prec (pp_assoc assoc)
+ | `Raw _ -> "R"
+ | `Loc _ -> "@"
+ | `ChildPos p -> sprintf "P(%s)" (pp_pos p)
+
+let rec pp_term ?(pp_parens = true) t =
+ let t_pp =
+ match t with
+ | Ast.AttributedTerm (attr, term) when debug_printing ->
+ sprintf "%s[%s]" (pp_attribute attr) (pp_term ~pp_parens:false term)
+ | Ast.AttributedTerm (`Raw text, _) -> text
+ | Ast.AttributedTerm (_, term) -> pp_term ~pp_parens:false term
+ | Ast.Appl terms ->
+ sprintf "%s" (String.concat " " (List.map pp_term terms))
+ | Ast.Binder (`Forall, (Ast.Ident ("_", None), typ), body)
+ | Ast.Binder (`Pi, (Ast.Ident ("_", None), typ), body) ->
+ sprintf "%s \\to %s"
+ (match typ with None -> "?" | Some typ -> pp_term typ)
+ (pp_term body)
+ | Ast.Binder (kind, var, body) ->
+ sprintf "\\%s %s.%s" (pp_binder kind) (pp_capture_variable var)
+ (pp_term body)
+ | Ast.Case (term, indtype, typ, patterns) ->
+ sprintf "%smatch %s%s with %s"
+ (match typ with None -> "" | Some t -> sprintf "[%s]" (pp_term t))
+ (pp_term term)
+ (match indtype with
+ | None -> ""
+ | Some (ty, href_opt) ->
+ sprintf " in %s%s" ty
+ (match debug_printing, href_opt with
+ | true, Some uri ->
+ sprintf "(i.e.%s)" (UriManager.string_of_uri uri)
+ | _ -> ""))
+ (pp_patterns patterns)
+ | Ast.Cast (t1, t2) -> sprintf "(%s: %s)" (pp_term t1) (pp_term t2)
+ | Ast.LetIn (var, t1, t2) ->
+ sprintf "let %s = %s in %s" (pp_capture_variable var) (pp_term t1)
+ (pp_term t2)
+ | Ast.LetRec (kind, definitions, term) ->
+ sprintf "let %s %s in %s"
+ (match kind with `Inductive -> "rec" | `CoInductive -> "corec")
+ (String.concat " and "
+ (List.map
+ (fun (var, body, _) ->
+ sprintf "%s = %s" (pp_capture_variable var) (pp_term body))
+ definitions))
+ (pp_term term)
+ | Ast.Ident (name, Some []) | Ast.Ident (name, None)
+ | Ast.Uri (name, Some []) | Ast.Uri (name, None) ->
+ name
+ | Ast.Ident (name, Some substs)
+ | Ast.Uri (name, Some substs) ->
+ sprintf "%s \\subst [%s]" name (pp_substs substs)
+ | Ast.Implicit -> "?"
+ | Ast.Meta (index, substs) ->
+ sprintf "%d[%s]" index
+ (String.concat "; "
+ (List.map (function None -> "_" | Some t -> pp_term t) substs))
+ | Ast.Num (num, _) -> num
+ | Ast.Sort `Set -> "Set"
+ | Ast.Sort `Prop -> "Prop"
+ | Ast.Sort (`Type _) -> "Type"
+ | Ast.Sort `CProp -> "CProp"
+ | Ast.Symbol (name, _) -> "'" ^ name
+
+ | Ast.UserInput -> ""
+
+ | Ast.Literal l -> pp_literal l
+ | Ast.Layout l -> pp_layout l
+ | Ast.Magic m -> pp_magic m
+ | Ast.Variable v -> pp_variable v
+ in
+ if pp_parens then sprintf "(%s)" t_pp
+ else t_pp
+
+and pp_subst (name, term) = sprintf "%s \\Assign %s" name (pp_term term)
+and pp_substs substs = String.concat "; " (List.map pp_subst substs)
+
+and pp_pattern ((head, href, vars), term) =
+ let head_pp =
+ head ^
+ (match debug_printing, href with
+ | true, Some uri -> sprintf "(i.e.%s)" (UriManager.string_of_uri uri)
+ | _ -> "")
+ in
+ sprintf "%s \\Rightarrow %s"
+ (match vars with
+ | [] -> head_pp
+ | _ ->
+ sprintf "(%s %s)" head_pp
+ (String.concat " " (List.map pp_capture_variable vars)))
+ (pp_term term)
+
+and pp_patterns patterns =
+ sprintf "[%s]" (String.concat " | " (List.map pp_pattern patterns))
+
+and pp_capture_variable = function
+ | term, None -> pp_term term
+ | term, Some typ -> "(" ^ pp_term term ^ ": " ^ pp_term typ ^ ")"
+
+and pp_box_spec (kind, spacing, indent) =
+ let int_of_bool b = if b then 1 else 0 in
+ let kind_string =
+ match kind with
+ Ast.H -> "H" | Ast.V -> "V" | Ast.HV -> "HV" | Ast.HOV -> "HOV"
+ in
+ sprintf "%sBOX%d%d" kind_string (int_of_bool spacing) (int_of_bool indent)
+
+and pp_layout = function
+ | Ast.Sub (t1, t2) -> sprintf "%s \\SUB %s" (pp_term t1) (pp_term t2)
+ | Ast.Sup (t1, t2) -> sprintf "%s \\SUP %s" (pp_term t1) (pp_term t2)
+ | Ast.Below (t1, t2) -> sprintf "%s \\BELOW %s" (pp_term t1) (pp_term t2)
+ | Ast.Above (t1, t2) -> sprintf "%s \\ABOVE %s" (pp_term t1) (pp_term t2)
+ | Ast.Over (t1, t2) -> sprintf "[%s \\OVER %s]" (pp_term t1) (pp_term t2)
+ | Ast.Atop (t1, t2) -> sprintf "[%s \\ATOP %s]" (pp_term t1) (pp_term t2)
+ | Ast.Frac (t1, t2) -> sprintf "\\FRAC %s %s" (pp_term t1) (pp_term t2)
+ | Ast.Sqrt t -> sprintf "\\SQRT %s" (pp_term t)
+ | Ast.Root (arg, index) ->
+ sprintf "\\ROOT %s \\OF %s" (pp_term index) (pp_term arg)
+ | Ast.Break -> "\\BREAK"
+(* | Space -> "\\SPACE" *)
+ | Ast.Box (box_spec, terms) ->
+ sprintf "\\%s [%s]" (pp_box_spec box_spec)
+ (String.concat " " (List.map pp_term terms))
+ | Ast.Group terms ->
+ sprintf "\\GROUP [%s]" (String.concat " " (List.map pp_term terms))
+
+and pp_magic = function
+ | Ast.List0 (t, sep_opt) ->
+ sprintf "list0 %s%s" (pp_term t) (pp_sep_opt sep_opt)
+ | Ast.List1 (t, sep_opt) ->
+ sprintf "list1 %s%s" (pp_term t) (pp_sep_opt sep_opt)
+ | Ast.Opt t -> sprintf "opt %s" (pp_term t)
+ | Ast.Fold (kind, p_base, names, p_rec) ->
+ let acc = match names with acc :: _ -> acc | _ -> assert false in
+ sprintf "fold %s %s rec %s %s"
+ (pp_fold_kind kind) (pp_term p_base) acc (pp_term p_rec)
+ | Ast.Default (p_some, p_none) ->
+ sprintf "default %s %s" (pp_term p_some) (pp_term p_none)
+ | Ast.If (p_test, p_true, p_false) ->
+ sprintf "if %s then %s else %s"
+ (pp_term p_test) (pp_term p_true) (pp_term p_false)
+ | Ast.Fail -> "fail"
+
+and pp_fold_kind = function
+ | `Left -> "left"
+ | `Right -> "right"
+
+and pp_sep_opt = function
+ | None -> ""
+ | Some sep -> sprintf " sep %s" (pp_literal sep)
+
+and pp_variable = function
+ | Ast.NumVar s -> "number " ^ s
+ | Ast.IdentVar s -> "ident " ^ s
+ | Ast.TermVar s -> "term " ^ s
+ | Ast.Ascription (t, n) -> assert false
+ | Ast.FreshVar n -> "fresh " ^ n
+
+let pp_term t = pp_term ~pp_parens:false t
+
+let pp_params = function
+ | [] -> ""
+ | params ->
+ " " ^
+ String.concat " "
+ (List.map
+ (fun (name, typ) -> sprintf "(%s:%s)" name (pp_term typ))
+ params)
+
+let pp_flavour = function
+ | `Definition -> "Definition"
+ | `Fact -> "Fact"
+ | `Goal -> "Goal"
+ | `Lemma -> "Lemma"
+ | `Remark -> "Remark"
+ | `Theorem -> "Theorem"
+ | `Variant -> "Variant"
+
+let pp_fields fields =
+ (if fields <> [] then "\n" else "") ^
+ String.concat ";\n"
+ (List.map
+ (fun (name,ty,coercion) ->
+ " " ^ name ^ if coercion then ":>" else ": " ^ pp_term ty) fields)
+
+let pp_obj = function
+ | Ast.Inductive (params, types) ->
+ let pp_constructors constructors =
+ String.concat "\n"
+ (List.map (fun (name, typ) -> sprintf "| %s: %s" name (pp_term typ))
+ constructors)
+ in
+ let pp_type (name, _, typ, constructors) =
+ sprintf "\nwith %s: %s \\def\n%s" name (pp_term typ)
+ (pp_constructors constructors)
+ in
+ (match types with
+ | [] -> assert false
+ | (name, inductive, typ, constructors) :: tl ->
+ let fst_typ_pp =
+ sprintf "%sinductive %s%s: %s \\def\n%s"
+ (if inductive then "" else "co") name (pp_params params)
+ (pp_term typ) (pp_constructors constructors)
+ in
+ fst_typ_pp ^ String.concat "" (List.map pp_type tl))
+ | Ast.Theorem (flavour, name, typ, body) ->
+ sprintf "%s %s: %s %s"
+ (pp_flavour flavour)
+ name
+ (pp_term typ)
+ (match body with
+ | None -> ""
+ | Some body -> "\\def " ^ pp_term body)
+ | Ast.Record (params,name,ty,fields) ->
+ "record " ^ name ^ " " ^ pp_params params ^ " \\def {" ^
+ pp_fields fields ^ "}"
+
+let rec pp_value = function
+ | Env.TermValue t -> sprintf "$%s$" (pp_term t)
+ | Env.StringValue s -> sprintf "\"%s\"" s
+ | Env.NumValue n -> n
+ | Env.OptValue (Some v) -> "Some " ^ pp_value v
+ | Env.OptValue None -> "None"
+ | Env.ListValue l -> sprintf "[%s]" (String.concat "; " (List.map pp_value l))
+
+let rec pp_value_type =
+ function
+ | Env.TermType -> "Term"
+ | Env.StringType -> "String"
+ | Env.NumType -> "Number"
+ | Env.OptType t -> "Maybe " ^ pp_value_type t
+ | Env.ListType l -> "List " ^ pp_value_type l
+
+let pp_env env =
+ String.concat "; "
+ (List.map
+ (fun (name, (ty, value)) ->
+ sprintf "%s : %s = %s" name (pp_value_type ty) (pp_value value))
+ env)
+
+let rec pp_cic_appl_pattern = function
+ | Ast.UriPattern uri -> UriManager.string_of_uri uri
+ | Ast.VarPattern name -> name
+ | Ast.ImplicitPattern -> "_"
+ | Ast.ApplPattern aps ->
+ sprintf "(%s)" (String.concat " " (List.map pp_cic_appl_pattern aps))
+
diff --git a/helm/ocaml/acic_content/cicNotationPp.mli b/helm/ocaml/acic_content/cicNotationPp.mli
new file mode 100644
index 000000000..57a4d6b82
--- /dev/null
+++ b/helm/ocaml/acic_content/cicNotationPp.mli
@@ -0,0 +1,37 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val pp_term: CicNotationPt.term -> string
+val pp_obj: CicNotationPt.obj -> string
+
+val pp_env: CicNotationEnv.t -> string
+val pp_value: CicNotationEnv.value -> string
+val pp_value_type: CicNotationEnv.value_type -> string
+
+val pp_pos: CicNotationPt.child_pos -> string
+val pp_attribute: CicNotationPt.term_attribute -> string
+
+val pp_cic_appl_pattern: CicNotationPt.cic_appl_pattern -> string
+
diff --git a/helm/ocaml/acic_content/cicNotationPt.ml b/helm/ocaml/acic_content/cicNotationPt.ml
new file mode 100644
index 000000000..a66aa5feb
--- /dev/null
+++ b/helm/ocaml/acic_content/cicNotationPt.ml
@@ -0,0 +1,190 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+(** CIC Notation Parse Tree *)
+
+type binder_kind = [ `Lambda | `Pi | `Exists | `Forall ]
+type induction_kind = [ `Inductive | `CoInductive ]
+type sort_kind = [ `Prop | `Set | `Type of CicUniv.universe | `CProp ]
+type fold_kind = [ `Left | `Right ]
+
+type location = Token.flocation
+let fail floc msg =
+ let (x, y) = HExtlib.loc_of_floc floc in
+ failwith (Printf.sprintf "Error at characters %d - %d: %s" x y msg)
+
+type href = UriManager.uri
+
+type child_pos = [ `Left | `Right | `Inner ]
+
+type term_attribute =
+ [ `Loc of location (* source file location *)
+ | `IdRef of string (* ACic pointer *)
+ | `Level of int * Gramext.g_assoc (* precedence, associativity *)
+ | `ChildPos of child_pos (* position of l1 pattern variables *)
+ | `XmlAttrs of (string option * string * string) list
+ (* list of XML attributes: namespace, name, value *)
+ | `Raw of string (* unparsed version *)
+ ]
+
+type literal =
+ [ `Symbol of string
+ | `Keyword of string
+ | `Number of string
+ ]
+
+type case_indtype = string * href option
+
+(** To be increased each time the term type below changes, used for "safe"
+ * marshalling *)
+let magic = 1
+
+type term =
+ (* CIC AST *)
+
+ | AttributedTerm of term_attribute * term
+
+ | Appl of term list
+ | Binder of binder_kind * capture_variable * term (* kind, name, body *)
+ | Case of term * case_indtype option * term option *
+ (case_pattern * term) list
+ (* what to match, inductive type, out type, <pattern,action> list *)
+ | Cast of term * term
+ | LetIn of capture_variable * term * term (* name, body, where *)
+ | LetRec of induction_kind * (capture_variable * term * int) list * term
+ (* (name, body, decreasing argument) list, where *)
+ | Ident of string * subst list option
+ (* literal, substitutions.
+ * Some [] -> user has given an empty explicit substitution list
+ * None -> user has given no explicit substitution list *)
+ | Implicit
+ | Meta of int * meta_subst list
+ | Num of string * int (* literal, instance *)
+ | Sort of sort_kind
+ | Symbol of string * int (* canonical name, instance *)
+
+ | UserInput (* place holder for user input, used by MatitaConsole, not to be
+ used elsewhere *)
+ | Uri of string * subst list option (* as Ident, for long names *)
+
+ (* Syntax pattern extensions *)
+
+ | Literal of literal
+ | Layout of layout_pattern
+
+ | Magic of magic_term
+ | Variable of pattern_variable
+
+ (* name, type. First component must be Ident or Variable (FreshVar _) *)
+and capture_variable = term * term option
+
+and meta_subst = term option
+and subst = string * term
+and case_pattern = string * href option * capture_variable list
+
+and box_kind = H | V | HV | HOV
+and box_spec = box_kind * bool * bool (* kind, spacing, indent *)
+
+and layout_pattern =
+ | Sub of term * term
+ | Sup of term * term
+ | Below of term * term
+ | Above of term * term
+ | Frac of term * term
+ | Over of term * term
+ | Atop of term * term
+(* | array of term * literal option * literal option
+ |+ column separator, row separator +| *)
+ | Sqrt of term
+ | Root of term * term (* argument, index *)
+ | Break
+ | Box of box_spec * term list
+ | Group of term list
+
+and magic_term =
+ (* level 1 magics *)
+ | List0 of term * literal option (* pattern, separator *)
+ | List1 of term * literal option (* pattern, separator *)
+ | Opt of term
+
+ (* level 2 magics *)
+ | Fold of fold_kind * term * string list * term
+ (* base case pattern, recursive case bound names, recursive case pattern *)
+ | Default of term * term (* "some" case pattern, "none" case pattern *)
+ | Fail
+ | If of term * term * term (* test, pattern if true, pattern if false *)
+
+and pattern_variable =
+ (* level 1 and 2 variables *)
+ | NumVar of string
+ | IdentVar of string
+ | TermVar of string
+
+ (* level 1 variables *)
+ | Ascription of term * string
+
+ (* level 2 variables *)
+ | FreshVar of string
+
+type argument_pattern =
+ | IdentArg of int * string (* eta-depth, name *)
+
+type cic_appl_pattern =
+ | UriPattern of UriManager.uri
+ | VarPattern of string
+ | ImplicitPattern
+ | ApplPattern of cic_appl_pattern list
+
+ (** <name, inductive/coinductive, type, constructor list>
+ * true means inductive, false coinductive *)
+type 'term inductive_type = string * bool * 'term * (string * 'term) list
+
+type obj =
+ | Inductive of (string * term) list * term inductive_type list
+ (** parameters, list of loc * mutual inductive types *)
+ | Theorem of Cic.object_flavour * string * term * term option
+ (** flavour, name, type, body
+ * - name is absent when an unnamed theorem is being proved, tipically in
+ * interactive usage
+ * - body is present when its given along with the command, otherwise it
+ * will be given in proof editing mode using the tactical language
+ *)
+ | Record of (string * term) list * string * term * (string * term * bool) list
+ (** left parameters, name, type, fields *)
+
+(** {2 Standard precedences} *)
+
+let let_in_prec = 10
+let binder_prec = 20
+let apply_prec = 70
+let simple_prec = 90
+
+let let_in_assoc = Gramext.NonA
+let binder_assoc = Gramext.RightA
+let apply_assoc = Gramext.LeftA
+let simple_assoc = Gramext.NonA
+
diff --git a/helm/ocaml/acic_content/cicNotationUtil.ml b/helm/ocaml/acic_content/cicNotationUtil.ml
new file mode 100644
index 000000000..8e487ed11
--- /dev/null
+++ b/helm/ocaml/acic_content/cicNotationUtil.ml
@@ -0,0 +1,388 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+module Ast = CicNotationPt
+
+let visit_ast ?(special_k = fun _ -> assert false) k =
+ let rec aux = function
+ | Ast.Appl terms -> Ast.Appl (List.map k terms)
+ | Ast.Binder (kind, var, body) ->
+ Ast.Binder (kind, aux_capture_variable var, k body)
+ | Ast.Case (term, indtype, typ, patterns) ->
+ Ast.Case (k term, indtype, aux_opt typ, aux_patterns patterns)
+ | Ast.Cast (t1, t2) -> Ast.Cast (k t1, k t2)
+ | Ast.LetIn (var, t1, t2) ->
+ Ast.LetIn (aux_capture_variable var, k t1, k t2)
+ | Ast.LetRec (kind, definitions, term) ->
+ let definitions =
+ List.map
+ (fun (var, ty, n) -> aux_capture_variable var, k ty, n)
+ definitions
+ in
+ Ast.LetRec (kind, definitions, k term)
+ | Ast.Ident (name, Some substs) ->
+ Ast.Ident (name, Some (aux_substs substs))
+ | Ast.Uri (name, Some substs) -> Ast.Uri (name, Some (aux_substs substs))
+ | Ast.Meta (index, substs) -> Ast.Meta (index, List.map aux_opt substs)
+ | (Ast.AttributedTerm _
+ | Ast.Layout _
+ | Ast.Literal _
+ | Ast.Magic _
+ | Ast.Variable _) as t -> special_k t
+ | (Ast.Ident _
+ | Ast.Implicit
+ | Ast.Num _
+ | Ast.Sort _
+ | Ast.Symbol _
+ | Ast.Uri _
+ | Ast.UserInput) as t -> t
+ and aux_opt = function
+ | None -> None
+ | Some term -> Some (k term)
+ and aux_capture_variable (term, typ_opt) = k term, aux_opt typ_opt
+ and aux_patterns patterns = List.map aux_pattern patterns
+ and aux_pattern ((head, hrefs, vars), term) =
+ ((head, hrefs, List.map aux_capture_variable vars), k term)
+ and aux_subst (name, term) = (name, k term)
+ and aux_substs substs = List.map aux_subst substs
+ in
+ aux
+
+let visit_layout k = function
+ | Ast.Sub (t1, t2) -> Ast.Sub (k t1, k t2)
+ | Ast.Sup (t1, t2) -> Ast.Sup (k t1, k t2)
+ | Ast.Below (t1, t2) -> Ast.Below (k t1, k t2)
+ | Ast.Above (t1, t2) -> Ast.Above (k t1, k t2)
+ | Ast.Over (t1, t2) -> Ast.Over (k t1, k t2)
+ | Ast.Atop (t1, t2) -> Ast.Atop (k t1, k t2)
+ | Ast.Frac (t1, t2) -> Ast.Frac (k t1, k t2)
+ | Ast.Sqrt t -> Ast.Sqrt (k t)
+ | Ast.Root (arg, index) -> Ast.Root (k arg, k index)
+ | Ast.Break -> Ast.Break
+ | Ast.Box (kind, terms) -> Ast.Box (kind, List.map k terms)
+ | Ast.Group terms -> Ast.Group (List.map k terms)
+
+let visit_magic k = function
+ | Ast.List0 (t, l) -> Ast.List0 (k t, l)
+ | Ast.List1 (t, l) -> Ast.List1 (k t, l)
+ | Ast.Opt t -> Ast.Opt (k t)
+ | Ast.Fold (kind, t1, names, t2) -> Ast.Fold (kind, k t1, names, k t2)
+ | Ast.Default (t1, t2) -> Ast.Default (k t1, k t2)
+ | Ast.If (t1, t2, t3) -> Ast.If (k t1, k t2, k t3)
+ | Ast.Fail -> Ast.Fail
+
+let visit_variable k = function
+ | Ast.NumVar _
+ | Ast.IdentVar _
+ | Ast.TermVar _
+ | Ast.FreshVar _ as t -> t
+ | Ast.Ascription (t, s) -> Ast.Ascription (k t, s)
+
+let variables_of_term t =
+ let rec vars = ref [] in
+ let add_variable v =
+ if List.mem v !vars then ()
+ else vars := v :: !vars
+ in
+ let rec aux = function
+ | Ast.Magic m -> Ast.Magic (visit_magic aux m)
+ | Ast.Layout l -> Ast.Layout (visit_layout aux l)
+ | Ast.Variable v -> Ast.Variable (aux_variable v)
+ | Ast.Literal _ as t -> t
+ | Ast.AttributedTerm (_, t) -> aux t
+ | t -> visit_ast aux t
+ and aux_variable = function
+ | (Ast.NumVar _
+ | Ast.IdentVar _
+ | Ast.TermVar _) as t ->
+ add_variable t ;
+ t
+ | Ast.FreshVar _ as t -> t
+ | Ast.Ascription _ -> assert false
+ in
+ ignore (aux t) ;
+ !vars
+
+let names_of_term t =
+ let aux = function
+ | Ast.NumVar s
+ | Ast.IdentVar s
+ | Ast.TermVar s -> s
+ | _ -> assert false
+ in
+ List.map aux (variables_of_term t)
+
+let keywords_of_term t =
+ let rec keywords = ref [] in
+ let add_keyword k = keywords := k :: !keywords in
+ let rec aux = function
+ | Ast.AttributedTerm (_, t) -> aux t
+ | Ast.Layout l -> Ast.Layout (visit_layout aux l)
+ | Ast.Literal (`Keyword k) as t ->
+ add_keyword k;
+ t
+ | Ast.Literal _ as t -> t
+ | Ast.Magic m -> Ast.Magic (visit_magic aux m)
+ | Ast.Variable _ as v -> v
+ | t -> visit_ast aux t
+ in
+ ignore (aux t) ;
+ !keywords
+
+let rec strip_attributes t =
+ let special_k = function
+ | Ast.AttributedTerm (_, term) -> strip_attributes term
+ | Ast.Magic m -> Ast.Magic (visit_magic strip_attributes m)
+ | Ast.Variable _ as t -> t
+ | t -> assert false
+ in
+ visit_ast ~special_k strip_attributes t
+
+let rec get_idrefs =
+ function
+ | Ast.AttributedTerm (`IdRef id, t) -> id :: get_idrefs t
+ | Ast.AttributedTerm (_, t) -> get_idrefs t
+ | _ -> []
+
+let meta_names_of_term term =
+ let rec names = ref [] in
+ let add_name n =
+ if List.mem n !names then ()
+ else names := n :: !names
+ in
+ let rec aux = function
+ | Ast.AttributedTerm (_, term) -> aux term
+ | Ast.Appl terms -> List.iter aux terms
+ | Ast.Binder (_, _, body) -> aux body
+ | Ast.Case (term, indty, outty_opt, patterns) ->
+ aux term ;
+ aux_opt outty_opt ;
+ List.iter aux_branch patterns
+ | Ast.LetIn (_, t1, t2) ->
+ aux t1 ;
+ aux t2
+ | Ast.LetRec (_, definitions, body) ->
+ List.iter aux_definition definitions ;
+ aux body
+ | Ast.Uri (_, Some substs) -> aux_substs substs
+ | Ast.Ident (_, Some substs) -> aux_substs substs
+ | Ast.Meta (_, substs) -> aux_meta_substs substs
+
+ | Ast.Implicit
+ | Ast.Ident _
+ | Ast.Num _
+ | Ast.Sort _
+ | Ast.Symbol _
+ | Ast.Uri _
+ | Ast.UserInput -> ()
+
+ | Ast.Magic magic -> aux_magic magic
+ | Ast.Variable var -> aux_variable var
+
+ | _ -> assert false
+ and aux_opt = function
+ | Some term -> aux term
+ | None -> ()
+ and aux_capture_var (_, ty_opt) = aux_opt ty_opt
+ and aux_branch (pattern, term) =
+ aux_pattern pattern ;
+ aux term
+ and aux_pattern (head, _, vars) =
+ List.iter aux_capture_var vars
+ and aux_definition (var, term, i) =
+ aux_capture_var var ;
+ aux term
+ and aux_substs substs = List.iter (fun (_, term) -> aux term) substs
+ and aux_meta_substs meta_substs = List.iter aux_opt meta_substs
+ and aux_variable = function
+ | Ast.NumVar name -> add_name name
+ | Ast.IdentVar name -> add_name name
+ | Ast.TermVar name -> add_name name
+ | Ast.FreshVar _ -> ()
+ | Ast.Ascription _ -> assert false
+ and aux_magic = function
+ | Ast.Default (t1, t2)
+ | Ast.Fold (_, t1, _, t2) ->
+ aux t1 ;
+ aux t2
+ | Ast.If (t1, t2, t3) ->
+ aux t1 ;
+ aux t2 ;
+ aux t3
+ | Ast.Fail -> ()
+ | _ -> assert false
+ in
+ aux term ;
+ !names
+
+let rectangular matrix =
+ let columns = Array.length matrix.(0) in
+ try
+ Array.iter (fun a -> if Array.length a <> columns then raise Exit) matrix;
+ true
+ with Exit -> false
+
+let ncombine ll =
+ let matrix = Array.of_list (List.map Array.of_list ll) in
+ assert (rectangular matrix);
+ let rows = Array.length matrix in
+ let columns = Array.length matrix.(0) in
+ let lists = ref [] in
+ for j = 0 to columns - 1 do
+ let l = ref [] in
+ for i = 0 to rows - 1 do
+ l := matrix.(i).(j) :: !l
+ done;
+ lists := List.rev !l :: !lists
+ done;
+ List.rev !lists
+
+let string_of_literal = function
+ | `Symbol s
+ | `Keyword s
+ | `Number s -> s
+
+let boxify = function
+ | [ a ] -> a
+ | l -> Ast.Layout (Ast.Box ((Ast.H, false, false), l))
+
+let unboxify = function
+ | Ast.Layout (Ast.Box ((Ast.H, false, false), [ a ])) -> a
+ | l -> l
+
+let group = function
+ | [ a ] -> a
+ | l -> Ast.Layout (Ast.Group l)
+
+let ungroup =
+ let rec aux acc =
+ function
+ [] -> List.rev acc
+ | Ast.Layout (Ast.Group terms) :: terms' -> aux acc (terms @ terms')
+ | term :: terms -> aux (term :: acc) terms
+ in
+ aux []
+
+let dress ~sep:sauce =
+ let rec aux =
+ function
+ | [] -> []
+ | [hd] -> [hd]
+ | hd :: tl -> hd :: sauce :: aux tl
+ in
+ aux
+
+let dressn ~sep:sauces =
+ let rec aux =
+ function
+ | [] -> []
+ | [hd] -> [hd]
+ | hd :: tl -> hd :: sauces @ aux tl
+ in
+ aux
+
+let find_appl_pattern_uris ap =
+ let rec aux acc =
+ function
+ | Ast.UriPattern uri -> uri :: acc
+ | Ast.ImplicitPattern
+ | Ast.VarPattern _ -> acc
+ | Ast.ApplPattern apl -> List.fold_left aux acc apl
+ in
+ let uris = aux [] ap in
+ HExtlib.list_uniq (List.fast_sort UriManager.compare uris)
+
+let rec find_branch =
+ function
+ Ast.Magic (Ast.If (_, Ast.Magic Ast.Fail, t)) -> find_branch t
+ | Ast.Magic (Ast.If (_, t, _)) -> find_branch t
+ | t -> t
+
+let cic_name_of_name = function
+ | Ast.Ident ("_", None) -> Cic.Anonymous
+ | Ast.Ident (name, None) -> Cic.Name name
+ | _ -> assert false
+
+let name_of_cic_name =
+(* let add_dummy_xref t = Ast.AttributedTerm (`IdRef "", t) in *)
+ (* ZACK why we used to generate dummy xrefs? *)
+ let add_dummy_xref t = t in
+ function
+ | Cic.Name s -> add_dummy_xref (Ast.Ident (s, None))
+ | Cic.Anonymous -> add_dummy_xref (Ast.Ident ("_", None))
+
+let fresh_index = ref ~-1
+
+type notation_id = int
+
+let fresh_id () =
+ incr fresh_index;
+ !fresh_index
+
+ (* TODO ensure that names generated by fresh_var do not clash with user's *)
+let fresh_name () = "fresh" ^ string_of_int (fresh_id ())
+
+let rec freshen_term ?(index = ref 0) term =
+ let freshen_term = freshen_term ~index in
+ let fresh_instance () = incr index; !index in
+ let special_k = function
+ | Ast.AttributedTerm (attr, t) -> Ast.AttributedTerm (attr, freshen_term t)
+ | Ast.Layout l -> Ast.Layout (visit_layout freshen_term l)
+ | Ast.Magic m -> Ast.Magic (visit_magic freshen_term m)
+ | Ast.Variable v -> Ast.Variable (visit_variable freshen_term v)
+ | Ast.Literal _ as t -> t
+ | _ -> assert false
+ in
+ match term with
+ | Ast.Symbol (s, instance) -> Ast.Symbol (s, fresh_instance ())
+ | Ast.Num (s, instance) -> Ast.Num (s, fresh_instance ())
+ | t -> visit_ast ~special_k freshen_term t
+
+let freshen_obj obj =
+ let index = ref 0 in
+ let freshen_term = freshen_term ~index in
+ let freshen_name_ty = List.map (fun (n, t) -> (n, freshen_term t)) in
+ let freshen_name_ty_b = List.map (fun (n, t, b) -> (n, freshen_term t, b)) in
+ match obj with
+ | CicNotationPt.Inductive (params, indtypes) ->
+ let indtypes =
+ List.map
+ (fun (n, co, ty, ctors) -> (n, co, ty, freshen_name_ty ctors))
+ indtypes
+ in
+ CicNotationPt.Inductive (freshen_name_ty params, indtypes)
+ | CicNotationPt.Theorem (flav, n, t, ty_opt) ->
+ let ty_opt =
+ match ty_opt with None -> None | Some ty -> Some (freshen_term ty)
+ in
+ CicNotationPt.Theorem (flav, n, freshen_term t, ty_opt)
+ | CicNotationPt.Record (params, n, ty, fields) ->
+ CicNotationPt.Record (freshen_name_ty params, n, freshen_term ty,
+ freshen_name_ty_b fields)
+
+let freshen_term = freshen_term ?index:None
+
diff --git a/helm/ocaml/acic_content/cicNotationUtil.mli b/helm/ocaml/acic_content/cicNotationUtil.mli
new file mode 100644
index 000000000..5d309d68f
--- /dev/null
+++ b/helm/ocaml/acic_content/cicNotationUtil.mli
@@ -0,0 +1,91 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val fresh_name: unit -> string
+
+val variables_of_term: CicNotationPt.term -> CicNotationPt.pattern_variable list
+val names_of_term: CicNotationPt.term -> string list
+
+ (** extract all keywords (i.e. string literals) from a level 1 pattern *)
+val keywords_of_term: CicNotationPt.term -> string list
+
+val visit_ast:
+ ?special_k:(CicNotationPt.term -> CicNotationPt.term) ->
+ (CicNotationPt.term -> CicNotationPt.term) ->
+ CicNotationPt.term ->
+ CicNotationPt.term
+
+val visit_layout:
+ (CicNotationPt.term -> CicNotationPt.term) ->
+ CicNotationPt.layout_pattern ->
+ CicNotationPt.layout_pattern
+
+val visit_magic:
+ (CicNotationPt.term -> CicNotationPt.term) ->
+ CicNotationPt.magic_term ->
+ CicNotationPt.magic_term
+
+val visit_variable:
+ (CicNotationPt.term -> CicNotationPt.term) ->
+ CicNotationPt.pattern_variable ->
+ CicNotationPt.pattern_variable
+
+val strip_attributes: CicNotationPt.term -> CicNotationPt.term
+
+ (** @return the list of proper (i.e. non recursive) IdRef of a term *)
+val get_idrefs: CicNotationPt.term -> string list
+
+ (** generalization of List.combine to n lists *)
+val ncombine: 'a list list -> 'a list list
+
+val string_of_literal: CicNotationPt.literal -> string
+
+val dress: sep:'a -> 'a list -> 'a list
+val dressn: sep:'a list -> 'a list -> 'a list
+
+val boxify: CicNotationPt.term list -> CicNotationPt.term
+val group: CicNotationPt.term list -> CicNotationPt.term
+val ungroup: CicNotationPt.term list -> CicNotationPt.term list
+
+val find_appl_pattern_uris:
+ CicNotationPt.cic_appl_pattern -> UriManager.uri list
+
+val find_branch:
+ CicNotationPt.term -> CicNotationPt.term
+
+val cic_name_of_name: CicNotationPt.term -> Cic.name
+val name_of_cic_name: Cic.name -> CicNotationPt.term
+
+ (** Symbol/Numbers instances *)
+
+val freshen_term: CicNotationPt.term -> CicNotationPt.term
+val freshen_obj: CicNotationPt.obj -> CicNotationPt.obj
+
+ (** Notation id handling *)
+
+type notation_id
+
+val fresh_id: unit -> notation_id
+
diff --git a/helm/ocaml/acic_content/content.ml b/helm/ocaml/acic_content/content.ml
new file mode 100644
index 000000000..22733dcaa
--- /dev/null
+++ b/helm/ocaml/acic_content/content.ml
@@ -0,0 +1,169 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(**************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Andrea Asperti <asperti@cs.unibo.it> *)
+(* 16/6/2003 *)
+(* *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+type id = string;;
+type joint_recursion_kind =
+ [ `Recursive of int list
+ | `CoRecursive
+ | `Inductive of int (* paramsno *)
+ | `CoInductive of int (* paramsno *)
+ ]
+;;
+
+type var_or_const = Var | Const;;
+
+type 'term declaration =
+ { dec_name : string option;
+ dec_id : id ;
+ dec_inductive : bool;
+ dec_aref : string;
+ dec_type : 'term
+ }
+;;
+
+type 'term definition =
+ { def_name : string option;
+ def_id : id ;
+ def_aref : string ;
+ def_term : 'term
+ }
+;;
+
+type 'term inductive =
+ { inductive_id : id ;
+ inductive_name : string;
+ inductive_kind : bool;
+ inductive_type : 'term;
+ inductive_constructors : 'term declaration list
+ }
+;;
+
+type 'term decl_context_element =
+ [ `Declaration of 'term declaration
+ | `Hypothesis of 'term declaration
+ ]
+;;
+
+type ('term,'proof) def_context_element =
+ [ `Proof of 'proof
+ | `Definition of 'term definition
+ ]
+;;
+
+type ('term,'proof) in_joint_context_element =
+ [ `Inductive of 'term inductive
+ | 'term decl_context_element
+ | ('term,'proof) def_context_element
+ ]
+;;
+
+type ('term,'proof) joint =
+ { joint_id : id ;
+ joint_kind : joint_recursion_kind ;
+ joint_defs : ('term,'proof) in_joint_context_element list
+ }
+;;
+
+type ('term,'proof) joint_context_element =
+ [ `Joint of ('term,'proof) joint ]
+;;
+
+type 'term proof =
+ { proof_name : string option;
+ proof_id : id ;
+ proof_context : 'term in_proof_context_element list ;
+ proof_apply_context: 'term proof list;
+ proof_conclude : 'term conclude_item
+ }
+
+and 'term in_proof_context_element =
+ [ 'term decl_context_element
+ | ('term,'term proof) def_context_element
+ | ('term,'term proof) joint_context_element
+ ]
+
+and 'term conclude_item =
+ { conclude_id : id;
+ conclude_aref : string;
+ conclude_method : string;
+ conclude_args : ('term arg) list ;
+ conclude_conclusion : 'term option
+ }
+
+and 'term arg =
+ Aux of string
+ | Premise of premise
+ | Lemma of lemma
+ | Term of 'term
+ | ArgProof of 'term proof
+ | ArgMethod of string (* ???? *)
+
+and premise =
+ { premise_id: id;
+ premise_xref : string ;
+ premise_binder : string option;
+ premise_n : int option;
+ }
+
+and lemma =
+ { lemma_id: id;
+ lemma_name: string;
+ lemma_uri: string
+ }
+
+;;
+
+type 'term conjecture = id * int * 'term context * 'term
+
+and 'term context = 'term hypothesis list
+
+and 'term hypothesis =
+ ['term decl_context_element | ('term,'term proof) def_context_element ] option
+;;
+
+type 'term in_object_context_element =
+ [ `Decl of var_or_const * 'term decl_context_element
+ | `Def of var_or_const * 'term * ('term,'term proof) def_context_element
+ | ('term,'term proof) joint_context_element
+ ]
+;;
+
+type 'term cobj =
+ id * (* id *)
+ UriManager.uri list * (* params *)
+ 'term conjecture list option * (* optional metasenv *)
+ 'term in_object_context_element (* actual object *)
+;;
diff --git a/helm/ocaml/acic_content/content.mli b/helm/ocaml/acic_content/content.mli
new file mode 100644
index 000000000..c1122b8f2
--- /dev/null
+++ b/helm/ocaml/acic_content/content.mli
@@ -0,0 +1,157 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+type id = string;;
+type joint_recursion_kind =
+ [ `Recursive of int list (* decreasing arguments *)
+ | `CoRecursive
+ | `Inductive of int (* paramsno *)
+ | `CoInductive of int (* paramsno *)
+ ]
+;;
+
+type var_or_const = Var | Const;;
+
+type 'term declaration =
+ { dec_name : string option;
+ dec_id : id ;
+ dec_inductive : bool;
+ dec_aref : string;
+ dec_type : 'term
+ }
+;;
+
+type 'term definition =
+ { def_name : string option;
+ def_id : id ;
+ def_aref : string ;
+ def_term : 'term
+ }
+;;
+
+type 'term inductive =
+ { inductive_id : id ;
+ inductive_name : string;
+ inductive_kind : bool;
+ inductive_type : 'term;
+ inductive_constructors : 'term declaration list
+ }
+;;
+
+type 'term decl_context_element =
+ [ `Declaration of 'term declaration
+ | `Hypothesis of 'term declaration
+ ]
+;;
+
+type ('term,'proof) def_context_element =
+ [ `Proof of 'proof
+ | `Definition of 'term definition
+ ]
+;;
+
+type ('term,'proof) in_joint_context_element =
+ [ `Inductive of 'term inductive
+ | 'term decl_context_element
+ | ('term,'proof) def_context_element
+ ]
+;;
+
+type ('term,'proof) joint =
+ { joint_id : id ;
+ joint_kind : joint_recursion_kind ;
+ joint_defs : ('term,'proof) in_joint_context_element list
+ }
+;;
+
+type ('term,'proof) joint_context_element =
+ [ `Joint of ('term,'proof) joint ]
+;;
+
+type 'term proof =
+ { proof_name : string option;
+ proof_id : id ;
+ proof_context : 'term in_proof_context_element list ;
+ proof_apply_context: 'term proof list;
+ proof_conclude : 'term conclude_item
+ }
+
+and 'term in_proof_context_element =
+ [ 'term decl_context_element
+ | ('term,'term proof) def_context_element
+ | ('term,'term proof) joint_context_element
+ ]
+
+and 'term conclude_item =
+ { conclude_id : id;
+ conclude_aref : string;
+ conclude_method : string;
+ conclude_args : ('term arg) list ;
+ conclude_conclusion : 'term option
+ }
+
+and 'term arg =
+ Aux of string
+ | Premise of premise
+ | Lemma of lemma
+ | Term of 'term
+ | ArgProof of 'term proof
+ | ArgMethod of string (* ???? *)
+
+and premise =
+ { premise_id: id;
+ premise_xref : string ;
+ premise_binder : string option;
+ premise_n : int option;
+ }
+
+and lemma =
+ { lemma_id: id;
+ lemma_name : string;
+ lemma_uri: string
+ }
+;;
+
+type 'term conjecture = id * int * 'term context * 'term
+
+and 'term context = 'term hypothesis list
+
+and 'term hypothesis =
+ ['term decl_context_element | ('term,'term proof) def_context_element ] option
+;;
+
+type 'term in_object_context_element =
+ [ `Decl of var_or_const * 'term decl_context_element
+ | `Def of var_or_const * 'term * ('term,'term proof) def_context_element
+ | ('term,'term proof) joint_context_element
+ ]
+;;
+
+type 'term cobj =
+ id * (* id *)
+ UriManager.uri list * (* params *)
+ 'term conjecture list option * (* optional metasenv *)
+ 'term in_object_context_element (* actual object *)
+;;
diff --git a/helm/ocaml/acic_content/content2cic.ml b/helm/ocaml/acic_content/content2cic.ml
new file mode 100644
index 000000000..9acea81fa
--- /dev/null
+++ b/helm/ocaml/acic_content/content2cic.ml
@@ -0,0 +1,270 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(***************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Andrea Asperti <asperti@cs.unibo.it> *)
+(* 17/06/2003 *)
+(* *)
+(***************************************************************************)
+
+(* $Id$ *)
+
+exception TO_DO;;
+
+let proof2cic deannotate p =
+ let rec proof2cic premise_env p =
+ let module C = Cic in
+ let module Con = Content in
+ let rec extend_premise_env current_env =
+ function
+ [] -> current_env
+ | p::atl ->
+ extend_premise_env
+ ((p.Con.proof_id,(proof2cic current_env p))::current_env) atl in
+ let new_premise_env = extend_premise_env premise_env p.Con.proof_apply_context in
+ let body = conclude2cic new_premise_env p.Con.proof_conclude in
+ context2cic premise_env p.Con.proof_context body
+
+ and context2cic premise_env context body =
+ List.fold_right (ce2cic premise_env) context body
+
+ and ce2cic premise_env ce target =
+ let module C = Cic in
+ let module Con = Content in
+ match ce with
+ `Declaration d ->
+ (match d.Con.dec_name with
+ Some s ->
+ C.Lambda (C.Name s, deannotate d.Con.dec_type, target)
+ | None ->
+ C.Lambda (C.Anonymous, deannotate d.Con.dec_type, target))
+ | `Hypothesis h ->
+ (match h.Con.dec_name with
+ Some s ->
+ C.Lambda (C.Name s, deannotate h.Con.dec_type, target)
+ | None ->
+ C.Lambda (C.Anonymous, deannotate h.Con.dec_type, target))
+ | `Proof p ->
+ (match p.Con.proof_name with
+ Some s ->
+ C.LetIn (C.Name s, proof2cic premise_env p, target)
+ | None ->
+ C.LetIn (C.Anonymous, proof2cic premise_env p, target))
+ | `Definition d ->
+ (match d.Con.def_name with
+ Some s ->
+ C.LetIn (C.Name s, proof2cic premise_env p, target)
+ | None ->
+ C.LetIn (C.Anonymous, proof2cic premise_env p, target))
+ | `Joint {Con.joint_kind = kind; Con.joint_defs = defs} ->
+ (match target with
+ C.Rel n ->
+ (match kind with
+ `Recursive l ->
+ let funs =
+ List.map2
+ (fun n bo ->
+ match bo with
+ `Proof bo ->
+ (match
+ bo.Con.proof_conclude.Con.conclude_conclusion,
+ bo.Con.proof_name
+ with
+ Some ty, Some name ->
+ (name,n,deannotate ty,
+ proof2cic premise_env bo)
+ | _,_ -> assert false)
+ | _ -> assert false)
+ l defs in
+ C.Fix (n, funs)
+ | `CoRecursive ->
+ let funs =
+ List.map
+ (function bo ->
+ match bo with
+ `Proof bo ->
+ (match
+ bo.Con.proof_conclude.Con.conclude_conclusion,
+ bo.Con.proof_name
+ with
+ Some ty, Some name ->
+ (name,deannotate ty,
+ proof2cic premise_env bo)
+ | _,_ -> assert false)
+ | _ -> assert false)
+ defs in
+ C.CoFix (n, funs)
+ | _ -> (* no inductive types in local contexts *)
+ assert false)
+ | _ -> assert false)
+
+ and conclude2cic premise_env conclude =
+ let module C = Cic in
+ let module Con = Content in
+ if conclude.Con.conclude_method = "TD_Conversion" then
+ (match conclude.Con.conclude_args with
+ [Con.ArgProof p] -> proof2cic [] p (* empty! *)
+ | _ -> prerr_endline "1"; assert false)
+ else if conclude.Con.conclude_method = "BU_Conversion" then
+ (match conclude.Con.conclude_args with
+ [Con.Premise prem] ->
+ (try List.assoc prem.Con.premise_xref premise_env
+ with Not_found ->
+ prerr_endline
+ ("Not_found in BU_Conversion: " ^ prem.Con.premise_xref);
+ raise Not_found)
+ | _ -> prerr_endline "2"; assert false)
+ else if conclude.Con.conclude_method = "Exact" then
+ (match conclude.Con.conclude_args with
+ [Con.Term t] -> deannotate t
+ | [Con.Premise prem] ->
+ (match prem.Con.premise_n with
+ None -> assert false
+ | Some n -> C.Rel n)
+ | _ -> prerr_endline "3"; assert false)
+ else if conclude.Con.conclude_method = "Intros+LetTac" then
+ (match conclude.Con.conclude_args with
+ [Con.ArgProof p] -> proof2cic [] p (* empty! *)
+ | _ -> prerr_endline "4"; assert false)
+ else if (conclude.Con.conclude_method = "ByInduction" ||
+ conclude.Con.conclude_method = "AndInd" ||
+ conclude.Con.conclude_method = "Exists" ||
+ conclude.Con.conclude_method = "FalseInd") then
+ (match (List.tl conclude.Con.conclude_args) with
+ Con.Term (C.AAppl (
+ id,((C.AConst(idc,uri,exp_named_subst))::params_and_IP)))::args ->
+ let subst =
+ List.map (fun (u,t) -> (u, deannotate t)) exp_named_subst in
+ let cargs = args2cic premise_env args in
+ let cparams_and_IP = List.map deannotate params_and_IP in
+ C.Appl (C.Const(uri,subst)::cparams_and_IP@cargs)
+ | _ -> prerr_endline "5"; assert false)
+ else if (conclude.Con.conclude_method = "Rewrite") then
+ (match conclude.Con.conclude_args with
+ Con.Term (C.AConst (sid,uri,exp_named_subst))::args ->
+ let subst =
+ List.map (fun (u,t) -> (u, deannotate t)) exp_named_subst in
+ let cargs = args2cic premise_env args in
+ C.Appl (C.Const(uri,subst)::cargs)
+ | _ -> prerr_endline "6"; assert false)
+ else if (conclude.Con.conclude_method = "Case") then
+ (match conclude.Con.conclude_args with
+ Con.Aux(uri)::Con.Aux(notype)::Con.Term(ty)::Con.Premise(prem)::patterns ->
+ C.MutCase
+ (UriManager.uri_of_string uri,
+ int_of_string notype, deannotate ty,
+ List.assoc prem.Con.premise_xref premise_env,
+ List.map
+ (function
+ Con.ArgProof p -> proof2cic [] p
+ | _ -> prerr_endline "7a"; assert false) patterns)
+ | Con.Aux(uri)::Con.Aux(notype)::Con.Term(ty)::Con.Term(te)::patterns -> C.MutCase
+ (UriManager.uri_of_string uri,
+ int_of_string notype, deannotate ty, deannotate te,
+ List.map
+ (function
+ (Con.ArgProof p) -> proof2cic [] p
+ | _ -> prerr_endline "7a"; assert false) patterns)
+ | _ -> (prerr_endline "7"; assert false))
+ else if (conclude.Con.conclude_method = "Apply") then
+ let cargs = (args2cic premise_env conclude.Con.conclude_args) in
+ C.Appl cargs
+ else (prerr_endline "8"; assert false)
+
+ and args2cic premise_env l =
+ List.map (arg2cic premise_env) l
+
+ and arg2cic premise_env =
+ let module C = Cic in
+ let module Con = Content in
+ function
+ Con.Aux n -> prerr_endline "8"; assert false
+ | Con.Premise prem ->
+ (match prem.Con.premise_n with
+ Some n -> C.Rel n
+ | None ->
+ (try List.assoc prem.Con.premise_xref premise_env
+ with Not_found ->
+ prerr_endline ("Not_found in arg2cic: premise " ^ (match prem.Con.premise_binder with None -> "previous" | Some p -> p) ^ ", xref=" ^ prem.Con.premise_xref);
+ raise Not_found))
+ | Con.Lemma lemma ->
+ CicUtil.term_of_uri (UriManager.uri_of_string lemma.Con.lemma_uri)
+ | Con.Term t -> deannotate t
+ | Con.ArgProof p -> proof2cic [] p (* empty! *)
+ | Con.ArgMethod s -> raise TO_DO
+
+in proof2cic [] p
+;;
+
+exception ToDo;;
+
+let cobj2obj deannotate (id,params,metasenv,obj) =
+ let module K = Content in
+ match obj with
+ `Def (Content.Const,ty,`Proof bo) ->
+ (match metasenv with
+ None ->
+ Cic.Constant
+ (id, Some (proof2cic deannotate bo), deannotate ty, params, [])
+ | Some metasenv' ->
+ let metasenv'' =
+ List.map
+ (function (_,i,canonical_context,term) ->
+ let canonical_context' =
+ List.map
+ (function
+ None -> None
+ | Some (`Declaration d)
+ | Some (`Hypothesis d) ->
+ (match d with
+ {K.dec_name = Some n ; K.dec_type = t} ->
+ Some (Cic.Name n, Cic.Decl (deannotate t))
+ | _ -> assert false)
+ | Some (`Definition d) ->
+ (match d with
+ {K.def_name = Some n ; K.def_term = t} ->
+ Some (Cic.Name n, Cic.Def ((deannotate t),None))
+ | _ -> assert false)
+ | Some (`Proof d) ->
+ (match d with
+ {K.proof_name = Some n } ->
+ Some (Cic.Name n,
+ Cic.Def ((proof2cic deannotate d),None))
+ | _ -> assert false)
+ ) canonical_context
+ in
+ (i,canonical_context',deannotate term)
+ ) metasenv'
+ in
+ Cic.CurrentProof
+ (id, metasenv'', proof2cic deannotate bo, deannotate ty, params,
+ []))
+ | _ -> raise ToDo
+;;
+
+let cobj2obj = cobj2obj Deannotate.deannotate_term;;
diff --git a/helm/ocaml/acic_content/content2cic.mli b/helm/ocaml/acic_content/content2cic.mli
new file mode 100644
index 000000000..9bb6509cc
--- /dev/null
+++ b/helm/ocaml/acic_content/content2cic.mli
@@ -0,0 +1,35 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(**************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Andrea Asperti <asperti@cs.unibo.it> *)
+(* 27/6/2003 *)
+(* *)
+(**************************************************************************)
+
+val cobj2obj : Cic.annterm Content.cobj -> Cic.obj
diff --git a/helm/ocaml/acic_content/contentPp.ml b/helm/ocaml/acic_content/contentPp.ml
new file mode 100644
index 000000000..ca89fad7d
--- /dev/null
+++ b/helm/ocaml/acic_content/contentPp.ml
@@ -0,0 +1,158 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(***************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Andrea Asperti <asperti@cs.unibo.it> *)
+(* 17/06/2003 *)
+(* *)
+(***************************************************************************)
+
+(* $Id$ *)
+
+exception ContentPpInternalError;;
+exception NotEnoughElements;;
+exception TO_DO
+
+(* Utility functions *)
+
+
+let string_of_name =
+ function
+ Some s -> s
+ | None -> "_"
+;;
+
+(* get_nth l n returns the nth element of the list l if it exists or *)
+(* raises NotEnoughElements if l has less than n elements *)
+let rec get_nth l n =
+ match (n,l) with
+ (1, he::_) -> he
+ | (n, he::tail) when n > 1 -> get_nth tail (n-1)
+ | (_,_) -> raise NotEnoughElements
+;;
+
+let rec blanks n =
+ if n = 0 then ""
+ else (" " ^ (blanks (n-1)));;
+
+let rec pproof (p: Cic.annterm Content.proof) indent =
+ let module Con = Content in
+ let new_indent =
+ (match p.Con.proof_name with
+ Some s ->
+ prerr_endline
+ ((blanks indent) ^ "(" ^ s ^ ")"); flush stderr ;(indent + 1)
+ | None ->indent) in
+ let new_indent1 =
+ if (p.Con.proof_context = []) then new_indent
+ else
+ (pcontext p.Con.proof_context new_indent; (new_indent + 1)) in
+ papply_context p.Con.proof_apply_context new_indent1;
+ pconclude p.Con.proof_conclude new_indent1;
+
+and pcontext c indent =
+ List.iter (pcontext_element indent) c
+
+and pcontext_element indent =
+ let module Con = Content in
+ function
+ `Declaration d ->
+ (match d.Con.dec_name with
+ Some s ->
+ prerr_endline
+ ((blanks indent)
+ ^ "Assume " ^ s ^ " : "
+ ^ (CicPp.ppterm (Deannotate.deannotate_term d.Con.dec_type)));
+ flush stderr
+ | None ->
+ prerr_endline ((blanks indent) ^ "NO NAME!!"))
+ | `Hypothesis h ->
+ (match h.Con.dec_name with
+ Some s ->
+ prerr_endline
+ ((blanks indent)
+ ^ "Suppose " ^ s ^ " : "
+ ^ (CicPp.ppterm (Deannotate.deannotate_term h.Con.dec_type)));
+ flush stderr
+ | None ->
+ prerr_endline ((blanks indent) ^ "NO NAME!!"))
+ | `Proof p -> pproof p indent
+ | `Definition d ->
+ (match d.Con.def_name with
+ Some s ->
+ prerr_endline
+ ((blanks indent) ^ "Let " ^ s ^ " = "
+ ^ (CicPp.ppterm (Deannotate.deannotate_term d.Con.def_term)));
+ flush stderr
+ | None ->
+ prerr_endline ((blanks indent) ^ "NO NAME!!"))
+ | `Joint ho ->
+ prerr_endline ((blanks indent) ^ "Joint Def");
+ flush stderr
+
+and papply_context ac indent =
+ List.iter(function p -> (pproof p indent)) ac
+
+and pconclude concl indent =
+ let module Con = Content in
+ prerr_endline ((blanks indent) ^ "Apply method " ^ concl.Con.conclude_method ^ " to");flush stderr;
+ pargs concl.Con.conclude_args indent;
+ match concl.Con.conclude_conclusion with
+ None -> prerr_endline ((blanks indent) ^"No conclude conclusion");flush stderr
+ | Some t -> prerr_endline ((blanks indent) ^ "conclude" ^ concl.Con.conclude_method ^ (CicPp.ppterm (Deannotate.deannotate_term t)));flush stderr
+
+and pargs args indent =
+ List.iter (parg indent) args
+
+and parg indent =
+ let module Con = Content in
+ function
+ Con.Aux n -> prerr_endline ((blanks (indent+1)) ^ n)
+ | Con.Premise prem -> prerr_endline ((blanks (indent+1)) ^ "Premise")
+ | Con.Lemma lemma -> prerr_endline ((blanks (indent+1)) ^ "Lemma")
+ | Con.Term t ->
+ prerr_endline ((blanks (indent+1)) ^ (CicPp.ppterm (Deannotate.deannotate_term t)))
+ | Con.ArgProof p -> pproof p (indent+1)
+ | Con.ArgMethod s -> prerr_endline ((blanks (indent+1)) ^ "A Method !!!")
+;;
+
+let print_proof p = pproof p 0;;
+
+let print_obj (_,_,_,obj) =
+ match obj with
+ `Decl (_,decl) ->
+ pcontext_element 0 (decl:> Cic.annterm Content.in_proof_context_element)
+ | `Def (_,_,def) ->
+ pcontext_element 0 (def:> Cic.annterm Content.in_proof_context_element)
+ | `Joint _ as jo -> pcontext_element 0 jo
+;;
+
+
+
+
+
diff --git a/helm/ocaml/acic_content/contentPp.mli b/helm/ocaml/acic_content/contentPp.mli
new file mode 100644
index 000000000..a160ab1ff
--- /dev/null
+++ b/helm/ocaml/acic_content/contentPp.mli
@@ -0,0 +1,30 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val print_proof: Cic.annterm Content.proof -> unit
+
+val print_obj: Cic.annterm Content.cobj -> unit
+
+val parg: int -> Cic.annterm Content.arg ->unit
diff --git a/helm/ocaml/acic_content/termAcicContent.ml b/helm/ocaml/acic_content/termAcicContent.ml
new file mode 100644
index 000000000..fddd777f7
--- /dev/null
+++ b/helm/ocaml/acic_content/termAcicContent.ml
@@ -0,0 +1,371 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+module Ast = CicNotationPt
+
+let debug = false
+let debug_print s = if debug then prerr_endline (Lazy.force s) else ()
+
+type interpretation_id = int
+
+let idref id t = Ast.AttributedTerm (`IdRef id, t)
+
+type term_info =
+ { sort: (Cic.id, Ast.sort_kind) Hashtbl.t;
+ uri: (Cic.id, UriManager.uri) Hashtbl.t;
+ }
+
+let get_types uri =
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ | Cic.InductiveDefinition (l,_,_,_) -> l
+ | _ -> assert false
+
+let name_of_inductive_type uri i =
+ let types = get_types uri in
+ let (name, _, _, _) = try List.nth types i with Not_found -> assert false in
+ name
+
+ (* returns <name, type> pairs *)
+let constructors_of_inductive_type uri i =
+ let types = get_types uri in
+ let (_, _, _, constructors) =
+ try List.nth types i with Not_found -> assert false
+ in
+ constructors
+
+ (* returns name only *)
+let constructor_of_inductive_type uri i j =
+ (try
+ fst (List.nth (constructors_of_inductive_type uri i) (j-1))
+ with Not_found -> assert false)
+
+let ast_of_acic0 term_info acic k =
+ let k = k term_info in
+ let id_to_uris = term_info.uri in
+ let register_uri id uri = Hashtbl.add id_to_uris id uri in
+ let sort_of_id id =
+ try
+ Hashtbl.find term_info.sort id
+ with Not_found ->
+ prerr_endline (sprintf "warning: sort of id %s not found, using Type" id);
+ `Type (CicUniv.fresh ())
+ in
+ let aux_substs substs =
+ Some
+ (List.map
+ (fun (uri, annterm) -> (UriManager.name_of_uri uri, k annterm))
+ substs)
+ in
+ let aux_context context =
+ List.map
+ (function
+ | None -> None
+ | Some annterm -> Some (k annterm))
+ context
+ in
+ let aux = function
+ | Cic.ARel (id,_,_,b) -> idref id (Ast.Ident (b, None))
+ | Cic.AVar (id,uri,substs) ->
+ register_uri id uri;
+ idref id (Ast.Ident (UriManager.name_of_uri uri, aux_substs substs))
+ | Cic.AMeta (id,n,l) -> idref id (Ast.Meta (n, aux_context l))
+ | Cic.ASort (id,Cic.Prop) -> idref id (Ast.Sort `Prop)
+ | Cic.ASort (id,Cic.Set) -> idref id (Ast.Sort `Set)
+ | Cic.ASort (id,Cic.Type u) -> idref id (Ast.Sort (`Type u))
+ | Cic.ASort (id,Cic.CProp) -> idref id (Ast.Sort `CProp)
+ | Cic.AImplicit (id, Some `Hole) -> idref id Ast.UserInput
+ | Cic.AImplicit (id, _) -> idref id Ast.Implicit
+ | Cic.AProd (id,n,s,t) ->
+ let binder_kind =
+ match sort_of_id id with
+ | `Set | `Type _ -> `Pi
+ | `Prop | `CProp -> `Forall
+ in
+ idref id (Ast.Binder (binder_kind,
+ (CicNotationUtil.name_of_cic_name n, Some (k s)), k t))
+ | Cic.ACast (id,v,t) -> idref id (Ast.Cast (k v, k t))
+ | Cic.ALambda (id,n,s,t) ->
+ idref id (Ast.Binder (`Lambda,
+ (CicNotationUtil.name_of_cic_name n, Some (k s)), k t))
+ | Cic.ALetIn (id,n,s,t) ->
+ idref id (Ast.LetIn ((CicNotationUtil.name_of_cic_name n, None),
+ k s, k t))
+ | Cic.AAppl (aid,args) -> idref aid (Ast.Appl (List.map k args))
+ | Cic.AConst (id,uri,substs) ->
+ register_uri id uri;
+ idref id (Ast.Ident (UriManager.name_of_uri uri, aux_substs substs))
+ | Cic.AMutInd (id,uri,i,substs) ->
+ let name = name_of_inductive_type uri i in
+ let uri_str = UriManager.string_of_uri uri in
+ let puri_str = sprintf "%s#xpointer(1/%d)" uri_str (i+1) in
+ register_uri id (UriManager.uri_of_string puri_str);
+ idref id (Ast.Ident (name, aux_substs substs))
+ | Cic.AMutConstruct (id,uri,i,j,substs) ->
+ let name = constructor_of_inductive_type uri i j in
+ let uri_str = UriManager.string_of_uri uri in
+ let puri_str = sprintf "%s#xpointer(1/%d/%d)" uri_str (i + 1) j in
+ register_uri id (UriManager.uri_of_string puri_str);
+ idref id (Ast.Ident (name, aux_substs substs))
+ | Cic.AMutCase (id,uri,typeno,ty,te,patterns) ->
+ let name = name_of_inductive_type uri typeno in
+ let uri_str = UriManager.string_of_uri uri in
+ let puri_str = sprintf "%s#xpointer(1/%d)" uri_str (typeno+1) in
+ let ctor_puri j =
+ UriManager.uri_of_string
+ (sprintf "%s#xpointer(1/%d/%d)" uri_str (typeno+1) j)
+ in
+ let case_indty = name, Some (UriManager.uri_of_string puri_str) in
+ let constructors = constructors_of_inductive_type uri typeno in
+ let rec eat_branch ty pat =
+ match (ty, pat) with
+ | Cic.Prod (_, _, t), Cic.ALambda (_, name, s, t') ->
+ let (cv, rhs) = eat_branch t t' in
+ (CicNotationUtil.name_of_cic_name name, Some (k s)) :: cv, rhs
+ | _, _ -> [], k pat
+ in
+ let j = ref 0 in
+ let patterns =
+ try
+ List.map2
+ (fun (name, ty) pat ->
+ incr j;
+ let (capture_variables, rhs) = eat_branch ty pat in
+ ((name, Some (ctor_puri !j), capture_variables), rhs))
+ constructors patterns
+ with Invalid_argument _ -> assert false
+ in
+ idref id (Ast.Case (k te, Some case_indty, Some (k ty), patterns))
+ | Cic.AFix (id, no, funs) ->
+ let defs =
+ List.map
+ (fun (_, n, decr_idx, ty, bo) ->
+ ((Ast.Ident (n, None), Some (k ty)), k bo, decr_idx))
+ funs
+ in
+ let name =
+ try
+ (match List.nth defs no with
+ | (Ast.Ident (n, _), _), _, _ when n <> "_" -> n
+ | _ -> assert false)
+ with Not_found -> assert false
+ in
+ idref id (Ast.LetRec (`Inductive, defs, Ast.Ident (name, None)))
+ | Cic.ACoFix (id, no, funs) ->
+ let defs =
+ List.map
+ (fun (_, n, ty, bo) ->
+ ((Ast.Ident (n, None), Some (k ty)), k bo, 0))
+ funs
+ in
+ let name =
+ try
+ (match List.nth defs no with
+ | (Ast.Ident (n, _), _), _, _ when n <> "_" -> n
+ | _ -> assert false)
+ with Not_found -> assert false
+ in
+ idref id (Ast.LetRec (`CoInductive, defs, Ast.Ident (name, None)))
+ in
+ aux acic
+
+ (* persistent state *)
+
+let level2_patterns32 = Hashtbl.create 211
+let interpretations = Hashtbl.create 211 (* symb -> id list ref *)
+
+let compiled32 = ref None
+let pattern32_matrix = ref []
+
+let get_compiled32 () =
+ match !compiled32 with
+ | None -> assert false
+ | Some f -> Lazy.force f
+
+let set_compiled32 f = compiled32 := Some f
+
+let add_idrefs =
+ List.fold_right (fun idref t -> Ast.AttributedTerm (`IdRef idref, t))
+
+let instantiate32 term_info idrefs env symbol args =
+ let rec instantiate_arg = function
+ | Ast.IdentArg (n, name) ->
+ let t = (try List.assoc name env with Not_found -> assert false) in
+ let rec count_lambda = function
+ | Ast.AttributedTerm (_, t) -> count_lambda t
+ | Ast.Binder (`Lambda, _, body) -> 1 + count_lambda body
+ | _ -> 0
+ in
+ let rec add_lambda t n =
+ if n > 0 then
+ let name = CicNotationUtil.fresh_name () in
+ Ast.Binder (`Lambda, (Ast.Ident (name, None), None),
+ Ast.Appl [add_lambda t (n - 1); Ast.Ident (name, None)])
+ else
+ t
+ in
+ add_lambda t (n - count_lambda t)
+ in
+ let head =
+ let symbol = Ast.Symbol (symbol, 0) in
+ add_idrefs idrefs symbol
+ in
+ if args = [] then head
+ else Ast.Appl (head :: List.map instantiate_arg args)
+
+let rec ast_of_acic1 term_info annterm =
+ let id_to_uris = term_info.uri in
+ let register_uri id uri = Hashtbl.add id_to_uris id uri in
+ match (get_compiled32 ()) annterm with
+ | None -> ast_of_acic0 term_info annterm ast_of_acic1
+ | Some (env, ctors, pid) ->
+ let idrefs =
+ List.map
+ (fun annterm ->
+ let idref = CicUtil.id_of_annterm annterm in
+ (try
+ register_uri idref
+ (CicUtil.uri_of_term (Deannotate.deannotate_term annterm))
+ with Invalid_argument _ -> ());
+ idref)
+ ctors
+ in
+ let env' =
+ List.map (fun (name, term) -> (name, ast_of_acic1 term_info term)) env
+ in
+ let _, symbol, args, _ =
+ try
+ Hashtbl.find level2_patterns32 pid
+ with Not_found -> assert false
+ in
+ let ast = instantiate32 term_info idrefs env' symbol args in
+ Ast.AttributedTerm (`IdRef (CicUtil.id_of_annterm annterm), ast)
+
+let load_patterns32 t =
+ let t =
+ HExtlib.filter_map (function (true, ap, id) -> Some (ap, id) | _ -> None) t
+ in
+ set_compiled32 (lazy (Acic2astMatcher.Matcher32.compiler t))
+
+let ast_of_acic id_to_sort annterm =
+ debug_print (lazy ("ast_of_acic <- "
+ ^ CicPp.ppterm (Deannotate.deannotate_term annterm)));
+ let term_info = { sort = id_to_sort; uri = Hashtbl.create 211 } in
+ let ast = ast_of_acic1 term_info annterm in
+ debug_print (lazy ("ast_of_acic -> " ^ CicNotationPp.pp_term ast));
+ ast, term_info.uri
+
+let fresh_id =
+ let counter = ref ~-1 in
+ fun () ->
+ incr counter;
+ !counter
+
+let add_interpretation dsc (symbol, args) appl_pattern =
+ let id = fresh_id () in
+ Hashtbl.add level2_patterns32 id (dsc, symbol, args, appl_pattern);
+ pattern32_matrix := (true, appl_pattern, id) :: !pattern32_matrix;
+ load_patterns32 !pattern32_matrix;
+ (try
+ let ids = Hashtbl.find interpretations symbol in
+ ids := id :: !ids
+ with Not_found -> Hashtbl.add interpretations symbol (ref [id]));
+ id
+
+let get_all_interpretations () =
+ List.map
+ (function (_, _, id) ->
+ let (dsc, _, _, _) =
+ try
+ Hashtbl.find level2_patterns32 id
+ with Not_found -> assert false
+ in
+ (id, dsc))
+ !pattern32_matrix
+
+let get_active_interpretations () =
+ HExtlib.filter_map (function (true, _, id) -> Some id | _ -> None)
+ !pattern32_matrix
+
+let set_active_interpretations ids =
+ let pattern32_matrix' =
+ List.map
+ (function
+ | (_, ap, id) when List.mem id ids -> (true, ap, id)
+ | (_, ap, id) -> (false, ap, id))
+ !pattern32_matrix
+ in
+ pattern32_matrix := pattern32_matrix';
+ load_patterns32 !pattern32_matrix
+
+exception Interpretation_not_found
+
+let lookup_interpretations symbol =
+ try
+ HExtlib.list_uniq
+ (List.sort Pervasives.compare
+ (List.map
+ (fun id ->
+ let (dsc, _, args, appl_pattern) =
+ try
+ Hashtbl.find level2_patterns32 id
+ with Not_found -> assert false
+ in
+ dsc, args, appl_pattern)
+ !(Hashtbl.find interpretations symbol)))
+ with Not_found -> raise Interpretation_not_found
+
+let remove_interpretation id =
+ (try
+ let _, symbol, _, _ = Hashtbl.find level2_patterns32 id in
+ let ids = Hashtbl.find interpretations symbol in
+ ids := List.filter ((<>) id) !ids;
+ Hashtbl.remove level2_patterns32 id;
+ with Not_found -> raise Interpretation_not_found);
+ pattern32_matrix :=
+ List.filter (fun (_, _, id') -> id <> id') !pattern32_matrix;
+ load_patterns32 !pattern32_matrix
+
+let _ = load_patterns32 []
+
+let instantiate_appl_pattern env appl_pattern =
+ let lookup name =
+ try List.assoc name env
+ with Not_found ->
+ prerr_endline (sprintf "Name %s not found" name);
+ assert false
+ in
+ let rec aux = function
+ | Ast.UriPattern uri -> CicUtil.term_of_uri uri
+ | Ast.ImplicitPattern -> Cic.Implicit None
+ | Ast.VarPattern name -> lookup name
+ | Ast.ApplPattern terms -> Cic.Appl (List.map aux terms)
+ in
+ aux appl_pattern
+
diff --git a/helm/ocaml/acic_content/termAcicContent.mli b/helm/ocaml/acic_content/termAcicContent.mli
new file mode 100644
index 000000000..1fd57e0d0
--- /dev/null
+++ b/helm/ocaml/acic_content/termAcicContent.mli
@@ -0,0 +1,68 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+ (** {2 Persistant state handling} *)
+
+type interpretation_id
+
+val add_interpretation:
+ string -> (* id / description *)
+ string * CicNotationPt.argument_pattern list -> (* symbol, level 2 pattern *)
+ CicNotationPt.cic_appl_pattern -> (* level 3 pattern *)
+ interpretation_id
+
+ (** @raise Interpretation_not_found *)
+val lookup_interpretations:
+ string -> (* symbol *)
+ (string * CicNotationPt.argument_pattern list *
+ CicNotationPt.cic_appl_pattern) list
+
+exception Interpretation_not_found
+
+ (** @raise Interpretation_not_found *)
+val remove_interpretation: interpretation_id -> unit
+
+ (** {3 Interpretations toggling} *)
+
+val get_all_interpretations: unit -> (interpretation_id * string) list
+val get_active_interpretations: unit -> interpretation_id list
+val set_active_interpretations: interpretation_id list -> unit
+
+ (** {2 acic -> content} *)
+
+val ast_of_acic:
+ (Cic.id, CicNotationPt.sort_kind) Hashtbl.t -> (* id -> sort *)
+ Cic.annterm -> (* acic *)
+ CicNotationPt.term (* ast *)
+ * (Cic.id, UriManager.uri) Hashtbl.t (* id -> uri *)
+
+ (** {2 content -> acic} *)
+
+ (** @param env environment from argument_pattern to cic terms
+ * @param pat cic_appl_pattern *)
+val instantiate_appl_pattern:
+ (string * Cic.term) list -> CicNotationPt.cic_appl_pattern ->
+ Cic.term
+
diff --git a/helm/ocaml/cic/.depend b/helm/ocaml/cic/.depend
new file mode 100644
index 000000000..a35156331
--- /dev/null
+++ b/helm/ocaml/cic/.depend
@@ -0,0 +1,27 @@
+unshare.cmi: cic.cmo
+deannotate.cmi: cic.cmo
+cicParser.cmi: cic.cmo
+cicUtil.cmi: cic.cmo
+helmLibraryObjects.cmi: cic.cmo
+discrimination_tree.cmi: cic.cmo
+path_indexing.cmi: cic.cmo
+cic.cmo: cicUniv.cmi
+cic.cmx: cicUniv.cmx
+unshare.cmo: cic.cmo unshare.cmi
+unshare.cmx: cic.cmx unshare.cmi
+cicUniv.cmo: cicUniv.cmi
+cicUniv.cmx: cicUniv.cmi
+deannotate.cmo: cic.cmo deannotate.cmi
+deannotate.cmx: cic.cmx deannotate.cmi
+cicParser.cmo: deannotate.cmi cicUniv.cmi cic.cmo cicParser.cmi
+cicParser.cmx: deannotate.cmx cicUniv.cmx cic.cmx cicParser.cmi
+cicUtil.cmo: cicUniv.cmi cic.cmo cicUtil.cmi
+cicUtil.cmx: cicUniv.cmx cic.cmx cicUtil.cmi
+helmLibraryObjects.cmo: cic.cmo helmLibraryObjects.cmi
+helmLibraryObjects.cmx: cic.cmx helmLibraryObjects.cmi
+libraryObjects.cmo: helmLibraryObjects.cmi libraryObjects.cmi
+libraryObjects.cmx: helmLibraryObjects.cmx libraryObjects.cmi
+discrimination_tree.cmo: cic.cmo discrimination_tree.cmi
+discrimination_tree.cmx: cic.cmx discrimination_tree.cmi
+path_indexing.cmo: cic.cmo path_indexing.cmi
+path_indexing.cmx: cic.cmx path_indexing.cmi
diff --git a/helm/ocaml/cic/Makefile b/helm/ocaml/cic/Makefile
new file mode 100644
index 000000000..4e36af019
--- /dev/null
+++ b/helm/ocaml/cic/Makefile
@@ -0,0 +1,19 @@
+PACKAGE = cic
+PREDICATES =
+
+INTERFACE_FILES = \
+ unshare.mli \
+ cicUniv.mli \
+ deannotate.mli \
+ cicParser.mli \
+ cicUtil.mli \
+ helmLibraryObjects.mli \
+ libraryObjects.mli \
+ discrimination_tree.mli \
+ path_indexing.mli
+IMPLEMENTATION_FILES = \
+ cic.ml $(INTERFACE_FILES:%.mli=%.ml)
+EXTRA_OBJECTS_TO_INSTALL = cic.ml cic.cmi
+EXTRA_OBJECTS_TO_CLEAN =
+
+include ../Makefile.common
diff --git a/helm/ocaml/cic/cic.ml b/helm/ocaml/cic/cic.ml
new file mode 100644
index 000000000..64825e505
--- /dev/null
+++ b/helm/ocaml/cic/cic.ml
@@ -0,0 +1,240 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(*****************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Claudio Sacerdoti Coen <sacerdot@cs.unibo.it> *)
+(* 29/11/2000 *)
+(* *)
+(* This module defines the internal representation of the objects (variables,*)
+(* blocks of (co)inductive definitions and constants) and the terms of cic *)
+(* *)
+(*****************************************************************************)
+
+(* $Id$ *)
+
+(* STUFF TO MANAGE IDENTIFIERS *)
+type id = string (* the abstract type of the (annotated) node identifiers *)
+type 'term explicit_named_substitution = (UriManager.uri * 'term) list
+
+type implicit_annotation = [ `Closed | `Type | `Hole ]
+
+(* INTERNAL REPRESENTATION OF CIC OBJECTS AND TERMS *)
+
+type sort =
+ Prop
+ | Set
+ | Type of CicUniv.universe
+ | CProp
+
+type name =
+ | Name of string
+ | Anonymous
+
+type object_flavour =
+ [ `Definition
+ | `Fact
+ | `Lemma
+ | `Remark
+ | `Theorem
+ | `Variant
+ ]
+
+type object_class =
+ [ `Coercion
+ | `Elim of sort (** elimination principle; if sort is Type, the universe is
+ * not relevant *)
+ | `Record of (string * bool) list (**
+ inductive type that encodes a record; the arguments are
+ the record fields names and if they are coercions *)
+ | `Projection (** record projection *)
+ ]
+
+type attribute =
+ [ `Class of object_class
+ | `Flavour of object_flavour
+ | `Generated
+ ]
+
+type term =
+ Rel of int (* DeBrujin index, 1 based*)
+ | Var of UriManager.uri * (* uri, *)
+ term explicit_named_substitution (* explicit named subst. *)
+ | Meta of int * (term option) list (* numeric id, *)
+ (* local context *)
+ | Sort of sort (* sort *)
+ | Implicit of implicit_annotation option (* *)
+ | Cast of term * term (* value, type *)
+ | Prod of name * term * term (* binder, source, target *)
+ | Lambda of name * term * term (* binder, source, target *)
+ | LetIn of name * term * term (* binder, term, target *)
+ | Appl of term list (* arguments *)
+ | Const of UriManager.uri * (* uri, *)
+ term explicit_named_substitution (* explicit named subst. *)
+ | MutInd of UriManager.uri * int * (* uri, typeno, *)
+ term explicit_named_substitution (* explicit named subst. *)
+ (* typeno is 0 based *)
+ | MutConstruct of UriManager.uri * (* uri, *)
+ int * int * (* typeno, consno *)
+ term explicit_named_substitution (* explicit named subst. *)
+ (* typeno is 0 based *)
+ (* consno is 1 based *)
+ | MutCase of UriManager.uri * (* ind. uri, *)
+ int * (* ind. typeno, *)
+ term * term * (* outtype, ind. term *)
+ term list (* patterns *)
+ | Fix of int * inductiveFun list (* funno (0 based), funs *)
+ | CoFix of int * coInductiveFun list (* funno (0 based), funs *)
+and obj =
+ Constant of string * term option * term * (* id, body, type, *)
+ UriManager.uri list * attribute list (* parameters *)
+ | Variable of string * term option * term * (* name, body, type *)
+ UriManager.uri list * attribute list (* parameters *)
+ | CurrentProof of string * metasenv * term * (* name, conjectures, body, *)
+ term * UriManager.uri list * attribute list (* type, parameters *)
+ | InductiveDefinition of inductiveType list * (* inductive types, *)
+ UriManager.uri list * int * attribute list (* params, left params no *)
+and inductiveType =
+ string * bool * term * (* typename, inductive, arity *)
+ constructor list (* constructors *)
+and constructor =
+ string * term (* id, type *)
+and inductiveFun =
+ string * int * term * term (* name, ind. index, type, body *)
+and coInductiveFun =
+ string * term * term (* name, type, body *)
+
+(* a metasenv is a list of declarations of metas in declarations *)
+(* order (i.e. [oldest ; ... ; newest]). Older variables can not *)
+(* depend on new ones. *)
+and conjecture = int * context * term
+and metasenv = conjecture list
+and substitution = (int * (context * term * term)) list
+
+
+
+(* a metasenv is a list of declarations of metas in declarations *)
+(* order (i.e. [oldest ; ... ; newest]). Older variables can not *)
+(* depend on new ones. *)
+and annconjecture = id * int * anncontext * annterm
+and annmetasenv = annconjecture list
+
+and annterm =
+ ARel of id * id * int * (* idref, DeBrujin index, *)
+ string (* binder *)
+ | AVar of id * UriManager.uri * (* uri, *)
+ annterm explicit_named_substitution (* explicit named subst. *)
+ | AMeta of id * int * (annterm option) list (* numeric id, *)
+ (* local context *)
+ | ASort of id * sort (* sort *)
+ | AImplicit of id * implicit_annotation option (* *)
+ | ACast of id * annterm * annterm (* value, type *)
+ | AProd of id * name * annterm * annterm (* binder, source, target *)
+ | ALambda of id * name * annterm * annterm (* binder, source, target *)
+ | ALetIn of id * name * annterm * annterm (* binder, term, target *)
+ | AAppl of id * annterm list (* arguments *)
+ | AConst of id * UriManager.uri * (* uri, *)
+ annterm explicit_named_substitution (* explicit named subst. *)
+ | AMutInd of id * UriManager.uri * int * (* uri, typeno *)
+ annterm explicit_named_substitution (* explicit named subst. *)
+ (* typeno is 0 based *)
+ | AMutConstruct of id * UriManager.uri * (* uri, *)
+ int * int * (* typeno, consno *)
+ annterm explicit_named_substitution (* explicit named subst. *)
+ (* typeno is 0 based *)
+ (* consno is 1 based *)
+ | AMutCase of id * UriManager.uri * (* ind. uri, *)
+ int * (* ind. typeno, *)
+ annterm * annterm * (* outtype, ind. term *)
+ annterm list (* patterns *)
+ | AFix of id * int * anninductiveFun list (* funno, functions *)
+ | ACoFix of id * int * anncoInductiveFun list (* funno, functions *)
+and annobj =
+ AConstant of id * id option * string * (* name, *)
+ annterm option * annterm * (* body, type, *)
+ UriManager.uri list * attribute list (* parameters *)
+ | AVariable of id *
+ string * annterm option * annterm * (* name, body, type *)
+ UriManager.uri list * attribute list (* parameters *)
+ | ACurrentProof of id * id *
+ string * annmetasenv * (* name, conjectures, *)
+ annterm * annterm * UriManager.uri list * (* body,type,parameters *)
+ attribute list
+ | AInductiveDefinition of id *
+ anninductiveType list * (* inductive types , *)
+ UriManager.uri list * int * attribute list (* parameters,n ind. pars*)
+and anninductiveType =
+ id * string * bool * annterm * (* typename, inductive, arity *)
+ annconstructor list (* constructors *)
+and annconstructor =
+ string * annterm (* id, type *)
+and anninductiveFun =
+ id * string * int * annterm * annterm (* name, ind. index, type, body *)
+and anncoInductiveFun =
+ id * string * annterm * annterm (* name, type, body *)
+and annotation =
+ string
+
+and context_entry = (* A declaration or definition *)
+ Decl of term
+ | Def of term * term option (* body, type (if known) *)
+
+and hypothesis =
+ (name * context_entry) option (* None means no more accessible *)
+
+and context = hypothesis list
+
+and anncontext_entry = (* A declaration or definition *)
+ ADecl of annterm
+ | ADef of annterm
+
+and annhypothesis =
+ id * (name * anncontext_entry) option (* None means no more accessible *)
+
+and anncontext = annhypothesis list
+;;
+
+type lazy_term =
+ context -> metasenv -> CicUniv.universe_graph ->
+ term * metasenv * CicUniv.universe_graph
+
+type anntarget =
+ Object of annobj (* if annobj is a Constant, this is its type *)
+ | ConstantBody of annobj
+ | Term of annterm
+ | Conjecture of annconjecture
+ | Hypothesis of annhypothesis
+
+module CicHash =
+ Hashtbl.Make
+ (struct
+ type t = term
+ let equal = (==)
+ let hash = Hashtbl.hash
+ end)
+;;
+
diff --git a/helm/ocaml/cic/cicParser.ml b/helm/ocaml/cic/cicParser.ml
new file mode 100644
index 000000000..317bcb9f0
--- /dev/null
+++ b/helm/ocaml/cic/cicParser.ml
@@ -0,0 +1,780 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let debug = false
+let debug_print s = if debug then prerr_endline (Lazy.force s)
+
+open Printf
+
+(* ZACK TODO element from the DTD still to be handled:
+ <!ELEMENT CurrentProof (Conjecture*,body)>
+ <!ELEMENT Sequent %sequent;>
+ <!ELEMENT Conjecture %sequent;>
+ <!ELEMENT Decl %term;>
+ <!ELEMENT Def %term;>
+ <!ELEMENT Hidden EMPTY>
+ <!ELEMENT Goal %term;>
+*)
+
+exception Getter_failure of string * string
+exception Parser_failure of string
+
+type stack_entry =
+ | Arg of string * Cic.annterm (* relative uri, term *)
+ (* constants' body and types resides in differne files, thus we can't simple
+ * keep constants in Cic_obj stack entries *)
+ | Cic_attributes of Cic.attribute list
+ | Cic_constant_body of string * string * UriManager.uri list * Cic.annterm
+ * Cic.attribute list
+ (* id, for, params, body, object attributes *)
+ | Cic_constant_type of string * string * UriManager.uri list * Cic.annterm
+ * Cic.attribute list
+ (* id, name, params, type, object attributes *)
+ | Cic_term of Cic.annterm (* term *)
+ | Cic_obj of Cic.annobj (* object *)
+ | Cofix_fun of Cic.id * string * Cic.annterm * Cic.annterm
+ (* id, name, type, body *)
+ | Constructor of string * Cic.annterm (* name, type *)
+ | Decl of Cic.id * Cic.name * Cic.annterm (* id, binder, source *)
+ | Def of Cic.id * Cic.name * Cic.annterm (* id, binder, source *)
+ | Fix_fun of Cic.id * string * int * Cic.annterm * Cic.annterm
+ (* id, name, ind. index, type, body *)
+ | Inductive_type of string * string * bool * Cic.annterm *
+ (string * Cic.annterm) list (* id, name, inductive, arity, constructors *)
+ | Meta_subst of Cic.annterm option
+ | Obj_class of Cic.object_class
+ | Obj_flavour of Cic.object_flavour
+ | Obj_field of string (* field name *)
+ | Obj_generated
+ | Tag of string * (string * string) list (* tag name, attributes *)
+ (* ZACK TODO add file position to tag stack entry so that when attribute
+ * errors occur, the position of their _start_tag_ could be printed
+ * instead of the current position (usually the end tag) *)
+
+type ctxt = {
+ mutable stack: stack_entry list;
+ mutable xml_parser: XmlPushParser.xml_parser option;
+ mutable filename: string;
+ uri: UriManager.uri;
+}
+
+let string_of_stack ctxt =
+ "[" ^ (String.concat "; "
+ (List.map
+ (function
+ | Arg (reluri, _) -> sprintf "Arg %s" reluri
+ | Cic_attributes _ -> "Cic_attributes"
+ | Cic_constant_body (id, name, _, _, _) ->
+ sprintf "Cic_constant_body %s (id=%s)" name id
+ | Cic_constant_type (id, name, _, _, _) ->
+ sprintf "Cic_constant_type %s (id=%s)" name id
+ | Cic_term _ -> "Cic_term"
+ | Cic_obj _ -> "Cic_obj"
+ | Constructor (name, _) -> "Constructor " ^ name
+ | Cofix_fun (id, _, _, _) -> sprintf "Cofix_fun (id=%s)" id
+ | Decl (id, _, _) -> sprintf "Decl (id=%s)" id
+ | Def (id, _, _) -> sprintf "Def (id=%s)" id
+ | Fix_fun (id, _, _, _, _) -> sprintf "Fix_fun (id=%s)" id
+ | Inductive_type (id, name, _, _, _) ->
+ sprintf "Inductive_type %s (id=%s)" name id
+ | Meta_subst _ -> "Meta_subst"
+ | Obj_class _ -> "Obj_class"
+ | Obj_flavour _ -> "Obj_flavour"
+ | Obj_field name -> "Obj_field " ^ name
+ | Obj_generated -> "Obj_generated"
+ | Tag (tag, _) -> "Tag " ^ tag)
+ ctxt.stack)) ^ "]"
+
+let compare_attrs (a1, v1) (a2, v2) = Pervasives.compare a1 a2
+let sort_attrs = List.sort compare_attrs
+
+let new_parser_context uri = {
+ stack = [];
+ xml_parser = None;
+ filename = "-";
+ uri = uri;
+}
+
+let get_parser ctxt =
+ match ctxt.xml_parser with
+ | Some p -> p
+ | None -> assert false
+
+(** {2 Error handling} *)
+
+let parse_error ctxt msg =
+ let (line, col) = XmlPushParser.get_position (get_parser ctxt) in
+ raise (Parser_failure (sprintf "[%s: line %d, column %d] %s"
+ ctxt.filename line col msg))
+
+let attribute_error ctxt tag =
+ parse_error ctxt ("wrong attribute set for " ^ tag)
+
+(** {2 Parsing context management} *)
+
+let pop ctxt =
+(* debug_print (lazy "pop");*)
+ match ctxt.stack with
+ | hd :: tl -> (ctxt.stack <- tl)
+ | _ -> assert false
+
+let push ctxt v =
+(* debug_print (lazy "push");*)
+ ctxt.stack <- v :: ctxt.stack
+
+let set_top ctxt v =
+(* debug_print (lazy "set_top");*)
+ match ctxt.stack with
+ | _ :: tl -> (ctxt.stack <- v :: tl)
+ | _ -> assert false
+
+ (** pop the last tag from the open tags stack returning a pair <tag_name,
+ * attribute_list> *)
+let pop_tag ctxt =
+ match ctxt.stack with
+ | Tag (tag, attrs) :: tl ->
+ ctxt.stack <- tl;
+ (tag, attrs)
+ | _ -> parse_error ctxt "unexpected extra content"
+
+ (** pop the last tag from the open tags stack returning its attributes.
+ * Attributes are returned as a list of pair <name, value> _sorted_ by
+ * attribute name *)
+let pop_tag_attrs ctxt = sort_attrs (snd (pop_tag ctxt))
+
+let pop_cics ctxt =
+ let rec aux acc stack =
+ match stack with
+ | Cic_term t :: tl -> aux (t :: acc) tl
+ | tl -> acc, tl
+ in
+ let values, new_stack = aux [] ctxt.stack in
+ ctxt.stack <- new_stack;
+ values
+
+let pop_class_modifiers ctxt =
+ let rec aux acc stack =
+ match stack with
+ | (Cic_term (Cic.ASort _) as m) :: tl
+ | (Obj_field _ as m) :: tl ->
+ aux (m :: acc) tl
+ | tl -> acc, tl
+ in
+ let values, new_stack = aux [] ctxt.stack in
+ ctxt.stack <- new_stack;
+ values
+
+let pop_meta_substs ctxt =
+ let rec aux acc stack =
+ match stack with
+ | Meta_subst t :: tl -> aux (t :: acc) tl
+ | tl -> acc, tl
+ in
+ let values, new_stack = aux [] ctxt.stack in
+ ctxt.stack <- new_stack;
+ values
+
+let pop_fix_funs ctxt =
+ let rec aux acc stack =
+ match stack with
+ | Fix_fun (id, name, index, typ, body) :: tl ->
+ aux ((id, name, index, typ, body) :: acc) tl
+ | tl -> acc, tl
+ in
+ let values, new_stack = aux [] ctxt.stack in
+ ctxt.stack <- new_stack;
+ values
+
+let pop_cofix_funs ctxt =
+ let rec aux acc stack =
+ match stack with
+ | Cofix_fun (id, name, typ, body) :: tl ->
+ aux ((id, name, typ, body) :: acc) tl
+ | tl -> acc, tl
+ in
+ let values, new_stack = aux [] ctxt.stack in
+ ctxt.stack <- new_stack;
+ values
+
+let pop_constructors ctxt =
+ let rec aux acc stack =
+ match stack with
+ | Constructor (name, t) :: tl -> aux ((name, t) :: acc) tl
+ | tl -> acc, tl
+ in
+ let values, new_stack = aux [] ctxt.stack in
+ ctxt.stack <- new_stack;
+ values
+
+let pop_inductive_types ctxt =
+ let rec aux acc stack =
+ match stack with
+ | Inductive_type (id, name, ind, arity, ctors) :: tl ->
+ aux ((id, name, ind, arity, ctors) :: acc) tl
+ | tl -> acc, tl
+ in
+ let values, new_stack = aux [] ctxt.stack in
+ if values = [] then
+ parse_error ctxt "no \"InductiveType\" element found";
+ ctxt.stack <- new_stack;
+ values
+
+ (** travels the stack (without popping) for the first term subject of explicit
+ * named substitution and return its URI *)
+let find_base_uri ctxt =
+ let rec aux = function
+ | Cic_term (Cic.AConst (_, uri, _)) :: _
+ | Cic_term (Cic.AMutInd (_, uri, _, _)) :: _
+ | Cic_term (Cic.AMutConstruct (_, uri, _, _, _)) :: _
+ | Cic_term (Cic.AVar (_, uri, _)) :: _ ->
+ uri
+ | Arg _ :: tl -> aux tl
+ | _ -> parse_error ctxt "no \"arg\" element found"
+ in
+ UriManager.buri_of_uri (aux ctxt.stack)
+
+ (** backwardly eats the stack building an explicit named substitution from Arg
+ * stack entries *)
+let pop_subst ctxt base_uri =
+ let rec aux acc stack =
+ match stack with
+ | Arg (rel_uri, term) :: tl ->
+ let uri = UriManager.uri_of_string (base_uri ^ "/" ^ rel_uri) in
+ aux ((uri, term) :: acc) tl
+ | tl -> acc, tl
+ in
+ let subst, new_stack = aux [] ctxt.stack in
+ if subst = [] then
+ parse_error ctxt "no \"arg\" element found";
+ ctxt.stack <- new_stack;
+ subst
+
+let pop_cic ctxt =
+ match ctxt.stack with
+ | Cic_term t :: tl ->
+ ctxt.stack <- tl;
+ t
+ | _ -> parse_error ctxt "no cic term found"
+
+let pop_obj_attributes ctxt =
+ match ctxt.stack with
+ | Cic_attributes attributes :: tl ->
+ ctxt.stack <- tl;
+ attributes
+ | _ -> []
+
+(** {2 Auxiliary functions} *)
+
+let uri_of_string = UriManager.uri_of_string
+
+let uri_list_of_string =
+ let space_RE = Str.regexp " " in
+ fun s ->
+ List.map uri_of_string (Str.split space_RE s)
+
+let sort_of_string ctxt = function
+ | "Prop" -> Cic.Prop
+ | "Set" -> Cic.Set
+ | "CProp" -> Cic.CProp
+ (* THIS CASE IS HERE ONLY TO ALLOW THE PARSING OF COQ LIBRARY
+ * THIS SHOULD BE REMOVED AS SOON AS univ_maker OR COQ'S EXPORTATION
+ * IS FIXED *)
+ | "Type" -> Cic.Type (CicUniv.fresh ~uri:ctxt.uri ())
+ | s ->
+ let len = String.length s in
+ if not(len > 5) then parse_error ctxt "sort expected";
+ if not(String.sub s 0 5 = "Type:") then parse_error ctxt "sort expected";
+ try
+ Cic.Type
+ (CicUniv.fresh
+ ~uri:ctxt.uri
+ ~id:(int_of_string (String.sub s 5 (len - 5))) ())
+ with
+ | Failure "int_of_string"
+ | Invalid_argument _ -> parse_error ctxt "sort expected"
+
+let patch_subst ctxt subst = function
+ | Cic.AConst (id, uri, _) -> Cic.AConst (id, uri, subst)
+ | Cic.AMutInd (id, uri, typeno, _) ->
+ Cic.AMutInd (id, uri, typeno, subst)
+ | Cic.AMutConstruct (id, uri, typeno, consno, _) ->
+ Cic.AMutConstruct (id, uri, typeno, consno, subst)
+ | Cic.AVar (id, uri, _) -> Cic.AVar (id, uri, subst)
+ | _ ->
+ parse_error ctxt
+ ("only \"CONST\", \"VAR\", \"MUTIND\", and \"MUTCONSTRUCT\" can be" ^
+ " instantiated")
+
+ (** backwardly eats the stack seeking for the first open tag carrying
+ * "helm:exception" attributes. If found return Some of a pair containing
+ * exception name and argument. Return None otherwise *)
+let find_helm_exception ctxt =
+ let rec aux = function
+ | [] -> None
+ | Tag (_, attrs) :: tl ->
+ (try
+ let exn = List.assoc "helm:exception" attrs in
+ let arg =
+ try List.assoc "helm:exception_arg" attrs with Not_found -> ""
+ in
+ Some (exn, arg)
+ with Not_found -> aux tl)
+ | _ :: tl -> aux tl
+ in
+ aux ctxt.stack
+
+(** {2 Push parser callbacks}
+ * each callback needs to be instantiated to a parsing context *)
+
+let start_element ctxt tag attrs =
+(* debug_print (lazy (sprintf "<%s%s>" tag (match attrs with | [] -> "" | _ -> " " ^ String.concat " " (List.map (fun (a,v) -> sprintf "%s=\"%s\"" a v) attrs))));*)
+ push ctxt (Tag (tag, attrs))
+
+let end_element ctxt tag =
+(* debug_print (lazy (sprintf "</%s>" tag));*)
+(* debug_print (lazy (string_of_stack ctxt));*)
+ let attribute_error () = attribute_error ctxt tag in
+ let parse_error = parse_error ctxt in
+ let sort_of_string = sort_of_string ctxt in
+ match tag with
+ | "REL" ->
+ push ctxt (Cic_term
+ (match pop_tag_attrs ctxt with
+ | ["binder", binder; "id", id; "idref", idref; "value", value]
+ | ["binder", binder; "id", id; "idref", idref; "sort", _;
+ "value", value] ->
+ Cic.ARel (id, idref, int_of_string value, binder)
+ | _ -> attribute_error ()))
+ | "VAR" ->
+ push ctxt (Cic_term
+ (match pop_tag_attrs ctxt with
+ | ["id", id; "uri", uri]
+ | ["id", id; "sort", _; "uri", uri] ->
+ Cic.AVar (id, uri_of_string uri, [])
+ | _ -> attribute_error ()))
+ | "CONST" ->
+ push ctxt (Cic_term
+ (match pop_tag_attrs ctxt with
+ | ["id", id; "uri", uri]
+ | ["id", id; "sort", _; "uri", uri] ->
+ Cic.AConst (id, uri_of_string uri, [])
+ | _ -> attribute_error ()))
+ | "SORT" ->
+ push ctxt (Cic_term
+ (match pop_tag_attrs ctxt with
+ | ["id", id; "value", sort] -> Cic.ASort (id, sort_of_string sort)
+ | _ -> attribute_error ()))
+ | "APPLY" ->
+ let args = pop_cics ctxt in
+ push ctxt (Cic_term
+ (match pop_tag_attrs ctxt with
+ | ["id", id ]
+ | ["id", id; "sort", _] -> Cic.AAppl (id, args)
+ | _ -> attribute_error ()))
+ | "decl" ->
+ let source = pop_cic ctxt in
+ push ctxt
+ (match pop_tag_attrs ctxt with
+ | ["binder", binder; "id", id ]
+ | ["binder", binder; "id", id; "type", _] ->
+ Decl (id, Cic.Name binder, source)
+ | ["id", id]
+ | ["id", id; "type", _] -> Decl (id, Cic.Anonymous, source)
+ | _ -> attribute_error ())
+ | "def" -> (* same as "decl" above *)
+ let source = pop_cic ctxt in
+ push ctxt
+ (match pop_tag_attrs ctxt with
+ | ["binder", binder; "id", id]
+ | ["binder", binder; "id", id; "sort", _] ->
+ Def (id, Cic.Name binder, source)
+ | ["id", id]
+ | ["id", id; "sort", _] -> Def (id, Cic.Anonymous, source)
+ | _ -> attribute_error ())
+ | "arity" (* transparent elements (i.e. which contain a CIC) *)
+ | "body"
+ | "inductiveTerm"
+ | "pattern"
+ | "patternsType"
+ | "target"
+ | "term"
+ | "type" ->
+ let term = pop_cic ctxt in
+ pop ctxt; (* pops start tag matching current end tag (e.g. <arity>) *)
+ push ctxt (Cic_term term)
+ | "substitution" -> (* optional transparent elements (i.e. which _may_
+ * contain a CIC) *)
+ set_top ctxt (* replace <substitution> *)
+ (match ctxt.stack with
+ | Cic_term term :: tl ->
+ ctxt.stack <- tl;
+ (Meta_subst (Some term))
+ | _ -> Meta_subst None)
+ | "PROD" ->
+ let target = pop_cic ctxt in
+ let rec add_decl target = function
+ | Decl (id, binder, source) :: tl ->
+ add_decl (Cic.AProd (id, binder, source, target)) tl
+ | tl ->
+ ctxt.stack <- tl;
+ target
+ in
+ let term = add_decl target ctxt.stack in
+ (match pop_tag_attrs ctxt with
+ []
+ | ["type", _] -> ()
+ | _ -> attribute_error ());
+ push ctxt (Cic_term term)
+ | "LAMBDA" ->
+ let target = pop_cic ctxt in
+ let rec add_decl target = function
+ | Decl (id, binder, source) :: tl ->
+ add_decl (Cic.ALambda (id, binder, source, target)) tl
+ | tl ->
+ ctxt.stack <- tl;
+ target
+ in
+ let term = add_decl target ctxt.stack in
+ (match pop_tag_attrs ctxt with
+ []
+ | ["sort", _] -> ()
+ | _ -> attribute_error ());
+ push ctxt (Cic_term term)
+ | "LETIN" ->
+ let target = pop_cic ctxt in
+ let rec add_def target = function
+ | Def (id, binder, source) :: tl ->
+ add_def (Cic.ALetIn (id, binder, source, target)) tl
+ | tl ->
+ ctxt.stack <- tl;
+ target
+ in
+ let term = add_def target ctxt.stack in
+ (match pop_tag_attrs ctxt with
+ []
+ | ["sort", _] -> ()
+ | _ -> attribute_error ());
+ push ctxt (Cic_term term)
+ | "CAST" ->
+ let typ = pop_cic ctxt in
+ let term = pop_cic ctxt in
+ push ctxt (Cic_term
+ (match pop_tag_attrs ctxt with
+ ["id", id]
+ | ["id", id; "sort", _] -> Cic.ACast (id, term, typ)
+ | _ -> attribute_error ()));
+ | "IMPLICIT" ->
+ push ctxt (Cic_term
+ (match pop_tag_attrs ctxt with
+ | ["id", id] -> Cic.AImplicit (id, None)
+ | ["annotation", annotation; "id", id] ->
+ let implicit_annotation =
+ match annotation with
+ | "closed" -> `Closed
+ | "hole" -> `Hole
+ | "type" -> `Type
+ | _ -> parse_error "invalid value for \"annotation\" attribute"
+ in
+ Cic.AImplicit (id, Some implicit_annotation)
+ | _ -> attribute_error ()))
+ | "META" ->
+ let meta_substs = pop_meta_substs ctxt in
+ push ctxt (Cic_term
+ (match pop_tag_attrs ctxt with
+ | ["id", id; "no", no]
+ | ["id", id; "no", no; "sort", _] ->
+ Cic.AMeta (id, int_of_string no, meta_substs)
+ | _ -> attribute_error ()));
+ | "MUTIND" ->
+ push ctxt (Cic_term
+ (match pop_tag_attrs ctxt with
+ | ["id", id; "noType", noType; "uri", uri] ->
+ Cic.AMutInd (id, uri_of_string uri, int_of_string noType, [])
+ | _ -> attribute_error ()));
+ | "MUTCONSTRUCT" ->
+ push ctxt (Cic_term
+ (match pop_tag_attrs ctxt with
+ | ["id", id; "noConstr", noConstr; "noType", noType; "uri", uri]
+ | ["id", id; "noConstr", noConstr; "noType", noType; "sort", _;
+ "uri", uri] ->
+ Cic.AMutConstruct (id, uri_of_string uri, int_of_string noType,
+ int_of_string noConstr, [])
+ | _ -> attribute_error ()));
+ | "FixFunction" ->
+ let body = pop_cic ctxt in
+ let typ = pop_cic ctxt in
+ push ctxt
+ (match pop_tag_attrs ctxt with
+ | ["id", id; "name", name; "recIndex", recIndex] ->
+ Fix_fun (id, name, int_of_string recIndex, typ, body)
+ | _ -> attribute_error ())
+ | "CofixFunction" ->
+ let body = pop_cic ctxt in
+ let typ = pop_cic ctxt in
+ push ctxt
+ (match pop_tag_attrs ctxt with
+ | ["id", id; "name", name] ->
+ Cofix_fun (id, name, typ, body)
+ | _ -> attribute_error ())
+ | "FIX" ->
+ let fix_funs = pop_fix_funs ctxt in
+ push ctxt (Cic_term
+ (match pop_tag_attrs ctxt with
+ | ["id", id; "noFun", noFun]
+ | ["id", id; "noFun", noFun; "sort", _] ->
+ Cic.AFix (id, int_of_string noFun, fix_funs)
+ | _ -> attribute_error ()))
+ | "COFIX" ->
+ let cofix_funs = pop_cofix_funs ctxt in
+ push ctxt (Cic_term
+ (match pop_tag_attrs ctxt with
+ | ["id", id; "noFun", noFun]
+ | ["id", id; "noFun", noFun; "sort", _] ->
+ Cic.ACoFix (id, int_of_string noFun, cofix_funs)
+ | _ -> attribute_error ()))
+ | "MUTCASE" ->
+ (match pop_cics ctxt with
+ | patternsType :: inductiveTerm :: patterns ->
+ push ctxt (Cic_term
+ (match pop_tag_attrs ctxt with
+ | ["id", id; "noType", noType; "uriType", uriType]
+ | ["id", id; "noType", noType; "sort", _; "uriType", uriType] ->
+ Cic.AMutCase (id, uri_of_string uriType, int_of_string noType,
+ patternsType, inductiveTerm, patterns)
+ | _ -> attribute_error ()))
+ | _ -> parse_error "invalid \"MUTCASE\" content")
+ | "Constructor" ->
+ let typ = pop_cic ctxt in
+ push ctxt
+ (match pop_tag_attrs ctxt with
+ | ["name", name] -> Constructor (name, typ)
+ | _ -> attribute_error ())
+ | "InductiveType" ->
+ let constructors = pop_constructors ctxt in
+ let arity = pop_cic ctxt in
+ push ctxt
+ (match pop_tag_attrs ctxt with
+ | ["id", id; "inductive", inductive; "name", name] ->
+ Inductive_type (id, name, bool_of_string inductive, arity,
+ constructors)
+ | _ -> attribute_error ())
+ | "InductiveDefinition" ->
+ let inductive_types = pop_inductive_types ctxt in
+ let obj_attributes = pop_obj_attributes ctxt in
+ push ctxt (Cic_obj
+ (match pop_tag_attrs ctxt with
+ | ["id", id; "noParams", noParams; "params", params] ->
+ Cic.AInductiveDefinition (id, inductive_types,
+ uri_list_of_string params, int_of_string noParams, obj_attributes)
+ | _ -> attribute_error ()))
+ | "ConstantType" ->
+ let typ = pop_cic ctxt in
+ let obj_attributes = pop_obj_attributes ctxt in
+ push ctxt
+ (match pop_tag_attrs ctxt with
+ | ["id", id; "name", name; "params", params] ->
+ Cic_constant_type (id, name, uri_list_of_string params, typ,
+ obj_attributes)
+ | _ -> attribute_error ())
+ | "ConstantBody" ->
+ let body = pop_cic ctxt in
+ let obj_attributes = pop_obj_attributes ctxt in
+ push ctxt
+ (match pop_tag_attrs ctxt with
+ | ["for", for_; "id", id; "params", params] ->
+ Cic_constant_body (id, for_, uri_list_of_string params, body,
+ obj_attributes)
+ | _ -> attribute_error ())
+ | "Variable" ->
+ let typ = pop_cic ctxt in
+ let body =
+ match pop_cics ctxt with
+ | [] -> None
+ | [t] -> Some t
+ | _ -> parse_error "wrong content for \"Variable\""
+ in
+ let obj_attributes = pop_obj_attributes ctxt in
+ push ctxt (Cic_obj
+ (match pop_tag_attrs ctxt with
+ | ["id", id; "name", name; "params", params] ->
+ Cic.AVariable (id, name, body, typ, uri_list_of_string params,
+ obj_attributes)
+ | _ -> attribute_error ()))
+ | "arg" ->
+ let term = pop_cic ctxt in
+ push ctxt
+ (match pop_tag_attrs ctxt with
+ | ["relUri", relUri] -> Arg (relUri, term)
+ | _ -> attribute_error ())
+ | "instantiate" ->
+ (* explicit named substitution handling: when the end tag of an element
+ * subject of exlicit named subst (MUTIND, MUTCONSTRUCT, CONST, VAR) it
+ * is stored on the stack with no substitutions (i.e. []). When the end
+ * tag of an "instantiate" element is found we patch the term currently
+ * on the stack with the substitution built from "instantiate" children
+ *)
+ (* XXX inefficiency here: first travels the <arg> elements in order to
+ * find the baseUri, then in order to build the explicit named subst *)
+ let base_uri = find_base_uri ctxt in
+ let subst = pop_subst ctxt base_uri in
+ let term = pop_cic ctxt in
+ (* comment from CicParser3.ml:
+ * CSC: the "id" optional attribute should be parsed and reflected in
+ * Cic.annterm and id = string_of_xml_attr (n#attribute "id") *)
+ (* replace <instantiate> *)
+ set_top ctxt (Cic_term (patch_subst ctxt subst term))
+ | "attributes" ->
+ let rec aux acc = function (* retrieve object attributes *)
+ | Obj_class c :: tl -> aux (`Class c :: acc) tl
+ | Obj_flavour f :: tl -> aux (`Flavour f :: acc) tl
+ | Obj_generated :: tl -> aux (`Generated :: acc) tl
+ | tl -> acc, tl
+ in
+ let obj_attrs, new_stack = aux [] ctxt.stack in
+ ctxt.stack <- new_stack;
+ set_top ctxt (Cic_attributes obj_attrs)
+ | "generated" -> set_top ctxt Obj_generated
+ | "field" ->
+ push ctxt
+ (match pop_tag_attrs ctxt with
+ | ["name", name] -> Obj_field name
+ | _ -> attribute_error ())
+ | "flavour" ->
+ push ctxt
+ (match pop_tag_attrs ctxt with
+ | [ "value", "definition"] -> Obj_flavour `Definition
+ | [ "value", "fact"] -> Obj_flavour `Fact
+ | [ "value", "lemma"] -> Obj_flavour `Lemma
+ | [ "value", "remark"] -> Obj_flavour `Remark
+ | [ "value", "theorem"] -> Obj_flavour `Theorem
+ | [ "value", "variant"] -> Obj_flavour `Variant
+ | _ -> attribute_error ())
+ | "class" ->
+ let class_modifiers = pop_class_modifiers ctxt in
+ push ctxt
+ (match pop_tag_attrs ctxt with
+ | ["value", "coercion"] -> Obj_class `Coercion
+ | ["value", "elim"] ->
+ (match class_modifiers with
+ | [Cic_term (Cic.ASort (_, sort))] -> Obj_class (`Elim sort)
+ | _ ->
+ parse_error
+ "unexpected extra content for \"elim\" object class")
+ | ["value", "record"] ->
+ let fields =
+ List.map
+ (function
+ | Obj_field name ->
+ (match Str.split (Str.regexp " ") name with
+ | [name] -> name, false
+ | [name;"coercion"] -> name,true
+ | _ ->
+ parse_error
+ "wrong \"field\"'s name attribute")
+ | _ ->
+ parse_error
+ "unexpected extra content for \"record\" object class")
+ class_modifiers
+ in
+ Obj_class (`Record fields)
+ | ["value", "projection"] -> Obj_class `Projection
+ | _ -> attribute_error ())
+ | tag ->
+ match find_helm_exception ctxt with
+ | Some (exn, arg) -> raise (Getter_failure (exn, arg))
+ | None -> parse_error (sprintf "unknown element \"%s\"" tag)
+
+(** {2 Parser internals} *)
+
+let has_gz_suffix fname =
+ try
+ let idx = String.rindex fname '.' in
+ let suffix = String.sub fname idx (String.length fname - idx) in
+ suffix = ".gz"
+ with Not_found -> false
+
+let parse uri filename =
+ let ctxt = new_parser_context uri in
+ ctxt.filename <- filename;
+ let module P = XmlPushParser in
+ let callbacks = {
+ P.default_callbacks with
+ P.start_element = Some (start_element ctxt);
+ P.end_element = Some (end_element ctxt);
+ } in
+ let xml_parser = P.create_parser callbacks in
+ ctxt.xml_parser <- Some xml_parser;
+ try
+ (try
+ let xml_source =
+ if has_gz_suffix filename then `Gzip_file filename
+ else `File filename
+ in
+ P.parse xml_parser xml_source
+ with exn ->
+ ctxt.xml_parser <- None;
+ (* ZACK: the above "<- None" is vital for garbage collection. Without it
+ * we keep in memory a circular structure parser -> callbacks -> ctxt ->
+ * parser. I don't know if the ocaml garbage collector is supposed to
+ * collect such structures, but for sure the expat bindings will (orribly)
+ * leak when used in conjunction with such structures *)
+ raise exn);
+ ctxt.xml_parser <- None; (* ZACK: same comment as above *)
+(* debug_print (lazy (string_of_stack stack));*)
+ (* assert (List.length ctxt.stack = 1) *)
+ List.hd ctxt.stack
+ with
+ | Failure "int_of_string" -> parse_error ctxt "integer number expected"
+ | Invalid_argument "bool_of_string" -> parse_error ctxt "boolean expected"
+ | P.Parse_error msg -> parse_error ctxt ("parse error: " ^ msg)
+ | Parser_failure _
+ | Getter_failure _ as exn ->
+ raise exn
+ | exn ->
+ raise (Parser_failure ("uncaught exception: " ^ Printexc.to_string exn))
+
+(** {2 API implementation} *)
+
+let annobj_of_xml uri filename filenamebody =
+ match filenamebody with
+ | None ->
+ (match parse uri filename with
+ | Cic_constant_type (id, name, params, typ, obj_attributes) ->
+ Cic.AConstant (id, None, name, None, typ, params, obj_attributes)
+ | Cic_obj obj -> obj
+ | _ -> raise (Parser_failure ("no object found in " ^ filename)))
+ | Some filenamebody ->
+ (match parse uri filename, parse uri filenamebody with
+ | Cic_constant_type (type_id, name, params, typ, obj_attributes),
+ Cic_constant_body (body_id, _, _, body, _) ->
+ Cic.AConstant (type_id, Some body_id, name, Some body, typ, params,[])
+ | _ ->
+ raise (Parser_failure (sprintf "no constant found in %s, %s"
+ filename filenamebody)))
+
+let obj_of_xml uri filename filenamebody =
+ Deannotate.deannotate_obj (annobj_of_xml uri filename filenamebody)
diff --git a/helm/ocaml/cic/cicParser.mli b/helm/ocaml/cic/cicParser.mli
new file mode 100644
index 000000000..9472b4c54
--- /dev/null
+++ b/helm/ocaml/cic/cicParser.mli
@@ -0,0 +1,46 @@
+(* Copyright (C) 2000-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+ (** raised for exception received by the getter (i.e. embedded in the source
+ * XML document). Arguments are values of "helm:exception" and
+ * "helm:exception_arg" attributes *)
+exception Getter_failure of string * string
+
+ (** generic parser failure *)
+exception Parser_failure of string
+
+ (* given the filename of an xml file of a cic object, it returns
+ * its internal annotated representation. In the case of constants (whose
+ * type is splitted from the body), a second xml file (for the body) must be
+ * provided.
+ * Both files are assumed to be gzipped. *)
+val annobj_of_xml: UriManager.uri -> string -> string option -> Cic.annobj
+
+ (* given the filename of an xml file of a cic object, it returns its internal
+ * logical representation. In the case of constants (whose type is splitted
+ * from the body), a second xml file (for the body) must be provided.
+ * Both files are assumed to be gzipped. *)
+val obj_of_xml : UriManager.uri -> string -> string option -> Cic.obj
+
diff --git a/helm/ocaml/cic/cicUniv.ml b/helm/ocaml/cic/cicUniv.ml
new file mode 100644
index 000000000..669025ffe
--- /dev/null
+++ b/helm/ocaml/cic/cicUniv.ml
@@ -0,0 +1,949 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(*****************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Enrico Tassi <tassi@cs.unibo.it> *)
+(* 23/04/2004 *)
+(* *)
+(* This module implements the aciclic graph of universes. *)
+(* *)
+(*****************************************************************************)
+
+(* $Id$ *)
+
+(*****************************************************************************)
+(** switch implementation **)
+(*****************************************************************************)
+
+let fast_implementation = ref true ;;
+
+(*****************************************************************************)
+(** open **)
+(*****************************************************************************)
+
+open Printf
+
+(*****************************************************************************)
+(** Types and default values **)
+(*****************************************************************************)
+
+type universe = int * UriManager.uri option
+
+module UniverseType = struct
+ type t = universe
+ let compare = Pervasives.compare
+end
+
+module SOF = Set.Make(UniverseType)
+
+type entry = {
+ eq_closure : SOF.t;
+ ge_closure : SOF.t;
+ gt_closure : SOF.t;
+ in_gegt_of : SOF.t;
+ one_s_eq : SOF.t;
+ one_s_ge : SOF.t;
+ one_s_gt : SOF.t;
+}
+
+module MAL = Map.Make(UniverseType)
+
+type arc_type = GE | GT | EQ
+
+type bag = entry MAL.t
+
+let empty_entry = {
+ eq_closure=SOF.empty;
+ ge_closure=SOF.empty;
+ gt_closure=SOF.empty;
+ in_gegt_of=SOF.empty;
+ one_s_eq=SOF.empty;
+ one_s_ge=SOF.empty;
+ one_s_gt=SOF.empty;
+}
+let empty_bag = MAL.empty
+
+let are_set_eq s1 s2 =
+ SOF.equal s1 s2
+
+let are_entry_eq v1 v2 =
+ (are_set_eq v1.gt_closure v2.gt_closure ) &&
+ (are_set_eq v1.ge_closure v2.ge_closure ) &&
+ (are_set_eq v1.eq_closure v2.eq_closure ) &&
+ (*(are_set_eq v1.in_gegt_of v2.in_gegt_of ) &&*)
+ (are_set_eq v1.one_s_ge v2.one_s_ge ) &&
+ (are_set_eq v1.one_s_gt v2.one_s_gt ) &&
+ (are_set_eq v1.one_s_eq v2.one_s_eq )
+
+let are_ugraph_eq = MAL.equal are_entry_eq
+
+(*****************************************************************************)
+(** Pretty printings **)
+(*****************************************************************************)
+
+let string_of_universe (i,u) =
+ match u with
+ Some u ->
+ "(" ^ ((string_of_int i) ^ "," ^ (UriManager.string_of_uri u) ^ ")")
+ | None -> "(" ^ (string_of_int i) ^ ",None)"
+
+let string_of_universe_set l =
+ SOF.fold (fun x s -> s ^ (string_of_universe x) ^ " ") l ""
+
+let string_of_node n =
+ "{"^
+ "eq_c: " ^ (string_of_universe_set n.eq_closure) ^ "; " ^
+ "ge_c: " ^ (string_of_universe_set n.ge_closure) ^ "; " ^
+ "gt_c: " ^ (string_of_universe_set n.gt_closure) ^ "; " ^
+ "i_gegt: " ^ (string_of_universe_set n.in_gegt_of) ^ "}\n"
+
+let string_of_arc (a,u,v) =
+ (string_of_universe u) ^ " " ^ a ^ " " ^ (string_of_universe v)
+
+let string_of_mal m =
+ let rc = ref "" in
+ MAL.iter (fun k v ->
+ rc := !rc ^ sprintf "%s --> %s" (string_of_universe k)
+ (string_of_node v)) m;
+ !rc
+
+let string_of_bag b =
+ string_of_mal b
+
+(*****************************************************************************)
+(** Helpers **)
+(*****************************************************************************)
+
+(* find the repr *)
+let repr u m =
+ try
+ MAL.find u m
+ with
+ Not_found -> empty_entry
+
+(* FIXME: May be faster if we make it by hand *)
+let merge_closures f nodes m =
+ SOF.fold (fun x i -> SOF.union (f (repr x m)) i ) nodes SOF.empty
+
+(*****************************************************************************)
+(** Benchmarking **)
+(*****************************************************************************)
+let time_spent = ref 0.0;;
+let partial = ref 0.0 ;;
+
+let reset_spent_time () = time_spent := 0.0;;
+let get_spent_time () = !time_spent ;;
+let begin_spending () =
+ (*assert (!partial = 0.0);*)
+ partial := Unix.gettimeofday ()
+;;
+
+let end_spending () =
+ assert (!partial > 0.0);
+ let interval = (Unix.gettimeofday ()) -. !partial in
+ partial := 0.0;
+ time_spent := !time_spent +. interval
+;;
+
+
+(*****************************************************************************)
+(** _fats implementation **)
+(*****************************************************************************)
+
+let rec closure_of_fast ru m =
+ let eq_c = closure_eq_fast ru m in
+ let ge_c = closure_ge_fast ru m in
+ let gt_c = closure_gt_fast ru m in
+ {
+ eq_closure = eq_c;
+ ge_closure = ge_c;
+ gt_closure = gt_c;
+ in_gegt_of = ru.in_gegt_of;
+ one_s_eq = ru.one_s_eq;
+ one_s_ge = ru.one_s_ge;
+ one_s_gt = ru.one_s_gt
+ }
+
+and closure_eq_fast ru m =
+ let eq_c =
+ let j = ru.one_s_eq in
+ let _Uj = merge_closures (fun x -> x.eq_closure) j m in
+ let one_step_eq = ru.one_s_eq in
+ (SOF.union one_step_eq _Uj)
+ in
+ eq_c
+
+and closure_ge_fast ru m =
+ let ge_c =
+ let j = SOF.union ru.one_s_ge (SOF.union ru.one_s_gt ru.one_s_eq) in
+ let _Uj = merge_closures (fun x -> x.ge_closure) j m in
+ let _Ux = j in
+ (SOF.union _Uj _Ux)
+ in
+ ge_c
+
+and closure_gt_fast ru m =
+ let gt_c =
+ let j = ru.one_s_gt in
+ let k = ru.one_s_ge in
+ let l = ru.one_s_eq in
+ let _Uj = merge_closures (fun x -> x.ge_closure) j m in
+ let _Uk = merge_closures (fun x -> x.gt_closure) k m in
+ let _Ul = merge_closures (fun x -> x.gt_closure) l m in
+ let one_step_gt = ru.one_s_gt in
+ (SOF.union (SOF.union (SOF.union _Ul one_step_gt) _Uk) _Uj)
+ in
+ gt_c
+
+and print_rec_status u ru =
+ print_endline ("Aggiusto " ^ (string_of_universe u) ^
+ "e ottengo questa chiusura\n " ^ (string_of_node ru))
+
+and adjust_fast u m =
+ let ru = repr u m in
+ let gt_c = closure_gt_fast ru m in
+ let ge_c = closure_ge_fast ru m in
+ let eq_c = closure_eq_fast ru m in
+ let changed_eq = not (are_set_eq eq_c ru.eq_closure) in
+ let changed_gegt =
+ (not (are_set_eq gt_c ru.gt_closure)) ||
+ (not (are_set_eq ge_c ru.ge_closure))
+ in
+ if ((not changed_gegt) && (not changed_eq)) then
+ m
+ else
+ begin
+ let ru' = {
+ eq_closure = eq_c;
+ ge_closure = ge_c;
+ gt_closure = gt_c;
+ in_gegt_of = ru.in_gegt_of;
+ one_s_eq = ru.one_s_eq;
+ one_s_ge = ru.one_s_ge;
+ one_s_gt = ru.one_s_gt}
+ in
+ let m = MAL.add u ru' m in
+ let m =
+ SOF.fold (fun x m -> adjust_fast x m)
+ (SOF.union ru'.eq_closure ru'.in_gegt_of) m
+ (* TESI:
+ ru'.in_gegt_of m
+ *)
+ in
+ m (*adjust_fast u m*)
+ end
+
+and add_gt_arc_fast u v m =
+ let ru = repr u m in
+ let ru' = {ru with one_s_gt = SOF.add v ru.one_s_gt} in
+ let m' = MAL.add u ru' m in
+ let rv = repr v m' in
+ let rv' = {rv with in_gegt_of = SOF.add u rv.in_gegt_of} in
+ let m'' = MAL.add v rv' m' in
+ adjust_fast u m''
+
+and add_ge_arc_fast u v m =
+ let ru = repr u m in
+ let ru' = { ru with one_s_ge = SOF.add v ru.one_s_ge} in
+ let m' = MAL.add u ru' m in
+ let rv = repr v m' in
+ let rv' = {rv with in_gegt_of = SOF.add u rv.in_gegt_of} in
+ let m'' = MAL.add v rv' m' in
+ adjust_fast u m''
+
+and add_eq_arc_fast u v m =
+ let ru = repr u m in
+ let rv = repr v m in
+ let ru' = {ru with one_s_eq = SOF.add v ru.one_s_eq} in
+ (*TESI: let ru' = {ru' with in_gegt_of = SOF.add v ru.in_gegt_of} in *)
+ let m' = MAL.add u ru' m in
+ let rv' = {rv with one_s_eq = SOF.add u rv.one_s_eq} in
+ (*TESI: let rv' = {rv' with in_gegt_of = SOF.add u rv.in_gegt_of} in *)
+ let m'' = MAL.add v rv' m' in
+ adjust_fast v (*(adjust_fast u*) m'' (* ) *)
+;;
+
+
+(*****************************************************************************)
+(** safe implementation **)
+(*****************************************************************************)
+
+let closure_of u m =
+ let ru = repr u m in
+ let eq_c =
+ let j = ru.one_s_eq in
+ let _Uj = merge_closures (fun x -> x.eq_closure) j m in
+ let one_step_eq = ru.one_s_eq in
+ (SOF.union one_step_eq _Uj)
+ in
+ let ge_c =
+ let j = SOF.union ru.one_s_ge (SOF.union ru.one_s_gt ru.one_s_eq) in
+ let _Uj = merge_closures (fun x -> x.ge_closure) j m in
+ let _Ux = j in
+ (SOF.union _Uj _Ux)
+ in
+ let gt_c =
+ let j = ru.one_s_gt in
+ let k = ru.one_s_ge in
+ let l = ru.one_s_eq in
+ let _Uj = merge_closures (fun x -> x.ge_closure) j m in
+ let _Uk = merge_closures (fun x -> x.gt_closure) k m in
+ let _Ul = merge_closures (fun x -> x.gt_closure) l m in
+ let one_step_gt = ru.one_s_gt in
+ (SOF.union (SOF.union (SOF.union _Ul one_step_gt) _Uk) _Uj)
+ in
+ {
+ eq_closure = eq_c;
+ ge_closure = ge_c;
+ gt_closure = gt_c;
+ in_gegt_of = ru.in_gegt_of;
+ one_s_eq = ru.one_s_eq;
+ one_s_ge = ru.one_s_ge;
+ one_s_gt = ru.one_s_gt
+ }
+
+let rec simple_adjust m =
+ let m' =
+ MAL.mapi (fun x _ -> closure_of x m) m
+ in
+ if not (are_ugraph_eq m m') then(
+ simple_adjust m')
+ else
+ m'
+
+let add_eq_arc u v m =
+ let ru = repr u m in
+ let rv = repr v m in
+ let ru' = {ru with one_s_eq = SOF.add v ru.one_s_eq} in
+ let m' = MAL.add u ru' m in
+ let rv' = {rv with one_s_eq = SOF.add u rv.one_s_eq} in
+ let m'' = MAL.add v rv' m' in
+ simple_adjust m''
+
+let add_ge_arc u v m =
+ let ru = repr u m in
+ let ru' = { ru with one_s_ge = SOF.add v ru.one_s_ge} in
+ let m' = MAL.add u ru' m in
+ simple_adjust m'
+
+let add_gt_arc u v m =
+ let ru = repr u m in
+ let ru' = {ru with one_s_gt = SOF.add v ru.one_s_gt} in
+ let m' = MAL.add u ru' m in
+ simple_adjust m'
+
+
+(*****************************************************************************)
+(** Outhern interface, that chooses between _fast and safe **)
+(*****************************************************************************)
+
+(*
+ given the 2 nodes plus the current bag, adds the arc, recomputes the
+ closures and returns the new map
+*)
+let add_eq fast u v b =
+ if fast then
+ add_eq_arc_fast u v b
+ else
+ add_eq_arc u v b
+
+(*
+ given the 2 nodes plus the current bag, adds the arc, recomputes the
+ closures and returns the new map
+*)
+let add_ge fast u v b =
+ if fast then
+ add_ge_arc_fast u v b
+ else
+ add_ge_arc u v b
+(*
+ given the 2 nodes plus the current bag, adds the arc, recomputes the
+ closures and returns the new map
+*)
+let add_gt fast u v b =
+ if fast then
+ add_gt_arc_fast u v b
+ else
+ add_gt_arc u v b
+
+
+(*****************************************************************************)
+(** Other real code **)
+(*****************************************************************************)
+
+exception UniverseInconsistency of string
+
+let error arc node1 closure_type node2 closure =
+ let s = "\n ===== Universe Inconsistency detected =====\n\n" ^
+ " Unable to add\n" ^
+ "\t" ^ (string_of_arc arc) ^ "\n" ^
+ " cause\n" ^
+ "\t" ^ (string_of_universe node1) ^ "\n" ^
+ " is in the " ^ closure_type ^ " closure\n" ^
+ "\t{" ^ (string_of_universe_set closure) ^ "}\n" ^
+ " of\n" ^
+ "\t" ^ (string_of_universe node2) ^ "\n\n" ^
+ " ===== Universe Inconsistency detected =====\n" in
+ prerr_endline s;
+ raise (UniverseInconsistency s)
+
+
+let fill_empty_nodes_with_uri g l uri =
+ let fill_empty_universe u =
+ match u with
+ (i,None) -> (i,Some uri)
+ | (i,Some _) as u -> u
+ in
+ let fill_empty_set s =
+ SOF.fold (fun e s -> SOF.add (fill_empty_universe e) s) s SOF.empty
+ in
+ let fill_empty_entry e = {
+ eq_closure = (fill_empty_set e.eq_closure) ;
+ ge_closure = (fill_empty_set e.ge_closure) ;
+ gt_closure = (fill_empty_set e.gt_closure) ;
+ in_gegt_of = (fill_empty_set e.in_gegt_of) ;
+ one_s_eq = (fill_empty_set e.one_s_eq) ;
+ one_s_ge = (fill_empty_set e.one_s_ge) ;
+ one_s_gt = (fill_empty_set e.one_s_gt) ;
+ } in
+ let m = g in
+ let m' = MAL.fold (
+ fun k v m ->
+ MAL.add (fill_empty_universe k) (fill_empty_entry v) m) m MAL.empty
+ in
+ let l' = List.map fill_empty_universe l in
+ m',l'
+
+
+(*****************************************************************************)
+(** World interface **)
+(*****************************************************************************)
+
+type universe_graph = bag
+
+let empty_ugraph = empty_bag
+
+let current_index_anon = ref (-1)
+let current_index_named = ref (-1)
+
+let restart_numbering () = current_index_named := (-1)
+
+let fresh ?uri ?id () =
+ let i =
+ match uri,id with
+ | None,None ->
+ current_index_anon := !current_index_anon + 1;
+ !current_index_anon
+ | None, Some _ -> assert false
+ | Some _, None ->
+ current_index_named := !current_index_named + 1;
+ !current_index_named
+ | Some _, Some id -> id
+ in
+ (i,uri)
+
+let name_universe u uri =
+ match u with
+ | (i, None) -> (i, Some uri)
+ | _ -> u
+
+let print_ugraph g =
+ prerr_endline (string_of_bag g)
+
+let add_eq ?(fast=(!fast_implementation)) u v b =
+ (* should we check to no add twice the same?? *)
+ let m = b in
+ let ru = repr u m in
+ if SOF.mem v ru.gt_closure then
+ error ("EQ",u,v) v "GT" u ru.gt_closure
+ else
+ begin
+ let rv = repr v m in
+ if SOF.mem u rv.gt_closure then
+ error ("EQ",u,v) u "GT" v rv.gt_closure
+ else
+ add_eq fast u v b
+ end
+
+let add_ge ?(fast=(!fast_implementation)) u v b =
+ (* should we check to no add twice the same?? *)
+ let m = b in
+ let rv = repr v m in
+ if SOF.mem u rv.gt_closure then
+ error ("GE",u,v) u "GT" v rv.gt_closure
+ else
+ add_ge fast u v b
+
+let add_gt ?(fast=(!fast_implementation)) u v b =
+ (* should we check to no add twice the same?? *)
+ (*
+ FIXME : check the thesis... no need to check GT and EQ closure since the
+ GE is a superset of both
+ *)
+ let m = b in
+ let rv = repr v m in
+
+ if u = v then
+ error ("GT",u,v) u "==" v SOF.empty
+ else
+
+ (*if SOF.mem u rv.gt_closure then
+ error ("GT",u,v) u "GT" v rv.gt_closure
+ else
+ begin*)
+ if SOF.mem u rv.ge_closure then
+ error ("GT",u,v) u "GE" v rv.ge_closure
+ else
+(* begin
+ if SOF.mem u rv.eq_closure then
+ error ("GT",u,v) u "EQ" v rv.eq_closure
+ else*)
+ add_gt fast u v b
+(* end
+ end*)
+
+(*****************************************************************************)
+(** START: Decomment this for performance comparisons **)
+(*****************************************************************************)
+
+let add_eq ?(fast=(!fast_implementation)) u v b =
+ begin_spending ();
+ let rc = add_eq ~fast u v b in
+ end_spending();
+ rc
+
+let add_ge ?(fast=(!fast_implementation)) u v b =
+ begin_spending ();
+ let rc = add_ge ~fast u v b in
+ end_spending();
+ rc
+
+let add_gt ?(fast=(!fast_implementation)) u v b =
+ begin_spending ();
+ let rc = add_gt ~fast u v b in
+ end_spending();
+ rc
+
+(*****************************************************************************)
+(** END: Decomment this for performance comparisons **)
+(*****************************************************************************)
+
+let merge_ugraphs u v =
+ (* this sucks *)
+ let merge_brutal u v =
+ if u = empty_bag then v
+ else if v = empty_bag then u
+ else
+ let m1 = u in
+ let m2 = v in
+ MAL.fold (
+ fun k v x ->
+ (SOF.fold (
+ fun u x ->
+ let m = add_gt k u x in m)
+ (SOF.union v.one_s_gt v.gt_closure)
+ (SOF.fold (
+ fun u x ->
+ let m = add_ge k u x in m)
+ (SOF.union v.one_s_ge v.ge_closure)
+ (SOF.fold (
+ fun u x ->
+ let m = add_eq k u x in m)
+ (SOF.union v.one_s_eq v.eq_closure) x)))
+ ) m1 m2
+ in
+ merge_brutal u v
+
+
+(*****************************************************************************)
+(** Xml sesialization and parsing **)
+(*****************************************************************************)
+
+let xml_of_universe name u =
+ match u with
+ | (i,Some u) ->
+ Xml.xml_empty name [
+ None,"id",(string_of_int i) ;
+ None,"uri",(UriManager.string_of_uri u)]
+ | (_,None) ->
+ raise (Failure "we can serialize only universes with uri")
+
+let xml_of_set s =
+ let l =
+ List.map (xml_of_universe "node") (SOF.elements s)
+ in
+ List.fold_left (fun s x -> [< s ; x >] ) [<>] l
+
+let xml_of_entry_content e =
+ let stream_of_field f name =
+ let eq_c = xml_of_set f in
+ if eq_c != [<>] then
+ Xml.xml_nempty name [] eq_c
+ else
+ [<>]
+ in
+ [<
+ (stream_of_field e.eq_closure "eq_closure");
+ (stream_of_field e.gt_closure "gt_closure");
+ (stream_of_field e.ge_closure "ge_closure");
+ (stream_of_field e.in_gegt_of "in_gegt_of");
+ (stream_of_field e.one_s_eq "one_s_eq");
+ (stream_of_field e.one_s_gt "one_s_gt");
+ (stream_of_field e.one_s_ge "one_s_ge")
+ >]
+
+let xml_of_entry u e =
+ let (i,u') = u in
+ let u'' =
+ match u' with
+ Some x -> x
+ | None ->
+ raise (Failure "we can serialize only universes (entry) with uri")
+ in
+ let ent = Xml.xml_nempty "entry" [
+ None,"id",(string_of_int i) ;
+ None,"uri",(UriManager.string_of_uri u'')] in
+ let content = xml_of_entry_content e in
+ ent content
+
+let write_xml_of_ugraph filename m l =
+ let tokens =
+ [<
+ Xml.xml_cdata "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n";
+ Xml.xml_nempty "ugraph" []
+ ([< (MAL.fold ( fun k v s -> [< s ; (xml_of_entry k v) >]) m [<>]) ;
+ (List.fold_left
+ (fun s u -> [< s ; xml_of_universe "owned_node" u >]) [<>] l) >])>]
+ in
+ Xml.pp ~gzip:true tokens (Some filename)
+
+let univno = fst
+
+
+let rec clean_ugraph m f =
+ let m' =
+ MAL.fold (fun k v x -> if (f k) then MAL.add k v x else x ) m MAL.empty in
+ let m'' = MAL.fold (fun k v x ->
+ let v' = {
+ eq_closure = SOF.filter f v.eq_closure;
+ ge_closure = SOF.filter f v.ge_closure;
+ gt_closure = SOF.filter f v.gt_closure;
+ in_gegt_of = SOF.filter f v.in_gegt_of;
+ one_s_eq = SOF.filter f v.one_s_eq;
+ one_s_ge = SOF.filter f v.one_s_ge;
+ one_s_gt = SOF.filter f v.one_s_gt
+ } in
+ MAL.add k v' x ) m' MAL.empty in
+ let e_l =
+ MAL.fold (fun k v l -> if v = empty_entry && not(f k) then
+ begin
+ k::l end else l) m'' []
+ in
+ if e_l != [] then
+ clean_ugraph m'' (fun u -> (f u) && not (List.mem u e_l))
+ else
+ MAL.fold
+ (fun k v x -> if v <> empty_entry then MAL.add k v x else x)
+ m'' MAL.empty
+
+let clean_ugraph g l =
+ clean_ugraph g (fun u -> List.mem u l)
+
+let assigner_of =
+ function
+ "ge_closure" -> (fun e u->{e with ge_closure=SOF.add u e.ge_closure})
+ | "gt_closure" -> (fun e u->{e with gt_closure=SOF.add u e.gt_closure})
+ | "eq_closure" -> (fun e u->{e with eq_closure=SOF.add u e.eq_closure})
+ | "in_gegt_of" -> (fun e u->{e with in_gegt_of =SOF.add u e.in_gegt_of})
+ | "one_s_ge" -> (fun e u->{e with one_s_ge =SOF.add u e.one_s_ge})
+ | "one_s_gt" -> (fun e u->{e with one_s_gt =SOF.add u e.one_s_gt})
+ | "one_s_eq" -> (fun e u->{e with one_s_eq =SOF.add u e.one_s_eq})
+ | s -> raise (Failure ("unsupported tag " ^ s))
+;;
+
+let cb_factory m l =
+ let module XPP = XmlPushParser in
+ let current_node = ref (0,None) in
+ let current_entry = ref empty_entry in
+ let current_assign = ref (assigner_of "in_gegt_of") in
+ { XPP.default_callbacks with
+ XPP.end_element = Some( fun name ->
+ match name with
+ | "entry" ->
+ m := MAL.add !current_node !current_entry !m;
+ current_entry := empty_entry
+ | _ -> ()
+ );
+ XPP.start_element = Some( fun name attlist ->
+ match name with
+ | "ugraph" -> ()
+ | "entry" ->
+ let id = List.assoc "id" attlist in
+ let uri = List.assoc "uri" attlist in
+ current_node := (int_of_string id,Some (UriManager.uri_of_string uri))
+ | "node" ->
+ let id = int_of_string (List.assoc "id" attlist) in
+ let uri = List.assoc "uri" attlist in
+ current_entry := !current_assign !current_entry
+ (id,Some (UriManager.uri_of_string uri))
+ | "owned_node" ->
+ let id = int_of_string (List.assoc "id" attlist) in
+ let uri = List.assoc "uri" attlist in
+ l := (id,Some (UriManager.uri_of_string uri)) :: !l
+ | s -> current_assign := assigner_of s
+ )
+ }
+;;
+
+let ugraph_and_univlist_of_xml filename =
+ let module XPP = XmlPushParser in
+ let result_map = ref MAL.empty in
+ let result_list = ref [] in
+ let cb = cb_factory result_map result_list in
+ let xml_parser = XPP.create_parser cb in
+ let xml_source = `Gzip_file filename in
+ (try XPP.parse xml_parser xml_source
+ with (XPP.Parse_error err) as exn -> raise exn);
+ !result_map, !result_list
+
+
+(*****************************************************************************)
+(** the main, only for testing **)
+(*****************************************************************************)
+
+(*
+
+type arc = Ge | Gt | Eq ;;
+
+let randomize_actionlist n m =
+ let ge_percent = 0.7 in
+ let gt_percent = 0.15 in
+ let random_step () =
+ let node1 = Random.int m in
+ let node2 = Random.int m in
+ let op =
+ let r = Random.float 1.0 in
+ if r < ge_percent then
+ Ge
+ else (if r < (ge_percent +. gt_percent) then
+ Gt
+ else
+ Eq)
+ in
+ op,node1,node2
+ in
+ let rec aux n =
+ match n with
+ 0 -> []
+ | n -> (random_step ())::(aux (n-1))
+ in
+ aux n
+
+let print_action_list l =
+ let string_of_step (op,node1,node2) =
+ (match op with
+ Ge -> "Ge"
+ | Gt -> "Gt"
+ | Eq -> "Eq") ^
+ "," ^ (string_of_int node1) ^ "," ^ (string_of_int node2)
+ in
+ let rec aux l =
+ match l with
+ [] -> "]"
+ | a::tl ->
+ ";" ^ (string_of_step a) ^ (aux tl)
+ in
+ let body = aux l in
+ let l_body = (String.length body) - 1 in
+ prerr_endline ("[" ^ (String.sub body 1 l_body))
+
+let debug = false
+let d_print_endline = if debug then print_endline else ignore
+let d_print_ugraph = if debug then print_ugraph else ignore
+
+let _ =
+ (if Array.length Sys.argv < 2 then
+ prerr_endline ("Usage " ^ Sys.argv.(0) ^ " max_edges max_nodes"));
+ Random.self_init ();
+ let max_edges = int_of_string Sys.argv.(1) in
+ let max_nodes = int_of_string Sys.argv.(2) in
+ let action_listR = randomize_actionlist max_edges max_nodes in
+
+ let action_list = [Ge,1,4;Ge,2,6;Ge,1,1;Eq,6,4;Gt,6,3] in
+ let action_list = action_listR in
+
+ print_action_list action_list;
+ let prform_step ?(fast=false) (t,u,v) g =
+ let f,str =
+ match t with
+ Ge -> add_ge,">="
+ | Gt -> add_gt,">"
+ | Eq -> add_eq,"="
+ in
+ d_print_endline (
+ "Aggiungo " ^
+ (string_of_int u) ^
+ " " ^ str ^ " " ^
+ (string_of_int v));
+ let g' = f ~fast (u,None) (v,None) g in
+ (*print_ugraph g' ;*)
+ g'
+ in
+ let fail = ref false in
+ let time1 = Unix.gettimeofday () in
+ let n_safe = ref 0 in
+ let g_safe =
+ try
+ d_print_endline "SAFE";
+ List.fold_left (
+ fun g e ->
+ n_safe := !n_safe + 1;
+ prform_step e g
+ ) empty_ugraph action_list
+ with
+ UniverseInconsistency s -> fail:=true;empty_bag
+ in
+ let time2 = Unix.gettimeofday () in
+ d_print_ugraph g_safe;
+ let time3 = Unix.gettimeofday () in
+ let n_test = ref 0 in
+ let g_test =
+ try
+ d_print_endline "FAST";
+ List.fold_left (
+ fun g e ->
+ n_test := !n_test + 1;
+ prform_step ~fast:true e g
+ ) empty_ugraph action_list
+ with
+ UniverseInconsistency s -> empty_bag
+ in
+ let time4 = Unix.gettimeofday () in
+ d_print_ugraph g_test;
+ if are_ugraph_eq g_safe g_test && !n_test = !n_safe then
+ begin
+ let num_eq =
+ List.fold_left (
+ fun s (e,_,_) ->
+ if e = Eq then s+1 else s
+ ) 0 action_list
+ in
+ let num_gt =
+ List.fold_left (
+ fun s (e,_,_) ->
+ if e = Gt then s+1 else s
+ ) 0 action_list
+ in
+ let num_ge = max_edges - num_gt - num_eq in
+ let time_fast = (time4 -. time3) in
+ let time_safe = (time2 -. time1) in
+ let gap = ((time_safe -. time_fast) *. 100.0) /. time_safe in
+ let fail = if !fail then 1 else 0 in
+ print_endline
+ (sprintf
+ "OK %d safe %1.4f fast %1.4f %% %1.2f #eq %d #gt %d #ge %d %d"
+ fail time_safe time_fast gap num_eq num_gt num_ge !n_safe);
+ exit 0
+ end
+ else
+ begin
+ print_endline "FAIL";
+ print_ugraph g_safe;
+ print_ugraph g_test;
+ exit 1
+ end
+;;
+
+ *)
+
+let recons_univ u =
+ match u with
+ | i, None -> u
+ | i, Some uri ->
+ i, Some (UriManager.uri_of_string (UriManager.string_of_uri uri))
+
+let recons_entry entry =
+ let recons_set set =
+ SOF.fold (fun univ set -> SOF.add (recons_univ univ) set) set SOF.empty
+ in
+ {
+ eq_closure = recons_set entry.eq_closure;
+ ge_closure = recons_set entry.ge_closure;
+ gt_closure = recons_set entry.gt_closure;
+ in_gegt_of = recons_set entry.in_gegt_of;
+ one_s_eq = recons_set entry.one_s_eq;
+ one_s_ge = recons_set entry.one_s_ge;
+ one_s_gt = recons_set entry.one_s_gt;
+ }
+
+let recons_graph graph =
+ MAL.fold
+ (fun universe entry map ->
+ MAL.add (recons_univ universe) (recons_entry entry) map)
+ graph MAL.empty
+
+let assert_univ u =
+ match u with
+ | (_,None) -> raise (UniverseInconsistency "This universe graph has a hole")
+ | _ -> ()
+
+let assert_univs_have_uri graph univlist =
+ let assert_set s =
+ SOF.iter (fun u -> assert_univ u) s
+ in
+ let assert_entry e =
+ assert_set e.eq_closure;
+ assert_set e.ge_closure;
+ assert_set e.gt_closure;
+ assert_set e.in_gegt_of;
+ assert_set e.one_s_eq;
+ assert_set e.one_s_ge;
+ assert_set e.one_s_gt;
+ in
+ MAL.iter (fun k v -> assert_univ k; assert_entry v)graph;
+ List.iter assert_univ univlist
+
+let eq u1 u2 =
+ match u1,u2 with
+ | (id1, Some uri1),(id2, Some uri2) ->
+ id1 = id2 && UriManager.eq uri1 uri2
+ | (id1, None),(id2, None) -> id1 = id2
+ | _ -> false
+
+let compare (id1, uri1) (id2, uri2) =
+ let cmp = id1 - id2 in
+ if cmp = 0 then
+ match uri1,uri2 with
+ | None, None -> 0
+ | Some _, None -> 1
+ | None, Some _ -> ~-1
+ | Some uri1, Some uri2 -> UriManager.compare uri1 uri2
+ else
+ cmp
+
+(* EOF *)
diff --git a/helm/ocaml/cic/cicUniv.mli b/helm/ocaml/cic/cicUniv.mli
new file mode 100644
index 000000000..be8c28bf3
--- /dev/null
+++ b/helm/ocaml/cic/cicUniv.mli
@@ -0,0 +1,152 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+
+(*
+ The strings contains an unreadable message
+*)
+exception UniverseInconsistency of string
+
+(*
+ Cic.Type of universe
+*)
+type universe
+
+(*
+ Opaque data structure you will use to store constraints
+*)
+type universe_graph
+
+(*
+ returns a fresh universe
+*)
+val fresh:
+ ?uri:UriManager.uri ->
+ ?id:int ->
+ unit ->
+ universe
+
+ (* names a universe if unnamed *)
+val name_universe: universe -> UriManager.uri -> universe
+
+(*
+ really useful at the begin and in all the functions that don't care
+ of universes
+*)
+val empty_ugraph: universe_graph
+
+(*
+ These are the real functions to add eq/ge/gt constraints
+ to the passed graph, returning an updated graph or raising
+ UniverseInconsistency
+*)
+val add_eq:
+ ?fast:bool -> universe -> universe -> universe_graph -> universe_graph
+val add_ge:
+ ?fast:bool -> universe -> universe -> universe_graph -> universe_graph
+val add_gt:
+ ?fast:bool -> universe -> universe -> universe_graph -> universe_graph
+
+(*
+ debug function to print the graph to standard error
+*)
+val print_ugraph:
+ universe_graph -> unit
+
+(*
+ does what expected, but I don't remember why this was exported
+*)
+val string_of_universe:
+ universe -> string
+
+(*
+ given the list of visible universes (see universes_of_obj) returns a
+ cleaned graph (cleaned from the not visible nodes)
+*)
+val clean_ugraph:
+ universe_graph -> universe list -> universe_graph
+
+(*
+ Since fresh() can't add the right uri to each node, you
+ must fill empty nodes with the uri before you serialize the graph to xml
+
+ these empty nodes are also filled in the universe list
+*)
+val fill_empty_nodes_with_uri:
+ universe_graph -> universe list -> UriManager.uri ->
+ universe_graph * universe list
+
+(*
+ makes a union.
+ TODO:
+ - remember already merged uri so that we completely skip already merged
+ graphs, this may include a dependecy graph (not merge a subpart of an
+ already merged graph)
+*)
+val merge_ugraphs:
+ universe_graph -> universe_graph -> universe_graph
+
+(*
+ ugraph to xml file and viceversa
+*)
+val write_xml_of_ugraph:
+ string -> universe_graph -> universe list -> unit
+
+(*
+ given a filename parses the xml and returns the data structure
+*)
+val ugraph_and_univlist_of_xml:
+ string -> universe_graph * universe list
+val restart_numbering:
+ unit -> unit
+
+(*
+ returns the universe number (used to save it do xml)
+*)
+val univno: universe -> int
+
+ (** re-hash-cons URIs contained in the given universe so that phisicaly
+ * equality could be enforced. Mainly used by
+ * CicEnvironment.restore_from_channel *)
+val recons_graph: universe_graph -> universe_graph
+
+ (** re-hash-cons a single universe *)
+val recons_univ: universe -> universe
+
+ (** consistency chek that should be done before committin the graph to the
+ * cache *)
+val assert_univs_have_uri: universe_graph -> universe list-> unit
+
+ (** asserts the universe is named *)
+val assert_univ: universe -> unit
+
+val compare: universe -> universe -> int
+val eq: universe -> universe -> bool
+
+(*
+ Benchmarking stuff
+*)
+val get_spent_time: unit -> float
+val reset_spent_time: unit -> unit
diff --git a/helm/ocaml/cic/cicUtil.ml b/helm/ocaml/cic/cicUtil.ml
new file mode 100644
index 000000000..7c6e3eabe
--- /dev/null
+++ b/helm/ocaml/cic/cicUtil.ml
@@ -0,0 +1,365 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+exception Meta_not_found of int
+exception Subst_not_found of int
+
+let lookup_meta index metasenv =
+ try
+ List.find (fun (index', _, _) -> index = index') metasenv
+ with Not_found -> raise (Meta_not_found index)
+
+let lookup_subst n subst =
+ try
+ List.assoc n subst
+ with Not_found -> raise (Subst_not_found n)
+
+let exists_meta index = List.exists (fun (index', _, _) -> (index = index'))
+
+(* clean_up_meta take a substitution, a metasenv a meta_inex and a local
+context l and clean up l with respect to the hidden hipothesis in the
+canonical context *)
+
+let clean_up_local_context subst metasenv n l =
+ let cc =
+ (try
+ let (cc,_,_) = lookup_subst n subst in cc
+ with Subst_not_found _ ->
+ try
+ let (_,cc,_) = lookup_meta n metasenv in cc
+ with Meta_not_found _ -> assert false) in
+ (try
+ List.map2
+ (fun t1 t2 ->
+ match t1,t2 with
+ None , _ -> None
+ | _ , t -> t) cc l
+ with
+ Invalid_argument _ -> assert false)
+
+let is_closed =
+ let module C = Cic in
+ let rec is_closed k =
+ function
+ C.Rel m when m > k -> false
+ | C.Rel m -> true
+ | C.Meta (_,l) ->
+ List.fold_left
+ (fun i t -> i && (match t with None -> true | Some t -> is_closed k t)
+ ) true l
+ | C.Sort _ -> true
+ | C.Implicit _ -> assert false
+ | C.Cast (te,ty) -> is_closed k te && is_closed k ty
+ | C.Prod (name,so,dest) -> is_closed k so && is_closed (k+1) dest
+ | C.Lambda (_,so,dest) -> is_closed k so && is_closed (k+1) dest
+ | C.LetIn (_,so,dest) -> is_closed k so && is_closed (k+1) dest
+ | C.Appl l ->
+ List.fold_right (fun x i -> i && is_closed k x) l true
+ | C.Var (_,exp_named_subst)
+ | C.Const (_,exp_named_subst)
+ | C.MutInd (_,_,exp_named_subst)
+ | C.MutConstruct (_,_,_,exp_named_subst) ->
+ List.fold_right (fun (_,x) i -> i && is_closed k x)
+ exp_named_subst true
+ | C.MutCase (_,_,out,te,pl) ->
+ is_closed k out && is_closed k te &&
+ List.fold_right (fun x i -> i && is_closed k x) pl true
+ | C.Fix (_,fl) ->
+ let len = List.length fl in
+ let k_plus_len = k + len in
+ List.fold_right
+ (fun (_,_,ty,bo) i -> i && is_closed k ty && is_closed k_plus_len bo
+ ) fl true
+ | C.CoFix (_,fl) ->
+ let len = List.length fl in
+ let k_plus_len = k + len in
+ List.fold_right
+ (fun (_,ty,bo) i -> i && is_closed k ty && is_closed k_plus_len bo
+ ) fl true
+in
+ is_closed 0
+;;
+
+let rec is_meta_closed =
+ function
+ Cic.Rel _ -> true
+ | Cic.Meta _ -> false
+ | Cic.Sort _ -> true
+ | Cic.Implicit _ -> assert false
+ | Cic.Cast (te,ty) -> is_meta_closed te && is_meta_closed ty
+ | Cic.Prod (name,so,dest) -> is_meta_closed so && is_meta_closed dest
+ | Cic.Lambda (_,so,dest) -> is_meta_closed so && is_meta_closed dest
+ | Cic.LetIn (_,so,dest) -> is_meta_closed so && is_meta_closed dest
+ | Cic.Appl l ->
+ not (List.exists (fun x -> not (is_meta_closed x)) l)
+ | Cic.Var (_,exp_named_subst)
+ | Cic.Const (_,exp_named_subst)
+ | Cic.MutInd (_,_,exp_named_subst)
+ | Cic.MutConstruct (_,_,_,exp_named_subst) ->
+ not (List.exists (fun (_,x) -> not (is_meta_closed x)) exp_named_subst)
+ | Cic.MutCase (_,_,out,te,pl) ->
+ is_meta_closed out && is_meta_closed te &&
+ not (List.exists (fun x -> not (is_meta_closed x)) pl)
+ | Cic.Fix (_,fl) ->
+ not (List.exists
+ (fun (_,_,ty,bo) ->
+ not (is_meta_closed ty) || not (is_meta_closed bo))
+ fl)
+ | Cic.CoFix (_,fl) ->
+ not (List.exists
+ (fun (_,ty,bo) ->
+ not (is_meta_closed ty) || not (is_meta_closed bo))
+ fl)
+;;
+
+let xpointer_RE = Str.regexp "\\([^#]+\\)#xpointer(\\(.*\\))"
+let slash_RE = Str.regexp "/"
+
+let term_of_uri uri =
+ let s = UriManager.string_of_uri uri in
+ try
+ (if UriManager.uri_is_con uri then
+ Cic.Const (uri, [])
+ else if UriManager.uri_is_var uri then
+ Cic.Var (uri, [])
+ else if not (Str.string_match xpointer_RE s 0) then
+ raise (UriManager.IllFormedUri s)
+ else
+ let (baseuri,xpointer) = (Str.matched_group 1 s, Str.matched_group 2 s) in
+ let baseuri = UriManager.uri_of_string baseuri in
+ (match Str.split slash_RE xpointer with
+ | [_; tyno] -> Cic.MutInd (baseuri, int_of_string tyno - 1, [])
+ | [_; tyno; consno] ->
+ Cic.MutConstruct
+ (baseuri, int_of_string tyno - 1, int_of_string consno, [])
+ | _ -> raise Exit))
+ with
+ | Exit
+ | Failure _
+ | Not_found -> raise (UriManager.IllFormedUri s)
+
+let uri_of_term = function
+ | Cic.Const (uri, [])
+ | Cic.Var (uri, []) -> uri
+ | Cic.MutInd (baseuri, tyno, []) ->
+ UriManager.uri_of_string
+ (sprintf "%s#xpointer(1/%d)" (UriManager.string_of_uri baseuri) (tyno+1))
+ | Cic.MutConstruct (baseuri, tyno, consno, []) ->
+ UriManager.uri_of_string
+ (sprintf "%s#xpointer(1/%d/%d)" (UriManager.string_of_uri baseuri)
+ (tyno + 1) consno)
+ | _ -> raise (Invalid_argument "uri_of_term")
+
+
+(*
+let pack terms =
+ List.fold_right
+ (fun term acc -> Cic.Prod (Cic.Anonymous, term, acc))
+ terms (Cic.Sort (Cic.Type (CicUniv.fresh ())))
+
+let rec unpack = function
+ | Cic.Prod (Cic.Anonymous, term, Cic.Sort (Cic.Type _)) -> [term]
+ | Cic.Prod (Cic.Anonymous, term, tgt) -> term :: unpack tgt
+ | _ -> assert false
+*)
+
+let rec strip_prods n = function
+ | t when n = 0 -> t
+ | Cic.Prod (_, _, tgt) when n > 0 -> strip_prods (n-1) tgt
+ | _ -> failwith "not enough prods"
+
+let params_of_obj = function
+ | Cic.Constant (_, _, _, params, _)
+ | Cic.Variable (_, _, _, params, _)
+ | Cic.CurrentProof (_, _, _, _, params, _)
+ | Cic.InductiveDefinition (_, params, _, _) ->
+ params
+
+let attributes_of_obj = function
+ | Cic.Constant (_, _, _, _, attributes)
+ | Cic.Variable (_, _, _, _, attributes)
+ | Cic.CurrentProof (_, _, _, _, _, attributes)
+ | Cic.InductiveDefinition (_, _, _, attributes) ->
+ attributes
+let rec mk_rels howmany from =
+ match howmany with
+ | 0 -> []
+ | _ -> (Cic.Rel (howmany + from)) :: (mk_rels (howmany-1) from)
+
+let id_of_annterm =
+ function
+ | Cic.ARel (id,_,_,_)
+ | Cic.AVar (id,_,_)
+ | Cic.AMeta (id,_,_)
+ | Cic.ASort (id,_)
+ | Cic.AImplicit (id,_)
+ | Cic.ACast (id,_,_)
+ | Cic.AProd (id,_,_,_)
+ | Cic.ALambda (id,_,_,_)
+ | Cic.ALetIn (id,_,_,_)
+ | Cic.AAppl (id,_)
+ | Cic.AConst (id,_,_)
+ | Cic.AMutInd (id,_,_,_)
+ | Cic.AMutConstruct (id,_,_,_,_)
+ | Cic.AMutCase (id,_,_,_,_,_)
+ | Cic.AFix (id,_,_)
+ | Cic.ACoFix (id,_,_) -> id
+
+
+let rec rehash_term =
+ let module C = Cic in
+ let recons uri = UriManager.uri_of_string (UriManager.string_of_uri uri) in
+ function
+ | (C.Rel _) as t -> t
+ | C.Var (uri,exp_named_subst) ->
+ let uri' = recons uri in
+ let exp_named_subst' =
+ List.map
+ (function (uri,t) ->(recons uri,rehash_term t))
+ exp_named_subst
+ in
+ C.Var (uri',exp_named_subst')
+ | C.Meta (i,l) ->
+ let l' =
+ List.map
+ (function
+ None -> None
+ | Some t -> Some (rehash_term t)
+ ) l
+ in
+ C.Meta(i,l')
+ | C.Sort (C.Type u) ->
+ CicUniv.assert_univ u;
+ C.Sort (C.Type (CicUniv.recons_univ u))
+ | C.Sort _ as t -> t
+ | C.Implicit _ as t -> t
+ | C.Cast (te,ty) -> C.Cast (rehash_term te, rehash_term ty)
+ | C.Prod (n,s,t) -> C.Prod (n, rehash_term s, rehash_term t)
+ | C.Lambda (n,s,t) -> C.Lambda (n, rehash_term s, rehash_term t)
+ | C.LetIn (n,s,t) -> C.LetIn (n, rehash_term s, rehash_term t)
+ | C.Appl l -> C.Appl (List.map rehash_term l)
+ | C.Const (uri,exp_named_subst) ->
+ let uri' = recons uri in
+ let exp_named_subst' =
+ List.map
+ (function (uri,t) -> (recons uri,rehash_term t)) exp_named_subst
+ in
+ C.Const (uri',exp_named_subst')
+ | C.MutInd (uri,tyno,exp_named_subst) ->
+ let uri' = recons uri in
+ let exp_named_subst' =
+ List.map
+ (function (uri,t) -> (recons uri,rehash_term t)) exp_named_subst
+ in
+ C.MutInd (uri',tyno,exp_named_subst')
+ | C.MutConstruct (uri,tyno,consno,exp_named_subst) ->
+ let uri' = recons uri in
+ let exp_named_subst' =
+ List.map
+ (function (uri,t) -> (recons uri,rehash_term t)) exp_named_subst
+ in
+ C.MutConstruct (uri',tyno,consno,exp_named_subst')
+ | C.MutCase (uri,i,outty,t,pl) ->
+ C.MutCase (recons uri, i, rehash_term outty, rehash_term t,
+ List.map rehash_term pl)
+ | C.Fix (i, fl) ->
+ let liftedfl =
+ List.map
+ (fun (name, i, ty, bo) ->
+ (name, i, rehash_term ty, rehash_term bo))
+ fl
+ in
+ C.Fix (i, liftedfl)
+ | C.CoFix (i, fl) ->
+ let liftedfl =
+ List.map
+ (fun (name, ty, bo) -> (name, rehash_term ty, rehash_term bo))
+ fl
+ in
+ C.CoFix (i, liftedfl)
+
+let rehash_obj =
+ let module C = Cic in
+ let recons uri = UriManager.uri_of_string (UriManager.string_of_uri uri) in
+ function
+ C.Constant (name,bo,ty,params,attrs) ->
+ let bo' =
+ match bo with
+ None -> None
+ | Some bo -> Some (rehash_term bo)
+ in
+ let ty' = rehash_term ty in
+ let params' = List.map recons params in
+ C.Constant (name, bo', ty', params',attrs)
+ | C.CurrentProof (name,conjs,bo,ty,params,attrs) ->
+ let conjs' =
+ List.map
+ (function (i,hyps,ty) ->
+ (i,
+ List.map (function
+ None -> None
+ | Some (name,C.Decl t) ->
+ Some (name,C.Decl (rehash_term t))
+ | Some (name,C.Def (bo,ty)) ->
+ let ty' =
+ match ty with
+ None -> None
+ | Some ty'' -> Some (rehash_term ty'')
+ in
+ Some (name,C.Def (rehash_term bo, ty'))) hyps,
+ rehash_term ty))
+ conjs
+ in
+ let bo' = rehash_term bo in
+ let ty' = rehash_term ty in
+ let params' = List.map recons params in
+ C.CurrentProof (name, conjs', bo', ty', params',attrs)
+ | C.Variable (name,bo,ty,params,attrs) ->
+ let bo' =
+ match bo with
+ None -> None
+ | Some bo -> Some (rehash_term bo)
+ in
+ let ty' = rehash_term ty in
+ let params' = List.map recons params in
+ C.Variable (name, bo', ty', params',attrs)
+ | C.InductiveDefinition (tl,params,paramsno,attrs) ->
+ let params' = List.map recons params in
+ let tl' =
+ List.map (function (name, inductive, ty, constructors) ->
+ name,
+ inductive,
+ rehash_term ty,
+ (List.map
+ (function (name, ty) -> name, rehash_term ty)
+ constructors))
+ tl
+ in
+ C.InductiveDefinition (tl', params', paramsno, attrs)
+
diff --git a/helm/ocaml/cic/cicUtil.mli b/helm/ocaml/cic/cicUtil.mli
new file mode 100644
index 000000000..b6fd7459d
--- /dev/null
+++ b/helm/ocaml/cic/cicUtil.mli
@@ -0,0 +1,61 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+exception Meta_not_found of int
+exception Subst_not_found of int
+
+val lookup_meta: int -> Cic.metasenv -> Cic.conjecture
+val lookup_subst: int -> Cic.substitution -> Cic.context * Cic.term * Cic.term
+val exists_meta: int -> Cic.metasenv -> bool
+val clean_up_local_context :
+ Cic.substitution -> Cic.metasenv -> int -> (Cic.term option) list
+ -> (Cic.term option) list
+
+val is_closed : Cic.term -> bool
+val is_meta_closed : Cic.term -> bool
+
+ (** @raise Failure "not enough prods" *)
+val strip_prods: int -> Cic.term -> Cic.term
+
+(** conversions between terms which are fully representable as uris (Var, Const,
+ * Mutind, and MutConstruct) and corresponding tree representations *)
+val term_of_uri: UriManager.uri -> Cic.term (** @raise UriManager.IllFormedUri *)
+val uri_of_term: Cic.term -> UriManager.uri (** @raise Invalid_argument "uri_of_term" *)
+
+val id_of_annterm: Cic.annterm -> Cic.id
+
+(** {2 Cic selectors} *)
+
+val params_of_obj: Cic.obj -> UriManager.uri list
+val attributes_of_obj: Cic.obj -> Cic.attribute list
+
+(** mk_rels [howmany] [from]
+ * creates a list of [howmany] rels starting from [from] in decreasing order *)
+val mk_rels : int -> int -> Cic.term list
+
+(** {2 Uri hash consing} *)
+val rehash_term: Cic.term -> Cic.term
+val rehash_obj: Cic.obj -> Cic.obj
+
diff --git a/helm/ocaml/cic/deannotate.ml b/helm/ocaml/cic/deannotate.ml
new file mode 100644
index 000000000..f04f5aa10
--- /dev/null
+++ b/helm/ocaml/cic/deannotate.ml
@@ -0,0 +1,126 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+(* converts annotated terms into cic terms (forgetting ids and names) *)
+let rec deannotate_term =
+ let module C = Cic in
+ function
+ C.ARel (_,_,n,_) -> C.Rel n
+ | C.AVar (_,uri,exp_named_subst) ->
+ let deann_exp_named_subst =
+ List.map (function (uri,t) -> uri,deannotate_term t) exp_named_subst
+ in
+ C.Var (uri, deann_exp_named_subst)
+ | C.AMeta (_,n, l) ->
+ let l' =
+ List.map
+ (function
+ None -> None
+ | Some at -> Some (deannotate_term at)
+ ) l
+ in
+ C.Meta (n, l')
+ | C.ASort (_,s) -> C.Sort s
+ | C.AImplicit (_, annotation) -> C.Implicit annotation
+ | C.ACast (_,va,ty) -> C.Cast (deannotate_term va, deannotate_term ty)
+ | C.AProd (_,name,so,ta) ->
+ C.Prod (name, deannotate_term so, deannotate_term ta)
+ | C.ALambda (_,name,so,ta) ->
+ C.Lambda (name, deannotate_term so, deannotate_term ta)
+ | C.ALetIn (_,name,so,ta) ->
+ C.LetIn (name, deannotate_term so, deannotate_term ta)
+ | C.AAppl (_,l) -> C.Appl (List.map deannotate_term l)
+ | C.AConst (_,uri,exp_named_subst) ->
+ let deann_exp_named_subst =
+ List.map (function (uri,t) -> uri,deannotate_term t) exp_named_subst
+ in
+ C.Const (uri, deann_exp_named_subst)
+ | C.AMutInd (_,uri,i,exp_named_subst) ->
+ let deann_exp_named_subst =
+ List.map (function (uri,t) -> uri,deannotate_term t) exp_named_subst
+ in
+ C.MutInd (uri,i,deann_exp_named_subst)
+ | C.AMutConstruct (_,uri,i,j,exp_named_subst) ->
+ let deann_exp_named_subst =
+ List.map (function (uri,t) -> uri,deannotate_term t) exp_named_subst
+ in
+ C.MutConstruct (uri,i,j,deann_exp_named_subst)
+ | C.AMutCase (_,uri,i,outtype,te,pl) ->
+ C.MutCase (uri,i,deannotate_term outtype,
+ deannotate_term te, List.map deannotate_term pl)
+ | C.AFix (_,funno,ifl) ->
+ C.Fix (funno, List.map deannotate_inductiveFun ifl)
+ | C.ACoFix (_,funno,ifl) ->
+ C.CoFix (funno, List.map deannotate_coinductiveFun ifl)
+
+and deannotate_inductiveFun (_,name,index,ty,bo) =
+ (name, index, deannotate_term ty, deannotate_term bo)
+
+and deannotate_coinductiveFun (_,name,ty,bo) =
+ (name, deannotate_term ty, deannotate_term bo)
+;;
+
+let deannotate_inductiveType (_, name, isinductive, arity, cons) =
+ (name, isinductive, deannotate_term arity,
+ List.map (fun (id,ty) -> (id,deannotate_term ty)) cons)
+;;
+
+let deannotate_obj =
+ let module C = Cic in
+ function
+ C.AConstant (_, _, id, bo, ty, params, attrs) ->
+ C.Constant (id,
+ (match bo with None -> None | Some bo -> Some (deannotate_term bo)),
+ deannotate_term ty, params, attrs)
+ | C.AVariable (_, name, bo, ty, params, attrs) ->
+ C.Variable (name,
+ (match bo with None -> None | Some bo -> Some (deannotate_term bo)),
+ deannotate_term ty, params, attrs)
+ | C.ACurrentProof (_, _, name, conjs, bo, ty, params, attrs) ->
+ C.CurrentProof (
+ name,
+ List.map
+ (function
+ (_,id,acontext,con) ->
+ let context =
+ List.map
+ (function
+ _,Some (n,(C.ADef at)) ->
+ Some (n,(C.Def ((deannotate_term at),None)))
+ | _,Some (n,(C.ADecl at)) ->
+ Some (n,(C.Decl (deannotate_term at)))
+ | _,None -> None
+ ) acontext
+ in
+ (id,context,deannotate_term con)
+ ) conjs,
+ deannotate_term bo,deannotate_term ty, params, attrs
+ )
+ | C.AInductiveDefinition (_, tys, params, parno, attrs) ->
+ C.InductiveDefinition (List.map deannotate_inductiveType tys,
+ params, parno, attrs)
+;;
diff --git a/helm/ocaml/cic/deannotate.mli b/helm/ocaml/cic/deannotate.mli
new file mode 100644
index 000000000..89b18d2d6
--- /dev/null
+++ b/helm/ocaml/cic/deannotate.mli
@@ -0,0 +1,36 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(******************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Claudio Sacerdoti Coen <sacerdot@cs.unibo.it> *)
+(* 29/11/2000 *)
+(* *)
+(******************************************************************************)
+
+val deannotate_term : Cic.annterm -> Cic.term
+val deannotate_obj : Cic.annobj -> Cic.obj
diff --git a/helm/ocaml/cic/discrimination_tree.ml b/helm/ocaml/cic/discrimination_tree.ml
new file mode 100644
index 000000000..0bef85a8c
--- /dev/null
+++ b/helm/ocaml/cic/discrimination_tree.ml
@@ -0,0 +1,343 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+module DiscriminationTreeIndexing =
+ functor (A:Set.S) ->
+ struct
+
+ type path_string_elem = Cic.term;;
+ type path_string = path_string_elem list;;
+
+
+ (* needed by the retrieve_* functions, to know the arities of the "functions" *)
+
+ let arities = Hashtbl.create 11;;
+
+
+ let rec path_string_of_term = function
+ | Cic.Meta _ -> [Cic.Implicit None]
+ | Cic.Appl ((hd::tl) as l) ->
+ if not (Hashtbl.mem arities hd) then
+ Hashtbl.add arities hd (List.length tl);
+ List.concat (List.map path_string_of_term l)
+ | term -> [term]
+ ;;
+
+
+ module OrderedPathStringElement = struct
+ type t = path_string_elem
+
+ let compare = Pervasives.compare
+ end
+
+ module PSMap = Map.Make(OrderedPathStringElement);;
+
+ type key = PSMap.key
+
+ module DiscriminationTree = Trie.Make(PSMap);;
+
+ type t = A.t DiscriminationTree.t
+ let empty = DiscriminationTree.empty
+
+(*
+ module OrderedPosEquality = struct
+ type t = Utils.pos * Inference.equality
+ let compare = Pervasives.compare
+ end
+
+ module PosEqSet = Set.Make(OrderedPosEquality);;
+
+ let string_of_discrimination_tree tree =
+ let rec to_string level = function
+ | DiscriminationTree.Node (value, map) ->
+ let s =
+ match value with
+ | Some v ->
+ (String.make (2 * level) ' ') ^
+ "{" ^ (String.concat "; "
+ (List.map
+ (fun (p, e) ->
+ "(" ^ (Utils.string_of_pos p) ^ ", " ^
+ (Inference.string_of_equality e) ^ ")")
+ (PosEqSet.elements v))) ^ "}"
+ | None -> ""
+ in
+ let rest =
+ String.concat "\n"
+ (PSMap.fold
+ (fun k v s ->
+ let ks = CicPp.ppterm k in
+ let rs = to_string (level+1) v in
+ ((String.make (2 * level) ' ') ^ ks ^ "\n" ^ rs)::s)
+ map [])
+ in
+ s ^ rest
+ in
+ to_string 0 tree
+ ;;
+*)
+
+ let index tree term info =
+ let ps = path_string_of_term term in
+ let ps_set =
+ try DiscriminationTree.find ps tree
+ with Not_found -> A.empty in
+ let tree =
+ DiscriminationTree.add ps (A.add info ps_set) tree in
+ tree
+
+(*
+ let index tree equality =
+ let _, _, (_, l, r, ordering), _, _ = equality in
+ let psl = path_string_of_term l
+ and psr = path_string_of_term r in
+ let index pos tree ps =
+ let ps_set =
+ try DiscriminationTree.find ps tree with Not_found -> PosEqSet.empty in
+ let tree =
+ DiscriminationTree.add ps (PosEqSet.add (pos, equality) ps_set) tree in
+ tree
+ in
+ match ordering with
+ | Utils.Gt -> index Utils.Left tree psl
+ | Utils.Lt -> index Utils.Right tree psr
+ | _ ->
+ let tree = index Utils.Left tree psl in
+ index Utils.Right tree psr
+ ;;
+*)
+
+ let remove_index tree term info =
+ let ps = path_string_of_term term in
+ try
+ let ps_set =
+ A.remove info (DiscriminationTree.find ps tree) in
+ if A.is_empty ps_set then
+ DiscriminationTree.remove ps tree
+ else
+ DiscriminationTree.add ps ps_set tree
+ with Not_found ->
+ tree
+
+(*
+let remove_index tree equality =
+ let _, _, (_, l, r, ordering), _, _ = equality in
+ let psl = path_string_of_term l
+ and psr = path_string_of_term r in
+ let remove_index pos tree ps =
+ try
+ let ps_set =
+ PosEqSet.remove (pos, equality) (DiscriminationTree.find ps tree) in
+ if PosEqSet.is_empty ps_set then
+ DiscriminationTree.remove ps tree
+ else
+ DiscriminationTree.add ps ps_set tree
+ with Not_found ->
+ tree
+ in
+ match ordering with
+ | Utils.Gt -> remove_index Utils.Left tree psl
+ | Utils.Lt -> remove_index Utils.Right tree psr
+ | _ ->
+ let tree = remove_index Utils.Left tree psl in
+ remove_index Utils.Right tree psr
+;;
+*)
+
+
+ let in_index tree term test =
+ let ps = path_string_of_term term in
+ try
+ let ps_set = DiscriminationTree.find ps tree in
+ A.exists test ps_set
+ with Not_found ->
+ false
+
+(*
+ let in_index tree equality =
+ let _, _, (_, l, r, ordering), _, _ = equality in
+ let psl = path_string_of_term l
+ and psr = path_string_of_term r in
+ let meta_convertibility = Inference.meta_convertibility_eq equality in
+ let ok ps =
+ try
+ let set = DiscriminationTree.find ps tree in
+ PosEqSet.exists (fun (p, e) -> meta_convertibility e) set
+ with Not_found ->
+ false
+ in
+ (ok psl) || (ok psr)
+;;
+*)
+
+
+ let head_of_term = function
+ | Cic.Appl (hd::tl) -> hd
+ | term -> term
+ ;;
+
+
+ let rec subterm_at_pos pos term =
+ match pos with
+ | [] -> term
+ | index::pos ->
+ match term with
+ | Cic.Appl l ->
+ (try subterm_at_pos pos (List.nth l index)
+ with Failure _ -> raise Not_found)
+ | _ -> raise Not_found
+ ;;
+
+
+ let rec after_t pos term =
+ let pos' =
+ match pos with
+ | [] -> raise Not_found
+ | pos -> List.fold_right (fun i r -> if r = [] then [i+1] else i::r) pos []
+ in
+ try
+ let t = subterm_at_pos pos' term in pos'
+ with Not_found ->
+ let pos, _ =
+ List.fold_right
+ (fun i (r, b) -> if b then (i::r, true) else (r, true)) pos ([], false)
+ in
+ after_t pos term
+ ;;
+
+
+ let next_t pos term =
+ let t = subterm_at_pos pos term in
+ try
+ let _ = subterm_at_pos [1] t in
+ pos @ [1]
+ with Not_found ->
+ match pos with
+ | [] -> [1]
+ | pos -> after_t pos term
+ ;;
+
+
+ let retrieve_generalizations tree term =
+ let rec retrieve tree term pos =
+ match tree with
+ | DiscriminationTree.Node (Some s, _) when pos = [] -> s
+ | DiscriminationTree.Node (_, map) ->
+ let res =
+ try
+ let hd_term = head_of_term (subterm_at_pos pos term) in
+ let n = PSMap.find hd_term map in
+ match n with
+ | DiscriminationTree.Node (Some s, _) -> s
+ | DiscriminationTree.Node (None, _) ->
+ let newpos = try next_t pos term with Not_found -> [] in
+ retrieve n term newpos
+ with Not_found ->
+ A.empty
+ in
+ try
+ let n = PSMap.find (Cic.Implicit None) map in
+ let newpos = try after_t pos term with Not_found -> [-1] in
+ if newpos = [-1] then
+ match n with
+ | DiscriminationTree.Node (Some s, _) -> A.union s res
+ | _ -> res
+ else
+ A.union res (retrieve n term newpos)
+ with Not_found ->
+ res
+ in
+ retrieve tree term []
+ ;;
+
+
+ let jump_list = function
+ | DiscriminationTree.Node (value, map) ->
+ let rec get n tree =
+ match tree with
+ | DiscriminationTree.Node (v, m) ->
+ if n = 0 then
+ [tree]
+ else
+ PSMap.fold
+ (fun k v res ->
+ let a = try Hashtbl.find arities k with Not_found -> 0 in
+ (get (n-1 + a) v) @ res) m []
+ in
+ PSMap.fold
+ (fun k v res ->
+ let arity = try Hashtbl.find arities k with Not_found -> 0 in
+ (get arity v) @ res)
+ map []
+ ;;
+
+
+ let retrieve_unifiables tree term =
+ let rec retrieve tree term pos =
+ match tree with
+ | DiscriminationTree.Node (Some s, _) when pos = [] -> s
+ | DiscriminationTree.Node (_, map) ->
+ let subterm =
+ try Some (subterm_at_pos pos term) with Not_found -> None
+ in
+ match subterm with
+ | None -> A.empty
+ | Some (Cic.Meta _) ->
+ let newpos = try next_t pos term with Not_found -> [] in
+ let jl = jump_list tree in
+ List.fold_left
+ (fun r s -> A.union r s)
+ A.empty
+ (List.map (fun t -> retrieve t term newpos) jl)
+ | Some subterm ->
+ let res =
+ try
+ let hd_term = head_of_term subterm in
+ let n = PSMap.find hd_term map in
+ match n with
+ | DiscriminationTree.Node (Some s, _) -> s
+ | DiscriminationTree.Node (None, _) ->
+ retrieve n term (next_t pos term)
+ with Not_found ->
+ A.empty
+ in
+ try
+ let n = PSMap.find (Cic.Implicit None) map in
+ let newpos = try after_t pos term with Not_found -> [-1] in
+ if newpos = [-1] then
+ match n with
+ | DiscriminationTree.Node (Some s, _) -> A.union s res
+ | _ -> res
+ else
+ A.union res (retrieve n term newpos)
+ with Not_found ->
+ res
+ in
+ retrieve tree term []
+ end
+;;
+
diff --git a/helm/ocaml/cic/discrimination_tree.mli b/helm/ocaml/cic/discrimination_tree.mli
new file mode 100644
index 000000000..61631f478
--- /dev/null
+++ b/helm/ocaml/cic/discrimination_tree.mli
@@ -0,0 +1,43 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+module DiscriminationTreeIndexing :
+ functor (A : Set.S) ->
+ sig
+
+ val arities : (Cic.term, int) Hashtbl.t
+
+ type key = Cic.term
+ type t
+
+ val empty : t
+ val index : t -> key -> A.elt -> t
+ val remove_index : t -> key -> A.elt -> t
+ val in_index : t -> key -> (A.elt -> bool) -> bool
+ val retrieve_generalizations : t -> key -> A.t
+ val retrieve_unifiables : t -> key -> A.t
+ end
+
+
diff --git a/helm/ocaml/cic/helmLibraryObjects.ml b/helm/ocaml/cic/helmLibraryObjects.ml
new file mode 100644
index 000000000..3038582ab
--- /dev/null
+++ b/helm/ocaml/cic/helmLibraryObjects.ml
@@ -0,0 +1,230 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+(** {2 Auxiliary functions} *)
+
+let uri = UriManager.uri_of_string
+
+let const ?(subst = []) uri = Cic.Const (uri, subst)
+let var ?(subst = []) uri = Cic.Var (uri, subst)
+let mutconstruct ?(subst = []) uri typeno consno =
+ Cic.MutConstruct (uri, typeno, consno, subst)
+let mutind ?(subst = []) uri typeno = Cic.MutInd (uri, typeno, subst)
+
+let indtyuri_of_uri uri =
+ let index_sharp = String.index uri '#' in
+ let index_num = index_sharp + 3 in
+ (UriManager.uri_of_string (String.sub uri 0 index_sharp),
+ int_of_string(String.sub uri index_num (String.length uri - index_num)) - 1)
+
+let indconuri_of_uri uri =
+ let index_sharp = String.index uri '#' in
+ let index_div = String.rindex uri '/' in
+ let index_con = index_div + 1 in
+ (UriManager.uri_of_string (String.sub uri 0 index_sharp),
+ int_of_string
+ (String.sub uri (index_sharp + 3) (index_div - index_sharp - 3)) - 1,
+ int_of_string
+ (String.sub uri index_con (String.length uri - index_con)))
+
+(** {2 Helm's objects shorthands} *)
+
+module Logic =
+ struct
+ let eq_SURI = "cic:/Coq/Init/Logic/eq.ind"
+ let eq_URI = uri eq_SURI
+ let eq_XURI = eq_SURI ^ "#xpointer(1/1)"
+ let eq_ind_URI = uri "cic:/Coq/Init/Logic/eq_ind.con"
+ let eq_ind_r_URI = uri "cic:/Coq/Init/Logic/eq_ind_r.con"
+ let true_URI = uri "cic:/Coq/Init/Logic/True.ind"
+ let false_URI = uri "cic:/Coq/Init/Logic/False.ind"
+ let false_ind_URI = uri "cic:/Coq/Init/Logic/False_ind.con"
+ let ex_SURI = "cic:/Coq/Init/Logic/ex.ind"
+ let ex_URI = uri ex_SURI
+ let ex_XURI = ex_SURI ^ "#xpointer(1/1)"
+ let ex_ind_URI = uri "cic:/Coq/Init/Logic/ex_ind.con"
+ let and_SURI = "cic:/Coq/Init/Logic/and.ind"
+ let and_URI = uri and_SURI
+ let and_XURI = and_SURI ^ "#xpointer(1/1)"
+ let and_ind_URI = uri "cic:/Coq/Init/Logic/and_ind.con"
+ let or_SURI = "cic:/Coq/Init/Logic/or.ind"
+ let or_URI = uri or_SURI
+ let or_XURI = or_SURI ^ "#xpointer(1/1)"
+ let not_SURI = "cic:/Coq/Init/Logic/not.con"
+ let not_URI = uri not_SURI
+ let iff_SURI = "cic:/Coq/Init/Logic/iff.con"
+ let iff_URI = uri "cic:/Coq/Init/Logic/iff.con"
+ let sym_eq_URI = uri "cic:/Coq/Init/Logic/sym_eq.con"
+ let trans_eq_URI = uri "cic:/Coq/Init/Logic/trans_eq.con"
+ let absurd_URI = uri "cic:/Coq/Init/Logic/absurd.con"
+ end
+
+module Datatypes =
+ struct
+ let bool_URI = uri "cic:/Coq/Init/Datatypes/bool.ind"
+ let nat_URI = uri "cic:/Coq/Init/Datatypes/nat.ind"
+
+ let trueb = mutconstruct bool_URI 0 1
+ let falseb = mutconstruct bool_URI 0 2
+ let zero = mutconstruct nat_URI 0 1
+ let succ = mutconstruct nat_URI 0 2
+ end
+
+module Reals =
+ struct
+ let r_URI = uri "cic:/Coq/Reals/Rdefinitions/R.con"
+ let rplus_SURI = "cic:/Coq/Reals/Rdefinitions/Rplus.con"
+ let rplus_URI = uri rplus_SURI
+ let rminus_SURI = "cic:/Coq/Reals/Rdefinitions/Rminus.con"
+ let rminus_URI = uri rminus_SURI
+ let rmult_SURI = "cic:/Coq/Reals/Rdefinitions/Rmult.con"
+ let rmult_URI = uri rmult_SURI
+ let rdiv_SURI = "cic:/Coq/Reals/Rdefinitions/Rdiv.con"
+ let rdiv_URI = uri rdiv_SURI
+ let ropp_SURI = "cic:/Coq/Reals/Rdefinitions/Ropp.con"
+ let ropp_URI = uri ropp_SURI
+ let rinv_SURI = "cic:/Coq/Reals/Rdefinitions/Rinv.con"
+ let rinv_URI = uri rinv_SURI
+ let r0_SURI = "cic:/Coq/Reals/Rdefinitions/R0.con"
+ let r0_URI = uri r0_SURI
+ let r1_SURI = "cic:/Coq/Reals/Rdefinitions/R1.con"
+ let r1_URI = uri r1_SURI
+ let rle_SURI = "cic:/Coq/Reals/Rdefinitions/Rle.con"
+ let rle_URI = uri rle_SURI
+ let rge_SURI = "cic:/Coq/Reals/Rdefinitions/Rge.con"
+ let rge_URI = uri rge_SURI
+ let rlt_SURI = "cic:/Coq/Reals/Rdefinitions/Rlt.con"
+ let rlt_URI = uri rlt_SURI
+ let rgt_SURI = "cic:/Coq/Reals/Rdefinitions/Rgt.con"
+ let rgt_URI = uri rgt_SURI
+ let rtheory_URI = uri "cic:/Coq/Reals/RIneq/RTheory.con"
+ let rinv_r1_URI = uri "cic:/Coq/Reals/RIneq/Rinv_1.con"
+ let pow_URI = uri "cic:/Coq/Reals/Rfunctions/pow.con"
+
+ let r = const r_URI
+ let rplus = const rplus_URI
+ let rmult = const rmult_URI
+ let ropp = const ropp_URI
+ let r0 = const r0_URI
+ let r1 = const r1_URI
+ let rtheory = const rtheory_URI
+ end
+
+module Peano =
+ struct
+ let plus_SURI = "cic:/Coq/Init/Peano/plus.con"
+ let plus_URI = uri plus_SURI
+ let minus_SURI = "cic:/Coq/Init/Peano/minus.con"
+ let minus_URI = uri minus_SURI
+ let mult_SURI = "cic:/Coq/Init/Peano/mult.con"
+ let mult_URI = uri mult_SURI
+ let pred_URI = uri "cic:/Coq/Init/Peano/pred.con"
+ let le_SURI = "cic:/Coq/Init/Peano/le.ind"
+ let le_URI = uri le_SURI
+ let le_XURI = le_SURI ^ "#xpointer(1/1)"
+ let ge_SURI = "cic:/Coq/Init/Peano/ge.con"
+ let ge_URI = uri ge_SURI
+ let lt_SURI = "cic:/Coq/Init/Peano/lt.con"
+ let lt_URI = uri lt_SURI
+ let gt_SURI = "cic:/Coq/Init/Peano/gt.con"
+ let gt_URI = uri gt_SURI
+
+ let plus = const plus_URI
+ let mult = const mult_URI
+ let pred = const pred_URI
+ end
+
+module BinPos =
+ struct
+ let positive_SURI = "cic:/Coq/NArith/BinPos/positive.ind"
+ let positive_URI = uri positive_SURI
+ let xI = mutconstruct positive_URI 0 1
+ let xO = mutconstruct positive_URI 0 2
+ let xH = mutconstruct positive_URI 0 3
+ let pplus_SURI = "cic:/Coq/NArith/BinPos/Pplus.con"
+ let pplus_URI = uri pplus_SURI
+ let pplus = const pplus_URI
+ let pminus_SURI = "cic:/Coq/NArith/BinPos/Pminus.con"
+ let pminus_URI = uri pminus_SURI
+ let pminus = const pminus_URI
+ let pmult_SURI = "cic:/Coq/NArith/BinPos/Pmult.con"
+ let pmult_URI = uri pmult_SURI
+ let pmult = const pmult_URI
+ end
+
+module BinInt =
+ struct
+ let zmult_URI = uri "cic:/Coq/ZArith/BinInt/Zmult.con"
+ let zmult = const zmult_URI
+ let zplus_SURI = "cic:/Coq/ZArith/BinInt/Zplus.con"
+ let zplus_URI = uri zplus_SURI
+ let zplus = const zplus_URI
+ let zminus_SURI = "cic:/Coq/ZArith/BinInt/Zminus.con"
+ let zminus_URI = uri zminus_SURI
+ let zminus = const zminus_URI
+ let z_SURI = "cic:/Coq/ZArith/BinInt/Z.ind"
+ let z_URI = uri z_SURI
+ let z0 = mutconstruct z_URI 0 1
+ let zpos = mutconstruct z_URI 0 2
+ let zneg = mutconstruct z_URI 0 3
+ let zopp_SURI = "cic:/Coq/ZArith/BinInt/Zopp.con"
+ let zopp_URI = uri zopp_SURI
+ let zopp = const zopp_URI
+ let zpower_URI = uri "cic:/Coq/ZArith/Zpower/Zpower.con"
+ end
+
+(** {2 Helpers for creating common terms}
+ * (e.g. numbers)} *)
+
+exception NegativeInteger
+
+let build_nat n =
+ if n < 0 then raise NegativeInteger;
+ let rec aux = function
+ | 0 -> Datatypes.zero
+ | n -> Cic.Appl [ Datatypes.succ; (aux (n - 1)) ]
+ in
+ aux n
+
+let build_real n =
+ if n < 0 then raise NegativeInteger;
+ let rec aux = function
+ | 0 -> Reals.r0
+ | 1 -> Reals.r1 (* to avoid trailing "+ 0" *)
+ | n -> Cic.Appl [ Reals.rplus; Reals.r1; (aux (n - 1)) ]
+ in
+ aux n
+
+let build_bin_pos n =
+ if n < 1 then raise NegativeInteger;
+ let rec aux = function
+ | 1 -> BinPos.xH
+ | n when n mod 2 = 0 -> Cic.Appl [ BinPos.xO; aux (n / 2) ]
+ | n -> Cic.Appl [ BinPos.xI; aux (n / 2) ]
+ in
+ aux n
+
diff --git a/helm/ocaml/cic/helmLibraryObjects.mli b/helm/ocaml/cic/helmLibraryObjects.mli
new file mode 100644
index 000000000..677879899
--- /dev/null
+++ b/helm/ocaml/cic/helmLibraryObjects.mli
@@ -0,0 +1,182 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+module Logic :
+ sig
+ val absurd_URI : UriManager.uri
+ val and_ind_URI : UriManager.uri
+ val and_URI : UriManager.uri
+ val eq_ind_r_URI : UriManager.uri
+ val eq_ind_URI : UriManager.uri
+ val eq_URI : UriManager.uri
+ val ex_ind_URI : UriManager.uri
+ val ex_URI : UriManager.uri
+ val false_ind_URI : UriManager.uri
+ val false_URI : UriManager.uri
+ val iff_URI : UriManager.uri
+ val not_URI : UriManager.uri
+ val or_URI : UriManager.uri
+ val sym_eq_URI : UriManager.uri
+ val trans_eq_URI : UriManager.uri
+ val true_URI : UriManager.uri
+
+ val and_SURI : string
+ val eq_SURI : string
+ val ex_SURI : string
+ val iff_SURI : string
+ val not_SURI : string
+ val or_SURI : string
+
+ val and_XURI : string
+ val eq_XURI : string
+ val ex_XURI : string
+ val or_XURI : string
+ end
+
+module Datatypes :
+ sig
+ val bool_URI : UriManager.uri
+ val nat_URI : UriManager.uri
+
+ val trueb : Cic.term
+ val falseb : Cic.term
+ val zero : Cic.term
+ val succ : Cic.term
+ end
+
+module Reals :
+ sig
+ val pow_URI : UriManager.uri
+ val r0_URI : UriManager.uri
+ val r1_URI : UriManager.uri
+ val rdiv_URI : UriManager.uri
+ val rge_URI : UriManager.uri
+ val rgt_URI : UriManager.uri
+ val rinv_r1_URI : UriManager.uri
+ val rinv_URI : UriManager.uri
+ val rle_URI : UriManager.uri
+ val rlt_URI : UriManager.uri
+ val rminus_URI : UriManager.uri
+ val rmult_URI : UriManager.uri
+ val ropp_URI : UriManager.uri
+ val rplus_URI : UriManager.uri
+ val rtheory_URI : UriManager.uri
+ val r_URI : UriManager.uri
+
+ val r0_SURI : string
+ val r1_SURI : string
+ val rdiv_SURI : string
+ val rge_SURI : string
+ val rgt_SURI : string
+ val rinv_SURI : string
+ val rle_SURI : string
+ val rlt_SURI : string
+ val rminus_SURI : string
+ val rmult_SURI : string
+ val ropp_SURI : string
+ val rplus_SURI : string
+
+ val r0 : Cic.term
+ val r1 : Cic.term
+ val r : Cic.term
+ val rmult : Cic.term
+ val ropp : Cic.term
+ val rplus : Cic.term
+ val rtheory : Cic.term
+ end
+
+module Peano :
+ sig
+ val ge_URI : UriManager.uri
+ val gt_URI : UriManager.uri
+ val le_URI : UriManager.uri
+ val lt_URI : UriManager.uri
+ val minus_URI : UriManager.uri
+ val mult_URI : UriManager.uri
+ val plus_URI : UriManager.uri
+ val pred_URI : UriManager.uri
+
+ val ge_SURI : string
+ val gt_SURI : string
+ val le_SURI : string
+ val lt_SURI : string
+ val minus_SURI : string
+ val mult_SURI : string
+ val plus_SURI : string
+
+ val le_XURI : string
+
+ val mult : Cic.term
+ val plus : Cic.term
+ val pred : Cic.term
+ end
+
+module BinPos :
+ sig
+ val pminus_URI : UriManager.uri
+ val pmult_URI : UriManager.uri
+ val positive_URI : UriManager.uri
+ val pplus_URI : UriManager.uri
+
+ val pminus_SURI : string
+ val pmult_SURI : string
+ val positive_SURI : string
+ val pplus_SURI : string
+
+ val pminus : Cic.term
+ val pmult : Cic.term
+ val pplus : Cic.term
+ val xH : Cic.term
+ val xI : Cic.term
+ val xO : Cic.term
+ end
+
+module BinInt :
+ sig
+ val zminus_URI : UriManager.uri
+ val zmult_URI : UriManager.uri
+ val zopp_URI : UriManager.uri
+ val zplus_URI : UriManager.uri
+ val zpower_URI : UriManager.uri
+ val z_URI : UriManager.uri
+
+ val zminus_SURI : string
+ val zopp_SURI : string
+ val zplus_SURI : string
+ val z_SURI : string
+
+ val z0 : Cic.term
+ val zminus : Cic.term
+ val zmult : Cic.term
+ val zneg : Cic.term
+ val zopp : Cic.term
+ val zplus : Cic.term
+ val zpos : Cic.term
+ end
+
+val build_bin_pos : int -> Cic.term
+val build_nat : int -> Cic.term
+val build_real : int -> Cic.term
+
diff --git a/helm/ocaml/cic/libraryObjects.ml b/helm/ocaml/cic/libraryObjects.ml
new file mode 100644
index 000000000..cc04322fa
--- /dev/null
+++ b/helm/ocaml/cic/libraryObjects.ml
@@ -0,0 +1,116 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+(**** TABLES ****)
+
+let default_eq_URIs =
+ [HelmLibraryObjects.Logic.eq_URI,
+ HelmLibraryObjects.Logic.sym_eq_URI,
+ HelmLibraryObjects.Logic.trans_eq_URI,
+ HelmLibraryObjects.Logic.eq_ind_URI,
+ HelmLibraryObjects.Logic.eq_ind_r_URI];;
+
+let default_true_URIs = [HelmLibraryObjects.Logic.true_URI]
+let default_false_URIs = [HelmLibraryObjects.Logic.false_URI]
+let default_absurd_URIs = [HelmLibraryObjects.Logic.absurd_URI]
+
+(* eq, sym_eq, trans_eq, eq_ind, eq_ind_R *)
+let eq_URIs_ref =
+ ref [HelmLibraryObjects.Logic.eq_URI,
+ HelmLibraryObjects.Logic.sym_eq_URI,
+ HelmLibraryObjects.Logic.trans_eq_URI,
+ HelmLibraryObjects.Logic.eq_ind_URI,
+ HelmLibraryObjects.Logic.eq_ind_r_URI];;
+
+let true_URIs_ref = ref [HelmLibraryObjects.Logic.true_URI]
+let false_URIs_ref = ref [HelmLibraryObjects.Logic.false_URI]
+let absurd_URIs_ref = ref [HelmLibraryObjects.Logic.absurd_URI]
+
+
+(**** SET_DEFAULT ****)
+
+exception NotRecognized;;
+
+(* insert an element in front of the list, removing from the list all the
+ previous elements with the same key associated *)
+let insert_unique e extract l =
+ let uri = extract e in
+ let l' =
+ List.filter (fun x -> let uri' = extract x in not (UriManager.eq uri uri')) l
+ in
+ e :: l'
+
+let set_default what l =
+ match what,l with
+ "equality",[eq_URI;sym_eq_URI;trans_eq_URI;eq_ind_URI;eq_ind_r_URI] ->
+ eq_URIs_ref :=
+ insert_unique (eq_URI,sym_eq_URI,trans_eq_URI,eq_ind_URI,eq_ind_r_URI)
+ (fun x,_,_,_,_ -> x) !eq_URIs_ref
+ | "true",[true_URI] ->
+ true_URIs_ref := insert_unique true_URI (fun x -> x) !true_URIs_ref
+ | "false",[false_URI] ->
+ false_URIs_ref := insert_unique false_URI (fun x -> x) !false_URIs_ref
+ | "absurd",[absurd_URI] ->
+ absurd_URIs_ref := insert_unique absurd_URI (fun x -> x) !absurd_URIs_ref
+ | _,_ -> raise NotRecognized
+
+let reset_defaults () =
+ eq_URIs_ref := default_eq_URIs;
+ true_URIs_ref := default_true_URIs;
+ false_URIs_ref := default_false_URIs;
+ absurd_URIs_ref := default_absurd_URIs
+
+(**** LOOKUP FUNCTIONS ****)
+
+let eq_URI () = let eq,_,_,_,_ = List.hd !eq_URIs_ref in eq
+
+let is_eq_URI uri =
+ List.exists (fun (eq,_,_,_,_) -> UriManager.eq eq uri) !eq_URIs_ref
+
+let sym_eq_URI ~eq:uri =
+ try
+ let _,x,_,_,_ = List.find (fun eq,_,_,_,_ -> UriManager.eq eq uri) !eq_URIs_ref in x
+ with Not_found -> raise NotRecognized
+
+let trans_eq_URI ~eq:uri =
+ try
+ let _,_,x,_,_ = List.find (fun eq,_,_,_,_ -> UriManager.eq eq uri) !eq_URIs_ref in x
+ with Not_found -> raise NotRecognized
+
+let eq_ind_URI ~eq:uri =
+ try
+ let _,_,_,x,_ = List.find (fun eq,_,_,_,_ -> UriManager.eq eq uri) !eq_URIs_ref in x
+ with Not_found -> raise NotRecognized
+
+let eq_ind_r_URI ~eq:uri =
+ try
+ let _,_,_,_,x = List.find (fun eq,_,_,_,_ -> UriManager.eq eq uri) !eq_URIs_ref in x
+ with Not_found -> raise NotRecognized
+
+let true_URI () = List.hd !true_URIs_ref
+let false_URI () = List.hd !false_URIs_ref
+let absurd_URI () = List.hd !absurd_URIs_ref
diff --git a/helm/ocaml/cic/libraryObjects.mli b/helm/ocaml/cic/libraryObjects.mli
new file mode 100644
index 000000000..f87065980
--- /dev/null
+++ b/helm/ocaml/cic/libraryObjects.mli
@@ -0,0 +1,44 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val set_default : string -> UriManager.uri list -> unit
+val reset_defaults : unit -> unit
+
+val eq_URI : unit -> UriManager.uri
+
+val is_eq_URI : UriManager.uri -> bool
+
+exception NotRecognized;;
+
+val eq_ind_URI : eq:UriManager.uri -> UriManager.uri
+val eq_ind_r_URI : eq:UriManager.uri -> UriManager.uri
+val trans_eq_URI : eq:UriManager.uri -> UriManager.uri
+val sym_eq_URI : eq:UriManager.uri -> UriManager.uri
+
+
+val false_URI : unit -> UriManager.uri
+val true_URI : unit -> UriManager.uri
+val absurd_URI : unit -> UriManager.uri
+
diff --git a/helm/ocaml/cic/path_indexing.ml b/helm/ocaml/cic/path_indexing.ml
new file mode 100644
index 000000000..c0e4bb2be
--- /dev/null
+++ b/helm/ocaml/cic/path_indexing.ml
@@ -0,0 +1,227 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+(* path indexing implementation *)
+
+(* position of the subterm, subterm (Appl are not stored...) *)
+
+module PathIndexing =
+ functor(A:Set.S) ->
+ struct
+
+type path_string_elem = Index of int | Term of Cic.term;;
+type path_string = path_string_elem list;;
+
+
+let rec path_strings_of_term index =
+ let module C = Cic in function
+ | C.Meta _ -> [ [Index index; Term (C.Implicit None)] ]
+ | C.Appl (hd::tl) ->
+ let p = if index > 0 then [Index index; Term hd] else [Term hd] in
+ let _, res =
+ List.fold_left
+ (fun (i, r) t ->
+ let rr = path_strings_of_term i t in
+ (i+1, r @ (List.map (fun ps -> p @ ps) rr)))
+ (1, []) tl
+ in
+ res
+ | term -> [ [Index index; Term term] ]
+;;
+
+(*
+let string_of_path_string ps =
+ String.concat "."
+ (List.map
+ (fun e ->
+ let s =
+ match e with
+ | Index i -> "Index " ^ (string_of_int i)
+ | Term t -> "Term " ^ (CicPp.ppterm t)
+ in
+ "(" ^ s ^ ")")
+ ps)
+;;
+*)
+
+module OrderedPathStringElement = struct
+ type t = path_string_elem
+
+ let compare t1 t2 =
+ match t1, t2 with
+ | Index i, Index j -> Pervasives.compare i j
+ | Term t1, Term t2 -> if t1 = t2 then 0 else Pervasives.compare t1 t2
+ | Index _, Term _ -> -1
+ | Term _, Index _ -> 1
+end
+
+module PSMap = Map.Make(OrderedPathStringElement);;
+
+module PSTrie = Trie.Make(PSMap);;
+
+type t = A.t PSTrie.t
+type key = Cic.term
+let empty = PSTrie.empty
+let arities = Hashtbl.create 0
+
+let index trie term info =
+ let ps = path_strings_of_term 0 term in
+ List.fold_left
+ (fun trie ps ->
+ let ps_set = try PSTrie.find ps trie with Not_found -> A.empty in
+ let trie = PSTrie.add ps (A.add info ps_set) trie in
+ trie) trie ps
+
+let remove_index trie term info=
+ let ps = path_strings_of_term 0 term in
+ List.fold_left
+ (fun trie ps ->
+ try
+ let ps_set = A.remove info (PSTrie.find ps trie) in
+ if A.is_empty ps_set then
+ PSTrie.remove ps trie
+ else
+ PSTrie.add ps ps_set trie
+ with Not_found -> trie) trie ps
+;;
+
+let in_index trie term test =
+ let ps = path_strings_of_term 0 term in
+ let ok ps =
+ try
+ let set = PSTrie.find ps trie in
+ A.exists test set
+ with Not_found ->
+ false
+ in
+ List.exists ok ps
+;;
+
+
+let head_of_term = function
+ | Cic.Appl (hd::tl) -> hd
+ | term -> term
+;;
+
+
+let subterm_at_pos index term =
+ if index = 0 then
+ term
+ else
+ match term with
+ | Cic.Appl l ->
+ (try List.nth l index with Failure _ -> raise Not_found)
+ | _ -> raise Not_found
+;;
+
+
+let rec retrieve_generalizations trie term =
+ match trie with
+ | PSTrie.Node (value, map) ->
+ let res =
+ match term with
+ | Cic.Meta _ -> A.empty
+ | term ->
+ let hd_term = head_of_term term in
+ try
+ let n = PSMap.find (Term hd_term) map in
+ match n with
+ | PSTrie.Node (Some s, _) -> s
+ | PSTrie.Node (None, m) ->
+ let l =
+ PSMap.fold
+ (fun k v res ->
+ match k with
+ | Index i ->
+ let t = subterm_at_pos i term in
+ let s = retrieve_generalizations v t in
+ s::res
+ | _ -> res)
+ m []
+ in
+ match l with
+ | hd::tl ->
+ List.fold_left (fun r s -> A.inter r s) hd tl
+ | _ -> A.empty
+ with Not_found ->
+ A.empty
+ in
+ try
+ let n = PSMap.find (Term (Cic.Implicit None)) map in
+ match n with
+ | PSTrie.Node (Some s, _) -> A.union res s
+ | _ -> res
+ with Not_found ->
+ res
+;;
+
+
+let rec retrieve_unifiables trie term =
+ match trie with
+ | PSTrie.Node (value, map) ->
+ let res =
+ match term with
+ | Cic.Meta _ ->
+ PSTrie.fold
+ (fun ps v res -> A.union res v)
+ (PSTrie.Node (None, map))
+ A.empty
+ | _ ->
+ let hd_term = head_of_term term in
+ try
+ let n = PSMap.find (Term hd_term) map in
+ match n with
+ | PSTrie.Node (Some v, _) -> v
+ | PSTrie.Node (None, m) ->
+ let l =
+ PSMap.fold
+ (fun k v res ->
+ match k with
+ | Index i ->
+ let t = subterm_at_pos i term in
+ let s = retrieve_unifiables v t in
+ s::res
+ | _ -> res)
+ m []
+ in
+ match l with
+ | hd::tl ->
+ List.fold_left (fun r s -> A.inter r s) hd tl
+ | _ -> A.empty
+ with Not_found ->
+ A.empty
+ in
+ try
+ let n = PSMap.find (Term (Cic.Implicit None)) map in
+ match n with
+ | PSTrie.Node (Some s, _) -> A.union res s
+ | _ -> res
+ with Not_found ->
+ res
+;;
+
+end
diff --git a/helm/ocaml/cic/path_indexing.mli b/helm/ocaml/cic/path_indexing.mli
new file mode 100644
index 000000000..899901618
--- /dev/null
+++ b/helm/ocaml/cic/path_indexing.mli
@@ -0,0 +1,42 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+module PathIndexing :
+ functor (A : Set.S) ->
+ sig
+ val arities : (Cic.term, int) Hashtbl.t
+
+ type key = Cic.term
+ type t
+
+ val empty : t
+ val index : t -> key -> A.elt -> t
+ val remove_index : t -> key -> A.elt -> t
+ val in_index : t -> key -> (A.elt -> bool) -> bool
+ val retrieve_generalizations : t -> key -> A.t
+ val retrieve_unifiables : t -> key -> A.t
+ end
+
+
diff --git a/helm/ocaml/cic/test.ml b/helm/ocaml/cic/test.ml
new file mode 100644
index 000000000..e15468f99
--- /dev/null
+++ b/helm/ocaml/cic/test.ml
@@ -0,0 +1,88 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+let _ =
+ Helm_registry.set "getter.mode" "remote";
+ Helm_registry.set "getter.url" "http://mowgli.cs.unibo.it:58081/"
+
+let body_RE = Str.regexp "^.*\\.body$"
+let con_RE = Str.regexp "^.*\\.con$"
+
+let unlink f =
+ if Sys.file_exists f then
+ Unix.unlink f
+
+let rec parse uri tmpfile1 tmpfile2 =
+(*prerr_endline (sprintf "%s %s" tmpfile1 (match tmpfile2 with None -> "None" | Some f -> "Some " ^ f));*)
+ (try
+ let uri' = UriManager.uri_of_string uri in
+ let time_new0 = Unix.gettimeofday () in
+(* let obj_new = CicPushParser.CicParser.annobj_of_xml tmpfile1 tmpfile2 in*)
+ let obj_new = CicParser.annobj_of_xml uri' tmpfile1 tmpfile2 in
+ let time_new1 = Unix.gettimeofday () in
+
+ let time_old0 = Unix.gettimeofday () in
+ ignore (Unix.system (sprintf "gunzip -c %s > test.tmp && mv test.tmp %s"
+ tmpfile1 tmpfile1));
+ (match tmpfile2 with
+ | Some tmpfile2 ->
+ ignore (Unix.system (sprintf "gunzip -c %s > test.tmp && mv test.tmp %s"
+ tmpfile2 tmpfile2));
+ | None -> ());
+ let obj_old = CicPxpParser.CicParser.annobj_of_xml uri' tmpfile1 tmpfile2 in
+ let time_old1 = Unix.gettimeofday () in
+
+ let time_old = time_old1 -. time_old0 in
+ let time_new = time_new1 -. time_new0 in
+ let are_equal = (obj_old = obj_new) in
+ printf "%s\t%b\t%f\t%f\t%f\n"
+ uri are_equal time_old time_new (time_new /. time_old *. 100.);
+ flush stdout;
+ with
+ | CicParser.Getter_failure ("key_not_found", uri)
+ when Str.string_match body_RE uri 0 ->
+ parse uri tmpfile1 None
+ | CicParser.Parser_failure msg ->
+ printf "%s FAILED (%s)\n" uri msg; flush stdout)
+
+let _ =
+ try
+ while true do
+ let uri = input_line stdin in
+ let tmpfile1 = Http_getter.getxml uri in
+ let tmpfile2 =
+ if Str.string_match con_RE uri 0 then begin
+ Some (Http_getter.getxml (uri ^ ".body"))
+ end else
+ None
+ in
+ parse uri tmpfile1 tmpfile2
+ done
+ with End_of_file -> ()
+
diff --git a/helm/ocaml/cic/unshare.ml b/helm/ocaml/cic/unshare.ml
new file mode 100644
index 000000000..e198bcd49
--- /dev/null
+++ b/helm/ocaml/cic/unshare.ml
@@ -0,0 +1,84 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+let rec unshare =
+ let module C = Cic in
+ function
+ C.Rel m -> C.Rel m
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,unshare t)) exp_named_subst
+ in
+ C.Var (uri,exp_named_subst')
+ | C.Meta (i,l) ->
+ let l' =
+ List.map
+ (function
+ None -> None
+ | Some t -> Some (unshare t)
+ ) l
+ in
+ C.Meta(i,l')
+ | C.Sort s -> C.Sort s
+ | C.Implicit info -> C.Implicit info
+ | C.Cast (te,ty) -> C.Cast (unshare te, unshare ty)
+ | C.Prod (n,s,t) -> C.Prod (n, unshare s, unshare t)
+ | C.Lambda (n,s,t) -> C.Lambda (n, unshare s, unshare t)
+ | C.LetIn (n,s,t) -> C.LetIn (n, unshare s, unshare t)
+ | C.Appl l -> C.Appl (List.map unshare l)
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,unshare t)) exp_named_subst
+ in
+ C.Const (uri,exp_named_subst')
+ | C.MutInd (uri,tyno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,unshare t)) exp_named_subst
+ in
+ C.MutInd (uri,tyno,exp_named_subst')
+ | C.MutConstruct (uri,tyno,consno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,unshare t)) exp_named_subst
+ in
+ C.MutConstruct (uri,tyno,consno,exp_named_subst')
+ | C.MutCase (sp,i,outty,t,pl) ->
+ C.MutCase (sp, i, unshare outty, unshare t,
+ List.map unshare pl)
+ | C.Fix (i, fl) ->
+ let liftedfl =
+ List.map
+ (fun (name, i, ty, bo) -> (name, i, unshare ty, unshare bo))
+ fl
+ in
+ C.Fix (i, liftedfl)
+ | C.CoFix (i, fl) ->
+ let liftedfl =
+ List.map
+ (fun (name, ty, bo) -> (name, unshare ty, unshare bo))
+ fl
+ in
+ C.CoFix (i, liftedfl)
diff --git a/helm/ocaml/cic/unshare.mli b/helm/ocaml/cic/unshare.mli
new file mode 100644
index 000000000..5582abcbf
--- /dev/null
+++ b/helm/ocaml/cic/unshare.mli
@@ -0,0 +1,26 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val unshare : Cic.term -> Cic.term
diff --git a/helm/ocaml/cic_acic/.depend b/helm/ocaml/cic_acic/.depend
new file mode 100644
index 000000000..3fc1e0dce
--- /dev/null
+++ b/helm/ocaml/cic_acic/.depend
@@ -0,0 +1,9 @@
+cic2Xml.cmi: cic2acic.cmi
+eta_fixing.cmo: eta_fixing.cmi
+eta_fixing.cmx: eta_fixing.cmi
+doubleTypeInference.cmo: doubleTypeInference.cmi
+doubleTypeInference.cmx: doubleTypeInference.cmi
+cic2acic.cmo: eta_fixing.cmi doubleTypeInference.cmi cic2acic.cmi
+cic2acic.cmx: eta_fixing.cmx doubleTypeInference.cmx cic2acic.cmi
+cic2Xml.cmo: cic2acic.cmi cic2Xml.cmi
+cic2Xml.cmx: cic2acic.cmx cic2Xml.cmi
diff --git a/helm/ocaml/cic_acic/Makefile b/helm/ocaml/cic_acic/Makefile
new file mode 100644
index 000000000..a7f1e19cf
--- /dev/null
+++ b/helm/ocaml/cic_acic/Makefile
@@ -0,0 +1,12 @@
+PACKAGE = cic_acic
+PREDICATES =
+
+INTERFACE_FILES = \
+ eta_fixing.mli \
+ doubleTypeInference.mli \
+ cic2acic.mli \
+ cic2Xml.mli \
+ $(NULL)
+IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml)
+
+include ../Makefile.common
diff --git a/helm/ocaml/cic_acic/cic2Xml.ml b/helm/ocaml/cic_acic/cic2Xml.ml
new file mode 100644
index 000000000..7e97dea6f
--- /dev/null
+++ b/helm/ocaml/cic_acic/cic2Xml.ml
@@ -0,0 +1,483 @@
+(* Copyright (C) 2000-2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+(*CSC codice cut & paste da cicPp e xmlcommand *)
+
+exception NotImplemented;;
+
+let dtdname ~ask_dtd_to_the_getter dtd =
+ if ask_dtd_to_the_getter then
+ Helm_registry.get "getter.url" ^ "getdtd?uri=" ^ dtd
+ else
+ "http://mowgli.cs.unibo.it/dtd/" ^ dtd
+;;
+
+let param_attribute_of_params params =
+ String.concat " " (List.map UriManager.string_of_uri params)
+;;
+
+(*CSC ottimizzazione: al posto di curi cdepth (vedi codice) *)
+let print_term ?ids_to_inner_sorts =
+ let find_sort name id =
+ match ids_to_inner_sorts with
+ None -> []
+ | Some ids_to_inner_sorts ->
+ [None,name,Cic2acic.string_of_sort (Hashtbl.find ids_to_inner_sorts id)]
+ in
+ let rec aux =
+ let module C = Cic in
+ let module X = Xml in
+ let module U = UriManager in
+ function
+ C.ARel (id,idref,n,b) ->
+ let sort = find_sort "sort" id in
+ X.xml_empty "REL"
+ (sort @
+ [None,"value",(string_of_int n) ; None,"binder",b ; None,"id",id ;
+ None,"idref",idref])
+ | C.AVar (id,uri,exp_named_subst) ->
+ let sort = find_sort "sort" id in
+ aux_subst uri
+ (X.xml_empty "VAR"
+ (sort @ [None,"uri",U.string_of_uri uri;None,"id",id]))
+ exp_named_subst
+ | C.AMeta (id,n,l) ->
+ let sort = find_sort "sort" id in
+ X.xml_nempty "META"
+ (sort @ [None,"no",(string_of_int n) ; None,"id",id])
+ (List.fold_left
+ (fun i t ->
+ match t with
+ Some t' ->
+ [< i ; X.xml_nempty "substitution" [] (aux t') >]
+ | None ->
+ [< i ; X.xml_empty "substitution" [] >]
+ ) [< >] l)
+ | C.ASort (id,s) ->
+ let string_of_sort s =
+ Cic2acic.string_of_sort (Cic2acic.sort_of_sort s)
+ in
+ X.xml_empty "SORT" [None,"value",(string_of_sort s) ; None,"id",id]
+ | C.AImplicit _ -> raise NotImplemented
+ | C.AProd (last_id,_,_,_) as prods ->
+ let rec eat_prods =
+ function
+ C.AProd (id,n,s,t) ->
+ let prods,t' = eat_prods t in
+ (id,n,s)::prods,t'
+ | t -> [],t
+ in
+ let prods,t = eat_prods prods in
+ let sort = find_sort "type" last_id in
+ X.xml_nempty "PROD" sort
+ [< List.fold_left
+ (fun i (id,binder,s) ->
+ let sort = find_sort "type" (Cic2acic.source_id_of_id id) in
+ let attrs =
+ sort @ ((None,"id",id)::
+ match binder with
+ C.Anonymous -> []
+ | C.Name b -> [None,"binder",b])
+ in
+ [< i ; X.xml_nempty "decl" attrs (aux s) >]
+ ) [< >] prods ;
+ X.xml_nempty "target" [] (aux t)
+ >]
+ | C.ACast (id,v,t) ->
+ let sort = find_sort "sort" id in
+ X.xml_nempty "CAST" (sort @ [None,"id",id])
+ [< X.xml_nempty "term" [] (aux v) ;
+ X.xml_nempty "type" [] (aux t)
+ >]
+ | C.ALambda (last_id,_,_,_) as lambdas ->
+ let rec eat_lambdas =
+ function
+ C.ALambda (id,n,s,t) ->
+ let lambdas,t' = eat_lambdas t in
+ (id,n,s)::lambdas,t'
+ | t -> [],t
+ in
+ let lambdas,t = eat_lambdas lambdas in
+ let sort = find_sort "sort" last_id in
+ X.xml_nempty "LAMBDA" sort
+ [< List.fold_left
+ (fun i (id,binder,s) ->
+ let sort = find_sort "type" (Cic2acic.source_id_of_id id) in
+ let attrs =
+ sort @ ((None,"id",id)::
+ match binder with
+ C.Anonymous -> []
+ | C.Name b -> [None,"binder",b])
+ in
+ [< i ; X.xml_nempty "decl" attrs (aux s) >]
+ ) [< >] lambdas ;
+ X.xml_nempty "target" [] (aux t)
+ >]
+ | C.ALetIn (xid,C.Anonymous,s,t) ->
+ assert false
+ | C.ALetIn (last_id,C.Name _,_,_) as letins ->
+ let rec eat_letins =
+ function
+ C.ALetIn (id,n,s,t) ->
+ let letins,t' = eat_letins t in
+ (id,n,s)::letins,t'
+ | t -> [],t
+ in
+ let letins,t = eat_letins letins in
+ let sort = find_sort "sort" last_id in
+ X.xml_nempty "LETIN" sort
+ [< List.fold_left
+ (fun i (id,binder,s) ->
+ let sort = find_sort "sort" id in
+ let attrs =
+ sort @ ((None,"id",id)::
+ match binder with
+ C.Anonymous -> []
+ | C.Name b -> [None,"binder",b])
+ in
+ [< i ; X.xml_nempty "def" attrs (aux s) >]
+ ) [< >] letins ;
+ X.xml_nempty "target" [] (aux t)
+ >]
+ | C.AAppl (id,li) ->
+ let sort = find_sort "sort" id in
+ X.xml_nempty "APPLY" (sort @ [None,"id",id])
+ [< (List.fold_right (fun x i -> [< (aux x) ; i >]) li [<>])
+ >]
+ | C.AConst (id,uri,exp_named_subst) ->
+ let sort = find_sort "sort" id in
+ aux_subst uri
+ (X.xml_empty "CONST"
+ (sort @ [None,"uri",(U.string_of_uri uri) ; None,"id",id])
+ ) exp_named_subst
+ | C.AMutInd (id,uri,i,exp_named_subst) ->
+ aux_subst uri
+ (X.xml_empty "MUTIND"
+ [None, "uri", (U.string_of_uri uri) ;
+ None, "noType", (string_of_int i) ;
+ None, "id", id]
+ ) exp_named_subst
+ | C.AMutConstruct (id,uri,i,j,exp_named_subst) ->
+ let sort = find_sort "sort" id in
+ aux_subst uri
+ (X.xml_empty "MUTCONSTRUCT"
+ (sort @
+ [None,"uri", (U.string_of_uri uri) ;
+ None,"noType",(string_of_int i) ;
+ None,"noConstr",(string_of_int j) ;
+ None,"id",id])
+ ) exp_named_subst
+ | C.AMutCase (id,uri,typeno,ty,te,patterns) ->
+ let sort = find_sort "sort" id in
+ X.xml_nempty "MUTCASE"
+ (sort @
+ [None,"uriType",(U.string_of_uri uri) ;
+ None,"noType", (string_of_int typeno) ;
+ None,"id", id])
+ [< X.xml_nempty "patternsType" [] [< (aux ty) >] ;
+ X.xml_nempty "inductiveTerm" [] [< (aux te) >] ;
+ List.fold_right
+ (fun x i -> [< X.xml_nempty "pattern" [] [< aux x >] ; i>])
+ patterns [<>]
+ >]
+ | C.AFix (id, no, funs) ->
+ let sort = find_sort "sort" id in
+ X.xml_nempty "FIX"
+ (sort @ [None,"noFun", (string_of_int no) ; None,"id",id])
+ [< List.fold_right
+ (fun (id,fi,ai,ti,bi) i ->
+ [< X.xml_nempty "FixFunction"
+ [None,"id",id ; None,"name", fi ;
+ None,"recIndex", (string_of_int ai)]
+ [< X.xml_nempty "type" [] [< aux ti >] ;
+ X.xml_nempty "body" [] [< aux bi >]
+ >] ;
+ i
+ >]
+ ) funs [<>]
+ >]
+ | C.ACoFix (id,no,funs) ->
+ let sort = find_sort "sort" id in
+ X.xml_nempty "COFIX"
+ (sort @ [None,"noFun", (string_of_int no) ; None,"id",id])
+ [< List.fold_right
+ (fun (id,fi,ti,bi) i ->
+ [< X.xml_nempty "CofixFunction" [None,"id",id ; None,"name", fi]
+ [< X.xml_nempty "type" [] [< aux ti >] ;
+ X.xml_nempty "body" [] [< aux bi >]
+ >] ;
+ i
+ >]
+ ) funs [<>]
+ >]
+ and aux_subst buri target subst =
+(*CSC: I have now no way to assign an ID to the explicit named substitution *)
+ let id = None in
+ if subst = [] then
+ target
+ else
+ Xml.xml_nempty "instantiate"
+ (match id with None -> [] | Some id -> [None,"id",id])
+ [< target ;
+ List.fold_left
+ (fun i (uri,arg) ->
+ let relUri =
+ let buri_frags =
+ Str.split (Str.regexp "/") (UriManager.string_of_uri buri) in
+ let uri_frags =
+ Str.split (Str.regexp "/") (UriManager.string_of_uri uri) in
+ let rec find_relUri buri_frags uri_frags =
+ match buri_frags,uri_frags with
+ [_], _ -> String.concat "/" uri_frags
+ | he1::tl1, he2::tl2 ->
+ assert (he1 = he2) ;
+ find_relUri tl1 tl2
+ | _,_ -> assert false (* uri is not relative to buri *)
+ in
+ find_relUri buri_frags uri_frags
+ in
+ [< i ; Xml.xml_nempty "arg" [None,"relUri", relUri] (aux arg) >]
+ ) [<>] subst
+ >]
+ in
+ aux
+;;
+
+let xml_of_attrs attributes =
+ let class_of = function
+ | `Coercion -> Xml.xml_empty "class" [None,"value","coercion"]
+ | `Elim s ->
+ Xml.xml_nempty "class" [None,"value","elim"]
+ [< Xml.xml_empty
+ "SORT" [None,"value",
+ (Cic2acic.string_of_sort (Cic2acic.sort_of_sort s)) ;
+ None,"id","elimination_sort"] >]
+ | `Record field_names ->
+ Xml.xml_nempty "class" [None,"value","record"]
+ (List.fold_right
+ (fun (name,coercion) res ->
+ [< Xml.xml_empty "field"
+ [None,"name",if coercion then name ^ " coercion" else name];
+ res >]
+ ) field_names [<>])
+ | `Projection -> Xml.xml_empty "class" [None,"value","projection"]
+ in
+ let flavour_of = function
+ | `Definition -> Xml.xml_empty "flavour" [None, "value", "definition"]
+ | `Fact -> Xml.xml_empty "flavour" [None, "value", "fact"]
+ | `Lemma -> Xml.xml_empty "flavour" [None, "value", "lemma"]
+ | `Remark -> Xml.xml_empty "flavour" [None, "value", "remark"]
+ | `Theorem -> Xml.xml_empty "flavour" [None, "value", "theorem"]
+ | `Variant -> Xml.xml_empty "flavour" [None, "value", "variant"]
+ in
+ let xml_attr_of = function
+ | `Generated -> Xml.xml_empty "generated" []
+ | `Class c -> class_of c
+ | `Flavour f -> flavour_of f
+ in
+ let xml_attrs =
+ List.fold_right
+ (fun attr res -> [< xml_attr_of attr ; res >]) attributes [<>]
+ in
+ Xml.xml_nempty "attributes" [] xml_attrs
+
+let print_object uri ?ids_to_inner_sorts ~ask_dtd_to_the_getter obj =
+ let module C = Cic in
+ let module X = Xml in
+ let module U = UriManager in
+ let dtdname = dtdname ~ask_dtd_to_the_getter "cic.dtd" in
+ match obj with
+ C.ACurrentProof (id,idbody,n,conjectures,bo,ty,params,obj_attrs) ->
+ let params' = param_attribute_of_params params in
+ let xml_attrs = xml_of_attrs obj_attrs in
+ let xml_for_current_proof_body =
+(*CSC: Should the CurrentProof also have the list of variables it depends on? *)
+(*CSC: I think so. Not implemented yet. *)
+ X.xml_nempty "CurrentProof"
+ [None,"of",UriManager.string_of_uri uri ; None,"id", id]
+ [< xml_attrs;
+ List.fold_left
+ (fun i (cid,n,canonical_context,t) ->
+ [< i ;
+ X.xml_nempty "Conjecture"
+ [None,"id",cid ; None,"no",(string_of_int n)]
+ [< List.fold_left
+ (fun i (hid,t) ->
+ [< (match t with
+ Some (n,C.ADecl t) ->
+ X.xml_nempty "Decl"
+ (match n with
+ C.Name n' ->
+ [None,"id",hid;None,"name",n']
+ | C.Anonymous -> [None,"id",hid])
+ (print_term ?ids_to_inner_sorts t)
+ | Some (n,C.ADef t) ->
+ X.xml_nempty "Def"
+ (match n with
+ C.Name n' ->
+ [None,"id",hid;None,"name",n']
+ | C.Anonymous -> [None,"id",hid])
+ (print_term ?ids_to_inner_sorts t)
+ | None -> X.xml_empty "Hidden" [None,"id",hid]
+ ) ;
+ i
+ >]
+ ) [< >] canonical_context ;
+ X.xml_nempty "Goal" []
+ (print_term ?ids_to_inner_sorts t)
+ >]
+ >])
+ [< >] conjectures ;
+ X.xml_nempty "body" [] (print_term ?ids_to_inner_sorts bo) >]
+ in
+ let xml_for_current_proof_type =
+ X.xml_nempty "ConstantType"
+ [None,"name",n ; None,"params",params' ; None,"id", id]
+ (print_term ?ids_to_inner_sorts ty)
+ in
+ let xmlbo =
+ [< X.xml_cdata "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n" ;
+ X.xml_cdata ("<!DOCTYPE CurrentProof SYSTEM \""^ dtdname ^ "\">\n");
+ xml_for_current_proof_body
+ >] in
+ let xmlty =
+ [< X.xml_cdata "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n" ;
+ X.xml_cdata ("<!DOCTYPE ConstantType SYSTEM \""^ dtdname ^ "\">\n");
+ xml_for_current_proof_type
+ >]
+ in
+ xmlty, Some xmlbo
+ | C.AConstant (id,idbody,n,bo,ty,params,obj_attrs) ->
+ let params' = param_attribute_of_params params in
+ let xml_attrs = xml_of_attrs obj_attrs in
+ let xmlbo =
+ match bo with
+ None -> None
+ | Some bo ->
+ Some
+ [< X.xml_cdata
+ "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n" ;
+ X.xml_cdata
+ ("<!DOCTYPE ConstantBody SYSTEM \"" ^ dtdname ^ "\">\n") ;
+ X.xml_nempty "ConstantBody"
+ [None,"for",UriManager.string_of_uri uri ;
+ None,"params",params' ; None,"id", id]
+ [< print_term ?ids_to_inner_sorts bo >]
+ >]
+ in
+ let xmlty =
+ [< X.xml_cdata "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n" ;
+ X.xml_cdata ("<!DOCTYPE ConstantType SYSTEM \""^ dtdname ^ "\">\n");
+ X.xml_nempty "ConstantType"
+ [None,"name",n ; None,"params",params' ; None,"id", id]
+ [< xml_attrs; print_term ?ids_to_inner_sorts ty >]
+ >]
+ in
+ xmlty, xmlbo
+ | C.AVariable (id,n,bo,ty,params,obj_attrs) ->
+ let params' = param_attribute_of_params params in
+ let xml_attrs = xml_of_attrs obj_attrs in
+ let xmlbo =
+ match bo with
+ None -> [< >]
+ | Some bo ->
+ X.xml_nempty "body" [] [< print_term ?ids_to_inner_sorts bo >]
+ in
+ let aobj =
+ [< X.xml_cdata "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n" ;
+ X.xml_cdata ("<!DOCTYPE Variable SYSTEM \"" ^ dtdname ^ "\">\n");
+ X.xml_nempty "Variable"
+ [None,"name",n ; None,"params",params' ; None,"id", id]
+ [< xml_attrs; xmlbo;
+ X.xml_nempty "type" [] (print_term ?ids_to_inner_sorts ty)
+ >]
+ >]
+ in
+ aobj, None
+ | C.AInductiveDefinition (id,tys,params,nparams,obj_attrs) ->
+ let params' = param_attribute_of_params params in
+ let xml_attrs = xml_of_attrs obj_attrs in
+ [< X.xml_cdata "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n" ;
+ X.xml_cdata
+ ("<!DOCTYPE InductiveDefinition SYSTEM \"" ^ dtdname ^ "\">\n") ;
+ X.xml_nempty "InductiveDefinition"
+ [None,"noParams",string_of_int nparams ;
+ None,"id",id ;
+ None,"params",params']
+ [< xml_attrs;
+ (List.fold_left
+ (fun i (id,typename,finite,arity,cons) ->
+ [< i ;
+ X.xml_nempty "InductiveType"
+ [None,"id",id ; None,"name",typename ;
+ None,"inductive",(string_of_bool finite)
+ ]
+ [< X.xml_nempty "arity" []
+ (print_term ?ids_to_inner_sorts arity) ;
+ (List.fold_left
+ (fun i (name,lc) ->
+ [< i ;
+ X.xml_nempty "Constructor"
+ [None,"name",name]
+ (print_term ?ids_to_inner_sorts lc)
+ >]) [<>] cons
+ )
+ >]
+ >]
+ ) [< >] tys
+ )
+ >]
+ >], None
+;;
+
+let
+ print_inner_types curi ~ids_to_inner_sorts ~ids_to_inner_types
+ ~ask_dtd_to_the_getter
+=
+ let module C2A = Cic2acic in
+ let module X = Xml in
+ let dtdname = dtdname ~ask_dtd_to_the_getter "cictypes.dtd" in
+ [< X.xml_cdata "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n" ;
+ X.xml_cdata
+ ("<!DOCTYPE InnerTypes SYSTEM \"" ^ dtdname ^ "\">\n") ;
+ X.xml_nempty "InnerTypes" [None,"of",UriManager.string_of_uri curi]
+ (Hashtbl.fold
+ (fun id {C2A.annsynthesized = synty ; C2A.annexpected = expty} x ->
+ [< x ;
+ X.xml_nempty "TYPE" [None,"of",id]
+ [< X.xml_nempty "synthesized" []
+ [< print_term ~ids_to_inner_sorts synty >] ;
+ match expty with
+ None -> [<>]
+ | Some expty' -> X.xml_nempty "expected" []
+ [< print_term ~ids_to_inner_sorts expty' >]
+ >]
+ >]
+ ) ids_to_inner_types [<>]
+ )
+ >]
+;;
diff --git a/helm/ocaml/cic_acic/cic2Xml.mli b/helm/ocaml/cic_acic/cic2Xml.mli
new file mode 100644
index 000000000..22c5669df
--- /dev/null
+++ b/helm/ocaml/cic_acic/cic2Xml.mli
@@ -0,0 +1,46 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+exception NotImplemented
+
+val print_term :
+ ?ids_to_inner_sorts: (string, Cic2acic.sort_kind) Hashtbl.t ->
+ Cic.annterm ->
+ Xml.token Stream.t
+
+val print_object :
+ UriManager.uri ->
+ ?ids_to_inner_sorts: (string, Cic2acic.sort_kind) Hashtbl.t ->
+ ask_dtd_to_the_getter:bool ->
+ Cic.annobj ->
+ Xml.token Stream.t * Xml.token Stream.t option
+
+val print_inner_types :
+ UriManager.uri ->
+ ids_to_inner_sorts: (string, Cic2acic.sort_kind) Hashtbl.t ->
+ ids_to_inner_types: (string, Cic2acic.anntypes) Hashtbl.t ->
+ ask_dtd_to_the_getter:bool ->
+ Xml.token Stream.t
+
diff --git a/helm/ocaml/cic_acic/cic2acic.ml b/helm/ocaml/cic_acic/cic2acic.ml
new file mode 100644
index 000000000..8540e0e64
--- /dev/null
+++ b/helm/ocaml/cic_acic/cic2acic.ml
@@ -0,0 +1,739 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+type sort_kind = [ `Prop | `Set | `Type of CicUniv.universe | `CProp ]
+
+let string_of_sort = function
+ | `Prop -> "Prop"
+ | `Set -> "Set"
+ | `Type u -> "Type:" ^ string_of_int (CicUniv.univno u)
+ | `CProp -> "CProp"
+
+let sort_of_sort = function
+ | Cic.Prop -> `Prop
+ | Cic.Set -> `Set
+ | Cic.Type u -> `Type u
+ | Cic.CProp -> `CProp
+
+(* let hashtbl_add_time = ref 0.0;; *)
+
+let xxx_add h k v =
+(* let t1 = Sys.time () in *)
+ Hashtbl.add h k v ;
+(* let t2 = Sys.time () in
+ hashtbl_add_time := !hashtbl_add_time +. t2 -. t1 *)
+;;
+
+(* let number_new_type_of_aux' = ref 0;;
+let type_of_aux'_add_time = ref 0.0;; *)
+
+let xxx_type_of_aux' m c t =
+(* let t1 = Sys.time () in *)
+ let res,_ =
+ try
+ CicTypeChecker.type_of_aux' m c t CicUniv.empty_ugraph
+ with
+ | CicTypeChecker.AssertFailure _
+ | CicTypeChecker.TypeCheckerFailure _ ->
+ Cic.Sort Cic.Prop, CicUniv.empty_ugraph
+ in
+(* let t2 = Sys.time () in
+ type_of_aux'_add_time := !type_of_aux'_add_time +. t2 -. t1 ; *)
+ res
+;;
+
+type anntypes =
+ {annsynthesized : Cic.annterm ; annexpected : Cic.annterm option}
+;;
+
+let gen_id seed =
+ let res = "i" ^ string_of_int !seed in
+ incr seed ;
+ res
+;;
+
+let fresh_id seed ids_to_terms ids_to_father_ids =
+ fun father t ->
+ let res = gen_id seed in
+ xxx_add ids_to_father_ids res father ;
+ xxx_add ids_to_terms res t ;
+ res
+;;
+
+let source_id_of_id id = "#source#" ^ id;;
+
+exception NotEnoughElements;;
+
+(*CSC: cut&paste da cicPp.ml *)
+(* get_nth l n returns the nth element of the list l if it exists or *)
+(* raises NotEnoughElements if l has less than n elements *)
+let rec get_nth l n =
+ match (n,l) with
+ (1, he::_) -> he
+ | (n, he::tail) when n > 1 -> get_nth tail (n-1)
+ | (_,_) -> raise NotEnoughElements
+;;
+
+let acic_of_cic_context' ~computeinnertypes:global_computeinnertypes
+ seed ids_to_terms ids_to_father_ids ids_to_inner_sorts ids_to_inner_types
+ metasenv context idrefs t expectedty
+=
+ let module D = DoubleTypeInference in
+ let module C = Cic in
+ let fresh_id' = fresh_id seed ids_to_terms ids_to_father_ids in
+(* let time1 = Sys.time () in *)
+ let terms_to_types =
+(*
+ let time0 = Sys.time () in
+ let prova = CicTypeChecker.type_of_aux' metasenv context t in
+ let time1 = Sys.time () in
+ prerr_endline ("*** Fine type_inference:" ^ (string_of_float (time1 -. time0)));
+ let res = D.double_type_of metasenv context t expectedty in
+ let time2 = Sys.time () in
+ prerr_endline ("*** Fine double_type_inference:" ^ (string_of_float (time2 -. time1)));
+ res
+*)
+ if global_computeinnertypes then
+ D.double_type_of metasenv context t expectedty
+ else
+ Cic.CicHash.create 1 (* empty table *)
+ in
+(*
+ let time2 = Sys.time () in
+ prerr_endline
+ ("++++++++++++ Tempi della double_type_of: "^ string_of_float (time2 -. time1)) ;
+*)
+ let rec aux computeinnertypes father context idrefs tt =
+ let fresh_id'' = fresh_id' father tt in
+ (*CSC: computeinnertypes era true, il che e' proprio sbagliato, no? *)
+ let aux' = aux computeinnertypes (Some fresh_id'') in
+ (* First of all we compute the inner type and the inner sort *)
+ (* of the term. They may be useful in what follows. *)
+ (*CSC: This is a very inefficient way of computing inner types *)
+ (*CSC: and inner sorts: very deep terms have their types/sorts *)
+ (*CSC: computed again and again. *)
+ let sort_of t =
+ match CicReduction.whd context t with
+ C.Sort C.Prop -> `Prop
+ | C.Sort C.Set -> `Set
+ | C.Sort (C.Type u) -> `Type u
+ | C.Meta _ -> `Type (CicUniv.fresh())
+ | C.Sort C.CProp -> `CProp
+ | t ->
+ prerr_endline ("Cic2acic.sort_of applied to: " ^ CicPp.ppterm t) ;
+ assert false
+ in
+ let ainnertypes,innertype,innersort,expected_available =
+(*CSC: Here we need the algorithm for Coscoy's double type-inference *)
+(*CSC: (expected type + inferred type). Just for now we use the usual *)
+(*CSC: type-inference, but the result is very poor. As a very weak *)
+(*CSC: patch, I apply whd to the computed type. Full beta *)
+(*CSC: reduction would be a much better option. *)
+(*CSC: solo per testare i tempi *)
+(*XXXXXXX *)
+ try
+(* *)
+ let {D.synthesized = synthesized; D.expected = expected} =
+ if computeinnertypes then
+ Cic.CicHash.find terms_to_types tt
+ else
+ (* We are already in an inner-type and Coscoy's double *)
+ (* type inference algorithm has not been applied. *)
+ { D.synthesized =
+(***CSC: patch per provare i tempi
+ CicReduction.whd context (xxx_type_of_aux' metasenv context tt) ; *)
+ if global_computeinnertypes then
+ Cic.Sort (Cic.Type (CicUniv.fresh()))
+ else
+ CicReduction.whd context (xxx_type_of_aux' metasenv context tt);
+ D.expected = None}
+ in
+(* incr number_new_type_of_aux' ; *)
+ let innersort = (*XXXXX *) xxx_type_of_aux' metasenv context synthesized (* Cic.Sort Cic.Prop *) in
+ let ainnertypes,expected_available =
+ if computeinnertypes then
+ let annexpected,expected_available =
+ match expected with
+ None -> None,false
+ | Some expectedty' ->
+ Some
+ (aux false (Some fresh_id'') context idrefs expectedty'),
+ true
+ in
+ Some
+ {annsynthesized =
+ aux false (Some fresh_id'') context idrefs synthesized ;
+ annexpected = annexpected
+ }, expected_available
+ else
+ None,false
+ in
+ ainnertypes,synthesized, sort_of innersort, expected_available
+(*XXXXXXXX *)
+ with
+ Not_found -> (* l'inner-type non e' nella tabella ==> sort <> Prop *)
+ (* CSC: Type or Set? I can not tell *)
+ let u = CicUniv.fresh() in
+ None,Cic.Sort (Cic.Type u),`Type u,false
+ (* TASSI non dovrebbe fare danni *)
+(* *)
+ in
+ let add_inner_type id =
+ match ainnertypes with
+ None -> ()
+ | Some ainnertypes -> xxx_add ids_to_inner_types id ainnertypes
+ in
+ match tt with
+ C.Rel n ->
+ let id =
+ match get_nth context n with
+ (Some (C.Name s,_)) -> s
+ | _ -> "__" ^ string_of_int n
+ in
+ xxx_add ids_to_inner_sorts fresh_id'' innersort ;
+ if innersort = `Prop && expected_available then
+ add_inner_type fresh_id'' ;
+ C.ARel (fresh_id'', List.nth idrefs (n-1), n, id)
+ | C.Var (uri,exp_named_subst) ->
+ xxx_add ids_to_inner_sorts fresh_id'' innersort ;
+ if innersort = `Prop && expected_available then
+ add_inner_type fresh_id'' ;
+ let exp_named_subst' =
+ List.map
+ (function i,t -> i, (aux' context idrefs t)) exp_named_subst
+ in
+ C.AVar (fresh_id'', uri,exp_named_subst')
+ | C.Meta (n,l) ->
+ let (_,canonical_context,_) = CicUtil.lookup_meta n metasenv in
+ xxx_add ids_to_inner_sorts fresh_id'' innersort ;
+ if innersort = `Prop && expected_available then
+ add_inner_type fresh_id'' ;
+ C.AMeta (fresh_id'', n,
+ (List.map2
+ (fun ct t ->
+ match (ct, t) with
+ | None, _ -> None
+ | _, Some t -> Some (aux' context idrefs t)
+ | Some _, None -> assert false (* due to typing rules *))
+ canonical_context l))
+ | C.Sort s -> C.ASort (fresh_id'', s)
+ | C.Implicit annotation -> C.AImplicit (fresh_id'', annotation)
+ | C.Cast (v,t) ->
+ xxx_add ids_to_inner_sorts fresh_id'' innersort ;
+ if innersort = `Prop then
+ add_inner_type fresh_id'' ;
+ C.ACast (fresh_id'', aux' context idrefs v, aux' context idrefs t)
+ | C.Prod (n,s,t) ->
+ xxx_add ids_to_inner_sorts fresh_id''
+ (sort_of innertype) ;
+ let sourcetype = xxx_type_of_aux' metasenv context s in
+ xxx_add ids_to_inner_sorts (source_id_of_id fresh_id'')
+ (sort_of sourcetype) ;
+ let n' =
+ match n with
+ C.Anonymous -> n
+ | C.Name n' ->
+ if DoubleTypeInference.does_not_occur 1 t then
+ C.Anonymous
+ else
+ C.Name n'
+ in
+ C.AProd
+ (fresh_id'', n', aux' context idrefs s,
+ aux' ((Some (n, C.Decl s))::context) (fresh_id''::idrefs) t)
+ | C.Lambda (n,s,t) ->
+ xxx_add ids_to_inner_sorts fresh_id'' innersort ;
+ let sourcetype = xxx_type_of_aux' metasenv context s in
+ xxx_add ids_to_inner_sorts (source_id_of_id fresh_id'')
+ (sort_of sourcetype) ;
+ if innersort = `Prop then
+ begin
+ let father_is_lambda =
+ match father with
+ None -> false
+ | Some father' ->
+ match Hashtbl.find ids_to_terms father' with
+ C.Lambda _ -> true
+ | _ -> false
+ in
+ if (not father_is_lambda) || expected_available then
+ add_inner_type fresh_id''
+ end ;
+ C.ALambda
+ (fresh_id'',n, aux' context idrefs s,
+ aux' ((Some (n, C.Decl s)::context)) (fresh_id''::idrefs) t)
+ | C.LetIn (n,s,t) ->
+ xxx_add ids_to_inner_sorts fresh_id'' innersort ;
+ if innersort = `Prop then
+ add_inner_type fresh_id'' ;
+ C.ALetIn
+ (fresh_id'', n, aux' context idrefs s,
+ aux' ((Some (n, C.Def(s,None)))::context) (fresh_id''::idrefs) t)
+ | C.Appl l ->
+ xxx_add ids_to_inner_sorts fresh_id'' innersort ;
+ if innersort = `Prop then
+ add_inner_type fresh_id'' ;
+ C.AAppl (fresh_id'', List.map (aux' context idrefs) l)
+ | C.Const (uri,exp_named_subst) ->
+ xxx_add ids_to_inner_sorts fresh_id'' innersort ;
+ if innersort = `Prop && expected_available then
+ add_inner_type fresh_id'' ;
+ let exp_named_subst' =
+ List.map
+ (function i,t -> i, (aux' context idrefs t)) exp_named_subst
+ in
+ C.AConst (fresh_id'', uri, exp_named_subst')
+ | C.MutInd (uri,tyno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map
+ (function i,t -> i, (aux' context idrefs t)) exp_named_subst
+ in
+ C.AMutInd (fresh_id'', uri, tyno, exp_named_subst')
+ | C.MutConstruct (uri,tyno,consno,exp_named_subst) ->
+ xxx_add ids_to_inner_sorts fresh_id'' innersort ;
+ if innersort = `Prop && expected_available then
+ add_inner_type fresh_id'' ;
+ let exp_named_subst' =
+ List.map
+ (function i,t -> i, (aux' context idrefs t)) exp_named_subst
+ in
+ C.AMutConstruct (fresh_id'', uri, tyno, consno, exp_named_subst')
+ | C.MutCase (uri, tyno, outty, term, patterns) ->
+ xxx_add ids_to_inner_sorts fresh_id'' innersort ;
+ if innersort = `Prop then
+ add_inner_type fresh_id'' ;
+ C.AMutCase (fresh_id'', uri, tyno, aux' context idrefs outty,
+ aux' context idrefs term, List.map (aux' context idrefs) patterns)
+ | C.Fix (funno, funs) ->
+ let fresh_idrefs =
+ List.map (function _ -> gen_id seed) funs in
+ let new_idrefs = List.rev fresh_idrefs @ idrefs in
+ let tys =
+ List.map (fun (name,_,ty,_) -> Some (C.Name name, C.Decl ty)) funs
+ in
+ xxx_add ids_to_inner_sorts fresh_id'' innersort ;
+ if innersort = `Prop then
+ add_inner_type fresh_id'' ;
+ C.AFix (fresh_id'', funno,
+ List.map2
+ (fun id (name, indidx, ty, bo) ->
+ (id, name, indidx, aux' context idrefs ty,
+ aux' (tys@context) new_idrefs bo)
+ ) fresh_idrefs funs
+ )
+ | C.CoFix (funno, funs) ->
+ let fresh_idrefs =
+ List.map (function _ -> gen_id seed) funs in
+ let new_idrefs = List.rev fresh_idrefs @ idrefs in
+ let tys =
+ List.map (fun (name,ty,_) -> Some (C.Name name, C.Decl ty)) funs
+ in
+ xxx_add ids_to_inner_sorts fresh_id'' innersort ;
+ if innersort = `Prop then
+ add_inner_type fresh_id'' ;
+ C.ACoFix (fresh_id'', funno,
+ List.map2
+ (fun id (name, ty, bo) ->
+ (id, name, aux' context idrefs ty,
+ aux' (tys@context) new_idrefs bo)
+ ) fresh_idrefs funs
+ )
+ in
+(*
+ let timea = Sys.time () in
+ let res = aux true None context idrefs t in
+ let timeb = Sys.time () in
+ prerr_endline
+ ("+++++++++++++ Tempi della aux dentro alla acic_of_cic: "^ string_of_float (timeb -. timea)) ;
+ res
+*)
+ aux global_computeinnertypes None context idrefs t
+;;
+
+let acic_of_cic_context ~computeinnertypes metasenv context idrefs t =
+ let ids_to_terms = Hashtbl.create 503 in
+ let ids_to_father_ids = Hashtbl.create 503 in
+ let ids_to_inner_sorts = Hashtbl.create 503 in
+ let ids_to_inner_types = Hashtbl.create 503 in
+ let seed = ref 0 in
+ acic_of_cic_context' ~computeinnertypes seed ids_to_terms ids_to_father_ids ids_to_inner_sorts
+ ids_to_inner_types metasenv context idrefs t,
+ ids_to_terms, ids_to_father_ids, ids_to_inner_sorts, ids_to_inner_types
+;;
+
+let aconjecture_of_conjecture seed ids_to_terms ids_to_father_ids
+ ids_to_inner_sorts ids_to_inner_types ids_to_hypotheses hypotheses_seed
+ metasenv (metano,context,goal)
+=
+ let computeinnertypes = false in
+ let acic_of_cic_context =
+ acic_of_cic_context' seed ids_to_terms ids_to_father_ids ids_to_inner_sorts
+ ids_to_inner_types metasenv in
+ let _, acontext,final_idrefs =
+ (List.fold_right
+ (fun binding (context, acontext,idrefs) ->
+ let hid = "h" ^ string_of_int !hypotheses_seed in
+ Hashtbl.add ids_to_hypotheses hid binding ;
+ incr hypotheses_seed ;
+ match binding with
+ Some (n,Cic.Def (t,_)) ->
+ let acic = acic_of_cic_context ~computeinnertypes context idrefs t None in
+ Hashtbl.replace ids_to_father_ids (CicUtil.id_of_annterm acic)
+ (Some hid);
+ (binding::context),
+ ((hid,Some (n,Cic.ADef acic))::acontext),(hid::idrefs)
+ | Some (n,Cic.Decl t) ->
+ let acic = acic_of_cic_context ~computeinnertypes context idrefs t None in
+ Hashtbl.replace ids_to_father_ids (CicUtil.id_of_annterm acic)
+ (Some hid);
+ (binding::context),
+ ((hid,Some (n,Cic.ADecl acic))::acontext),(hid::idrefs)
+ | None ->
+ (* Invariant: "" is never looked up *)
+ (None::context),((hid,None)::acontext),""::idrefs
+ ) context ([],[],[])
+ )
+ in
+ let agoal = acic_of_cic_context ~computeinnertypes context final_idrefs goal None in
+ (metano,acontext,agoal)
+;;
+
+let asequent_of_sequent (metasenv:Cic.metasenv) (sequent:Cic.conjecture) =
+ let ids_to_terms = Hashtbl.create 503 in
+ let ids_to_father_ids = Hashtbl.create 503 in
+ let ids_to_inner_sorts = Hashtbl.create 503 in
+ let ids_to_inner_types = Hashtbl.create 503 in
+ let ids_to_hypotheses = Hashtbl.create 23 in
+ let hypotheses_seed = ref 0 in
+ let seed = ref 1 in (* 'i0' is used for the whole sequent *)
+ let unsh_sequent =
+ let i,canonical_context,term = sequent in
+ let canonical_context' =
+ List.fold_right
+ (fun d canonical_context' ->
+ let d =
+ match d with
+ None -> None
+ | Some (n, Cic.Decl t)->
+ Some (n, Cic.Decl (Unshare.unshare t))
+ | Some (n, Cic.Def (t,None)) ->
+ Some (n, Cic.Def ((Unshare.unshare t),None))
+ | Some (n,Cic.Def (bo,Some ty)) ->
+ Some (n, Cic.Def (Unshare.unshare bo,Some (Unshare.unshare ty)))
+ in
+ d::canonical_context'
+ ) canonical_context []
+ in
+ let term' = Unshare.unshare term in
+ (i,canonical_context',term')
+ in
+ let (metano,acontext,agoal) =
+ aconjecture_of_conjecture seed ids_to_terms ids_to_father_ids
+ ids_to_inner_sorts ids_to_inner_types ids_to_hypotheses hypotheses_seed
+ metasenv unsh_sequent in
+ (unsh_sequent,
+ (("i0",metano,acontext,agoal),
+ ids_to_terms,ids_to_father_ids,ids_to_inner_sorts,ids_to_hypotheses))
+;;
+
+let acic_object_of_cic_object ?(eta_fix=true) obj =
+ let module C = Cic in
+ let module E = Eta_fixing in
+ let ids_to_terms = Hashtbl.create 503 in
+ let ids_to_father_ids = Hashtbl.create 503 in
+ let ids_to_inner_sorts = Hashtbl.create 503 in
+ let ids_to_inner_types = Hashtbl.create 503 in
+ let ids_to_conjectures = Hashtbl.create 11 in
+ let ids_to_hypotheses = Hashtbl.create 127 in
+ let hypotheses_seed = ref 0 in
+ let conjectures_seed = ref 0 in
+ let seed = ref 0 in
+ let acic_term_of_cic_term_context' =
+ acic_of_cic_context' seed ids_to_terms ids_to_father_ids ids_to_inner_sorts
+ ids_to_inner_types in
+ let acic_term_of_cic_term' = acic_term_of_cic_term_context' [] [] [] in
+ let aconjecture_of_conjecture' = aconjecture_of_conjecture seed
+ ids_to_terms ids_to_father_ids ids_to_inner_sorts ids_to_inner_types
+ ids_to_hypotheses hypotheses_seed in
+ let eta_fix metasenv context t =
+ let t = if eta_fix then E.eta_fix metasenv context t else t in
+ Unshare.unshare t in
+ let aobj =
+ match obj with
+ C.Constant (id,Some bo,ty,params,attrs) ->
+ let bo' = eta_fix [] [] bo in
+ let ty' = eta_fix [] [] ty in
+ let abo = acic_term_of_cic_term' ~computeinnertypes:true bo' (Some ty') in
+ let aty = acic_term_of_cic_term' ~computeinnertypes:false ty' None in
+ C.AConstant
+ ("mettereaposto",Some "mettereaposto2",id,Some abo,aty,params,attrs)
+ | C.Constant (id,None,ty,params,attrs) ->
+ let ty' = eta_fix [] [] ty in
+ let aty = acic_term_of_cic_term' ~computeinnertypes:false ty' None in
+ C.AConstant
+ ("mettereaposto",None,id,None,aty,params,attrs)
+ | C.Variable (id,bo,ty,params,attrs) ->
+ let ty' = eta_fix [] [] ty in
+ let abo =
+ match bo with
+ None -> None
+ | Some bo ->
+ let bo' = eta_fix [] [] bo in
+ Some (acic_term_of_cic_term' ~computeinnertypes:true bo' (Some ty'))
+ in
+ let aty = acic_term_of_cic_term' ~computeinnertypes:false ty' None in
+ C.AVariable
+ ("mettereaposto",id,abo,aty,params,attrs)
+ | C.CurrentProof (id,conjectures,bo,ty,params,attrs) ->
+ let conjectures' =
+ List.map
+ (function (i,canonical_context,term) ->
+ let canonical_context' =
+ List.fold_right
+ (fun d canonical_context' ->
+ let d =
+ match d with
+ None -> None
+ | Some (n, C.Decl t)->
+ Some (n, C.Decl (eta_fix conjectures canonical_context' t))
+ | Some (n, C.Def (t,None)) ->
+ Some (n,
+ C.Def ((eta_fix conjectures canonical_context' t),None))
+ | Some (_,C.Def (_,Some _)) -> assert false
+ in
+ d::canonical_context'
+ ) canonical_context []
+ in
+ let term' = eta_fix conjectures canonical_context' term in
+ (i,canonical_context',term')
+ ) conjectures
+ in
+ let aconjectures =
+ List.map
+ (function (i,canonical_context,term) as conjecture ->
+ let cid = "c" ^ string_of_int !conjectures_seed in
+ xxx_add ids_to_conjectures cid conjecture ;
+ incr conjectures_seed ;
+ let (i,acanonical_context,aterm)
+ = aconjecture_of_conjecture' conjectures conjecture in
+ (cid,i,acanonical_context,aterm))
+ conjectures' in
+(* let time1 = Sys.time () in *)
+ let bo' = eta_fix conjectures' [] bo in
+ let ty' = eta_fix conjectures' [] ty in
+(*
+ let time2 = Sys.time () in
+ prerr_endline
+ ("++++++++++ Tempi della eta_fix: "^ string_of_float (time2 -. time1)) ;
+ hashtbl_add_time := 0.0 ;
+ type_of_aux'_add_time := 0.0 ;
+ DoubleTypeInference.syntactic_equality_add_time := 0.0 ;
+*)
+ let abo =
+ acic_term_of_cic_term_context' ~computeinnertypes:true conjectures' [] [] bo' (Some ty') in
+ let aty = acic_term_of_cic_term_context' ~computeinnertypes:false conjectures' [] [] ty' None in
+(*
+ let time3 = Sys.time () in
+ prerr_endline
+ ("++++++++++++ Tempi della hashtbl_add_time: " ^ string_of_float !hashtbl_add_time) ;
+ prerr_endline
+ ("++++++++++++ Tempi della type_of_aux'_add_time(" ^ string_of_int !number_new_type_of_aux' ^ "): " ^ string_of_float !type_of_aux'_add_time) ;
+ prerr_endline
+ ("++++++++++++ Tempi della type_of_aux'_add_time nella double_type_inference(" ^ string_of_int !DoubleTypeInference.number_new_type_of_aux'_double_work ^ ";" ^ string_of_int !DoubleTypeInference.number_new_type_of_aux'_prop ^ "/" ^ string_of_int !DoubleTypeInference.number_new_type_of_aux' ^ "): " ^ string_of_float !DoubleTypeInference.type_of_aux'_add_time) ;
+ prerr_endline
+ ("++++++++++++ Tempi della syntactic_equality_add_time: " ^ string_of_float !DoubleTypeInference.syntactic_equality_add_time) ;
+ prerr_endline
+ ("++++++++++ Tempi della acic_of_cic: " ^ string_of_float (time3 -. time2)) ;
+ prerr_endline
+ ("++++++++++ Numero di iterazioni della acic_of_cic: " ^ string_of_int !seed) ;
+*)
+ C.ACurrentProof
+ ("mettereaposto","mettereaposto2",id,aconjectures,abo,aty,params,attrs)
+ | C.InductiveDefinition (tys,params,paramsno,attrs) ->
+ let tys =
+ List.map
+ (fun (name,i,arity,cl) ->
+ (name,i,Unshare.unshare arity,
+ List.map (fun (name,ty) -> name,Unshare.unshare ty) cl)) tys in
+ let context =
+ List.map
+ (fun (name,_,arity,_) ->
+ Some (C.Name name, C.Decl (Unshare.unshare arity))) tys in
+ let idrefs = List.map (function _ -> gen_id seed) tys in
+ let atys =
+ List.map2
+ (fun id (name,inductive,ty,cons) ->
+ let acons =
+ List.map
+ (function (name,ty) ->
+ (name,
+ acic_term_of_cic_term_context' ~computeinnertypes:false [] context idrefs ty None)
+ ) cons
+ in
+ (id,name,inductive,
+ acic_term_of_cic_term' ~computeinnertypes:false ty None,acons)
+ ) (List.rev idrefs) tys
+ in
+ C.AInductiveDefinition ("mettereaposto",atys,params,paramsno,attrs)
+ in
+ aobj,ids_to_terms,ids_to_father_ids,ids_to_inner_sorts,ids_to_inner_types,
+ ids_to_conjectures,ids_to_hypotheses
+;;
+
+let plain_acic_term_of_cic_term =
+ let module C = Cic in
+ let mk_fresh_id =
+ let id = ref 0 in
+ function () -> incr id; "i" ^ string_of_int !id in
+ let rec aux context t =
+ let fresh_id = mk_fresh_id () in
+ match t with
+ C.Rel n ->
+ let idref,id =
+ match get_nth context n with
+ idref,(Some (C.Name s,_)) -> idref,s
+ | idref,_ -> idref,"__" ^ string_of_int n
+ in
+ C.ARel (fresh_id, idref, n, id)
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map
+ (function i,t -> i, (aux context t)) exp_named_subst
+ in
+ C.AVar (fresh_id,uri,exp_named_subst')
+ | C.Implicit _
+ | C.Meta _ -> assert false
+ | C.Sort s -> C.ASort (fresh_id, s)
+ | C.Cast (v,t) ->
+ C.ACast (fresh_id, aux context v, aux context t)
+ | C.Prod (n,s,t) ->
+ C.AProd
+ (fresh_id, n, aux context s,
+ aux ((fresh_id, Some (n, C.Decl s))::context) t)
+ | C.Lambda (n,s,t) ->
+ C.ALambda
+ (fresh_id,n, aux context s,
+ aux ((fresh_id, Some (n, C.Decl s))::context) t)
+ | C.LetIn (n,s,t) ->
+ C.ALetIn
+ (fresh_id, n, aux context s,
+ aux ((fresh_id, Some (n, C.Def(s,None)))::context) t)
+ | C.Appl l ->
+ C.AAppl (fresh_id, List.map (aux context) l)
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map
+ (function i,t -> i, (aux context t)) exp_named_subst
+ in
+ C.AConst (fresh_id, uri, exp_named_subst')
+ | C.MutInd (uri,tyno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map
+ (function i,t -> i, (aux context t)) exp_named_subst
+ in
+ C.AMutInd (fresh_id, uri, tyno, exp_named_subst')
+ | C.MutConstruct (uri,tyno,consno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map
+ (function i,t -> i, (aux context t)) exp_named_subst
+ in
+ C.AMutConstruct (fresh_id, uri, tyno, consno, exp_named_subst')
+ | C.MutCase (uri, tyno, outty, term, patterns) ->
+ C.AMutCase (fresh_id, uri, tyno, aux context outty,
+ aux context term, List.map (aux context) patterns)
+ | C.Fix (funno, funs) ->
+ let tys =
+ List.map
+ (fun (name,_,ty,_) -> mk_fresh_id (), Some (C.Name name, C.Decl ty)) funs
+ in
+ C.AFix (fresh_id, funno,
+ List.map2
+ (fun (id,_) (name, indidx, ty, bo) ->
+ (id, name, indidx, aux context ty, aux (tys@context) bo)
+ ) tys funs
+ )
+ | C.CoFix (funno, funs) ->
+ let tys =
+ List.map (fun (name,ty,_) ->
+ mk_fresh_id (),Some (C.Name name, C.Decl ty)) funs
+ in
+ C.ACoFix (fresh_id, funno,
+ List.map2
+ (fun (id,_) (name, ty, bo) ->
+ (id, name, aux context ty, aux (tys@context) bo)
+ ) tys funs
+ )
+ in
+ aux
+;;
+
+let plain_acic_object_of_cic_object obj =
+ let module C = Cic in
+ let mk_fresh_id =
+ let id = ref 0 in
+ function () -> incr id; "it" ^ string_of_int !id
+ in
+ match obj with
+ C.Constant (id,Some bo,ty,params,attrs) ->
+ let abo = plain_acic_term_of_cic_term [] bo in
+ let aty = plain_acic_term_of_cic_term [] ty in
+ C.AConstant
+ ("mettereaposto",Some "mettereaposto2",id,Some abo,aty,params,attrs)
+ | C.Constant (id,None,ty,params,attrs) ->
+ let aty = plain_acic_term_of_cic_term [] ty in
+ C.AConstant
+ ("mettereaposto",None,id,None,aty,params,attrs)
+ | C.Variable (id,bo,ty,params,attrs) ->
+ let abo =
+ match bo with
+ None -> None
+ | Some bo -> Some (plain_acic_term_of_cic_term [] bo)
+ in
+ let aty = plain_acic_term_of_cic_term [] ty in
+ C.AVariable
+ ("mettereaposto",id,abo,aty,params,attrs)
+ | C.CurrentProof _ -> assert false
+ | C.InductiveDefinition (tys,params,paramsno,attrs) ->
+ let context =
+ List.map
+ (fun (name,_,arity,_) ->
+ mk_fresh_id (), Some (C.Name name, C.Decl arity)) tys in
+ let atys =
+ List.map2
+ (fun (id,_) (name,inductive,ty,cons) ->
+ let acons =
+ List.map
+ (function (name,ty) ->
+ (name,
+ plain_acic_term_of_cic_term context ty)
+ ) cons
+ in
+ (id,name,inductive,plain_acic_term_of_cic_term [] ty,acons)
+ ) context tys
+ in
+ C.AInductiveDefinition ("mettereaposto",atys,params,paramsno,attrs)
+;;
diff --git a/helm/ocaml/cic_acic/cic2acic.mli b/helm/ocaml/cic_acic/cic2acic.mli
new file mode 100644
index 000000000..e6379283d
--- /dev/null
+++ b/helm/ocaml/cic_acic/cic2acic.mli
@@ -0,0 +1,61 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+exception NotEnoughElements
+
+val source_id_of_id : string -> string
+
+type anntypes =
+ {annsynthesized : Cic.annterm ; annexpected : Cic.annterm option}
+;;
+
+type sort_kind = [ `Prop | `Set | `Type of CicUniv.universe | `CProp ]
+
+val string_of_sort: sort_kind -> string
+(*val sort_of_string: string -> sort_kind*)
+val sort_of_sort: Cic.sort -> sort_kind
+
+val acic_object_of_cic_object :
+ ?eta_fix: bool -> (* perform eta_fixing; default: true*)
+ Cic.obj -> (* object *)
+ Cic.annobj * (* annotated object *)
+ (Cic.id, Cic.term) Hashtbl.t * (* ids_to_terms *)
+ (Cic.id, Cic.id option) Hashtbl.t * (* ids_to_father_ids *)
+ (Cic.id, sort_kind) Hashtbl.t * (* ids_to_inner_sorts *)
+ (Cic.id, anntypes) Hashtbl.t * (* ids_to_inner_types *)
+ (Cic.id, Cic.conjecture) Hashtbl.t * (* ids_to_conjectures *)
+ (Cic.id, Cic.hypothesis) Hashtbl.t (* ids_to_hypotheses *)
+
+val asequent_of_sequent :
+ Cic.metasenv -> (* metasenv *)
+ Cic.conjecture -> (* sequent *)
+ Cic.conjecture * (* unshared sequent *)
+ (Cic.annconjecture * (* annotated sequent *)
+ (Cic.id, Cic.term) Hashtbl.t * (* ids_to_terms *)
+ (Cic.id, Cic.id option) Hashtbl.t * (* ids_to_father_ids *)
+ (Cic.id, sort_kind) Hashtbl.t * (* ids_to_inner_sorts *)
+ (Cic.id, Cic.hypothesis) Hashtbl.t) (* ids_to_hypotheses *)
+
+val plain_acic_object_of_cic_object : Cic.obj -> Cic.annobj
diff --git a/helm/ocaml/cic_acic/doubleTypeInference.ml b/helm/ocaml/cic_acic/doubleTypeInference.ml
new file mode 100644
index 000000000..30a8f5c29
--- /dev/null
+++ b/helm/ocaml/cic_acic/doubleTypeInference.ml
@@ -0,0 +1,734 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+exception Impossible of int;;
+exception NotWellTyped of string;;
+exception WrongUriToConstant of string;;
+exception WrongUriToVariable of string;;
+exception WrongUriToMutualInductiveDefinitions of string;;
+exception ListTooShort;;
+exception RelToHiddenHypothesis;;
+
+let syntactic_equality_add_time = ref 0.0;;
+let type_of_aux'_add_time = ref 0.0;;
+let number_new_type_of_aux'_double_work = ref 0;;
+let number_new_type_of_aux' = ref 0;;
+let number_new_type_of_aux'_prop = ref 0;;
+
+let double_work = ref 0;;
+
+let xxx_type_of_aux' m c t =
+ let t1 = Sys.time () in
+ let res,_ = CicTypeChecker.type_of_aux' m c t CicUniv.empty_ugraph in
+ let t2 = Sys.time () in
+ type_of_aux'_add_time := !type_of_aux'_add_time +. t2 -. t1 ;
+ res
+;;
+
+type types = {synthesized : Cic.term ; expected : Cic.term option};;
+
+(* does_not_occur n te *)
+(* returns [true] if [Rel n] does not occur in [te] *)
+let rec does_not_occur n =
+ let module C = Cic in
+ function
+ C.Rel m when m = n -> false
+ | C.Rel _
+ | C.Meta _
+ | C.Sort _
+ | C.Implicit _ -> true
+ | C.Cast (te,ty) ->
+ does_not_occur n te && does_not_occur n ty
+ | C.Prod (name,so,dest) ->
+ does_not_occur n so &&
+ does_not_occur (n + 1) dest
+ | C.Lambda (name,so,dest) ->
+ does_not_occur n so &&
+ does_not_occur (n + 1) dest
+ | C.LetIn (name,so,dest) ->
+ does_not_occur n so &&
+ does_not_occur (n + 1) dest
+ | C.Appl l ->
+ List.fold_right (fun x i -> i && does_not_occur n x) l true
+ | C.Var (_,exp_named_subst)
+ | C.Const (_,exp_named_subst)
+ | C.MutInd (_,_,exp_named_subst)
+ | C.MutConstruct (_,_,_,exp_named_subst) ->
+ List.fold_right (fun (_,x) i -> i && does_not_occur n x)
+ exp_named_subst true
+ | C.MutCase (_,_,out,te,pl) ->
+ does_not_occur n out && does_not_occur n te &&
+ List.fold_right (fun x i -> i && does_not_occur n x) pl true
+ | C.Fix (_,fl) ->
+ let len = List.length fl in
+ let n_plus_len = n + len in
+ List.fold_right
+ (fun (_,_,ty,bo) i ->
+ i && does_not_occur n ty &&
+ does_not_occur n_plus_len bo
+ ) fl true
+ | C.CoFix (_,fl) ->
+ let len = List.length fl in
+ let n_plus_len = n + len in
+ List.fold_right
+ (fun (_,ty,bo) i ->
+ i && does_not_occur n ty &&
+ does_not_occur n_plus_len bo
+ ) fl true
+;;
+
+let rec beta_reduce =
+ let module S = CicSubstitution in
+ let module C = Cic in
+ function
+ C.Rel _ as t -> t
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (i,t) -> i, beta_reduce t) exp_named_subst
+ in
+ C.Var (uri,exp_named_subst')
+ | C.Meta (n,l) ->
+ C.Meta (n,
+ List.map
+ (function None -> None | Some t -> Some (beta_reduce t)) l
+ )
+ | C.Sort _ as t -> t
+ | C.Implicit _ -> assert false
+ | C.Cast (te,ty) ->
+ C.Cast (beta_reduce te, beta_reduce ty)
+ | C.Prod (n,s,t) ->
+ C.Prod (n, beta_reduce s, beta_reduce t)
+ | C.Lambda (n,s,t) ->
+ C.Lambda (n, beta_reduce s, beta_reduce t)
+ | C.LetIn (n,s,t) ->
+ C.LetIn (n, beta_reduce s, beta_reduce t)
+ | C.Appl ((C.Lambda (name,s,t))::he::tl) ->
+ let he' = S.subst he t in
+ if tl = [] then
+ beta_reduce he'
+ else
+ (match he' with
+ C.Appl l -> beta_reduce (C.Appl (l@tl))
+ | _ -> beta_reduce (C.Appl (he'::tl)))
+ | C.Appl l ->
+ C.Appl (List.map beta_reduce l)
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (i,t) -> i, beta_reduce t) exp_named_subst
+ in
+ C.Const (uri,exp_named_subst')
+ | C.MutInd (uri,i,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (i,t) -> i, beta_reduce t) exp_named_subst
+ in
+ C.MutInd (uri,i,exp_named_subst')
+ | C.MutConstruct (uri,i,j,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (i,t) -> i, beta_reduce t) exp_named_subst
+ in
+ C.MutConstruct (uri,i,j,exp_named_subst')
+ | C.MutCase (sp,i,outt,t,pl) ->
+ C.MutCase (sp,i,beta_reduce outt,beta_reduce t,
+ List.map beta_reduce pl)
+ | C.Fix (i,fl) ->
+ let fl' =
+ List.map
+ (function (name,i,ty,bo) ->
+ name,i,beta_reduce ty,beta_reduce bo
+ ) fl
+ in
+ C.Fix (i,fl')
+ | C.CoFix (i,fl) ->
+ let fl' =
+ List.map
+ (function (name,ty,bo) ->
+ name,beta_reduce ty,beta_reduce bo
+ ) fl
+ in
+ C.CoFix (i,fl')
+;;
+
+(* syntactic_equality up to the *)
+(* distinction between fake dependent products *)
+(* and non-dependent products, alfa-conversion *)
+(*CSC: must alfa-conversion be considered or not? *)
+let syntactic_equality t t' =
+ let module C = Cic in
+ let rec syntactic_equality t t' =
+ if t = t' then true
+ else
+ match t, t' with
+ C.Var (uri,exp_named_subst), C.Var (uri',exp_named_subst') ->
+ UriManager.eq uri uri' &&
+ syntactic_equality_exp_named_subst exp_named_subst exp_named_subst'
+ | C.Cast (te,ty), C.Cast (te',ty') ->
+ syntactic_equality te te' &&
+ syntactic_equality ty ty'
+ | C.Prod (_,s,t), C.Prod (_,s',t') ->
+ syntactic_equality s s' &&
+ syntactic_equality t t'
+ | C.Lambda (_,s,t), C.Lambda (_,s',t') ->
+ syntactic_equality s s' &&
+ syntactic_equality t t'
+ | C.LetIn (_,s,t), C.LetIn(_,s',t') ->
+ syntactic_equality s s' &&
+ syntactic_equality t t'
+ | C.Appl l, C.Appl l' ->
+ List.fold_left2 (fun b t1 t2 -> b && syntactic_equality t1 t2) true l l'
+ | C.Const (uri,exp_named_subst), C.Const (uri',exp_named_subst') ->
+ UriManager.eq uri uri' &&
+ syntactic_equality_exp_named_subst exp_named_subst exp_named_subst'
+ | C.MutInd (uri,i,exp_named_subst), C.MutInd (uri',i',exp_named_subst') ->
+ UriManager.eq uri uri' && i = i' &&
+ syntactic_equality_exp_named_subst exp_named_subst exp_named_subst'
+ | C.MutConstruct (uri,i,j,exp_named_subst),
+ C.MutConstruct (uri',i',j',exp_named_subst') ->
+ UriManager.eq uri uri' && i = i' && j = j' &&
+ syntactic_equality_exp_named_subst exp_named_subst exp_named_subst'
+ | C.MutCase (sp,i,outt,t,pl), C.MutCase (sp',i',outt',t',pl') ->
+ UriManager.eq sp sp' && i = i' &&
+ syntactic_equality outt outt' &&
+ syntactic_equality t t' &&
+ List.fold_left2
+ (fun b t1 t2 -> b && syntactic_equality t1 t2) true pl pl'
+ | C.Fix (i,fl), C.Fix (i',fl') ->
+ i = i' &&
+ List.fold_left2
+ (fun b (_,i,ty,bo) (_,i',ty',bo') ->
+ b && i = i' &&
+ syntactic_equality ty ty' &&
+ syntactic_equality bo bo') true fl fl'
+ | C.CoFix (i,fl), C.CoFix (i',fl') ->
+ i = i' &&
+ List.fold_left2
+ (fun b (_,ty,bo) (_,ty',bo') ->
+ b &&
+ syntactic_equality ty ty' &&
+ syntactic_equality bo bo') true fl fl'
+ | _, _ -> false (* we already know that t != t' *)
+ and syntactic_equality_exp_named_subst exp_named_subst1 exp_named_subst2 =
+ List.fold_left2
+ (fun b (_,t1) (_,t2) -> b && syntactic_equality t1 t2) true
+ exp_named_subst1 exp_named_subst2
+ in
+ try
+ syntactic_equality t t'
+ with
+ _ -> false
+;;
+
+let xxx_syntactic_equality t t' =
+ let t1 = Sys.time () in
+ let res = syntactic_equality t t' in
+ let t2 = Sys.time () in
+ syntactic_equality_add_time := !syntactic_equality_add_time +. t2 -. t1 ;
+ res
+;;
+
+
+let rec split l n =
+ match (l,n) with
+ (l,0) -> ([], l)
+ | (he::tl, n) -> let (l1,l2) = split tl (n-1) in (he::l1,l2)
+ | (_,_) -> raise ListTooShort
+;;
+
+let type_of_constant uri =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+ let cobj =
+ match CicEnvironment.is_type_checked CicUniv.empty_ugraph uri with
+ CicEnvironment.CheckedObj (cobj,_) -> cobj
+ | CicEnvironment.UncheckedObj uobj ->
+ raise (NotWellTyped "Reference to an unchecked constant")
+ in
+ match cobj with
+ C.Constant (_,_,ty,_,_) -> ty
+ | C.CurrentProof (_,_,_,ty,_,_) -> ty
+ | _ -> raise (WrongUriToConstant (U.string_of_uri uri))
+;;
+
+let type_of_variable uri =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+ match CicEnvironment.is_type_checked CicUniv.empty_ugraph uri with
+ CicEnvironment.CheckedObj ((C.Variable (_,_,ty,_,_)),_) -> ty
+ | CicEnvironment.UncheckedObj (C.Variable _) ->
+ raise (NotWellTyped "Reference to an unchecked variable")
+ | _ -> raise (WrongUriToVariable (UriManager.string_of_uri uri))
+;;
+
+let type_of_mutual_inductive_defs uri i =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+ let cobj =
+ match CicEnvironment.is_type_checked CicUniv.empty_ugraph uri with
+ CicEnvironment.CheckedObj (cobj,_) -> cobj
+ | CicEnvironment.UncheckedObj uobj ->
+ raise (NotWellTyped "Reference to an unchecked inductive type")
+ in
+ match cobj with
+ C.InductiveDefinition (dl,_,_,_) ->
+ let (_,_,arity,_) = List.nth dl i in
+ arity
+ | _ -> raise (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri))
+;;
+
+let type_of_mutual_inductive_constr uri i j =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+ let cobj =
+ match CicEnvironment.is_type_checked CicUniv.empty_ugraph uri with
+ CicEnvironment.CheckedObj (cobj,_) -> cobj
+ | CicEnvironment.UncheckedObj uobj ->
+ raise (NotWellTyped "Reference to an unchecked constructor")
+ in
+ match cobj with
+ C.InductiveDefinition (dl,_,_,_) ->
+ let (_,_,_,cl) = List.nth dl i in
+ let (_,ty) = List.nth cl (j-1) in
+ ty
+ | _ -> raise (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri))
+;;
+
+(* type_of_aux' is just another name (with a different scope) for type_of_aux *)
+let rec type_of_aux' subterms_to_types metasenv context t expectedty =
+ (* Coscoy's double type-inference algorithm *)
+ (* It computes the inner-types of every subterm of [t], *)
+ (* even when they are not needed to compute the types *)
+ (* of other terms. *)
+ let rec type_of_aux context t expectedty =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module S = CicSubstitution in
+ let module U = UriManager in
+ let synthesized =
+ match t with
+ C.Rel n ->
+ (try
+ match List.nth context (n - 1) with
+ Some (_,C.Decl t) -> S.lift n t
+ | Some (_,C.Def (_,Some ty)) -> S.lift n ty
+ | Some (_,C.Def (bo,None)) ->
+ type_of_aux context (S.lift n bo) expectedty
+ | None -> raise RelToHiddenHypothesis
+ with
+ _ -> raise (NotWellTyped "Not a close term")
+ )
+ | C.Var (uri,exp_named_subst) ->
+ visit_exp_named_subst context uri exp_named_subst ;
+ CicSubstitution.subst_vars exp_named_subst (type_of_variable uri)
+ | C.Meta (n,l) ->
+ (* Let's visit all the subterms that will not be visited later *)
+ let (_,canonical_context,_) = CicUtil.lookup_meta n metasenv in
+ let lifted_canonical_context =
+ let rec aux i =
+ function
+ [] -> []
+ | (Some (n,C.Decl t))::tl ->
+ (Some (n,C.Decl (S.subst_meta l (S.lift i t))))::(aux (i+1) tl)
+ | (Some (n,C.Def (t,None)))::tl ->
+ (Some (n,C.Def ((S.subst_meta l (S.lift i t)),None)))::
+ (aux (i+1) tl)
+ | None::tl -> None::(aux (i+1) tl)
+ | (Some (_,C.Def (_,Some _)))::_ -> assert false
+ in
+ aux 1 canonical_context
+ in
+ let _ =
+ List.iter2
+ (fun t ct ->
+ match t,ct with
+ _,None -> ()
+ | Some t,Some (_,C.Def (ct,_)) ->
+ let expected_type =
+ R.whd context
+ (xxx_type_of_aux' metasenv context ct)
+ in
+ (* Maybe I am a bit too paranoid, because *)
+ (* if the term is well-typed than t and ct *)
+ (* are convertible. Nevertheless, I compute *)
+ (* the expected type. *)
+ ignore (type_of_aux context t (Some expected_type))
+ | Some t,Some (_,C.Decl ct) ->
+ ignore (type_of_aux context t (Some ct))
+ | _,_ -> assert false (* the term is not well typed!!! *)
+ ) l lifted_canonical_context
+ in
+ let (_,canonical_context,ty) = CicUtil.lookup_meta n metasenv in
+ (* Checks suppressed *)
+ CicSubstitution.subst_meta l ty
+ | C.Sort (C.Type t) -> (* TASSI: CONSTRAINT *)
+ C.Sort (C.Type (CicUniv.fresh()))
+ | C.Sort _ -> C.Sort (C.Type (CicUniv.fresh())) (* TASSI: CONSTRAINT *)
+ | C.Implicit _ -> raise (Impossible 21)
+ | C.Cast (te,ty) ->
+ (* Let's visit all the subterms that will not be visited later *)
+ let _ = type_of_aux context te (Some (beta_reduce ty)) in
+ let _ = type_of_aux context ty None in
+ (* Checks suppressed *)
+ ty
+ | C.Prod (name,s,t) ->
+ let sort1 = type_of_aux context s None
+ and sort2 = type_of_aux ((Some (name,(C.Decl s)))::context) t None in
+ sort_of_prod context (name,s) (sort1,sort2)
+ | C.Lambda (n,s,t) ->
+ (* Let's visit all the subterms that will not be visited later *)
+ let _ = type_of_aux context s None in
+ let expected_target_type =
+ match expectedty with
+ None -> None
+ | Some expectedty' ->
+ let ty =
+ match R.whd context expectedty' with
+ C.Prod (_,_,expected_target_type) ->
+ beta_reduce expected_target_type
+ | _ -> assert false
+ in
+ Some ty
+ in
+ let type2 =
+ type_of_aux ((Some (n,(C.Decl s)))::context) t expected_target_type
+ in
+ (* Checks suppressed *)
+ C.Prod (n,s,type2)
+ | C.LetIn (n,s,t) ->
+(*CSC: What are the right expected types for the source and *)
+(*CSC: target of a LetIn? None used. *)
+ (* Let's visit all the subterms that will not be visited later *)
+ let ty = type_of_aux context s None in
+ let t_typ =
+ (* Checks suppressed *)
+ type_of_aux ((Some (n,(C.Def (s,Some ty))))::context) t None
+ in (* CicSubstitution.subst s t_typ *)
+ if does_not_occur 1 t_typ then
+ (* since [Rel 1] does not occur in typ, substituting any term *)
+ (* in place of [Rel 1] is equivalent to delifting once *)
+ CicSubstitution.subst (C.Implicit None) t_typ
+ else
+ C.LetIn (n,s,t_typ)
+ | C.Appl (he::tl) when List.length tl > 0 ->
+ (*
+ let expected_hetype =
+ (* Inefficient, the head is computed twice. But I know *)
+ (* of no other solution. *)
+ (beta_reduce
+ (R.whd context (xxx_type_of_aux' metasenv context he)))
+ in
+ let hetype = type_of_aux context he (Some expected_hetype) in
+ let tlbody_and_type =
+ let rec aux =
+ function
+ _,[] -> []
+ | C.Prod (n,s,t),he::tl ->
+ (he, type_of_aux context he (Some (beta_reduce s)))::
+ (aux (R.whd context (S.subst he t), tl))
+ | _ -> assert false
+ in
+ aux (expected_hetype, tl) *)
+ let hetype = R.whd context (type_of_aux context he None) in
+ let tlbody_and_type =
+ let rec aux =
+ function
+ _,[] -> []
+ | C.Prod (n,s,t),he::tl ->
+ (he, type_of_aux context he (Some (beta_reduce s)))::
+ (aux (R.whd context (S.subst he t), tl))
+ | _ -> assert false
+ in
+ aux (hetype, tl)
+ in
+ eat_prods context hetype tlbody_and_type
+ | C.Appl _ -> raise (NotWellTyped "Appl: no arguments")
+ | C.Const (uri,exp_named_subst) ->
+ visit_exp_named_subst context uri exp_named_subst ;
+ CicSubstitution.subst_vars exp_named_subst (type_of_constant uri)
+ | C.MutInd (uri,i,exp_named_subst) ->
+ visit_exp_named_subst context uri exp_named_subst ;
+ CicSubstitution.subst_vars exp_named_subst
+ (type_of_mutual_inductive_defs uri i)
+ | C.MutConstruct (uri,i,j,exp_named_subst) ->
+ visit_exp_named_subst context uri exp_named_subst ;
+ CicSubstitution.subst_vars exp_named_subst
+ (type_of_mutual_inductive_constr uri i j)
+ | C.MutCase (uri,i,outtype,term,pl) ->
+ let outsort = type_of_aux context outtype None in
+ let (need_dummy, k) =
+ let rec guess_args context t =
+ match CicReduction.whd context t with
+ C.Sort _ -> (true, 0)
+ | C.Prod (name, s, t) ->
+ let (b, n) = guess_args ((Some (name,(C.Decl s)))::context) t in
+ if n = 0 then
+ (* last prod before sort *)
+ match CicReduction.whd context s with
+ C.MutInd (uri',i',_) when U.eq uri' uri && i' = i ->
+ (false, 1)
+ | C.Appl ((C.MutInd (uri',i',_)) :: _)
+ when U.eq uri' uri && i' = i -> (false, 1)
+ | _ -> (true, 1)
+ else
+ (b, n + 1)
+ | _ -> raise (NotWellTyped "MutCase: outtype ill-formed")
+ in
+ let (b, k) = guess_args context outsort in
+ if not b then (b, k - 1) else (b, k)
+ in
+ let (parameters, arguments,exp_named_subst) =
+ let type_of_term =
+ xxx_type_of_aux' metasenv context term
+ in
+ match
+ R.whd context (type_of_aux context term
+ (Some (beta_reduce type_of_term)))
+ with
+ (*CSC manca il caso dei CAST *)
+ C.MutInd (uri',i',exp_named_subst) ->
+ (* Checks suppressed *)
+ [],[],exp_named_subst
+ | C.Appl (C.MutInd (uri',i',exp_named_subst) :: tl) ->
+ let params,args =
+ split tl (List.length tl - k)
+ in params,args,exp_named_subst
+ | _ ->
+ raise (NotWellTyped "MutCase: the term is not an inductive one")
+ in
+ (* Checks suppressed *)
+ (* Let's visit all the subterms that will not be visited later *)
+ let (cl,parsno) =
+ let obj,_ =
+ try
+ CicEnvironment.get_cooked_obj CicUniv.empty_ugraph uri
+ with Not_found -> assert false
+ in
+ match obj with
+ C.InductiveDefinition (tl,_,parsno,_) ->
+ let (_,_,_,cl) = List.nth tl i in (cl,parsno)
+ | _ ->
+ raise (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri))
+ in
+ let _ =
+ List.fold_left
+ (fun j (p,(_,c)) ->
+ let cons =
+ if parameters = [] then
+ (C.MutConstruct (uri,i,j,exp_named_subst))
+ else
+ (C.Appl (C.MutConstruct (uri,i,j,exp_named_subst)::parameters))
+ in
+ let expectedtype =
+ type_of_branch context parsno need_dummy outtype cons
+ (xxx_type_of_aux' metasenv context cons)
+ in
+ ignore (type_of_aux context p
+ (Some (beta_reduce expectedtype))) ;
+ j+1
+ ) 1 (List.combine pl cl)
+ in
+ if not need_dummy then
+ C.Appl ((outtype::arguments)@[term])
+ else if arguments = [] then
+ outtype
+ else
+ C.Appl (outtype::arguments)
+ | C.Fix (i,fl) ->
+ (* Let's visit all the subterms that will not be visited later *)
+ let context' =
+ List.rev
+ (List.map
+ (fun (n,_,ty,_) ->
+ let _ = type_of_aux context ty None in
+ (Some (C.Name n,(C.Decl ty)))
+ ) fl
+ ) @
+ context
+ in
+ let _ =
+ List.iter
+ (fun (_,_,ty,bo) ->
+ let expectedty =
+ beta_reduce (CicSubstitution.lift (List.length fl) ty)
+ in
+ ignore (type_of_aux context' bo (Some expectedty))
+ ) fl
+ in
+ (* Checks suppressed *)
+ let (_,_,ty,_) = List.nth fl i in
+ ty
+ | C.CoFix (i,fl) ->
+ (* Let's visit all the subterms that will not be visited later *)
+ let context' =
+ List.rev
+ (List.map
+ (fun (n,ty,_) ->
+ let _ = type_of_aux context ty None in
+ (Some (C.Name n,(C.Decl ty)))
+ ) fl
+ ) @
+ context
+ in
+ let _ =
+ List.iter
+ (fun (_,ty,bo) ->
+ let expectedty =
+ beta_reduce (CicSubstitution.lift (List.length fl) ty)
+ in
+ ignore (type_of_aux context' bo (Some expectedty))
+ ) fl
+ in
+ (* Checks suppressed *)
+ let (_,ty,_) = List.nth fl i in
+ ty
+ in
+ let synthesized' = beta_reduce synthesized in
+ let types,res =
+ match expectedty with
+ None ->
+ (* No expected type *)
+ {synthesized = synthesized' ; expected = None}, synthesized
+ | Some ty when xxx_syntactic_equality synthesized' ty ->
+ (* The expected type is synthactically equal to *)
+ (* the synthesized type. Let's forget it. *)
+ {synthesized = synthesized' ; expected = None}, synthesized
+ | Some expectedty' ->
+ {synthesized = synthesized' ; expected = Some expectedty'},
+ expectedty'
+ in
+ assert (not (Cic.CicHash.mem subterms_to_types t));
+ Cic.CicHash.add subterms_to_types t types ;
+ res
+
+ and visit_exp_named_subst context uri exp_named_subst =
+ let uris_and_types =
+ let obj,_ =
+ try
+ CicEnvironment.get_cooked_obj CicUniv.empty_ugraph uri
+ with Not_found -> assert false
+ in
+ let params = CicUtil.params_of_obj obj in
+ List.map
+ (function uri ->
+ let obj,_ =
+ try
+ CicEnvironment.get_cooked_obj CicUniv.empty_ugraph uri
+ with Not_found -> assert false
+ in
+ match obj with
+ Cic.Variable (_,None,ty,_,_) -> uri,ty
+ | _ -> assert false (* the theorem is well-typed *)
+ ) params
+ in
+ let rec check uris_and_types subst =
+ match uris_and_types,subst with
+ _,[] -> []
+ | (uri,ty)::tytl,(uri',t)::substtl when uri = uri' ->
+ ignore (type_of_aux context t (Some ty)) ;
+ let tytl' =
+ List.map
+ (function uri,t' -> uri,(CicSubstitution.subst_vars [uri',t] t')) tytl
+ in
+ check tytl' substtl
+ | _,_ -> assert false (* the theorem is well-typed *)
+ in
+ check uris_and_types exp_named_subst
+
+ and sort_of_prod context (name,s) (t1, t2) =
+ let module C = Cic in
+ let t1' = CicReduction.whd context t1 in
+ let t2' = CicReduction.whd ((Some (name,C.Decl s))::context) t2 in
+ match (t1', t2') with
+ (C.Sort _, C.Sort s2)
+ when (s2 = C.Prop or s2 = C.Set or s2 = C.CProp) ->
+ (* different from Coq manual!!! *)
+ C.Sort s2
+ | (C.Sort (C.Type t1), C.Sort (C.Type t2)) ->
+ C.Sort (C.Type (CicUniv.fresh()))
+ | (C.Sort _,C.Sort (C.Type t1)) ->
+ (* TASSI: CONSRTAINTS: the same in cictypechecker,cicrefine *)
+ C.Sort (C.Type t1) (* c'e' bisogno di un fresh? *)
+ | (C.Meta _, C.Sort _) -> t2'
+ | (C.Meta _, (C.Meta (_,_) as t))
+ | (C.Sort _, (C.Meta (_,_) as t)) when CicUtil.is_closed t ->
+ t2'
+ | (_,_) ->
+ raise
+ (NotWellTyped
+ ("Prod: sort1= " ^ CicPp.ppterm t1' ^ " ; sort2= " ^ CicPp.ppterm t2'))
+
+ and eat_prods context hetype =
+ (*CSC: siamo sicuri che le are_convertible non lavorino con termini non *)
+ (*CSC: cucinati *)
+ function
+ [] -> hetype
+ | (hete, hety)::tl ->
+ (match (CicReduction.whd context hetype) with
+ Cic.Prod (n,s,t) ->
+ (* Checks suppressed *)
+ eat_prods context (CicSubstitution.subst hete t) tl
+ | _ -> raise (NotWellTyped "Appl: wrong Prod-type")
+ )
+
+and type_of_branch context argsno need_dummy outtype term constype =
+ let module C = Cic in
+ let module R = CicReduction in
+ match R.whd context constype with
+ C.MutInd (_,_,_) ->
+ if need_dummy then
+ outtype
+ else
+ C.Appl [outtype ; term]
+ | C.Appl (C.MutInd (_,_,_)::tl) ->
+ let (_,arguments) = split tl argsno
+ in
+ if need_dummy && arguments = [] then
+ outtype
+ else
+ C.Appl (outtype::arguments@(if need_dummy then [] else [term]))
+ | C.Prod (name,so,de) ->
+ let term' =
+ match CicSubstitution.lift 1 term with
+ C.Appl l -> C.Appl (l@[C.Rel 1])
+ | t -> C.Appl [t ; C.Rel 1]
+ in
+ C.Prod (C.Anonymous,so,type_of_branch
+ ((Some (name,(C.Decl so)))::context) argsno need_dummy
+ (CicSubstitution.lift 1 outtype) term' de)
+ | _ -> raise (Impossible 20)
+
+ in
+ type_of_aux context t expectedty
+;;
+
+let double_type_of metasenv context t expectedty =
+ let subterms_to_types = Cic.CicHash.create 503 in
+ ignore (type_of_aux' subterms_to_types metasenv context t expectedty) ;
+ subterms_to_types
+;;
diff --git a/helm/ocaml/cic_acic/doubleTypeInference.mli b/helm/ocaml/cic_acic/doubleTypeInference.mli
new file mode 100644
index 000000000..892e09f8a
--- /dev/null
+++ b/helm/ocaml/cic_acic/doubleTypeInference.mli
@@ -0,0 +1,25 @@
+exception Impossible of int
+exception NotWellTyped of string
+exception WrongUriToConstant of string
+exception WrongUriToVariable of string
+exception WrongUriToMutualInductiveDefinitions of string
+exception ListTooShort
+exception RelToHiddenHypothesis
+
+val syntactic_equality_add_time: float ref
+val type_of_aux'_add_time: float ref
+val number_new_type_of_aux'_double_work: int ref
+val number_new_type_of_aux': int ref
+val number_new_type_of_aux'_prop: int ref
+
+type types = {synthesized : Cic.term ; expected : Cic.term option};;
+
+val double_type_of :
+ Cic.metasenv -> Cic.context -> Cic.term -> Cic.term option ->
+ types Cic.CicHash.t
+
+(** Auxiliary functions **)
+
+(* does_not_occur n te *)
+(* returns [true] if [Rel n] does not occur in [te] *)
+val does_not_occur : int -> Cic.term -> bool
diff --git a/helm/ocaml/cic_acic/eta_fixing.ml b/helm/ocaml/cic_acic/eta_fixing.ml
new file mode 100644
index 000000000..22d26e1bd
--- /dev/null
+++ b/helm/ocaml/cic_acic/eta_fixing.ml
@@ -0,0 +1,313 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+exception ReferenceToNonVariable;;
+
+let prerr_endline _ = ();;
+
+(*
+let rec fix_lambdas_wrt_type ty te =
+ let module C = Cic in
+ let module S = CicSubstitution in
+(* prerr_endline ("entering fix_lambdas: type=" ^ CicPp.ppterm ty ^ "term=" ^ CicPp.ppterm te); *)
+ match ty with
+ C.Prod (_,_,ty') ->
+ (match CicReduction.whd [] te with
+ C.Lambda (n,s,te') ->
+ C.Lambda (n,s,fix_lambdas_wrt_type ty' te')
+ | t ->
+ let rec get_sources =
+ function
+ C.Prod (_,s,ty) -> s::(get_sources ty)
+ | _ -> [] in
+ let sources = get_sources ty in
+ let no_sources = List.length sources in
+ let rec mk_rels n shift =
+ if n = 0 then []
+ else (C.Rel (n + shift))::(mk_rels (n - 1) shift) in
+ let t' = S.lift no_sources t in
+ let t2 =
+ match t' with
+ C.Appl l ->
+ C.LetIn
+ (C.Name "w",t',C.Appl ((C.Rel 1)::(mk_rels no_sources 1)))
+ | _ ->
+ C.Appl (t'::(mk_rels no_sources 0)) in
+ List.fold_right
+ (fun source t -> C.Lambda (C.Name "y",source,t))
+ sources t2)
+ | _ -> te
+;; *)
+
+let rec fix_lambdas_wrt_type ty te =
+ let module C = Cic in
+ let module S = CicSubstitution in
+(* prerr_endline ("entering fix_lambdas: type=" ^ CicPp.ppterm ty ^ "term=" ^ CicPp.ppterm te); *)
+ match ty,te with
+ C.Prod (_,_,ty'), C.Lambda (n,s,te') ->
+ C.Lambda (n,s,fix_lambdas_wrt_type ty' te')
+ | C.Prod (_,s,ty'), t ->
+ let rec get_sources =
+ function
+ C.Prod (_,s,ty) -> s::(get_sources ty)
+ | _ -> [] in
+ let sources = get_sources ty in
+ let no_sources = List.length sources in
+ let rec mk_rels n shift =
+ if n = 0 then []
+ else (C.Rel (n + shift))::(mk_rels (n - 1) shift) in
+ let t' = S.lift no_sources t in
+ let t2 =
+ match t' with
+ C.Appl l ->
+ C.LetIn (C.Name "w",t',C.Appl ((C.Rel 1)::(mk_rels no_sources 1)))
+ | _ -> C.Appl (t'::(mk_rels no_sources 0)) in
+ List.fold_right
+ (fun source t -> C.Lambda (C.Name "y",CicReduction.whd [] source,t)) sources t2
+ | _, _ -> te
+;;
+
+(*
+let rec fix_lambdas_wrt_type ty te =
+ let module C = Cic in
+ let module S = CicSubstitution in
+(* prerr_endline ("entering fix_lambdas: type=" ^ CicPp.ppterm ty ^ "term=" ^ CicPp.ppterm te); *)
+ match ty,te with
+ C.Prod (_,_,ty'), C.Lambda (n,s,te') ->
+ C.Lambda (n,s,fix_lambdas_wrt_type ty' te')
+ | C.Prod (_,s,ty'), ((C.Appl (C.Const _ ::_)) as t) ->
+ (* const have a fixed arity *)
+ (* prerr_endline ("******** fl - eta expansion 0: type=" ^ CicPp.ppterm ty ^ "term=" ^ CicPp.ppterm te); *)
+ let t' = S.lift 1 t in
+ C.Lambda (C.Name "x",s,
+ C.LetIn
+ (C.Name "H", fix_lambdas_wrt_type ty' t',
+ C.Appl [C.Rel 1;C.Rel 2]))
+ | C.Prod (_,s,ty'), C.Appl l ->
+ (* prerr_endline ("******** fl - eta expansion 1: type=" ^ CicPp.ppterm ty ^ "term=" ^ CicPp.ppterm te); *)
+ let l' = List.map (S.lift 1) l in
+ C.Lambda (C.Name "x",s,
+ fix_lambdas_wrt_type ty' (C.Appl (l'@[C.Rel 1])))
+ | C.Prod (_,s,ty'), _ ->
+ (* prerr_endline ("******** fl - eta expansion 2: type=" ^ CicPp.ppterm ty ^ "term=" ^ CicPp.ppterm te); *)
+ flush stderr ;
+ let te' = S.lift 1 te in
+ C.Lambda (C.Name "x",s,
+ fix_lambdas_wrt_type ty' (C.Appl [te';C.Rel 1]))
+ | _, _ -> te
+;;*)
+
+let fix_according_to_type ty hd tl =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ let rec count_prods =
+ function
+ C.Prod (_,_,t) -> 1 + (count_prods t)
+ | _ -> 0 in
+ let expected_arity = count_prods ty in
+ let rec aux n ty tl res =
+ if n = 0 then
+ (match tl with
+ [] ->
+ (match res with
+ [] -> assert false
+ | [res] -> res
+ | _ -> C.Appl res)
+ | _ ->
+ match res with
+ [] -> assert false
+ | [a] -> C.Appl (a::tl)
+ | _ ->
+ (* prerr_endline ("******* too many args: type=" ^ CicPp.ppterm ty ^ "term=" ^ CicPp.ppterm (C.Appl res)); *)
+ C.LetIn
+ (C.Name "H",
+ C.Appl res, C.Appl (C.Rel 1::(List.map (S.lift 1) tl))))
+ else
+ let name,source,target =
+ (match ty with
+ C.Prod (C.Name _ as n,s,t) -> n,s,t
+ | C.Prod (C.Anonymous, s,t) -> C.Name "z",s,t
+ | _ -> (* prods number may only increase for substitution *)
+ assert false) in
+ match tl with
+ [] ->
+ (* prerr_endline ("******* too few args: type=" ^ CicPp.ppterm ty ^ "term=" ^ CicPp.ppterm (C.Appl res)); *)
+ let res' = List.map (S.lift 1) res in
+ C.Lambda
+ (name, source, aux (n-1) target [] (res'@[C.Rel 1]))
+ | hd::tl' ->
+ let hd' = fix_lambdas_wrt_type source hd in
+ (* (prerr_endline ("++++++prima :" ^(CicPp.ppterm hd));
+ prerr_endline ("++++++dopo :" ^(CicPp.ppterm hd'))); *)
+ aux (n-1) (S.subst hd' target) tl' (res@[hd']) in
+ aux expected_arity ty tl [hd]
+;;
+
+let eta_fix metasenv context t =
+ let rec eta_fix' context t =
+ (* prerr_endline ("entering aux with: term=" ^ CicPp.ppterm t);
+ flush stderr ; *)
+ let module C = Cic in
+ let module S = CicSubstitution in
+ match t with
+ C.Rel n -> C.Rel n
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' = fix_exp_named_subst context exp_named_subst in
+ C.Var (uri,exp_named_subst')
+ | C.Meta (n,l) ->
+ let (_,canonical_context,_) = CicUtil.lookup_meta n metasenv in
+ let l' =
+ List.map2
+ (fun ct t ->
+ match (ct, t) with
+ None, _ -> None
+ | _, Some t -> Some (eta_fix' context t)
+ | Some _, None -> assert false (* due to typing rules *))
+ canonical_context l
+ in
+ C.Meta (n,l')
+ | C.Sort s -> C.Sort s
+ | C.Implicit _ as t -> t
+ | C.Cast (v,t) -> C.Cast (eta_fix' context v, eta_fix' context t)
+ | C.Prod (n,s,t) ->
+ C.Prod
+ (n, eta_fix' context s, eta_fix' ((Some (n,(C.Decl s)))::context) t)
+ | C.Lambda (n,s,t) ->
+ C.Lambda
+ (n, eta_fix' context s, eta_fix' ((Some (n,(C.Decl s)))::context) t)
+ | C.LetIn (n,s,t) ->
+ C.LetIn
+ (n,eta_fix' context s,eta_fix' ((Some (n,(C.Def (s,None))))::context) t)
+ | C.Appl l ->
+ let l' = List.map (eta_fix' context) l
+ in
+ (match l' with
+ [] -> assert false
+ | he::tl ->
+ let ty,_ =
+ CicTypeChecker.type_of_aux' metasenv context he
+ CicUniv.empty_ugraph
+ in
+ fix_according_to_type ty he tl
+(*
+ C.Const(uri,exp_named_subst)::l'' ->
+ let constant_type =
+ (match CicEnvironment.get_obj uri with
+ C.Constant (_,_,ty,_) -> ty
+ | C.Variable _ -> raise ReferenceToVariable
+ | C.CurrentProof (_,_,_,_,params) -> raise ReferenceToCurrentProof
+ | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+ ) in
+ fix_according_to_type
+ constant_type (C.Const(uri,exp_named_subst)) l''
+ | _ -> C.Appl l' *))
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst' = fix_exp_named_subst context exp_named_subst in
+ C.Const (uri,exp_named_subst')
+ | C.MutInd (uri,tyno,exp_named_subst) ->
+ let exp_named_subst' = fix_exp_named_subst context exp_named_subst in
+ C.MutInd (uri, tyno, exp_named_subst')
+ | C.MutConstruct (uri,tyno,consno,exp_named_subst) ->
+ let exp_named_subst' = fix_exp_named_subst context exp_named_subst in
+ C.MutConstruct (uri, tyno, consno, exp_named_subst')
+ | C.MutCase (uri, tyno, outty, term, patterns) ->
+ let outty' = eta_fix' context outty in
+ let term' = eta_fix' context term in
+ let patterns' = List.map (eta_fix' context) patterns in
+ let inductive_types,noparams =
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ (match o with
+ Cic.Constant _ -> assert false
+ | Cic.Variable _ -> assert false
+ | Cic.CurrentProof _ -> assert false
+ | Cic.InductiveDefinition (l,_,n,_) -> l,n
+ ) in
+ let (_,_,_,constructors) = List.nth inductive_types tyno in
+ let constructor_types =
+ let rec clean_up t =
+ function
+ [] -> t
+ | a::tl ->
+ (match t with
+ Cic.Prod (_,_,t') -> clean_up (S.subst a t') tl
+ | _ -> assert false) in
+ if noparams = 0 then
+ List.map (fun (_,t) -> t) constructors
+ else
+ let term_type,_ =
+ CicTypeChecker.type_of_aux' metasenv context term
+ CicUniv.empty_ugraph
+ in
+ (match term_type with
+ C.Appl (hd::params) ->
+ let rec first_n n l =
+ if n = 0 then []
+ else
+ (match l with
+ a::tl -> a::(first_n (n-1) tl)
+ | _ -> assert false) in
+ List.map
+ (fun (_,t) ->
+ clean_up t (first_n noparams params)) constructors
+ | _ -> prerr_endline ("QUA"); assert false) in
+ let patterns2 =
+ List.map2 fix_lambdas_wrt_type
+ constructor_types patterns' in
+ C.MutCase (uri, tyno, outty',term',patterns2)
+ | C.Fix (funno, funs) ->
+ let fun_types =
+ List.map (fun (n,_,ty,_) -> Some (C.Name n,(Cic.Decl ty))) funs in
+ C.Fix (funno,
+ List.map
+ (fun (name, no, ty, bo) ->
+ (name, no, eta_fix' context ty, eta_fix' (fun_types@context) bo))
+ funs)
+ | C.CoFix (funno, funs) ->
+ let fun_types =
+ List.map (fun (n,ty,_) -> Some (C.Name n,(Cic.Decl ty))) funs in
+ C.CoFix (funno,
+ List.map
+ (fun (name, ty, bo) ->
+ (name, eta_fix' context ty, eta_fix' (fun_types@context) bo)) funs)
+ and fix_exp_named_subst context exp_named_subst =
+ List.rev
+ (List.fold_left
+ (fun newsubst (uri,t) ->
+ let t' = eta_fix' context t in
+ let ty =
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ Cic.Variable (_,_,ty,_,_) ->
+ CicSubstitution.subst_vars newsubst ty
+ | _ -> raise ReferenceToNonVariable
+ in
+ let t'' = fix_according_to_type ty t' [] in
+ (uri,t'')::newsubst
+ ) [] exp_named_subst)
+ in
+ eta_fix' context t
+;;
diff --git a/helm/ocaml/cic_acic/eta_fixing.mli b/helm/ocaml/cic_acic/eta_fixing.mli
new file mode 100644
index 000000000..c6c68119d
--- /dev/null
+++ b/helm/ocaml/cic_acic/eta_fixing.mli
@@ -0,0 +1,28 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val eta_fix : Cic.metasenv -> Cic.context -> Cic.term -> Cic.term
+
+
diff --git a/helm/ocaml/cic_disambiguation/.depend b/helm/ocaml/cic_disambiguation/.depend
new file mode 100644
index 000000000..ca4124461
--- /dev/null
+++ b/helm/ocaml/cic_disambiguation/.depend
@@ -0,0 +1,12 @@
+disambiguateChoices.cmi: disambiguateTypes.cmi
+disambiguate.cmi: disambiguateTypes.cmi
+disambiguateTypes.cmo: disambiguateTypes.cmi
+disambiguateTypes.cmx: disambiguateTypes.cmi
+disambiguateChoices.cmo: disambiguateTypes.cmi disambiguateChoices.cmi
+disambiguateChoices.cmx: disambiguateTypes.cmx disambiguateChoices.cmi
+disambiguate.cmo: disambiguateTypes.cmi disambiguateChoices.cmi \
+ disambiguate.cmi
+disambiguate.cmx: disambiguateTypes.cmx disambiguateChoices.cmx \
+ disambiguate.cmi
+number_notation.cmo: disambiguateTypes.cmi disambiguateChoices.cmi
+number_notation.cmx: disambiguateTypes.cmx disambiguateChoices.cmx
diff --git a/helm/ocaml/cic_disambiguation/Makefile b/helm/ocaml/cic_disambiguation/Makefile
new file mode 100644
index 000000000..729590da5
--- /dev/null
+++ b/helm/ocaml/cic_disambiguation/Makefile
@@ -0,0 +1,27 @@
+
+PACKAGE = cic_disambiguation
+NOTATIONS = number
+INTERFACE_FILES = \
+ disambiguateTypes.mli \
+ disambiguateChoices.mli \
+ disambiguate.mli
+IMPLEMENTATION_FILES = \
+ $(patsubst %.mli, %.ml, $(INTERFACE_FILES)) \
+ $(patsubst %,%_notation.ml,$(NOTATIONS))
+
+all:
+
+clean:
+distclean:
+ rm -f macro_table.dump
+
+include ../Makefile.common
+OCAMLARCHIVEOPTIONS += -linkall
+
+disambiguateTypes.cmi: disambiguateTypes.mli
+ $(OCAMLC) -c -rectypes $<
+disambiguateTypes.cmo: disambiguateTypes.ml disambiguateTypes.cmi
+ $(OCAMLC) -c -rectypes $<
+disambiguateTypes.cmx: disambiguateTypes.ml disambiguateTypes.cmi
+ $(OCAMLOPT) -c -rectypes $<
+
diff --git a/helm/ocaml/cic_disambiguation/disambiguate.ml b/helm/ocaml/cic_disambiguation/disambiguate.ml
new file mode 100644
index 000000000..667c50770
--- /dev/null
+++ b/helm/ocaml/cic_disambiguation/disambiguate.ml
@@ -0,0 +1,1009 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+open DisambiguateTypes
+open UriManager
+
+(* the integer is an offset to be added to each location *)
+exception NoWellTypedInterpretation of
+ int * (Token.flocation option * string Lazy.t) list
+exception PathNotWellFormed
+
+ (** raised when an environment is not enough informative to decide *)
+exception Try_again of string Lazy.t
+
+type aliases = bool * DisambiguateTypes.environment
+
+let debug = false
+let debug_print s = if debug then prerr_endline (Lazy.force s) else ()
+
+(*
+ (** print benchmark information *)
+let benchmark = true
+let max_refinements = ref 0 (* benchmarking is not thread safe *)
+let actual_refinements = ref 0
+let domain_size = ref 0
+let choices_avg = ref 0.
+*)
+
+let descr_of_domain_item = function
+ | Id s -> s
+ | Symbol (s, _) -> s
+ | Num i -> string_of_int i
+
+type 'a test_result =
+ | Ok of 'a * Cic.metasenv
+ | Ko of Token.flocation option * string Lazy.t
+ | Uncertain of Token.flocation option * string Lazy.t
+
+let refine_term metasenv context uri term ugraph ~localization_tbl =
+(* if benchmark then incr actual_refinements; *)
+ assert (uri=None);
+ debug_print (lazy (sprintf "TEST_INTERPRETATION: %s" (CicPp.ppterm term)));
+ try
+ let term', _, metasenv',ugraph1 =
+ CicRefine.type_of_aux' metasenv context term ugraph ~localization_tbl in
+ (Ok (term', metasenv')),ugraph1
+ with
+ exn ->
+ let rec process_exn loc =
+ function
+ HExtlib.Localized (loc,exn) -> process_exn (Some loc) exn
+ | CicRefine.Uncertain msg ->
+ debug_print (lazy ("UNCERTAIN!!! [" ^ (Lazy.force msg) ^ "] " ^ CicPp.ppterm term)) ;
+ Uncertain (loc,msg),ugraph
+ | CicRefine.RefineFailure msg ->
+ debug_print (lazy (sprintf "PRUNED!!!\nterm%s\nmessage:%s"
+ (CicPp.ppterm term) (Lazy.force msg)));
+ Ko (loc,msg),ugraph
+ | exn -> raise exn
+ in
+ process_exn None exn
+
+let refine_obj metasenv context uri obj ugraph ~localization_tbl =
+ assert (context = []);
+ debug_print (lazy (sprintf "TEST_INTERPRETATION: %s" (CicPp.ppobj obj))) ;
+ try
+ let obj', metasenv,ugraph =
+ CicRefine.typecheck metasenv uri obj ~localization_tbl
+ in
+ (Ok (obj', metasenv)),ugraph
+ with
+ exn ->
+ let rec process_exn loc =
+ function
+ HExtlib.Localized (loc,exn) -> process_exn (Some loc) exn
+ | CicRefine.Uncertain msg ->
+ debug_print (lazy ("UNCERTAIN!!! [" ^ (Lazy.force msg) ^ "] " ^ CicPp.ppobj obj)) ;
+ Uncertain (loc,msg),ugraph
+ | CicRefine.RefineFailure msg ->
+ debug_print (lazy (sprintf "PRUNED!!!\nterm%s\nmessage:%s"
+ (CicPp.ppobj obj) (Lazy.force msg))) ;
+ Ko (loc,msg),ugraph
+ | exn -> raise exn
+ in
+ process_exn None exn
+
+let resolve (env: codomain_item Environment.t) (item: domain_item) ?(num = "") ?(args = []) () =
+ try
+ snd (Environment.find item env) env num args
+ with Not_found ->
+ failwith ("Domain item not found: " ^
+ (DisambiguateTypes.string_of_domain_item item))
+
+ (* TODO move it to Cic *)
+let find_in_context name context =
+ let rec aux acc = function
+ | [] -> raise Not_found
+ | Cic.Name hd :: tl when hd = name -> acc
+ | _ :: tl -> aux (acc + 1) tl
+ in
+ aux 1 context
+
+let interpretate_term ~(context: Cic.name list) ~env ~uri ~is_path ast
+ ~localization_tbl
+=
+ assert (uri = None);
+ let rec aux ~localize loc (context: Cic.name list) = function
+ | CicNotationPt.AttributedTerm (`Loc loc, term) ->
+ let res = aux ~localize loc context term in
+ if localize then Cic.CicHash.add localization_tbl res loc;
+ res
+ | CicNotationPt.AttributedTerm (_, term) -> aux ~localize loc context term
+ | CicNotationPt.Appl (CicNotationPt.Symbol (symb, i) :: args) ->
+ let cic_args = List.map (aux ~localize loc context) args in
+ resolve env (Symbol (symb, i)) ~args:cic_args ()
+ | CicNotationPt.Appl terms ->
+ Cic.Appl (List.map (aux ~localize loc context) terms)
+ | CicNotationPt.Binder (binder_kind, (var, typ), body) ->
+ let cic_type = aux_option ~localize loc context (Some `Type) typ in
+ let cic_name = CicNotationUtil.cic_name_of_name var in
+ let cic_body = aux ~localize loc (cic_name :: context) body in
+ (match binder_kind with
+ | `Lambda -> Cic.Lambda (cic_name, cic_type, cic_body)
+ | `Pi
+ | `Forall -> Cic.Prod (cic_name, cic_type, cic_body)
+ | `Exists ->
+ resolve env (Symbol ("exists", 0))
+ ~args:[ cic_type; Cic.Lambda (cic_name, cic_type, cic_body) ] ())
+ | CicNotationPt.Case (term, indty_ident, outtype, branches) ->
+ let cic_term = aux ~localize loc context term in
+ let cic_outtype = aux_option ~localize loc context None outtype in
+ let do_branch ((head, _, args), term) =
+ let rec do_branch' context = function
+ | [] -> aux ~localize loc context term
+ | (name, typ) :: tl ->
+ let cic_name = CicNotationUtil.cic_name_of_name name in
+ let cic_body = do_branch' (cic_name :: context) tl in
+ let typ =
+ match typ with
+ | None -> Cic.Implicit (Some `Type)
+ | Some typ -> aux ~localize loc context typ
+ in
+ Cic.Lambda (cic_name, typ, cic_body)
+ in
+ do_branch' context args
+ in
+ let (indtype_uri, indtype_no) =
+ match indty_ident with
+ | Some (indty_ident, _) ->
+ (match resolve env (Id indty_ident) () with
+ | Cic.MutInd (uri, tyno, _) -> (uri, tyno)
+ | Cic.Implicit _ ->
+ raise (Try_again (lazy "The type of the term to be matched
+ is still unknown"))
+ | _ ->
+ raise (Invalid_choice (lazy "The type of the term to be matched is not (co)inductive!")))
+ | None ->
+ let fst_constructor =
+ match branches with
+ | ((head, _, _), _) :: _ -> head
+ | [] -> raise (Invalid_choice (lazy "The type of the term to be matched is an inductive type without constructors that cannot be determined"))
+ in
+ (match resolve env (Id fst_constructor) () with
+ | Cic.MutConstruct (indtype_uri, indtype_no, _, _) ->
+ (indtype_uri, indtype_no)
+ | Cic.Implicit _ ->
+ raise (Try_again (lazy "The type of the term to be matched
+ is still unknown"))
+ | _ ->
+ raise (Invalid_choice (lazy "The type of the term to be matched is not (co)inductive!")))
+ in
+ Cic.MutCase (indtype_uri, indtype_no, cic_outtype, cic_term,
+ (List.map do_branch branches))
+ | CicNotationPt.Cast (t1, t2) ->
+ let cic_t1 = aux ~localize loc context t1 in
+ let cic_t2 = aux ~localize loc context t2 in
+ Cic.Cast (cic_t1, cic_t2)
+ | CicNotationPt.LetIn ((name, typ), def, body) ->
+ let cic_def = aux ~localize loc context def in
+ let cic_name = CicNotationUtil.cic_name_of_name name in
+ let cic_def =
+ match typ with
+ | None -> cic_def
+ | Some t -> Cic.Cast (cic_def, aux ~localize loc context t)
+ in
+ let cic_body = aux ~localize loc (cic_name :: context) body in
+ Cic.LetIn (cic_name, cic_def, cic_body)
+ | CicNotationPt.LetRec (kind, defs, body) ->
+ let context' =
+ List.fold_left
+ (fun acc ((name, _), _, _) ->
+ CicNotationUtil.cic_name_of_name name :: acc)
+ context defs
+ in
+ let cic_body =
+ let unlocalized_body = aux ~localize:false loc context' body in
+ match unlocalized_body with
+ Cic.Rel 1 -> `AvoidLetInNoAppl
+ | Cic.Appl (Cic.Rel 1::l) ->
+ (try
+ let l' =
+ List.map
+ (function t ->
+ let t',subst,metasenv =
+ CicMetaSubst.delift_rels [] [] 1 t
+ in
+ assert (subst=[]);
+ assert (metasenv=[]);
+ t') l
+ in
+ (* We can avoid the LetIn. But maybe we need to recompute l'
+ so that it is localized *)
+ if localize then
+ match body with
+ CicNotationPt.AttributedTerm (_,CicNotationPt.Appl(_::l)) ->
+ let l' = List.map (aux ~localize loc context) l in
+ `AvoidLetIn l'
+ | _ -> assert false
+ else
+ `AvoidLetIn l'
+ with
+ CicMetaSubst.DeliftingARelWouldCaptureAFreeVariable ->
+ if localize then
+ `AddLetIn (aux ~localize loc context' body)
+ else
+ `AddLetIn unlocalized_body)
+ | _ ->
+ if localize then
+ `AddLetIn (aux ~localize loc context' body)
+ else
+ `AddLetIn unlocalized_body
+ in
+ let inductiveFuns =
+ List.map
+ (fun ((name, typ), body, decr_idx) ->
+ let cic_body = aux ~localize loc context' body in
+ let cic_type =
+ aux_option ~localize loc context (Some `Type) typ in
+ let name =
+ match CicNotationUtil.cic_name_of_name name with
+ | Cic.Anonymous ->
+ CicNotationPt.fail loc
+ "Recursive functions cannot be anonymous"
+ | Cic.Name name -> name
+ in
+ (name, decr_idx, cic_type, cic_body))
+ defs
+ in
+ let counter = ref ~-1 in
+ let build_term funs =
+ (* this is the body of the fold_right function below. Rationale: Fix
+ * and CoFix cases differs only in an additional index in the
+ * inductiveFun list, see Cic.term *)
+ match kind with
+ | `Inductive ->
+ (fun (var, _, _, _) cic ->
+ incr counter;
+ let fix = Cic.Fix (!counter,funs) in
+ match cic with
+ `Recipe (`AddLetIn cic) ->
+ `Term (Cic.LetIn (Cic.Name var, fix, cic))
+ | `Recipe (`AvoidLetIn l) -> `Term (Cic.Appl (fix::l))
+ | `Recipe `AvoidLetInNoAppl -> `Term fix
+ | `Term t -> `Term (Cic.LetIn (Cic.Name var, fix, t)))
+ | `CoInductive ->
+ let funs =
+ List.map (fun (name, _, typ, body) -> (name, typ, body)) funs
+ in
+ (fun (var, _, _, _) cic ->
+ incr counter;
+ let cofix = Cic.CoFix (!counter,funs) in
+ match cic with
+ `Recipe (`AddLetIn cic) ->
+ `Term (Cic.LetIn (Cic.Name var, cofix, cic))
+ | `Recipe (`AvoidLetIn l) -> `Term (Cic.Appl (cofix::l))
+ | `Recipe `AvoidLetInNoAppl -> `Term cofix
+ | `Term t -> `Term (Cic.LetIn (Cic.Name var, cofix, t)))
+ in
+ (match
+ List.fold_right (build_term inductiveFuns) inductiveFuns
+ (`Recipe cic_body)
+ with
+ `Recipe _ -> assert false
+ | `Term t -> t)
+ | CicNotationPt.Ident _
+ | CicNotationPt.Uri _ when is_path -> raise PathNotWellFormed
+ | CicNotationPt.Ident (name, subst)
+ | CicNotationPt.Uri (name, subst) as ast ->
+ let is_uri = function CicNotationPt.Uri _ -> true | _ -> false in
+ (try
+ if is_uri ast then raise Not_found;(* don't search the env for URIs *)
+ let index = find_in_context name context in
+ if subst <> None then
+ CicNotationPt.fail loc "Explicit substitutions not allowed here";
+ Cic.Rel index
+ with Not_found ->
+ let cic =
+ if is_uri ast then (* we have the URI, build the term out of it *)
+ try
+ CicUtil.term_of_uri (UriManager.uri_of_string name)
+ with UriManager.IllFormedUri _ ->
+ CicNotationPt.fail loc "Ill formed URI"
+ else
+ resolve env (Id name) ()
+ in
+ let mk_subst uris =
+ let ids_to_uris =
+ List.map (fun uri -> UriManager.name_of_uri uri, uri) uris
+ in
+ (match subst with
+ | Some subst ->
+ List.map
+ (fun (s, term) ->
+ (try
+ List.assoc s ids_to_uris, aux ~localize loc context term
+ with Not_found ->
+ raise (Invalid_choice (lazy "The provided explicit named substitution is trying to instantiate a named variable the object is not abstracted on"))))
+ subst
+ | None -> List.map (fun uri -> uri, Cic.Implicit None) uris)
+ in
+ (try
+ match cic with
+ | Cic.Const (uri, []) ->
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ let uris = CicUtil.params_of_obj o in
+ Cic.Const (uri, mk_subst uris)
+ | Cic.Var (uri, []) ->
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ let uris = CicUtil.params_of_obj o in
+ Cic.Var (uri, mk_subst uris)
+ | Cic.MutInd (uri, i, []) ->
+ (try
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ let uris = CicUtil.params_of_obj o in
+ Cic.MutInd (uri, i, mk_subst uris)
+ with
+ CicEnvironment.Object_not_found _ ->
+ (* if we are here it is probably the case that during the
+ definition of a mutual inductive type we have met an
+ occurrence of the type in one of its constructors.
+ However, the inductive type is not yet in the environment
+ *)
+ (*here the explicit_named_substituion is assumed to be of length 0 *)
+ Cic.MutInd (uri,i,[]))
+ | Cic.MutConstruct (uri, i, j, []) ->
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ let uris = CicUtil.params_of_obj o in
+ Cic.MutConstruct (uri, i, j, mk_subst uris)
+ | Cic.Meta _ | Cic.Implicit _ as t ->
+(*
+ debug_print (lazy (sprintf
+ "Warning: %s must be instantiated with _[%s] but we do not enforce it"
+ (CicPp.ppterm t)
+ (String.concat "; "
+ (List.map
+ (fun (s, term) -> s ^ " := " ^ CicNotationPtPp.pp_term term)
+ subst))));
+*)
+ t
+ | _ ->
+ raise (Invalid_choice (lazy "??? Can this happen?"))
+ with
+ CicEnvironment.CircularDependency _ ->
+ raise (Invalid_choice (lazy "Circular dependency in the environment"))))
+ | CicNotationPt.Implicit -> Cic.Implicit None
+ | CicNotationPt.UserInput -> Cic.Implicit (Some `Hole)
+ | CicNotationPt.Num (num, i) -> resolve env (Num i) ~num ()
+ | CicNotationPt.Meta (index, subst) ->
+ let cic_subst =
+ List.map
+ (function
+ None -> None
+ | Some term -> Some (aux ~localize loc context term))
+ subst
+ in
+ Cic.Meta (index, cic_subst)
+ | CicNotationPt.Sort `Prop -> Cic.Sort Cic.Prop
+ | CicNotationPt.Sort `Set -> Cic.Sort Cic.Set
+ | CicNotationPt.Sort (`Type u) -> Cic.Sort (Cic.Type u)
+ | CicNotationPt.Sort `CProp -> Cic.Sort Cic.CProp
+ | CicNotationPt.Symbol (symbol, instance) ->
+ resolve env (Symbol (symbol, instance)) ()
+ | _ -> assert false (* god bless Bologna *)
+ and aux_option ~localize loc (context: Cic.name list) annotation = function
+ | None -> Cic.Implicit annotation
+ | Some term -> aux ~localize loc context term
+ in
+ aux ~localize:true HExtlib.dummy_floc context ast
+
+let interpretate_path ~context path =
+ let localization_tbl = Cic.CicHash.create 23 in
+ (* here we are throwing away useful localization informations!!! *)
+ fst (
+ interpretate_term ~context ~env:Environment.empty ~uri:None ~is_path:true
+ path ~localization_tbl, localization_tbl)
+
+let interpretate_obj ~context ~env ~uri ~is_path obj ~localization_tbl =
+ assert (context = []);
+ assert (is_path = false);
+ let interpretate_term = interpretate_term ~localization_tbl in
+ match obj with
+ | CicNotationPt.Inductive (params,tyl) ->
+ let uri = match uri with Some uri -> uri | None -> assert false in
+ let context,params =
+ let context,res =
+ List.fold_left
+ (fun (context,res) (name,t) ->
+ Cic.Name name :: context,
+ (name, interpretate_term context env None false t)::res
+ ) ([],[]) params
+ in
+ context,List.rev res in
+ let add_params =
+ List.fold_right
+ (fun (name,ty) t -> Cic.Prod (Cic.Name name,ty,t)) params in
+ let name_to_uris =
+ snd (
+ List.fold_left
+ (*here the explicit_named_substituion is assumed to be of length 0 *)
+ (fun (i,res) (name,_,_,_) ->
+ i + 1,(name,name,Cic.MutInd (uri,i,[]))::res
+ ) (0,[]) tyl) in
+ let con_env = DisambiguateTypes.env_of_list name_to_uris env in
+ let tyl =
+ List.map
+ (fun (name,b,ty,cl) ->
+ let ty' = add_params (interpretate_term context env None false ty) in
+ let cl' =
+ List.map
+ (fun (name,ty) ->
+ let ty' =
+ add_params (interpretate_term context con_env None false ty)
+ in
+ name,ty'
+ ) cl
+ in
+ name,b,ty',cl'
+ ) tyl
+ in
+ Cic.InductiveDefinition (tyl,[],List.length params,[])
+ | CicNotationPt.Record (params,name,ty,fields) ->
+ let uri = match uri with Some uri -> uri | None -> assert false in
+ let context,params =
+ let context,res =
+ List.fold_left
+ (fun (context,res) (name,t) ->
+ (Cic.Name name :: context),
+ (name, interpretate_term context env None false t)::res
+ ) ([],[]) params
+ in
+ context,List.rev res in
+ let add_params =
+ List.fold_right
+ (fun (name,ty) t -> Cic.Prod (Cic.Name name,ty,t)) params in
+ let ty' = add_params (interpretate_term context env None false ty) in
+ let fields' =
+ snd (
+ List.fold_left
+ (fun (context,res) (name,ty,_coercion) ->
+ let context' = Cic.Name name :: context in
+ context',(name,interpretate_term context env None false ty)::res
+ ) (context,[]) fields) in
+ let concl =
+ (*here the explicit_named_substituion is assumed to be of length 0 *)
+ let mutind = Cic.MutInd (uri,0,[]) in
+ if params = [] then mutind
+ else
+ Cic.Appl
+ (mutind::CicUtil.mk_rels (List.length params) (List.length fields)) in
+ let con =
+ List.fold_left
+ (fun t (name,ty) -> Cic.Prod (Cic.Name name,ty,t))
+ concl fields' in
+ let con' = add_params con in
+ let tyl = [name,true,ty',["mk_" ^ name,con']] in
+ let field_names = List.map (fun (x,_,y) -> x,y) fields in
+ Cic.InductiveDefinition
+ (tyl,[],List.length params,[`Class (`Record field_names)])
+ | CicNotationPt.Theorem (flavour, name, ty, bo) ->
+ let attrs = [`Flavour flavour] in
+ let ty' = interpretate_term [] env None false ty in
+ (match bo with
+ None ->
+ Cic.CurrentProof (name,[],Cic.Implicit None,ty',[],attrs)
+ | Some bo ->
+ let bo' = Some (interpretate_term [] env None false bo) in
+ Cic.Constant (name,bo',ty',[],attrs))
+
+
+ (* e.g. [5;1;1;1;2;3;4;1;2] -> [2;1;4;3;5] *)
+let rev_uniq =
+ let module SortedItem =
+ struct
+ type t = DisambiguateTypes.domain_item
+ let compare = Pervasives.compare
+ end
+ in
+ let module Set = Set.Make (SortedItem) in
+ fun l ->
+ let rev_l = List.rev l in
+ let (_, uniq_rev_l) =
+ List.fold_left
+ (fun (members, rev_l) elt ->
+ if Set.mem elt members then
+ (members, rev_l)
+ else
+ Set.add elt members, elt :: rev_l)
+ (Set.empty, []) rev_l
+ in
+ List.rev uniq_rev_l
+
+(* "aux" keeps domain in reverse order and doesn't care about duplicates.
+ * Domain item more in deep in the list will be processed first.
+ *)
+let rec domain_rev_of_term ?(loc = HExtlib.dummy_floc) context = function
+ | CicNotationPt.AttributedTerm (`Loc loc, term) ->
+ domain_rev_of_term ~loc context term
+ | CicNotationPt.AttributedTerm (_, term) ->
+ domain_rev_of_term ~loc context term
+ | CicNotationPt.Appl terms ->
+ List.fold_left
+ (fun dom term -> domain_rev_of_term ~loc context term @ dom) [] terms
+ | CicNotationPt.Binder (kind, (var, typ), body) ->
+ let kind_dom =
+ match kind with
+ | `Exists -> [ Symbol ("exists", 0) ]
+ | _ -> []
+ in
+ let type_dom = domain_rev_of_term_option loc context typ in
+ let body_dom =
+ domain_rev_of_term ~loc
+ (CicNotationUtil.cic_name_of_name var :: context) body
+ in
+ body_dom @ type_dom @ kind_dom
+ | CicNotationPt.Case (term, indty_ident, outtype, branches) ->
+ let term_dom = domain_rev_of_term ~loc context term in
+ let outtype_dom = domain_rev_of_term_option loc context outtype in
+ let get_first_constructor = function
+ | [] -> []
+ | ((head, _, _), _) :: _ -> [ Id head ]
+ in
+ let do_branch ((head, _, args), term) =
+ let (term_context, args_domain) =
+ List.fold_left
+ (fun (cont, dom) (name, typ) ->
+ (CicNotationUtil.cic_name_of_name name :: cont,
+ (match typ with
+ | None -> dom
+ | Some typ -> domain_rev_of_term ~loc cont typ @ dom)))
+ (context, []) args
+ in
+ args_domain @ domain_rev_of_term ~loc term_context term
+ in
+ let branches_dom =
+ List.fold_left (fun dom branch -> do_branch branch @ dom) [] branches
+ in
+ branches_dom @ outtype_dom @ term_dom @
+ (match indty_ident with
+ | None -> get_first_constructor branches
+ | Some (ident, _) -> [ Id ident ])
+ | CicNotationPt.Cast (term, ty) ->
+ let term_dom = domain_rev_of_term ~loc context term in
+ let ty_dom = domain_rev_of_term ~loc context ty in
+ ty_dom @ term_dom
+ | CicNotationPt.LetIn ((var, typ), body, where) ->
+ let body_dom = domain_rev_of_term ~loc context body in
+ let type_dom = domain_rev_of_term_option loc context typ in
+ let where_dom =
+ domain_rev_of_term ~loc
+ (CicNotationUtil.cic_name_of_name var :: context) where
+ in
+ where_dom @ type_dom @ body_dom
+ | CicNotationPt.LetRec (kind, defs, where) ->
+ let context' =
+ List.fold_left
+ (fun acc ((var, typ), _, _) ->
+ CicNotationUtil.cic_name_of_name var :: acc)
+ context defs
+ in
+ let where_dom = domain_rev_of_term ~loc context' where in
+ let defs_dom =
+ List.fold_left
+ (fun dom ((_, typ), body, _) ->
+ domain_rev_of_term ~loc context' body @
+ domain_rev_of_term_option loc context typ)
+ [] defs
+ in
+ where_dom @ defs_dom
+ | CicNotationPt.Ident (name, subst) ->
+ (try
+ (* the next line can raise Not_found *)
+ ignore(find_in_context name context);
+ if subst <> None then
+ CicNotationPt.fail loc "Explicit substitutions not allowed here"
+ else
+ []
+ with Not_found ->
+ (match subst with
+ | None -> [Id name]
+ | Some subst ->
+ List.fold_left
+ (fun dom (_, term) ->
+ let dom' = domain_rev_of_term ~loc context term in
+ dom' @ dom)
+ [Id name] subst))
+ | CicNotationPt.Uri _ -> []
+ | CicNotationPt.Implicit -> []
+ | CicNotationPt.Num (num, i) -> [ Num i ]
+ | CicNotationPt.Meta (index, local_context) ->
+ List.fold_left
+ (fun dom term -> domain_rev_of_term_option loc context term @ dom) []
+ local_context
+ | CicNotationPt.Sort _ -> []
+ | CicNotationPt.Symbol (symbol, instance) -> [ Symbol (symbol, instance) ]
+ | CicNotationPt.UserInput
+ | CicNotationPt.Literal _
+ | CicNotationPt.Layout _
+ | CicNotationPt.Magic _
+ | CicNotationPt.Variable _ -> assert false
+
+and domain_rev_of_term_option loc context = function
+ | None -> []
+ | Some t -> domain_rev_of_term ~loc context t
+
+let domain_of_term ~context ast = rev_uniq (domain_rev_of_term context ast)
+
+let domain_of_obj ~context ast =
+ assert (context = []);
+ let domain_rev =
+ match ast with
+ | CicNotationPt.Theorem (_,_,ty,bo) ->
+ (match bo with
+ None -> []
+ | Some bo -> domain_rev_of_term [] bo) @
+ domain_of_term [] ty
+ | CicNotationPt.Inductive (params,tyl) ->
+ let dom =
+ List.flatten (
+ List.rev_map
+ (fun (_,_,ty,cl) ->
+ List.flatten (
+ List.rev_map
+ (fun (_,ty) -> domain_rev_of_term [] ty) cl) @
+ domain_rev_of_term [] ty) tyl) in
+ let dom =
+ List.fold_left
+ (fun dom (_,ty) ->
+ domain_rev_of_term [] ty @ dom
+ ) dom params
+ in
+ List.filter
+ (fun name ->
+ not ( List.exists (fun (name',_) -> name = Id name') params
+ || List.exists (fun (name',_,_,_) -> name = Id name') tyl)
+ ) dom
+ | CicNotationPt.Record (params,_,ty,fields) ->
+ let dom =
+ List.flatten
+ (List.rev_map (fun (_,ty,_) -> domain_rev_of_term [] ty) fields) in
+ let dom =
+ List.fold_left
+ (fun dom (_,ty) ->
+ domain_rev_of_term [] ty @ dom
+ ) (dom @ domain_rev_of_term [] ty) params
+ in
+ List.filter
+ (fun name->
+ not ( List.exists (fun (name',_) -> name = Id name') params
+ || List.exists (fun (name',_,_) -> name = Id name') fields)
+ ) dom
+ in
+ rev_uniq domain_rev
+
+ (* dom1 \ dom2 *)
+let domain_diff dom1 dom2 =
+(* let domain_diff = Domain.diff *)
+ let is_in_dom2 =
+ List.fold_left (fun pred elt -> (fun elt' -> elt' = elt || pred elt'))
+ (fun _ -> false) dom2
+ in
+ List.filter (fun elt -> not (is_in_dom2 elt)) dom1
+
+module type Disambiguator =
+sig
+ val disambiguate_term :
+ ?fresh_instances:bool ->
+ dbd:HMysql.dbd ->
+ context:Cic.context ->
+ metasenv:Cic.metasenv ->
+ ?initial_ugraph:CicUniv.universe_graph ->
+ aliases:DisambiguateTypes.environment ->(* previous interpretation status *)
+ universe:DisambiguateTypes.multiple_environment option ->
+ CicNotationPt.term ->
+ ((DisambiguateTypes.domain_item * DisambiguateTypes.codomain_item) list *
+ Cic.metasenv * (* new metasenv *)
+ Cic.term*
+ CicUniv.universe_graph) list * (* disambiguated term *)
+ bool
+
+ val disambiguate_obj :
+ ?fresh_instances:bool ->
+ dbd:HMysql.dbd ->
+ aliases:DisambiguateTypes.environment ->(* previous interpretation status *)
+ universe:DisambiguateTypes.multiple_environment option ->
+ uri:UriManager.uri option -> (* required only for inductive types *)
+ CicNotationPt.obj ->
+ ((DisambiguateTypes.domain_item * DisambiguateTypes.codomain_item) list *
+ Cic.metasenv * (* new metasenv *)
+ Cic.obj *
+ CicUniv.universe_graph) list * (* disambiguated obj *)
+ bool
+end
+
+module Make (C: Callbacks) =
+ struct
+ let choices_of_id dbd id =
+ let uris = Whelp.locate ~dbd id in
+ let uris =
+ match uris with
+ | [] ->
+ [(C.input_or_locate_uri
+ ~title:("URI matching \"" ^ id ^ "\" unknown.") ~id ())]
+ | [uri] -> [uri]
+ | _ ->
+ C.interactive_user_uri_choice ~selection_mode:`MULTIPLE
+ ~ok:"Try selected." ~enable_button_for_non_vars:true
+ ~title:"Ambiguous input." ~id
+ ~msg: ("Ambiguous input \"" ^ id ^
+ "\". Please, choose one or more interpretations:")
+ uris
+ in
+ List.map
+ (fun uri ->
+ (UriManager.string_of_uri uri,
+ let term =
+ try
+ CicUtil.term_of_uri uri
+ with exn ->
+ debug_print (lazy (UriManager.string_of_uri uri));
+ debug_print (lazy (Printexc.to_string exn));
+ assert false
+ in
+ fun _ _ _ -> term))
+ uris
+
+let refine_profiler = HExtlib.profile "disambiguate_thing.refine_thing"
+
+ let disambiguate_thing ~dbd ~context ~metasenv
+ ?(initial_ugraph = CicUniv.empty_ugraph) ~aliases ~universe
+ ~uri ~pp_thing ~domain_of_thing ~interpretate_thing ~refine_thing thing
+ =
+ debug_print (lazy "DISAMBIGUATE INPUT");
+ let disambiguate_context = (* cic context -> disambiguate context *)
+ List.map
+ (function None -> Cic.Anonymous | Some (name, _) -> name)
+ context
+ in
+ debug_print (lazy ("TERM IS: " ^ (pp_thing thing)));
+ let thing_dom = domain_of_thing ~context:disambiguate_context thing in
+ debug_print (lazy (sprintf "DISAMBIGUATION DOMAIN: %s"
+ (string_of_domain thing_dom)));
+(*
+ debug_print (lazy (sprintf "DISAMBIGUATION ENVIRONMENT: %s"
+ (DisambiguatePp.pp_environment aliases)));
+ debug_print (lazy (sprintf "DISAMBIGUATION UNIVERSE: %s"
+ (match universe with None -> "None" | Some _ -> "Some _")));
+*)
+ let current_dom =
+ Environment.fold (fun item _ dom -> item :: dom) aliases []
+ in
+ let todo_dom = domain_diff thing_dom current_dom in
+ (* (2) lookup function for any item (Id/Symbol/Num) *)
+ let lookup_choices =
+ fun item ->
+ let choices =
+ let lookup_in_library () =
+ match item with
+ | Id id -> choices_of_id dbd id
+ | Symbol (symb, _) ->
+ List.map DisambiguateChoices.mk_choice
+ (TermAcicContent.lookup_interpretations symb)
+ | Num instance ->
+ DisambiguateChoices.lookup_num_choices ()
+ in
+ match universe with
+ | None -> lookup_in_library ()
+ | Some e ->
+ (try
+ let item =
+ match item with
+ | Symbol (symb, _) -> Symbol (symb, 0)
+ | item -> item
+ in
+ Environment.find item e
+ with Not_found -> [])
+ in
+ choices
+ in
+(*
+ (* <benchmark> *)
+ let _ =
+ if benchmark then begin
+ let per_item_choices =
+ List.map
+ (fun dom_item ->
+ try
+ let len = List.length (lookup_choices dom_item) in
+ debug_print (lazy (sprintf "BENCHMARK %s: %d"
+ (string_of_domain_item dom_item) len));
+ len
+ with No_choices _ -> 0)
+ thing_dom
+ in
+ max_refinements := List.fold_left ( * ) 1 per_item_choices;
+ actual_refinements := 0;
+ domain_size := List.length thing_dom;
+ choices_avg :=
+ (float_of_int !max_refinements) ** (1. /. float_of_int !domain_size)
+ end
+ in
+ (* </benchmark> *)
+*)
+
+ (* (3) test an interpretation filling with meta uninterpreted identifiers
+ *)
+ let test_env aliases todo_dom ugraph =
+ let filled_env =
+ List.fold_left
+ (fun env item ->
+ Environment.add item
+ ("Implicit",
+ (match item with
+ | Id _ | Num _ -> (fun _ _ _ -> Cic.Implicit (Some `Closed))
+ | Symbol _ -> (fun _ _ _ -> Cic.Implicit None))) env)
+ aliases todo_dom
+ in
+ try
+ let localization_tbl = Cic.CicHash.create 503 in
+ let cic_thing =
+ interpretate_thing ~context:disambiguate_context ~env:filled_env
+ ~uri ~is_path:false thing ~localization_tbl
+ in
+let foo () =
+ let k,ugraph1 =
+ refine_thing metasenv context uri cic_thing ugraph ~localization_tbl
+ in
+ (k , ugraph1 )
+in refine_profiler.HExtlib.profile foo ()
+ with
+ | Try_again msg -> Uncertain (None,msg), ugraph
+ | Invalid_choice msg -> Ko (None,msg), ugraph
+ in
+ (* (4) build all possible interpretations *)
+ let (@@) (l1,l2) (l1',l2') = l1@l1', l2@l2' in
+ let rec aux aliases diff lookup_in_todo_dom todo_dom base_univ =
+ match todo_dom with
+ | [] ->
+ assert (lookup_in_todo_dom = None);
+ (match test_env aliases [] base_univ with
+ | Ok (thing, metasenv),new_univ ->
+ [ aliases, diff, metasenv, thing, new_univ ], []
+ | Ko (loc,msg),_ | Uncertain (loc,msg),_ -> [],[loc,msg])
+ | item :: remaining_dom ->
+ debug_print (lazy (sprintf "CHOOSED ITEM: %s"
+ (string_of_domain_item item)));
+ let choices =
+ match lookup_in_todo_dom with
+ None -> lookup_choices item
+ | Some choices -> choices in
+ match choices with
+ [] ->
+ [], [None,lazy ("No choices for " ^ string_of_domain_item item)]
+ | [codomain_item] ->
+ (* just one choice. We perform a one-step look-up and
+ if the next set of choices is also a singleton we
+ skip this refinement step *)
+ debug_print(lazy (sprintf "%s CHOSEN" (fst codomain_item)));
+ let new_env = Environment.add item codomain_item aliases in
+ let new_diff = (item,codomain_item)::diff in
+ let lookup_in_todo_dom,next_choice_is_single =
+ match remaining_dom with
+ [] -> None,false
+ | he::_ ->
+ let choices = lookup_choices he in
+ Some choices,List.length choices = 1
+ in
+ if next_choice_is_single then
+ aux new_env new_diff lookup_in_todo_dom remaining_dom
+ base_univ
+ else
+ (match test_env new_env remaining_dom base_univ with
+ | Ok (thing, metasenv),new_univ ->
+ (match remaining_dom with
+ | [] ->
+ [ new_env, new_diff, metasenv, thing, new_univ ], []
+ | _ ->
+ aux new_env new_diff lookup_in_todo_dom
+ remaining_dom new_univ)
+ | Uncertain (loc,msg),new_univ ->
+ (match remaining_dom with
+ | [] -> [], [loc,msg]
+ | _ ->
+ aux new_env new_diff lookup_in_todo_dom
+ remaining_dom new_univ)
+ | Ko (loc,msg),_ -> [], [loc,msg])
+ | _::_ ->
+ let rec filter univ = function
+ | [] -> [],[]
+ | codomain_item :: tl ->
+ debug_print(lazy (sprintf "%s CHOSEN" (fst codomain_item)));
+ let new_env = Environment.add item codomain_item aliases in
+ let new_diff = (item,codomain_item)::diff in
+ (match test_env new_env remaining_dom univ with
+ | Ok (thing, metasenv),new_univ ->
+ (match remaining_dom with
+ | [] -> [ new_env, new_diff, metasenv, thing, new_univ ], []
+ | _ -> aux new_env new_diff None remaining_dom new_univ
+ ) @@
+ filter univ tl
+ | Uncertain (loc,msg),new_univ ->
+ (match remaining_dom with
+ | [] -> [],[loc,msg]
+ | _ -> aux new_env new_diff None remaining_dom new_univ
+ ) @@
+ filter univ tl
+ | Ko (loc,msg),_ -> ([],[loc,msg]) @@ filter univ tl)
+ in
+ filter base_univ choices
+ in
+ let base_univ = initial_ugraph in
+ try
+ let res =
+ match aux aliases [] None todo_dom base_univ with
+ | [],errors -> raise (NoWellTypedInterpretation (0,errors))
+ | [_,diff,metasenv,t,ugraph],_ ->
+ debug_print (lazy "SINGLE INTERPRETATION");
+ [diff,metasenv,t,ugraph], false
+ | l,_ ->
+ debug_print (lazy (sprintf "MANY INTERPRETATIONS (%d)" (List.length l)));
+ let choices =
+ List.map
+ (fun (env, _, _, _, _) ->
+ List.map
+ (fun domain_item ->
+ let description =
+ fst (Environment.find domain_item env)
+ in
+ (descr_of_domain_item domain_item, description))
+ thing_dom)
+ l
+ in
+ let choosed = C.interactive_interpretation_choice choices in
+ (List.map (fun n->let _,d,m,t,u= List.nth l n in d,m,t,u) choosed),
+ true
+ in
+ res
+ with
+ CicEnvironment.CircularDependency s ->
+ failwith "Disambiguate: circular dependency"
+
+ let disambiguate_term ?(fresh_instances=false) ~dbd ~context ~metasenv
+ ?(initial_ugraph = CicUniv.empty_ugraph) ~aliases ~universe term
+ =
+ let term =
+ if fresh_instances then CicNotationUtil.freshen_term term else term
+ in
+ disambiguate_thing ~dbd ~context ~metasenv ~initial_ugraph ~aliases
+ ~universe ~uri:None ~pp_thing:CicNotationPp.pp_term
+ ~domain_of_thing:domain_of_term ~interpretate_thing:interpretate_term
+ ~refine_thing:refine_term term
+
+ let disambiguate_obj ?(fresh_instances=false) ~dbd ~aliases ~universe ~uri
+ obj
+ =
+ let obj =
+ if fresh_instances then CicNotationUtil.freshen_obj obj else obj
+ in
+ disambiguate_thing ~dbd ~context:[] ~metasenv:[] ~aliases ~universe ~uri
+ ~pp_thing:CicNotationPp.pp_obj ~domain_of_thing:domain_of_obj
+ ~interpretate_thing:interpretate_obj ~refine_thing:refine_obj
+ obj
+ end
+
diff --git a/helm/ocaml/cic_disambiguation/disambiguate.mli b/helm/ocaml/cic_disambiguation/disambiguate.mli
new file mode 100644
index 000000000..a2cc0d0e7
--- /dev/null
+++ b/helm/ocaml/cic_disambiguation/disambiguate.mli
@@ -0,0 +1,73 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** {2 Disambiguation interface} *)
+
+(* the integer is an offset to be added to each location *)
+exception NoWellTypedInterpretation of
+ int * (Token.flocation option * string Lazy.t) list
+exception PathNotWellFormed
+
+val interpretate_path :
+ context:Cic.name list -> CicNotationPt.term ->
+ Cic.term
+
+module type Disambiguator =
+sig
+ (** @param fresh_instances when set to true fresh instances will be generated
+ * for each number _and_ symbol in the disambiguation domain. Instances of the
+ * input AST will be ignored. Defaults to false. *)
+ val disambiguate_term :
+ ?fresh_instances:bool ->
+ dbd:HMysql.dbd ->
+ context:Cic.context ->
+ metasenv:Cic.metasenv ->
+ ?initial_ugraph:CicUniv.universe_graph ->
+ aliases:DisambiguateTypes.environment ->(* previous interpretation status *)
+ universe:DisambiguateTypes.multiple_environment option ->
+ CicNotationPt.term ->
+ ((DisambiguateTypes.domain_item * DisambiguateTypes.codomain_item) list *
+ Cic.metasenv * (* new metasenv *)
+ Cic.term *
+ CicUniv.universe_graph) list * (* disambiguated term *)
+ bool (* has interactive_interpretation_choice been invoked? *)
+
+ (** @param fresh_instances as per disambiguate_term *)
+ val disambiguate_obj :
+ ?fresh_instances:bool ->
+ dbd:HMysql.dbd ->
+ aliases:DisambiguateTypes.environment ->(* previous interpretation status *)
+ universe:DisambiguateTypes.multiple_environment option ->
+ uri:UriManager.uri option -> (* required only for inductive types *)
+ CicNotationPt.obj ->
+ ((DisambiguateTypes.domain_item * DisambiguateTypes.codomain_item) list *
+ Cic.metasenv * (* new metasenv *)
+ Cic.obj *
+ CicUniv.universe_graph) list * (* disambiguated obj *)
+ bool (* has interactive_interpretation_choice been invoked? *)
+end
+
+module Make (C : DisambiguateTypes.Callbacks) : Disambiguator
+
diff --git a/helm/ocaml/cic_disambiguation/disambiguateChoices.ml b/helm/ocaml/cic_disambiguation/disambiguateChoices.ml
new file mode 100644
index 000000000..bdbc93179
--- /dev/null
+++ b/helm/ocaml/cic_disambiguation/disambiguateChoices.ml
@@ -0,0 +1,69 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+open DisambiguateTypes
+
+exception Choice_not_found of string Lazy.t
+
+let num_choices = ref []
+
+let add_num_choice choice = num_choices := choice :: !num_choices
+
+let has_description dsc = (fun x -> fst x = dsc)
+
+let lookup_num_choices () = !num_choices
+
+let lookup_num_by_dsc dsc =
+ try
+ List.find (has_description dsc) !num_choices
+ with Not_found -> raise (Choice_not_found (lazy ("Num with dsc " ^ dsc)))
+
+let mk_choice (dsc, args, appl_pattern) =
+ dsc,
+ (fun env _ cic_args ->
+ let env' =
+ let names =
+ List.map (function CicNotationPt.IdentArg (_, name) -> name) args
+ in
+ try
+ List.combine names cic_args
+ with Invalid_argument _ ->
+ raise (Invalid_choice (lazy "The notation expects a different number of arguments"))
+ in
+ TermAcicContent.instantiate_appl_pattern env' appl_pattern)
+
+let lookup_symbol_by_dsc symbol dsc =
+ try
+ mk_choice
+ (List.find
+ (fun (dsc', _, _) -> dsc = dsc')
+ (TermAcicContent.lookup_interpretations symbol))
+ with TermAcicContent.Interpretation_not_found | Not_found ->
+ raise (Choice_not_found (lazy (sprintf "Symbol %s, dsc %s" symbol dsc)))
+
diff --git a/helm/ocaml/cic_disambiguation/disambiguateChoices.mli b/helm/ocaml/cic_disambiguation/disambiguateChoices.mli
new file mode 100644
index 000000000..0ad498106
--- /dev/null
+++ b/helm/ocaml/cic_disambiguation/disambiguateChoices.mli
@@ -0,0 +1,53 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+open DisambiguateTypes
+
+(** {2 Choice registration low-level interface} *)
+
+ (** raised by lookup_XXXX below *)
+exception Choice_not_found of string Lazy.t
+
+ (** register a new number choice *)
+val add_num_choice: codomain_item -> unit
+
+(** {2 Choices lookup}
+ * for user defined aliases *)
+
+val lookup_num_choices: unit -> codomain_item list
+
+ (** @param dsc description (1st component of codomain_item) *)
+val lookup_num_by_dsc: string -> codomain_item
+
+ (** @param symbol symbol as per AST
+ * @param dsc description (1st component of codomain_item)
+ *)
+val lookup_symbol_by_dsc: string -> string -> codomain_item
+
+val mk_choice:
+ string * CicNotationPt.argument_pattern list *
+ CicNotationPt.cic_appl_pattern ->
+ codomain_item
+
diff --git a/helm/ocaml/cic_disambiguation/disambiguateTypes.ml b/helm/ocaml/cic_disambiguation/disambiguateTypes.ml
new file mode 100644
index 000000000..4a2e43a20
--- /dev/null
+++ b/helm/ocaml/cic_disambiguation/disambiguateTypes.ml
@@ -0,0 +1,119 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+(*
+type term = CicNotationPt.term
+type tactic = (term, term, GrafiteAst.reduction, string) GrafiteAst.tactic
+type tactical = (term, term, GrafiteAst.reduction, string) GrafiteAst.tactical
+type script_entry =
+ | Command of tactical
+ | Comment of CicNotationPt.location * string
+type script = CicNotationPt.location * script_entry list
+*)
+
+type domain_item =
+ | Id of string (* literal *)
+ | Symbol of string * int (* literal, instance num *)
+ | Num of int (* instance num *)
+
+exception Invalid_choice of string Lazy.t
+
+module OrderedDomain =
+ struct
+ type t = domain_item
+ let compare = Pervasives.compare
+ end
+
+(* module Domain = Set.Make (OrderedDomain) *)
+module Environment =
+struct
+ module Environment' = Map.Make (OrderedDomain)
+
+ include Environment'
+
+ let cons k v env =
+ try
+ let current = find k env in
+ let dsc, _ = v in
+ add k (v :: (List.filter (fun (dsc', _) -> dsc' <> dsc) current)) env
+ with Not_found ->
+ add k [v] env
+
+ let hd list_env =
+ try
+ map List.hd list_env
+ with Failure _ -> assert false
+
+ let fold_flatten f env base =
+ fold
+ (fun k l acc -> List.fold_right (fun v acc -> f k v acc) l acc)
+ env base
+
+end
+
+type codomain_item =
+ string * (* description *)
+ (environment -> string -> Cic.term list -> Cic.term)
+ (* environment, literal number, arguments as needed *)
+
+and environment = codomain_item Environment.t
+
+type multiple_environment = codomain_item list Environment.t
+
+
+(** adds a (name,uri) list l to a disambiguation environment e **)
+let multiple_env_of_list l e =
+ List.fold_left
+ (fun e (name,descr,t) -> Environment.cons (Id name) (descr,fun _ _ _ -> t) e)
+ e l
+
+let env_of_list l e =
+ List.fold_left
+ (fun e (name,descr,t) -> Environment.add (Id name) (descr,fun _ _ _ -> t) e)
+ e l
+
+module type Callbacks =
+ sig
+ val interactive_user_uri_choice:
+ selection_mode:[`SINGLE | `MULTIPLE] ->
+ ?ok:string ->
+ ?enable_button_for_non_vars:bool ->
+ title:string -> msg:string -> id:string -> UriManager.uri list ->
+ UriManager.uri list
+ val interactive_interpretation_choice:
+ (string * string) list list -> int list
+ val input_or_locate_uri:
+ title:string -> ?id:string -> unit -> UriManager.uri
+ end
+
+let string_of_domain_item = function
+ | Id s -> Printf.sprintf "ID(%s)" s
+ | Symbol (s, i) -> Printf.sprintf "SYMBOL(%s,%d)" s i
+ | Num i -> Printf.sprintf "NUM(instance %d)" i
+
+let string_of_domain dom =
+ String.concat "; " (List.map string_of_domain_item dom)
diff --git a/helm/ocaml/cic_disambiguation/disambiguateTypes.mli b/helm/ocaml/cic_disambiguation/disambiguateTypes.mli
new file mode 100644
index 000000000..4f4b3c3ec
--- /dev/null
+++ b/helm/ocaml/cic_disambiguation/disambiguateTypes.mli
@@ -0,0 +1,96 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+type domain_item =
+ | Id of string (* literal *)
+ | Symbol of string * int (* literal, instance num *)
+ | Num of int (* instance num *)
+
+(* module Domain: Set.S with type elt = domain_item *)
+module Environment:
+sig
+ include Map.S with type key = domain_item
+ val cons: domain_item -> ('a * 'b) -> ('a * 'b) list t -> ('a * 'b) list t
+ val hd: 'a list t -> 'a t
+
+ (** last alias cons-ed will be processed first *)
+ val fold_flatten: (domain_item -> 'a -> 'b -> 'b) -> 'a list t -> 'b -> 'b
+end
+
+ (** to be raised when a choice is invalid due to some given parameter (e.g.
+ * wrong number of Cic.term arguments received) *)
+exception Invalid_choice of string Lazy.t
+
+type codomain_item =
+ string * (* description *)
+ (environment -> string -> Cic.term list -> Cic.term)
+ (* environment, literal number, arguments as needed *)
+
+and environment = codomain_item Environment.t
+
+type multiple_environment = codomain_item list Environment.t
+
+(* a simple case of extension of a disambiguation environment *)
+val env_of_list:
+ (string * string * Cic.term) list -> environment -> environment
+
+val multiple_env_of_list:
+ (string * string * Cic.term) list -> multiple_environment ->
+ multiple_environment
+
+module type Callbacks =
+ sig
+
+ val interactive_user_uri_choice :
+ selection_mode:[`SINGLE | `MULTIPLE] ->
+ ?ok:string ->
+ ?enable_button_for_non_vars:bool ->
+ title:string -> msg:string -> id:string -> UriManager.uri list ->
+ UriManager.uri list
+
+ val interactive_interpretation_choice :
+ (string * string) list list -> int list
+
+ (** @param title gtk window title for user prompting
+ * @param id unbound identifier which originated this callback invocation *)
+ val input_or_locate_uri:
+ title:string -> ?id:string -> unit -> UriManager.uri
+ end
+
+val string_of_domain_item: domain_item -> string
+val string_of_domain: domain_item list -> string
+
+(** {3 type shortands} *)
+
+(*
+type term = CicNotationPt.term
+type tactic = (term, term, GrafiteAst.reduction, string) GrafiteAst.tactic
+type tactical = (term, term, GrafiteAst.reduction, string) GrafiteAst.tactical
+
+type script_entry =
+ | Command of tactical
+ | Comment of CicNotationPt.location * string
+type script = CicNotationPt.location * script_entry list
+*)
diff --git a/helm/ocaml/cic_disambiguation/doc/precedence.txt b/helm/ocaml/cic_disambiguation/doc/precedence.txt
new file mode 100644
index 000000000..09efea853
--- /dev/null
+++ b/helm/ocaml/cic_disambiguation/doc/precedence.txt
@@ -0,0 +1,32 @@
+
+Input Should be parsed as Derived constraint
+ on precedence
+--------------------------------------------------------------------------------
+\lambda x.x y \lambda x.(x y) lambda > apply
+S x = y (= (S x) y) apply > infix operators
+\forall x.x=x (\forall x.(= x x)) infix operators > binders
+\lambda x.x \to x \lambda. (x \to x) \to > \lambda
+--------------------------------------------------------------------------------
+
+Precedence total order:
+
+ apply > infix operators > to > binders
+
+where binders are all binders except lambda (i.e. \forall, \pi, \exists)
+
+to test:
+
+./test_parser term << EOT
+ \lambda x.x y
+ S x = y
+ \forall x.x=x
+ \lambda x.x \to x
+EOT
+
+should respond with:
+
+ \lambda x.(x y)
+ (eq (S x) y)
+ \forall x.(eq x x)
+ \lambda x.(x \to x)
+
diff --git a/helm/ocaml/cic_disambiguation/number_notation.ml b/helm/ocaml/cic_disambiguation/number_notation.ml
new file mode 100644
index 000000000..2b3ce2d60
--- /dev/null
+++ b/helm/ocaml/cic_disambiguation/number_notation.ml
@@ -0,0 +1,55 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let _ =
+ DisambiguateChoices.add_num_choice
+ ("natural number",
+ (fun _ num _ -> HelmLibraryObjects.build_nat (int_of_string num)));
+ DisambiguateChoices.add_num_choice
+ ("real number",
+ (fun _ num _ -> HelmLibraryObjects.build_real (int_of_string num)));
+ DisambiguateChoices.add_num_choice
+ ("binary positive number",
+ (fun _ num _ ->
+ let num = int_of_string num in
+ if num = 0 then
+ raise (DisambiguateTypes.Invalid_choice (lazy "0 is not a valid positive number"))
+ else
+ HelmLibraryObjects.build_bin_pos num));
+ DisambiguateChoices.add_num_choice
+ ("binary integer number",
+ (fun _ num _ ->
+ let num = int_of_string num in
+ if num = 0 then
+ HelmLibraryObjects.BinInt.z0
+ else if num > 0 then
+ Cic.Appl [
+ HelmLibraryObjects.BinInt.zpos;
+ HelmLibraryObjects.build_bin_pos num ]
+ else
+ assert false))
+
diff --git a/helm/ocaml/cic_disambiguation/tests/aliases.txt b/helm/ocaml/cic_disambiguation/tests/aliases.txt
new file mode 100644
index 000000000..12b09fff1
--- /dev/null
+++ b/helm/ocaml/cic_disambiguation/tests/aliases.txt
@@ -0,0 +1,6 @@
+alias id foo = cic:/a.con
+alias id bar = cic:/b.con
+alias symbol "plus" (instance 0) = "real plus"
+alias symbol "plus" (instance 1) = "natural plus"
+alias num (instance 0) = "real number"
+alias num (instance 1) = "natural number"
diff --git a/helm/ocaml/cic_disambiguation/tests/eq.txt b/helm/ocaml/cic_disambiguation/tests/eq.txt
new file mode 100644
index 000000000..6a826fc71
--- /dev/null
+++ b/helm/ocaml/cic_disambiguation/tests/eq.txt
@@ -0,0 +1 @@
+\forall n. \forall m. n + m = n
diff --git a/helm/ocaml/cic_disambiguation/tests/match.txt b/helm/ocaml/cic_disambiguation/tests/match.txt
new file mode 100644
index 000000000..87bb0159b
--- /dev/null
+++ b/helm/ocaml/cic_disambiguation/tests/match.txt
@@ -0,0 +1,49 @@
+[\lambda x:nat.
+ [\lambda y:nat. Set]
+ match x:nat with [ O \Rightarrow nat | (S x) \Rightarrow bool ]]
+match (S O):nat with
+[ O \Rightarrow O
+| (S x) \Rightarrow false ]
+
+[\lambda z:nat. \lambda h:(le O z). (eq nat O O)]
+match (le_n O): le with
+[ le_n \Rightarrow (refl_equal nat O)
+| (le_S x y) \Rightarrow (refl_equal nat O) ]
+
+[\lambda z:nat. \lambda h:(le (plus (plus O O) (plus O O)) z). (eq nat (plus (plus O O) (plus O O)) (plus (plus O O) (plus O O)))]
+match (le_n (plus (plus O O) (plus O O))): le with
+[ le_n \Rightarrow (refl_equal nat (plus (plus O O) (plus O O)))
+| (le_S x y) \Rightarrow (refl_equal nat (plus (plus O O) (plus O O))) ]
+
+(*
+[\lambda z:nat. \lambda h:(le 1 z). (le 0 z)]
+match (le_S 2 (le_n 1)): le with
+[ le_n \Rightarrow (le_S 1 (le_n 0))
+| (le_S x y) \Rightarrow y ]
+*)
+
+[\lambda z:nat. \lambda h:(le 0 z). (le 0 (S z))]
+match (le_S 0 0 (le_n 0)): le with
+[ le_n \Rightarrow (le_S 0 0 (le_n 0))
+| (le_S x y) \Rightarrow (le_S 0 (S x) (le_S 0 x y)) ]
+
+
+[\lambda x:bool. nat]
+match true:bool with
+[ true \Rightarrow O
+| false \Rightarrow (S O) ]
+
+[\lambda x:nat. nat]
+match O:nat with
+[ O \Rightarrow O
+| (S x) \Rightarrow (S (S x)) ]
+
+[\lambda x:list. list]
+match nil:list with
+[ nil \Rightarrow nil
+| (cons x y) \Rightarrow (cons x y) ]
+
+\lambda x:False.
+ [\lambda h:False. True]
+ match x:False with []
+
diff --git a/helm/ocaml/cic_proof_checking/.depend b/helm/ocaml/cic_proof_checking/.depend
new file mode 100644
index 000000000..06b9188a0
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/.depend
@@ -0,0 +1,24 @@
+cicLogger.cmo: cicLogger.cmi
+cicLogger.cmx: cicLogger.cmi
+cicEnvironment.cmo: cicEnvironment.cmi
+cicEnvironment.cmx: cicEnvironment.cmi
+cicPp.cmo: cicEnvironment.cmi cicPp.cmi
+cicPp.cmx: cicEnvironment.cmx cicPp.cmi
+cicUnivUtils.cmo: cicEnvironment.cmi cicUnivUtils.cmi
+cicUnivUtils.cmx: cicEnvironment.cmx cicUnivUtils.cmi
+cicSubstitution.cmo: cicEnvironment.cmi cicSubstitution.cmi
+cicSubstitution.cmx: cicEnvironment.cmx cicSubstitution.cmi
+cicMiniReduction.cmo: cicSubstitution.cmi cicMiniReduction.cmi
+cicMiniReduction.cmx: cicSubstitution.cmx cicMiniReduction.cmi
+cicReduction.cmo: cicSubstitution.cmi cicPp.cmi cicEnvironment.cmi \
+ cicReduction.cmi
+cicReduction.cmx: cicSubstitution.cmx cicPp.cmx cicEnvironment.cmx \
+ cicReduction.cmi
+cicTypeChecker.cmo: cicUnivUtils.cmi cicSubstitution.cmi cicReduction.cmi \
+ cicPp.cmi cicLogger.cmi cicEnvironment.cmi cicTypeChecker.cmi
+cicTypeChecker.cmx: cicUnivUtils.cmx cicSubstitution.cmx cicReduction.cmx \
+ cicPp.cmx cicLogger.cmx cicEnvironment.cmx cicTypeChecker.cmi
+freshNamesGenerator.cmo: cicTypeChecker.cmi cicSubstitution.cmi \
+ freshNamesGenerator.cmi
+freshNamesGenerator.cmx: cicTypeChecker.cmx cicSubstitution.cmx \
+ freshNamesGenerator.cmi
diff --git a/helm/ocaml/cic_proof_checking/Makefile b/helm/ocaml/cic_proof_checking/Makefile
new file mode 100644
index 000000000..3fbe90ddb
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/Makefile
@@ -0,0 +1,39 @@
+
+PACKAGE = cic_proof_checking
+PREDICATES =
+
+REDUCTION_IMPLEMENTATION = cicReductionMachine.ml
+
+INTERFACE_FILES = \
+ cicLogger.mli \
+ cicEnvironment.mli \
+ cicPp.mli \
+ cicUnivUtils.mli \
+ cicSubstitution.mli \
+ cicMiniReduction.mli \
+ cicReduction.mli \
+ cicTypeChecker.mli \
+ freshNamesGenerator.mli \
+ $(NULL)
+IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml)
+
+# Metadata tools only need zeta-reduction
+EXTRA_OBJECTS_TO_INSTALL = \
+ cicSubstitution.cmo cicSubstitution.cmx cicSubstitution.o \
+ cicMiniReduction.cmo cicMiniReduction.cmx cicMiniReduction.o
+EXTRA_OBJECTS_TO_CLEAN =
+
+include ../Makefile.common
+
+all: all_utilities
+opt: opt_utilities
+
+all_utilities:
+ $(MAKE) -C utilities/ all
+opt_utilities:
+ $(MAKE) -C utilities/ opt
+
+clean: clean_utilities
+clean_utilities:
+ $(MAKE) -C utilities/ clean
+
diff --git a/helm/ocaml/cic_proof_checking/cicEnvironment.ml b/helm/ocaml/cic_proof_checking/cicEnvironment.ml
new file mode 100644
index 000000000..22845725a
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/cicEnvironment.ml
@@ -0,0 +1,545 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(*****************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Claudio Sacerdoti Coen <sacerdot@cs.unibo.it> *)
+(* 24/01/2000 *)
+(* *)
+(* This module implements a trival cache system (an hash-table) for cic *)
+(* objects. Uses the getter (getter.ml) and the parser (cicParser.ml) *)
+(* *)
+(*****************************************************************************)
+
+(* $Id$ *)
+
+(* ************************************************************************** *
+ CicEnvironment SETTINGS (trust and clean_tmp)
+ * ************************************************************************** *)
+
+let cleanup_tmp = true;;
+let trust = ref (fun _ -> true);;
+let set_trust f = trust := f
+let trust_obj uri = !trust uri
+let debug_print = fun x -> prerr_endline (Lazy.force x)
+
+(* ************************************************************************** *
+ TYPES
+ * ************************************************************************** *)
+
+type type_checked_obj =
+ CheckedObj of (Cic.obj * CicUniv.universe_graph) (* cooked obj *)
+ | UncheckedObj of Cic.obj (* uncooked obj to proof-check *)
+;;
+
+exception AlreadyCooked of string;;
+exception CircularDependency of string Lazy.t;;
+exception CouldNotFreeze of string;;
+exception CouldNotUnfreeze of string;;
+exception Object_not_found of UriManager.uri;;
+
+
+(* ************************************************************************** *
+ HERE STARTS THE CACHE MODULE
+ * ************************************************************************** *)
+
+(* I think this should be the right place to implement mecanisms and
+ * invasriants
+ *)
+
+(* Cache that uses == instead of = for testing equality *)
+(* Invariant: an object is always in at most one of the *)
+(* following states: unchecked, frozen and cooked. *)
+module Cache :
+ sig
+ val find_or_add_to_unchecked :
+ UriManager.uri ->
+ get_object_to_add:
+ (UriManager.uri ->
+ Cic.obj * (CicUniv.universe_graph * CicUniv.universe list) option) ->
+ Cic.obj * CicUniv.universe_graph * CicUniv.universe list
+ val can_be_cooked:
+ UriManager.uri -> bool
+ val unchecked_to_frozen :
+ UriManager.uri -> unit
+ val frozen_to_cooked :
+ uri:UriManager.uri -> unit
+ val hack_univ:
+ UriManager.uri -> CicUniv.universe_graph * CicUniv.universe list -> unit
+ val find_cooked :
+ key:UriManager.uri ->
+ Cic.obj * CicUniv.universe_graph * CicUniv.universe list
+ val add_cooked :
+ key:UriManager.uri ->
+ (Cic.obj * CicUniv.universe_graph * CicUniv.universe list) -> unit
+ val remove: UriManager.uri -> unit
+ val dump_to_channel : ?callback:(string -> unit) -> out_channel -> unit
+ val restore_from_channel : ?callback:(string -> unit) -> in_channel -> unit
+ val empty : unit -> unit
+ val is_in_frozen: UriManager.uri -> bool
+ val is_in_unchecked: UriManager.uri -> bool
+ val is_in_cooked: UriManager.uri -> bool
+ val list_all_cooked_uris: unit -> UriManager.uri list
+ end
+=
+ struct
+ (*************************************************************************
+ TASSI: invariant
+ The cacheOfCookedObjects will contain only objects with a valid universe
+ graph. valid means that not None (used if there is no universe file
+ in the universe generation phase).
+ **************************************************************************)
+
+ (* DATA: the data structure that implements the CACHE *)
+ module HashedType =
+ struct
+ type t = UriManager.uri
+ let equal = UriManager.eq
+ let hash = Hashtbl.hash
+ end
+ ;;
+
+ module HT = Hashtbl.Make(HashedType);;
+
+ let cacheOfCookedObjects = HT.create 1009;;
+
+ (* DATA: The parking lists
+ * the lists elements are (uri * (obj * universe_graph option))
+ * ( u, ( o, None )) means that the object has no universes file, this
+ * should happen only in the universe generation phase.
+ * FIXME: if the universe generation is integrated in the library
+ * exportation phase, the 'option' MUST be removed.
+ * ( u, ( o, Some g)) means that the object has a universes file,
+ * the usual case.
+ *)
+
+ (* frozen is used to detect circular dependency. *)
+ let frozen_list = ref [];;
+ (* unchecked is used to store objects just fetched, nothing more. *)
+ let unchecked_list = ref [];;
+
+ let empty () =
+ HT.clear cacheOfCookedObjects;
+ unchecked_list := [] ;
+ frozen_list := []
+ ;;
+
+ (* FIX: universe stuff?? *)
+ let dump_to_channel ?(callback = ignore) oc =
+ HT.iter (fun uri _ -> callback (UriManager.string_of_uri uri))
+ cacheOfCookedObjects;
+ Marshal.to_channel oc cacheOfCookedObjects []
+ ;;
+
+ (* FIX: universes stuff?? *)
+ let restore_from_channel ?(callback = ignore) ic =
+ let restored = Marshal.from_channel ic in
+ (* FIXME: should this empty clean the frozen and unchecked?
+ * if not, the only-one-empty-end-not-3 patch is wrong
+ *)
+ empty ();
+ HT.iter
+ (fun k (v,u,l) ->
+ callback (UriManager.string_of_uri k);
+ let reconsed_entry =
+ CicUtil.rehash_obj v,
+ CicUniv.recons_graph u,
+ List.map CicUniv.recons_univ l
+ in
+ HT.add cacheOfCookedObjects
+ (UriManager.uri_of_string (UriManager.string_of_uri k))
+ reconsed_entry)
+ restored
+ ;;
+
+
+ let is_in_frozen uri =
+ List.mem_assoc uri !frozen_list
+ ;;
+
+ let is_in_unchecked uri =
+ List.mem_assoc uri !unchecked_list
+ ;;
+
+ let is_in_cooked uri =
+ HT.mem cacheOfCookedObjects uri
+ ;;
+
+
+ (*******************************************************************
+ TASSI: invariant
+ we need, in the universe generation phase, to traverse objects
+ that are not yet committed, so we search them in the frozen list.
+ Only uncommitted objects without a universe file (see the assertion)
+ can be searched with method
+ *******************************************************************)
+
+ let find_or_add_to_unchecked uri ~get_object_to_add =
+ try
+ let o,g_and_l = List.assq uri !unchecked_list in
+ match g_and_l with
+ (* FIXME: we accept both cases, as at the end of this function
+ * maybe the None universe outside the cache module should be
+ * avoided elsewhere.
+ *
+ * another thing that should be removed if univ generation phase
+ * and lib exportation are unified.
+ *)
+ | None -> o,CicUniv.empty_ugraph,[]
+ | Some (g,l) -> o,g,l
+ with
+ Not_found ->
+ if List.mem_assq uri !frozen_list then
+ (* CIRCULAR DEPENDENCY DETECTED, print the error and raise *)
+ begin
+ print_endline "\nCircularDependency!\nfrozen list: \n";
+ List.iter (
+ fun (u,(_,o)) ->
+ let su = UriManager.string_of_uri u in
+ let univ = if o = None then "NO_UNIV" else "" in
+ print_endline (su^" "^univ))
+ !frozen_list;
+ raise (CircularDependency (lazy (UriManager.string_of_uri uri)))
+ end
+ else
+ if HT.mem cacheOfCookedObjects uri then
+ (* DOUBLE COOK DETECTED, raise the exception *)
+ raise (AlreadyCooked (UriManager.string_of_uri uri))
+ else
+ (* OK, it is not already frozen nor cooked *)
+ let obj,ugraph_and_univlist = get_object_to_add uri in
+ let ugraph_real, univlist_real =
+ match ugraph_and_univlist with
+ (* FIXME: not sure it is OK*)
+ None -> CicUniv.empty_ugraph, []
+ | Some ((g,l) as g_and_l) -> g_and_l
+ in
+ unchecked_list :=
+ (uri,(obj,ugraph_and_univlist))::!unchecked_list ;
+ obj, ugraph_real, univlist_real
+ ;;
+
+ let unchecked_to_frozen uri =
+ try
+ let obj,ugraph_and_univlist = List.assq uri !unchecked_list in
+ unchecked_list := List.remove_assq uri !unchecked_list ;
+ frozen_list := (uri,(obj,ugraph_and_univlist))::!frozen_list
+ with
+ Not_found -> raise (CouldNotFreeze (UriManager.string_of_uri uri))
+ ;;
+
+
+ (************************************************************
+ TASSI: invariant
+ only object with a valid universe graph can be committed
+
+ this should disappear if the universe generation phase and the
+ library exportation are unified.
+ *************************************************************)
+ let frozen_to_cooked ~uri =
+ try
+ let obj,ugraph_and_univlist = List.assq uri !frozen_list in
+ match ugraph_and_univlist with
+ | None -> assert false (* only NON dummy universes can be committed *)
+ | Some (g,l) ->
+ CicUniv.assert_univs_have_uri g l;
+ frozen_list := List.remove_assq uri !frozen_list ;
+ HT.add cacheOfCookedObjects uri (obj,g,l)
+ with
+ Not_found -> raise (CouldNotUnfreeze (UriManager.string_of_uri uri))
+ ;;
+
+ let can_be_cooked uri =
+ try
+ let obj,ugraph_and_univlist = List.assq uri !frozen_list in
+ (* FIXME: another thing to remove if univ generation phase and lib
+ * exportation are unified.
+ *)
+ match ugraph_and_univlist with
+ None -> false
+ | Some _ -> true
+ with
+ Not_found -> false
+ ;;
+
+ (* this function injects a real universe graph in a (uri, (obj, None))
+ * element of the frozen list.
+ *
+ * FIXME: another thing to remove if univ generation phase and lib
+ * exportation are unified.
+ *)
+ let hack_univ uri (real_ugraph, real_univlist) =
+ try
+ let o,ugraph_and_univlist = List.assq uri !frozen_list in
+ match ugraph_and_univlist with
+ None ->
+ frozen_list := List.remove_assoc uri !frozen_list;
+ frozen_list :=
+ (uri,(o,Some (real_ugraph, real_univlist)))::!frozen_list;
+ | Some g ->
+ debug_print (lazy (
+ "You are probably hacking an object already hacked or an"^
+ " object that has the universe file but is not"^
+ " yet committed."));
+ assert false
+ with
+ Not_found ->
+ debug_print (lazy (
+ "You are hacking an object that is not in the"^
+ " frozen_list, this means you are probably generating an"^
+ " universe file for an object that already"^
+ " as an universe file"));
+ assert false
+ ;;
+
+ let find_cooked ~key:uri = HT.find cacheOfCookedObjects uri ;;
+
+ let add_cooked ~key:uri (obj,ugraph,univlist) =
+ HT.add cacheOfCookedObjects uri (obj,ugraph,univlist)
+ ;;
+
+ (* invariant
+ *
+ * an object can be romeved from the cache only if we are not typechecking
+ * something. this means check and frozen must be empty.
+ *)
+ let remove uri =
+ if !frozen_list <> [] then
+ failwith "CicEnvironment.remove while type checking"
+ else
+ begin
+ HT.remove cacheOfCookedObjects uri;
+ unchecked_list :=
+ List.filter (fun (uri',_) -> not (UriManager.eq uri uri')) !unchecked_list
+ end
+ ;;
+
+ let list_all_cooked_uris () =
+ HT.fold (fun u _ l -> u::l) cacheOfCookedObjects []
+ ;;
+
+ end
+;;
+
+(* ************************************************************************
+ HERE ENDS THE CACHE MODULE
+ * ************************************************************************ *)
+
+(* exported cache functions *)
+let dump_to_channel = Cache.dump_to_channel;;
+let restore_from_channel = Cache.restore_from_channel;;
+let empty = Cache.empty;;
+
+let total_parsing_time = ref 0.0
+
+let get_object_to_add uri =
+ try
+ let filename = Http_getter.getxml' uri in
+ let bodyfilename =
+ match UriManager.bodyuri_of_uri uri with
+ None -> None
+ | Some bodyuri ->
+ if Http_getter.exists' bodyuri then
+ Some (Http_getter.getxml' bodyuri)
+ else
+ None
+ in
+ let obj =
+ try
+ let time = Unix.gettimeofday() in
+ let rc = CicParser.obj_of_xml uri filename bodyfilename in
+ total_parsing_time :=
+ !total_parsing_time +. ((Unix.gettimeofday()) -. time );
+ rc
+ with exn ->
+ (match exn with
+ | CicParser.Getter_failure ("key_not_found", uri) ->
+ raise (Object_not_found (UriManager.uri_of_string uri))
+ | _ -> raise exn)
+ in
+ let ugraph_and_univlist,filename_univ =
+ try
+ let filename_univ =
+ let univ_uri = UriManager.univgraphuri_of_uri uri in
+ Http_getter.getxml' univ_uri
+ in
+ Some (CicUniv.ugraph_and_univlist_of_xml filename_univ),
+ Some filename_univ
+ with
+ | Http_getter_types.Key_not_found _
+ | Http_getter_types.Unresolvable_URI _ ->
+ debug_print (lazy (
+ "WE HAVE NO UNIVERSE FILE FOR " ^ (UriManager.string_of_uri uri)));
+ (* WE SHOULD FAIL (or return None, None *)
+ Some (CicUniv.empty_ugraph, []), None
+ in
+ obj, ugraph_and_univlist
+ with Http_getter_types.Key_not_found _ -> raise (Object_not_found uri)
+;;
+
+(* this is the function to fetch the object in the unchecked list and
+ * nothing more (except returning it)
+ *)
+let find_or_add_to_unchecked uri =
+ Cache.find_or_add_to_unchecked uri ~get_object_to_add
+
+(* set_type_checking_info uri *)
+(* must be called once the type-checking of uri is finished *)
+(* The object whose uri is uri is unfreezed *)
+(* *)
+(* the replacement ugraph must be the one returned by the *)
+(* typechecker, restricted with the CicUnivUtils.clean_and_fill *)
+let set_type_checking_info ?(replace_ugraph_and_univlist=None) uri =
+(*
+ if not (Cache.can_be_cooked uri) && replace_ugraph <> None then begin
+ debug_print (lazy (
+ "?replace_ugraph must be None if you are not committing an "^
+ "object that has a universe graph associated "^
+ "(can happen only in the fase of universes graphs generation)."));
+ assert false
+ else
+*)
+ match Cache.can_be_cooked uri, replace_ugraph_and_univlist with
+ | true, Some _
+ | false, None ->
+ debug_print (lazy (
+ "?replace_ugraph must be (Some ugraph) when committing an object that "^
+ "has no associated universe graph. If this is in make_univ phase you "^
+ "should drop this exception and let univ_make commit thi object with "^
+ "proper arguments"));
+ assert false
+ | _ ->
+ (match replace_ugraph_and_univlist with
+ | None -> ()
+ | Some g_and_l -> Cache.hack_univ uri g_and_l);
+ Cache.frozen_to_cooked uri
+;;
+
+(* fetch, unfreeze and commit an uri to the cacheOfCookedObjects and
+ * return the object,ugraph
+ *)
+let add_trusted_uri_to_cache uri =
+ let _ = find_or_add_to_unchecked uri in
+ Cache.unchecked_to_frozen uri;
+ set_type_checking_info uri;
+ try
+ Cache.find_cooked uri
+ with Not_found -> assert false
+;;
+
+(* get the uri, if we trust it will be added to the cacheOfCookedObjects *)
+let get_cooked_obj_with_univlist ?(trust=true) base_univ uri =
+ try
+ (* the object should be in the cacheOfCookedObjects *)
+ let o,u,l = Cache.find_cooked uri in
+ o,(CicUniv.merge_ugraphs base_univ u),l
+ with Not_found ->
+ (* this should be an error case, but if we trust the uri... *)
+ if trust && trust_obj uri then
+ (* trusting means that we will fetch cook it on the fly *)
+ let o,u,l = add_trusted_uri_to_cache uri in
+ o,(CicUniv.merge_ugraphs base_univ u),l
+ else
+ (* we don't trust the uri, so we fail *)
+ begin
+ debug_print (lazy ("CACHE MISS: " ^ (UriManager.string_of_uri uri)));
+ raise Not_found
+ end
+
+let get_cooked_obj ?trust base_univ uri =
+ let o,g,_ = get_cooked_obj_with_univlist ?trust base_univ uri in
+ o,g
+
+(* This has not the old semantic :( but is what the name suggests
+ *
+ * let is_type_checked ?(trust=true) uri =
+ * try
+ * let _ = Cache.find_cooked uri in
+ * true
+ * with
+ * Not_found ->
+ * trust && trust_obj uri
+ * ;;
+ *
+ * as the get_cooked_obj but returns a type_checked_obj
+ *
+ *)
+let is_type_checked ?(trust=true) base_univ uri =
+ try
+ let o,u,_ = Cache.find_cooked uri in
+ CheckedObj (o,(CicUniv.merge_ugraphs base_univ u))
+ with Not_found ->
+ (* this should return UncheckedObj *)
+ if trust && trust_obj uri then
+ (* trusting means that we will fetch cook it on the fly *)
+ let o,u,_ = add_trusted_uri_to_cache uri in
+ CheckedObj ( o, CicUniv.merge_ugraphs u base_univ )
+ else
+ let o,u,_ = find_or_add_to_unchecked uri in
+ Cache.unchecked_to_frozen uri;
+ UncheckedObj o
+;;
+
+(* as the get cooked, but if not present the object is only fetched,
+ * not unfreezed and committed
+ *)
+let get_obj base_univ uri =
+ try
+ (* the object should be in the cacheOfCookedObjects *)
+ let o,u,_ = Cache.find_cooked uri in
+ o,(CicUniv.merge_ugraphs base_univ u)
+ with Not_found ->
+ (* this should be an error case, but if we trust the uri... *)
+ let o,u,_ = find_or_add_to_unchecked uri in
+ o,(CicUniv.merge_ugraphs base_univ u)
+;;
+
+let in_cache uri =
+ Cache.is_in_cooked uri || Cache.is_in_frozen uri || Cache.is_in_unchecked uri
+
+let add_type_checked_obj uri (obj,ugraph,univlist) =
+ Cache.add_cooked ~key:uri (obj,ugraph,univlist)
+
+let in_library uri = in_cache uri || Http_getter.exists' uri
+
+let remove_obj = Cache.remove
+
+let list_uri () =
+ Cache.list_all_cooked_uris ()
+;;
+
+let list_obj () =
+ try
+ List.map (fun u ->
+ let o,ug = get_obj CicUniv.empty_ugraph u in
+ (u,o,ug))
+ (list_uri ())
+ with
+ Not_found ->
+ debug_print (lazy "Who has removed the uri in the meanwhile?");
+ raise Not_found
+;;
diff --git a/helm/ocaml/cic_proof_checking/cicEnvironment.mli b/helm/ocaml/cic_proof_checking/cicEnvironment.mli
new file mode 100644
index 000000000..55566a614
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/cicEnvironment.mli
@@ -0,0 +1,136 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(****************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Claudio Sacerdoti Coen <sacerdot@cs.unibo.it> *)
+(* 24/01/2000 *)
+(* *)
+(* This module implements a trival cache system (an hash-table) for cic *)
+(* ^^^^^^ *)
+(* objects. Uses the getter (getter.ml) and the parser (cicParser.ml) *)
+(* *)
+(****************************************************************************)
+
+exception CircularDependency of string Lazy.t;;
+exception Object_not_found of UriManager.uri;;
+
+(* as the get cooked, but if not present the object is only fetched,
+ * not unfreezed and committed
+ *)
+val get_obj :
+ CicUniv.universe_graph -> UriManager.uri ->
+ Cic.obj * CicUniv.universe_graph
+
+type type_checked_obj =
+ CheckedObj of (Cic.obj * CicUniv.universe_graph) (* cooked obj *)
+ | UncheckedObj of Cic.obj (* uncooked obj *)
+
+(*
+ * I think this should be the real semantic:
+ *
+ * val is_type_checked:
+ * ?trust:bool -> UriManager.uri -> bool
+ *
+ * but the old semantic is similar to get_cooked_obj, but
+ * returns an unchecked object intead of a Not_found
+ *)
+val is_type_checked :
+ ?trust:bool -> CicUniv.universe_graph -> UriManager.uri ->
+ type_checked_obj
+
+(* set_type_checking_info uri *)
+(* must be called once the type-checking of uri is finished *)
+(* The object whose uri is uri is unfreezed and won't be type-checked *)
+(* again in the future (is_type_checked will return true) *)
+(* *)
+(* Since the universes are not exported directly, but generated *)
+(* typecheking the library, we can't find them in the library as we *)
+(* do for the types. This means that when we commit uris during *)
+(* univ generation we can't associate the uri with the universe graph *)
+(* we find in the library, we have to calculate it and then inject it *)
+(* in the cacke. This is an orrible backdoor used by univ_maker. *)
+(* see the .ml file for some reassuring invariants *)
+(* WARNING: THIS FUNCTION MUST BE CALLED ONLY BY CicTypeChecker *)
+val set_type_checking_info :
+ ?replace_ugraph_and_univlist:
+ ((CicUniv.universe_graph * CicUniv.universe list) option) ->
+ UriManager.uri -> unit
+
+(* this function is called by CicTypeChecker.typecheck_obj to add to the *)
+(* environment a new well typed object that is not yet in the library *)
+(* WARNING: THIS FUNCTION MUST BE CALLED ONLY BY CicTypeChecker *)
+val add_type_checked_obj :
+ UriManager.uri ->
+ (Cic.obj * CicUniv.universe_graph * CicUniv.universe list) -> unit
+
+ (** remove a type checked object
+ * @raise Object_not_found when given term is not in the environment
+ * @raise Failure when remove_term is invoked while type checking *)
+val remove_obj: UriManager.uri -> unit
+
+(* get_cooked_obj ~trust uri *)
+(* returns the object if it is already type-checked or if it can be *)
+(* trusted (if [trust] = true and the trusting function accepts it) *)
+(* Otherwise it raises Not_found *)
+val get_cooked_obj :
+ ?trust:bool -> CicUniv.universe_graph -> UriManager.uri ->
+ Cic.obj * CicUniv.universe_graph
+
+(* get_cooked_obj_with_univlist ~trust uri *)
+(* returns the object if it is already type-checked or if it can be *)
+(* trusted (if [trust] = true and the trusting function accepts it) *)
+(* Otherwise it raises Not_found *)
+val get_cooked_obj_with_univlist :
+ ?trust:bool -> CicUniv.universe_graph -> UriManager.uri ->
+ Cic.obj * CicUniv.universe_graph * CicUniv.universe list
+
+(* FUNCTIONS USED ONLY IN THE TOPLEVEL/PROOF-ENGINE *)
+
+(* (de)serialization *)
+val dump_to_channel : ?callback:(string -> unit) -> out_channel -> unit
+val restore_from_channel : ?callback:(string -> unit) -> in_channel -> unit
+val empty : unit -> unit
+
+(** Set trust function. Per default this function is set to (fun _ -> true) *)
+val set_trust: (UriManager.uri -> bool) -> unit
+
+ (** @return true for objects currently cooked/frozend/unchecked, false
+ * otherwise (i.e. objects already parsed from XML) *)
+val in_cache : UriManager.uri -> bool
+
+(* to debug the matitac batch compiler *)
+val list_obj: unit -> (UriManager.uri * Cic.obj * CicUniv.universe_graph) list
+val list_uri: unit -> UriManager.uri list
+
+ (** @return true for objects available in the library *)
+val in_library: UriManager.uri -> bool
+
+ (** total parsing time, only to benchmark the parser *)
+val total_parsing_time: float ref
+
+(* EOF *)
diff --git a/helm/ocaml/cic_proof_checking/cicLogger.ml b/helm/ocaml/cic_proof_checking/cicLogger.ml
new file mode 100644
index 000000000..5921c61b0
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/cicLogger.ml
@@ -0,0 +1,62 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+type msg =
+ [ `Start_type_checking of UriManager.uri
+ | `Type_checking_completed of UriManager.uri
+ | `Trusting of UriManager.uri
+ ]
+
+let log ?(level = 1) =
+ let module U = UriManager in
+ function
+ | `Start_type_checking uri ->
+ HelmLogger.log (`Msg (`DIV (level, None, `T
+ ("Type-Checking of " ^ (U.string_of_uri uri) ^ " started"))))
+ | `Type_checking_completed uri ->
+ HelmLogger.log (`Msg (`DIV (level, Some "green", `T
+ ("Type-Checking of " ^ (U.string_of_uri uri) ^ " completed"))))
+ | `Trusting uri ->
+ HelmLogger.log (`Msg (`DIV (level, Some "blue", `T
+ ((U.string_of_uri uri) ^ " is trusted."))))
+
+class logger =
+ object
+ val mutable level = 0 (* indentation level *)
+ method log (msg: msg) =
+ match msg with
+ | `Start_type_checking _ ->
+ level <- level + 1;
+ log ~level msg
+ | `Type_checking_completed _ ->
+ log ~level msg;
+ level <- level - 1;
+ | _ -> log ~level msg
+ end
+
+let log msg = log ~level:1 msg
+
diff --git a/helm/ocaml/cic_proof_checking/cicLogger.mli b/helm/ocaml/cic_proof_checking/cicLogger.mli
new file mode 100644
index 000000000..408bc8879
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/cicLogger.mli
@@ -0,0 +1,42 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+type msg =
+ [ `Start_type_checking of UriManager.uri
+ | `Type_checking_completed of UriManager.uri
+ | `Trusting of UriManager.uri
+ ]
+
+ (** Stateless logging. Each message is logged with indentation level 1 *)
+val log: msg -> unit
+
+ (** Stateful logging. Each `Start_type_checing message increase the
+ * indentation level by 1, each `Type_checking_completed message decrease it by
+ * the same amount. *)
+class logger:
+ object
+ method log: msg -> unit
+ end
+
diff --git a/helm/ocaml/cic_proof_checking/cicMiniReduction.ml b/helm/ocaml/cic_proof_checking/cicMiniReduction.ml
new file mode 100644
index 000000000..5c88713c5
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/cicMiniReduction.ml
@@ -0,0 +1,76 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+let rec letin_nf =
+ let module C = Cic in
+ function
+ C.Rel _ as t -> t
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,letin_nf t)) exp_named_subst
+ in
+ C.Var (uri,exp_named_subst')
+ | C.Meta _ as t -> t
+ | C.Sort _ as t -> t
+ | C.Implicit _ as t -> t
+ | C.Cast (te,ty) -> C.Cast (letin_nf te, letin_nf ty)
+ | C.Prod (n,s,t) -> C.Prod (n, letin_nf s, letin_nf t)
+ | C.Lambda (n,s,t) -> C.Lambda (n, letin_nf s, letin_nf t)
+ | C.LetIn (n,s,t) -> CicSubstitution.subst (letin_nf s) t
+ | C.Appl l -> C.Appl (List.map letin_nf l)
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,letin_nf t)) exp_named_subst
+ in
+ C.Const (uri,exp_named_subst')
+ | C.MutInd (uri,typeno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,letin_nf t)) exp_named_subst
+ in
+ C.MutInd (uri,typeno,exp_named_subst')
+ | C.MutConstruct (uri,typeno,consno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,letin_nf t)) exp_named_subst
+ in
+ C.MutConstruct (uri,typeno,consno,exp_named_subst')
+ | C.MutCase (sp,i,outt,t,pl) ->
+ C.MutCase (sp,i,letin_nf outt, letin_nf t, List.map letin_nf pl)
+ | C.Fix (i,fl) ->
+ let substitutedfl =
+ List.map
+ (fun (name,i,ty,bo) -> (name, i, letin_nf ty, letin_nf bo))
+ fl
+ in
+ C.Fix (i, substitutedfl)
+ | C.CoFix (i,fl) ->
+ let substitutedfl =
+ List.map
+ (fun (name,ty,bo) -> (name, letin_nf ty, letin_nf bo))
+ fl
+ in
+ C.CoFix (i, substitutedfl)
+;;
diff --git a/helm/ocaml/cic_proof_checking/cicMiniReduction.mli b/helm/ocaml/cic_proof_checking/cicMiniReduction.mli
new file mode 100644
index 000000000..c923c6acf
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/cicMiniReduction.mli
@@ -0,0 +1,26 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val letin_nf : Cic.term -> Cic.term
diff --git a/helm/ocaml/cic_proof_checking/cicPp.ml b/helm/ocaml/cic_proof_checking/cicPp.ml
new file mode 100644
index 000000000..53f52272a
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/cicPp.ml
@@ -0,0 +1,480 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(*****************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* This module implements a very simple Coq-like pretty printer that, given *)
+(* an object of cic (internal representation) returns a string describing *)
+(* the object in a syntax similar to that of coq *)
+(* *)
+(* It also contains the utility functions to check a name w.r.t the Matita *)
+(* naming policy *)
+(* *)
+(*****************************************************************************)
+
+(* $Id$ *)
+
+exception CicPpInternalError;;
+exception NotEnoughElements;;
+
+(* Utility functions *)
+
+let ppname =
+ function
+ Cic.Name s -> s
+ | Cic.Anonymous -> "_"
+;;
+
+(* get_nth l n returns the nth element of the list l if it exists or *)
+(* raises NotEnoughElements if l has less than n elements *)
+let rec get_nth l n =
+ match (n,l) with
+ (1, he::_) -> he
+ | (n, he::tail) when n > 1 -> get_nth tail (n-1)
+ | (_,_) -> raise NotEnoughElements
+;;
+
+(* pp t l *)
+(* pretty-prints a term t of cic in an environment l where l is a list of *)
+(* identifier names used to resolve DeBrujin indexes. The head of l is the *)
+(* name associated to the greatest DeBrujin index in t *)
+let rec pp t l =
+ let module C = Cic in
+ match t with
+ C.Rel n ->
+ begin
+ try
+ (match get_nth l n with
+ Some (C.Name s) -> s
+ | Some C.Anonymous -> "__" ^ string_of_int n
+ | None -> "_hidden_" ^ string_of_int n
+ )
+ with
+ NotEnoughElements -> string_of_int (List.length l - n)
+ end
+ | C.Var (uri,exp_named_subst) ->
+ UriManager.string_of_uri (*UriManager.name_of_uri*) uri ^ pp_exp_named_subst exp_named_subst l
+ | C.Meta (n,l1) ->
+ "?" ^ (string_of_int n) ^ "[" ^
+ String.concat " ; "
+ (List.rev_map (function None -> "_" | Some t -> pp t l) l1) ^
+ "]"
+ | C.Sort s ->
+ (match s with
+ C.Prop -> "Prop"
+ | C.Set -> "Set"
+ | C.Type _ -> "Type"
+ (*| C.Type u -> ("Type" ^ CicUniv.string_of_universe u)*)
+ | C.CProp -> "CProp"
+ )
+ | C.Implicit (Some `Hole) -> "%"
+ | C.Implicit _ -> "?"
+ | C.Prod (b,s,t) ->
+ (match b with
+ C.Name n -> "(" ^ n ^ ":" ^ pp s l ^ ")" ^ pp t ((Some b)::l)
+ | C.Anonymous -> "(" ^ pp s l ^ "->" ^ pp t ((Some b)::l) ^ ")"
+ )
+ | C.Cast (v,t) -> "(" ^ pp v l ^ ":" ^ pp t l ^ ")"
+ | C.Lambda (b,s,t) ->
+ "[" ^ ppname b ^ ":" ^ pp s l ^ "]" ^ pp t ((Some b)::l)
+ | C.LetIn (b,s,t) ->
+ "[" ^ ppname b ^ ":=" ^ pp s l ^ "]" ^ pp t ((Some b)::l)
+ | C.Appl li ->
+ "(" ^
+ (List.fold_right
+ (fun x i -> pp x l ^ (match i with "" -> "" | _ -> " ") ^ i)
+ li ""
+ ) ^ ")"
+ | C.Const (uri,exp_named_subst) ->
+ UriManager.name_of_uri uri ^ pp_exp_named_subst exp_named_subst l
+ | C.MutInd (uri,n,exp_named_subst) ->
+ (try
+ match fst(CicEnvironment.get_obj CicUniv.empty_ugraph uri) with
+ C.InductiveDefinition (dl,_,_,_) ->
+ let (name,_,_,_) = get_nth dl (n+1) in
+ name ^ pp_exp_named_subst exp_named_subst l
+ | _ -> raise CicPpInternalError
+ with
+ _ -> UriManager.string_of_uri uri ^ "#1/" ^ string_of_int (n + 1)
+ )
+ | C.MutConstruct (uri,n1,n2,exp_named_subst) ->
+ (try
+ match fst(CicEnvironment.get_obj CicUniv.empty_ugraph uri) with
+ C.InductiveDefinition (dl,_,_,_) ->
+ let (_,_,_,cons) = get_nth dl (n1+1) in
+ let (id,_) = get_nth cons n2 in
+ id ^ pp_exp_named_subst exp_named_subst l
+ | _ -> raise CicPpInternalError
+ with
+ _ ->
+ UriManager.string_of_uri uri ^ "#1/" ^ string_of_int (n1 + 1) ^ "/" ^
+ string_of_int n2
+ )
+ | C.MutCase (uri,n1,ty,te,patterns) ->
+ let connames =
+ (match fst(CicEnvironment.get_obj CicUniv.empty_ugraph uri) with
+ C.InductiveDefinition (dl,_,_,_) ->
+ let (_,_,_,cons) = get_nth dl (n1+1) in
+ List.map (fun (id,_) -> id) cons
+ | _ -> raise CicPpInternalError
+ )
+ in
+ let connames_and_patterns =
+ let rec combine =
+ function
+ [],[] -> []
+ | [],l -> List.map (fun x -> "???",Some x) l
+ | l,[] -> List.map (fun x -> x,None) l
+ | x::tlx,y::tly -> (x,Some y)::(combine (tlx,tly))
+ in
+ combine (connames,patterns)
+ in
+ "\n<" ^ pp ty l ^ ">Cases " ^ pp te l ^ " of " ^
+ List.fold_right
+ (fun (x,y) i -> "\n " ^ x ^ " => " ^
+ (match y with None -> "" | Some y -> pp y l) ^ i)
+ connames_and_patterns "" ^
+ "\nend"
+ | C.Fix (no, funs) ->
+ let snames = List.map (fun (name,_,_,_) -> name) funs in
+ let names =
+ List.rev (List.map (function name -> Some (C.Name name)) snames)
+ in
+ "\nFix " ^ get_nth snames (no + 1) ^ " {" ^
+ List.fold_right
+ (fun (name,ind,ty,bo) i -> "\n" ^ name ^ " / " ^ string_of_int ind ^
+ " : " ^ pp ty l ^ " := \n" ^
+ pp bo (names@l) ^ i)
+ funs "" ^
+ "}\n"
+ | C.CoFix (no,funs) ->
+ let snames = List.map (fun (name,_,_) -> name) funs in
+ let names =
+ List.rev (List.map (function name -> Some (C.Name name)) snames)
+ in
+ "\nCoFix " ^ get_nth snames (no + 1) ^ " {" ^
+ List.fold_right
+ (fun (name,ty,bo) i -> "\n" ^ name ^
+ " : " ^ pp ty l ^ " := \n" ^
+ pp bo (names@l) ^ i)
+ funs "" ^
+ "}\n"
+and pp_exp_named_subst exp_named_subst l =
+ if exp_named_subst = [] then "" else
+ "{" ^
+ String.concat " ; " (
+ List.map
+ (function (uri,t) -> UriManager.name_of_uri uri ^ ":=" ^ pp t l)
+ exp_named_subst
+ ) ^ "}"
+;;
+
+let ppterm t =
+ pp t []
+;;
+
+(* ppinductiveType (typename, inductive, arity, cons) *)
+(* pretty-prints a single inductive definition *)
+(* (typename, inductive, arity, cons) *)
+let ppinductiveType (typename, inductive, arity, cons) =
+ (if inductive then "\nInductive " else "\nCoInductive ") ^ typename ^ ": " ^
+ pp arity [] ^ " =\n " ^
+ List.fold_right
+ (fun (id,ty) i -> id ^ " : " ^ pp ty [] ^
+ (if i = "" then "\n" else "\n | ") ^ i)
+ cons ""
+;;
+
+let ppcontext ?(sep = "\n") context =
+ let separate s = if s = "" then "" else s ^ sep in
+ fst (List.fold_right
+ (fun context_entry (i,name_context) ->
+ match context_entry with
+ Some (n,Cic.Decl t) ->
+ Printf.sprintf "%s%s : %s" (separate i) (ppname n)
+ (pp t name_context), (Some n)::name_context
+ | Some (n,Cic.Def (bo,ty)) ->
+ Printf.sprintf "%s%s : %s := %s" (separate i) (ppname n)
+ (match ty with
+ None -> "_"
+ | Some ty -> pp ty name_context)
+ (pp bo name_context), (Some n)::name_context
+ | None ->
+ Printf.sprintf "%s_ :? _" (separate i), None::name_context
+ ) context ("",[]))
+
+(* ppobj obj returns a string with describing the cic object obj in a syntax *)
+(* similar to the one used by Coq *)
+let ppobj obj =
+ let module C = Cic in
+ let module U = UriManager in
+ match obj with
+ C.Constant (name, Some t1, t2, params, _) ->
+ "Definition of " ^ name ^
+ "(" ^ String.concat ";" (List.map UriManager.string_of_uri params) ^
+ ")" ^ ":\n" ^ pp t1 [] ^ " : " ^ pp t2 []
+ | C.Constant (name, None, ty, params, _) ->
+ "Axiom " ^ name ^
+ "(" ^ String.concat ";" (List.map UriManager.string_of_uri params) ^
+ "):\n" ^ pp ty []
+ | C.Variable (name, bo, ty, params, _) ->
+ "Variable " ^ name ^
+ "(" ^ String.concat ";" (List.map UriManager.string_of_uri params) ^
+ ")" ^ ":\n" ^
+ pp ty [] ^ "\n" ^
+ (match bo with None -> "" | Some bo -> ":= " ^ pp bo [])
+ | C.CurrentProof (name, conjectures, value, ty, params, _) ->
+ "Current Proof of " ^ name ^
+ "(" ^ String.concat ";" (List.map UriManager.string_of_uri params) ^
+ ")" ^ ":\n" ^
+ let separate s = if s = "" then "" else s ^ " ; " in
+ List.fold_right
+ (fun (n, context, t) i ->
+ let conjectures',name_context =
+ List.fold_right
+ (fun context_entry (i,name_context) ->
+ (match context_entry with
+ Some (n,C.Decl at) ->
+ (separate i) ^
+ ppname n ^ ":" ^ pp at name_context ^ " ",
+ (Some n)::name_context
+ | Some (n,C.Def (at,None)) ->
+ (separate i) ^
+ ppname n ^ ":= " ^ pp at name_context ^ " ",
+ (Some n)::name_context
+ | None ->
+ (separate i) ^ "_ :? _ ", None::name_context
+ | _ -> assert false)
+ ) context ("",[])
+ in
+ conjectures' ^ " |- " ^ "?" ^ (string_of_int n) ^ ": " ^
+ pp t name_context ^ "\n" ^ i
+ ) conjectures "" ^
+ "\n" ^ pp value [] ^ " : " ^ pp ty []
+ | C.InductiveDefinition (l, params, nparams, _) ->
+ "Parameters = " ^
+ String.concat ";" (List.map UriManager.string_of_uri params) ^ "\n" ^
+ "NParams = " ^ string_of_int nparams ^ "\n" ^
+ List.fold_right (fun x i -> ppinductiveType x ^ i) l ""
+;;
+
+let ppsort = function
+ | Cic.Prop -> "Prop"
+ | Cic.Set -> "Set"
+ | Cic.Type _ -> "Type"
+ | Cic.CProp -> "CProp"
+
+
+(* MATITA NAMING CONVENTION *)
+
+let is_prefix prefix string =
+ let len = String.length prefix in
+ let len1 = String.length string in
+ if len <= len1 then
+ begin
+ let head = String.sub string 0 len in
+ if
+ (String.compare (String.lowercase head) (String.lowercase prefix)=0) then
+ begin
+ let diff = len1-len in
+ let tail = String.sub string len diff in
+ if ((diff > 0) && (String.rcontains_from tail 0 '_')) then
+ Some (String.sub tail 1 (diff-1))
+ else Some tail
+ end
+ else None
+ end
+ else None
+
+let remove_prefix prefix (last,string) =
+ if prefix="append" then
+ begin
+ prerr_endline last;
+ prerr_endline string;
+ end;
+ if string = "" then (last,string)
+ else
+ match is_prefix prefix string with
+ None ->
+ if last <> "" then
+ match is_prefix last prefix with
+ None -> (last,string)
+ | Some _ ->
+ (match is_prefix prefix (last^string) with
+ None -> (last,string)
+ | Some tail -> (prefix,tail))
+ else (last,string)
+ | Some tail -> (prefix, tail)
+
+let legal_suffix string =
+ if string = "" then true else
+ begin
+ let legal_s = Str.regexp "_?\\([0-9]+\\|r\\|l\\|'\\|\"\\)" in
+ (Str.string_match legal_s string 0) && (Str.matched_string string = string)
+ end
+
+(** check if a prefix of string_name is legal for term and returns the tail.
+ chec_rec cannot fail: at worst it return string_name.
+ The algorithm is greedy, but last contains the last name matched, providing
+ a one slot buffer.
+ string_name is here a pair (last,string_name).*)
+
+let rec check_rec ctx string_name =
+ function
+ | Cic.Rel m ->
+ (match List.nth ctx (m-1) with
+ Cic.Name name ->
+ remove_prefix name string_name
+ | Cic.Anonymous -> string_name)
+ | Cic.Meta _ -> string_name
+ | Cic.Sort sort -> remove_prefix (ppsort sort) string_name
+ | Cic.Implicit _ -> string_name
+ | Cic.Cast (te,ty) -> check_rec ctx string_name te
+ | Cic.Prod (name,so,dest) ->
+ let l_string_name = check_rec ctx string_name so in
+ check_rec (name::ctx) string_name dest
+ | Cic.Lambda (name,so,dest) ->
+ let string_name =
+ match name with
+ Cic.Anonymous -> string_name
+ | Cic.Name name -> remove_prefix name string_name in
+ let l_string_name = check_rec ctx string_name so in
+ check_rec (name::ctx) l_string_name dest
+ | Cic.LetIn (name,so,dest) ->
+ let string_name = check_rec ctx string_name so in
+ check_rec (name::ctx) string_name dest
+ | Cic.Appl l ->
+ List.fold_left (check_rec ctx) string_name l
+ | Cic.Var (uri,exp_named_subst) ->
+ let name = UriManager.name_of_uri uri in
+ remove_prefix name string_name
+ | Cic.Const (uri,exp_named_subst) ->
+ let name = UriManager.name_of_uri uri in
+ remove_prefix name string_name
+ | Cic.MutInd (uri,_,exp_named_subst) ->
+ let name = UriManager.name_of_uri uri in
+ remove_prefix name string_name
+ | Cic.MutConstruct (uri,n,m,exp_named_subst) ->
+ let name =
+ (match fst(CicEnvironment.get_obj CicUniv.empty_ugraph uri) with
+ Cic.InductiveDefinition (dl,_,_,_) ->
+ let (_,_,_,cons) = get_nth dl (n+1) in
+ let (id,_) = get_nth cons m in
+ id
+ | _ -> assert false) in
+ remove_prefix name string_name
+ | Cic.MutCase (_,_,_,te,pl) ->
+ let strig_name = remove_prefix "match" string_name in
+ let string_name = check_rec ctx string_name te in
+ List.fold_right (fun t s -> check_rec ctx s t) pl string_name
+ | Cic.Fix (_,fl) ->
+ let strig_name = remove_prefix "fix" string_name in
+ let names = List.map (fun (name,_,_,_) -> name) fl in
+ let onames =
+ List.rev (List.map (function name -> Cic.Name name) names)
+ in
+ List.fold_right
+ (fun (_,_,_,bo) s -> check_rec (onames@ctx) s bo) fl string_name
+ | Cic.CoFix (_,fl) ->
+ let strig_name = remove_prefix "cofix" string_name in
+ let names = List.map (fun (name,_,_) -> name) fl in
+ let onames =
+ List.rev (List.map (function name -> Cic.Name name) names)
+ in
+ List.fold_right
+ (fun (_,_,bo) s -> check_rec (onames@ctx) s bo) fl string_name
+
+let check_name ?(allow_suffix=false) ctx name term =
+ let (_,tail) = check_rec ctx ("",name) term in
+ if (not allow_suffix) then (String.length tail = 0)
+ else legal_suffix tail
+
+let check_elim ctx conclusion_name =
+ let elim = Str.regexp "_elim\\|_case" in
+ if (Str.string_match elim conclusion_name 0) then
+ let len = String.length conclusion_name in
+ let tail = String.sub conclusion_name 5 (len-5) in
+ legal_suffix tail
+ else false
+
+let rec check_names ctx hyp_names conclusion_name t =
+ match t with
+ | Cic.Prod (name,s,t) ->
+ (match hyp_names with
+ [] -> check_names (name::ctx) hyp_names conclusion_name t
+ | hd::tl ->
+ if check_name ctx hd s then
+ check_names (name::ctx) tl conclusion_name t
+ else
+ check_names (name::ctx) hyp_names conclusion_name t)
+ | Cic.Appl ((Cic.Rel n)::args) ->
+ (match hyp_names with
+ | [] ->
+ (check_name ~allow_suffix:true ctx conclusion_name t) ||
+ (check_elim ctx conclusion_name)
+ | [what_to_elim] ->
+ (* what to elim could be an argument
+ of the predicate: e.g. leb_elim *)
+ let (last,tail) =
+ List.fold_left (check_rec ctx) ("",what_to_elim) args in
+ (tail = "" && check_elim ctx conclusion_name)
+ | _ -> false)
+ | Cic.MutCase (_,_,Cic.Lambda(name,so,ty),te,_) ->
+ (match hyp_names with
+ | [] ->
+ (match is_prefix "match" conclusion_name with
+ None -> check_name ~allow_suffix:true ctx conclusion_name t
+ | Some tail -> check_name ~allow_suffix:true ctx tail t)
+ | [what_to_match] ->
+ (* what to match could be the term te or its type so; in this case the
+ conclusion name should match ty *)
+ check_name ~allow_suffix:true (name::ctx) conclusion_name ty &&
+ (check_name ctx what_to_match te || check_name ctx what_to_match so)
+ | _ -> false)
+ | _ ->
+ hyp_names=[] && check_name ~allow_suffix:true ctx conclusion_name t
+
+let check name term =
+(* prerr_endline name;
+ prerr_endline (ppterm term); *)
+ let names = Str.split (Str.regexp_string "_to_") name in
+ let hyp_names,conclusion_name =
+ match List.rev names with
+ [] -> assert false
+ | hd::tl ->
+ let elim = Str.regexp "_elim\\|_case" in
+ let len = String.length hd in
+ try
+ let pos = Str.search_backward elim hd len in
+ let hyp = String.sub hd 0 pos in
+ let concl = String.sub hd pos (len-pos) in
+ List.rev (hyp::tl),concl
+ with Not_found -> (List.rev tl),hd in
+ check_names [] hyp_names conclusion_name term
+;;
+
+
diff --git a/helm/ocaml/cic_proof_checking/cicPp.mli b/helm/ocaml/cic_proof_checking/cicPp.mli
new file mode 100644
index 000000000..e84ae4fed
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/cicPp.mli
@@ -0,0 +1,55 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(*****************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Claudio Sacerdoti Coen <sacerdot@cs.unibo.it> *)
+(* 24/01/2000 *)
+(* *)
+(* This module implements a very simple Coq-like pretty printer that, given *)
+(* an object of cic (internal representation) returns a string describing the*)
+(* object in a syntax similar to that of coq *)
+(* *)
+(*****************************************************************************)
+
+(* ppobj obj returns a string with describing the cic object obj in a syntax*)
+(* similar to the one used by Coq *)
+val ppobj : Cic.obj -> string
+
+val ppterm : Cic.term -> string
+
+val ppcontext : ?sep:string -> Cic.context -> string
+
+(* Required only by the topLevel. It is the generalization of ppterm to *)
+(* work with environments. *)
+val pp : Cic.term -> (Cic.name option) list -> string
+
+val ppname : Cic.name -> string
+
+val ppsort: Cic.sort -> string
+
+val check: string -> Cic.term -> bool
diff --git a/helm/ocaml/cic_proof_checking/cicReduction.ml b/helm/ocaml/cic_proof_checking/cicReduction.ml
new file mode 100644
index 000000000..b7592f0fa
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/cicReduction.ml
@@ -0,0 +1,1137 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+(* TODO unify exceptions *)
+
+exception CicReductionInternalError;;
+exception WrongUriToInductiveDefinition;;
+exception Impossible of int;;
+exception ReferenceToConstant;;
+exception ReferenceToVariable;;
+exception ReferenceToCurrentProof;;
+exception ReferenceToInductiveDefinition;;
+
+let debug = false
+let profile = false
+let debug_print s = if debug then prerr_endline (Lazy.force s)
+
+let fdebug = ref 1;;
+let debug t env s =
+ let rec debug_aux t i =
+ let module C = Cic in
+ let module U = UriManager in
+ CicPp.ppobj (C.Variable ("DEBUG", None, t, [], [])) ^ "\n" ^ i
+ in
+ if !fdebug = 0 then
+ debug_print (lazy (s ^ "\n" ^ List.fold_right debug_aux (t::env) ""))
+;;
+
+module type Strategy =
+ sig
+ type stack_term
+ type env_term
+ type ens_term
+ val to_stack : Cic.term -> stack_term
+ val to_stack_list : Cic.term list -> stack_term list
+ val to_env : Cic.term -> env_term
+ val to_ens : Cic.term -> ens_term
+ val from_stack :
+ unwind:
+ (int -> env_term list -> ens_term Cic.explicit_named_substitution ->
+ Cic.term -> Cic.term) ->
+ stack_term -> Cic.term
+ val from_stack_list :
+ unwind:
+ (int -> env_term list -> ens_term Cic.explicit_named_substitution ->
+ Cic.term -> Cic.term) ->
+ stack_term list -> Cic.term list
+ val from_env : env_term -> Cic.term
+ val from_ens : ens_term -> Cic.term
+ val stack_to_env :
+ reduce:
+ (int * env_term list * ens_term Cic.explicit_named_substitution *
+ Cic.term * stack_term list -> Cic.term) ->
+ unwind:
+ (int -> env_term list -> ens_term Cic.explicit_named_substitution ->
+ Cic.term -> Cic.term) ->
+ stack_term -> env_term
+ val compute_to_env :
+ reduce:
+ (int * env_term list * ens_term Cic.explicit_named_substitution * Cic.term *
+ stack_term list -> Cic.term) ->
+ unwind:
+ (int -> env_term list -> ens_term Cic.explicit_named_substitution ->
+ Cic.term -> Cic.term) ->
+ int -> env_term list -> ens_term Cic.explicit_named_substitution ->
+ Cic.term -> env_term
+ val compute_to_stack :
+ reduce:
+ (int * env_term list * ens_term Cic.explicit_named_substitution * Cic.term *
+ stack_term list -> Cic.term) ->
+ unwind:
+ (int -> env_term list -> ens_term Cic.explicit_named_substitution ->
+ Cic.term -> Cic.term) ->
+ int -> env_term list -> ens_term Cic.explicit_named_substitution ->
+ Cic.term -> stack_term
+ end
+;;
+
+module CallByNameStrategy =
+ struct
+ type stack_term = Cic.term
+ type env_term = Cic.term
+ type ens_term = Cic.term
+ let to_stack v = v
+ let to_stack_list l = l
+ let to_env v = v
+ let to_ens v = v
+ let from_stack ~unwind v = v
+ let from_stack_list ~unwind l = l
+ let from_env v = v
+ let from_ens v = v
+ let stack_to_env ~reduce ~unwind v = v
+ let compute_to_stack ~reduce ~unwind k e ens t = unwind k e ens t
+ let compute_to_env ~reduce ~unwind k e ens t = unwind k e ens t
+ end
+;;
+
+module CallByValueStrategy =
+ struct
+ type stack_term = Cic.term
+ type env_term = Cic.term
+ type ens_term = Cic.term
+ let to_stack v = v
+ let to_stack_list l = l
+ let to_env v = v
+ let to_ens v = v
+ let from_stack ~unwind v = v
+ let from_stack_list ~unwind l = l
+ let from_env v = v
+ let from_ens v = v
+ let stack_to_env ~reduce ~unwind v = v
+ let compute_to_stack ~reduce ~unwind k e ens t = reduce (k,e,ens,t,[])
+ let compute_to_env ~reduce ~unwind k e ens t = reduce (k,e,ens,t,[])
+ end
+;;
+
+module CallByValueStrategyByNameOnConstants =
+ struct
+ type stack_term = Cic.term
+ type env_term = Cic.term
+ type ens_term = Cic.term
+ let to_stack v = v
+ let to_stack_list l = l
+ let to_env v = v
+ let to_ens v = v
+ let from_stack ~unwind v = v
+ let from_stack_list ~unwind l = l
+ let from_env v = v
+ let from_ens v = v
+ let stack_to_env ~reduce ~unwind v = v
+ let compute_to_stack ~reduce ~unwind k e ens =
+ function
+ Cic.Const _ as t -> unwind k e ens t
+ | t -> reduce (k,e,ens,t,[])
+ let compute_to_env ~reduce ~unwind k e ens =
+ function
+ Cic.Const _ as t -> unwind k e ens t
+ | t -> reduce (k,e,ens,t,[])
+ end
+;;
+
+module LazyCallByValueStrategy =
+ struct
+ type stack_term = Cic.term lazy_t
+ type env_term = Cic.term lazy_t
+ type ens_term = Cic.term lazy_t
+ let to_stack v = lazy v
+ let to_stack_list l = List.map to_stack l
+ let to_env v = lazy v
+ let to_ens v = lazy v
+ let from_stack ~unwind v = Lazy.force v
+ let from_stack_list ~unwind l = List.map (from_stack ~unwind) l
+ let from_env v = Lazy.force v
+ let from_ens v = Lazy.force v
+ let stack_to_env ~reduce ~unwind v = v
+ let compute_to_stack ~reduce ~unwind k e ens t = lazy (reduce (k,e,ens,t,[]))
+ let compute_to_env ~reduce ~unwind k e ens t = lazy (reduce (k,e,ens,t,[]))
+ end
+;;
+
+module LazyCallByValueStrategyByNameOnConstants =
+ struct
+ type stack_term = Cic.term lazy_t
+ type env_term = Cic.term lazy_t
+ type ens_term = Cic.term lazy_t
+ let to_stack v = lazy v
+ let to_stack_list l = List.map to_stack l
+ let to_env v = lazy v
+ let to_ens v = lazy v
+ let from_stack ~unwind v = Lazy.force v
+ let from_stack_list ~unwind l = List.map (from_stack ~unwind) l
+ let from_env v = Lazy.force v
+ let from_ens v = Lazy.force v
+ let stack_to_env ~reduce ~unwind v = v
+ let compute_to_stack ~reduce ~unwind k e ens t =
+ lazy (
+ match t with
+ Cic.Const _ as t -> unwind k e ens t
+ | t -> reduce (k,e,ens,t,[]))
+ let compute_to_env ~reduce ~unwind k e ens t =
+ lazy (
+ match t with
+ Cic.Const _ as t -> unwind k e ens t
+ | t -> reduce (k,e,ens,t,[]))
+ end
+;;
+
+module LazyCallByNameStrategy =
+ struct
+ type stack_term = Cic.term lazy_t
+ type env_term = Cic.term lazy_t
+ type ens_term = Cic.term lazy_t
+ let to_stack v = lazy v
+ let to_stack_list l = List.map to_stack l
+ let to_env v = lazy v
+ let to_ens v = lazy v
+ let from_stack ~unwind v = Lazy.force v
+ let from_stack_list ~unwind l = List.map (from_stack ~unwind) l
+ let from_env v = Lazy.force v
+ let from_ens v = Lazy.force v
+ let stack_to_env ~reduce ~unwind v = v
+ let compute_to_stack ~reduce ~unwind k e ens t = lazy (unwind k e ens t)
+ let compute_to_env ~reduce ~unwind k e ens t = lazy (unwind k e ens t)
+ end
+;;
+
+module
+ LazyCallByValueByNameOnConstantsWhenFromStack_ByNameStrategyWhenFromEnvOrEns
+=
+ struct
+ type stack_term = reduce:bool -> Cic.term
+ type env_term = reduce:bool -> Cic.term
+ type ens_term = reduce:bool -> Cic.term
+ let to_stack v =
+ let value = lazy v in
+ fun ~reduce -> Lazy.force value
+ let to_stack_list l = List.map to_stack l
+ let to_env v =
+ let value = lazy v in
+ fun ~reduce -> Lazy.force value
+ let to_ens v =
+ let value = lazy v in
+ fun ~reduce -> Lazy.force value
+ let from_stack ~unwind v = (v ~reduce:false)
+ let from_stack_list ~unwind l = List.map (from_stack ~unwind) l
+ let from_env v = (v ~reduce:true)
+ let from_ens v = (v ~reduce:true)
+ let stack_to_env ~reduce ~unwind v = v
+ let compute_to_stack ~reduce ~unwind k e ens t =
+ let svalue =
+ lazy (
+ match t with
+ Cic.Const _ as t -> unwind k e ens t
+ | t -> reduce (k,e,ens,t,[])
+ ) in
+ let lvalue =
+ lazy (unwind k e ens t)
+ in
+ fun ~reduce ->
+ if reduce then Lazy.force svalue else Lazy.force lvalue
+ let compute_to_env ~reduce ~unwind k e ens t =
+ let svalue =
+ lazy (
+ match t with
+ Cic.Const _ as t -> unwind k e ens t
+ | t -> reduce (k,e,ens,t,[])
+ ) in
+ let lvalue =
+ lazy (unwind k e ens t)
+ in
+ fun ~reduce ->
+ if reduce then Lazy.force svalue else Lazy.force lvalue
+ end
+;;
+
+module ClosuresOnStackByValueFromEnvOrEnsStrategy =
+ struct
+ type stack_term =
+ int * Cic.term list * Cic.term Cic.explicit_named_substitution * Cic.term
+ type env_term = Cic.term
+ type ens_term = Cic.term
+ let to_stack v = (0,[],[],v)
+ let to_stack_list l = List.map to_stack l
+ let to_env v = v
+ let to_ens v = v
+ let from_stack ~unwind (k,e,ens,t) = unwind k e ens t
+ let from_stack_list ~unwind l = List.map (from_stack ~unwind) l
+ let from_env v = v
+ let from_ens v = v
+ let stack_to_env ~reduce ~unwind (k,e,ens,t) = reduce (k,e,ens,t,[])
+ let compute_to_env ~reduce ~unwind k e ens t =
+ unwind k e ens t
+ let compute_to_stack ~reduce ~unwind k e ens t = (k,e,ens,t)
+ end
+;;
+
+module ClosuresOnStackByValueFromEnvOrEnsByNameOnConstantsStrategy =
+ struct
+ type stack_term =
+ int * Cic.term list * Cic.term Cic.explicit_named_substitution * Cic.term
+ type env_term = Cic.term
+ type ens_term = Cic.term
+ let to_stack v = (0,[],[],v)
+ let to_stack_list l = List.map to_stack l
+ let to_env v = v
+ let to_ens v = v
+ let from_stack ~unwind (k,e,ens,t) = unwind k e ens t
+ let from_stack_list ~unwind l = List.map (from_stack ~unwind) l
+ let from_env v = v
+ let from_ens v = v
+ let stack_to_env ~reduce ~unwind (k,e,ens,t) =
+ match t with
+ Cic.Const _ as t -> unwind k e ens t
+ | t -> reduce (k,e,ens,t,[])
+ let compute_to_env ~reduce ~unwind k e ens t =
+ unwind k e ens t
+ let compute_to_stack ~reduce ~unwind k e ens t = (k,e,ens,t)
+ end
+;;
+
+module Reduction(RS : Strategy) =
+ struct
+ type env = RS.env_term list
+ type ens = RS.ens_term Cic.explicit_named_substitution
+ type stack = RS.stack_term list
+ type config = int * env * ens * Cic.term * stack
+
+ (* k is the length of the environment e *)
+ (* m is the current depth inside the term *)
+ let unwind' m k e ens t =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ if k = 0 && ens = [] then
+ t
+ else
+ let rec unwind_aux m =
+ function
+ C.Rel n as t ->
+ if n <= m then t else
+ let d =
+ try
+ Some (RS.from_env (List.nth e (n-m-1)))
+ with _ -> None
+ in
+ (match d with
+ Some t' ->
+ if m = 0 then t' else S.lift m t'
+ | None -> C.Rel (n-k)
+ )
+ | C.Var (uri,exp_named_subst) ->
+(*
+debug_print (lazy ("%%%%%UWVAR " ^ String.concat " ; " (List.map (function (uri,t) -> UriManager.string_of_uri uri ^ " := " ^ CicPp.ppterm t) ens))) ;
+*)
+ if List.exists (function (uri',_) -> UriManager.eq uri' uri) ens then
+ CicSubstitution.lift m (RS.from_ens (List.assq uri ens))
+ else
+ let params =
+ let o,_ =
+ CicEnvironment.get_cooked_obj CicUniv.empty_ugraph uri
+ in
+ (match o with
+ C.Constant _ -> raise ReferenceToConstant
+ | C.Variable (_,_,_,params,_) -> params
+ | C.CurrentProof _ -> raise ReferenceToCurrentProof
+ | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+ )
+ in
+ let exp_named_subst' =
+ substaux_in_exp_named_subst params exp_named_subst m
+ in
+ C.Var (uri,exp_named_subst')
+ | C.Meta (i,l) ->
+ let l' =
+ List.map
+ (function
+ None -> None
+ | Some t -> Some (unwind_aux m t)
+ ) l
+ in
+ C.Meta (i, l')
+ | C.Sort _ as t -> t
+ | C.Implicit _ as t -> t
+ | C.Cast (te,ty) -> C.Cast (unwind_aux m te, unwind_aux m ty) (*CSC ???*)
+ | C.Prod (n,s,t) -> C.Prod (n, unwind_aux m s, unwind_aux (m + 1) t)
+ | C.Lambda (n,s,t) -> C.Lambda (n, unwind_aux m s, unwind_aux (m + 1) t)
+ | C.LetIn (n,s,t) -> C.LetIn (n, unwind_aux m s, unwind_aux (m + 1) t)
+ | C.Appl l -> C.Appl (List.map (unwind_aux m) l)
+ | C.Const (uri,exp_named_subst) ->
+ let params =
+ let o,_ =
+ CicEnvironment.get_cooked_obj CicUniv.empty_ugraph uri
+ in
+ (match o with
+ C.Constant (_,_,_,params,_) -> params
+ | C.Variable _ -> raise ReferenceToVariable
+ | C.CurrentProof (_,_,_,_,params,_) -> params
+ | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+ )
+ in
+ let exp_named_subst' =
+ substaux_in_exp_named_subst params exp_named_subst m
+ in
+ C.Const (uri,exp_named_subst')
+ | C.MutInd (uri,i,exp_named_subst) ->
+ let params =
+ let o,_ =
+ CicEnvironment.get_cooked_obj CicUniv.empty_ugraph uri
+ in
+ (match o with
+ C.Constant _ -> raise ReferenceToConstant
+ | C.Variable _ -> raise ReferenceToVariable
+ | C.CurrentProof _ -> raise ReferenceToCurrentProof
+ | C.InductiveDefinition (_,params,_,_) -> params
+ )
+ in
+ let exp_named_subst' =
+ substaux_in_exp_named_subst params exp_named_subst m
+ in
+ C.MutInd (uri,i,exp_named_subst')
+ | C.MutConstruct (uri,i,j,exp_named_subst) ->
+ let params =
+ let o,_ =
+ CicEnvironment.get_cooked_obj CicUniv.empty_ugraph uri
+ in
+ (match o with
+ C.Constant _ -> raise ReferenceToConstant
+ | C.Variable _ -> raise ReferenceToVariable
+ | C.CurrentProof _ -> raise ReferenceToCurrentProof
+ | C.InductiveDefinition (_,params,_,_) -> params
+ )
+ in
+ let exp_named_subst' =
+ substaux_in_exp_named_subst params exp_named_subst m
+ in
+ C.MutConstruct (uri,i,j,exp_named_subst')
+ | C.MutCase (sp,i,outt,t,pl) ->
+ C.MutCase (sp,i,unwind_aux m outt, unwind_aux m t,
+ List.map (unwind_aux m) pl)
+ | C.Fix (i,fl) ->
+ let len = List.length fl in
+ let substitutedfl =
+ List.map
+ (fun (name,i,ty,bo) ->
+ (name, i, unwind_aux m ty, unwind_aux (m+len) bo))
+ fl
+ in
+ C.Fix (i, substitutedfl)
+ | C.CoFix (i,fl) ->
+ let len = List.length fl in
+ let substitutedfl =
+ List.map
+ (fun (name,ty,bo) -> (name, unwind_aux m ty, unwind_aux (m+len) bo))
+ fl
+ in
+ C.CoFix (i, substitutedfl)
+ and substaux_in_exp_named_subst params exp_named_subst' m =
+ (*CSC: Idea di Andrea di ordinare compatibilmente con l'ordine dei params
+ let ens' =
+ List.map (function (uri,t) -> uri, unwind_aux m t) exp_named_subst' @
+ (*CSC: qui liftiamo tutti gli ens anche se magari me ne servono la meta'!!! *)
+ List.map (function (uri,t) -> uri, CicSubstitution.lift m t) ens
+ in
+ let rec filter_and_lift =
+ function
+ [] -> []
+ | uri::tl ->
+ let r = filter_and_lift tl in
+ (try
+ (uri,(List.assq uri ens'))::r
+ with
+ Not_found -> r
+ )
+ in
+ filter_and_lift params
+ *)
+
+ (*CSC: invece di concatenare sarebbe meglio rispettare l'ordine dei params *)
+ (*CSC: e' vero???? una veloce prova non sembra confermare la teoria *)
+
+ (*CSC: codice copiato e modificato dalla cicSubstitution.subst_vars *)
+ (*CSC: codice altamente inefficiente *)
+ let rec filter_and_lift already_instantiated =
+ function
+ [] -> []
+ | (uri,t)::tl when
+ List.for_all
+ (function (uri',_)-> not (UriManager.eq uri uri')) exp_named_subst'
+ &&
+ not (List.mem uri already_instantiated)
+ &&
+ List.mem uri params
+ ->
+ (uri,CicSubstitution.lift m (RS.from_ens t)) ::
+ (filter_and_lift (uri::already_instantiated) tl)
+ | _::tl -> filter_and_lift already_instantiated tl
+(*
+ | (uri,_)::tl ->
+debug_print (lazy ("---- SKIPPO " ^ UriManager.string_of_uri uri)) ;
+if List.for_all (function (uri',_) -> not (UriManager.eq uri uri'))
+exp_named_subst' then debug_print (lazy "---- OK1") ;
+debug_print (lazy ("++++ uri " ^ UriManager.string_of_uri uri ^ " not in " ^ String.concat " ; " (List.map UriManager.string_of_uri params))) ;
+if List.mem uri params then debug_print (lazy "---- OK2") ;
+ filter_and_lift tl
+*)
+ in
+ List.map (function (uri,t) -> uri, unwind_aux m t) exp_named_subst' @
+ (filter_and_lift [] (List.rev ens))
+ in
+ unwind_aux m t
+ ;;
+
+ let unwind = unwind' 0;;
+
+(*
+ let unwind =
+ let profiler_unwind = HExtlib.profile ~enable:profile "are_convertible.unwind" in
+ fun k e ens t ->
+ profiler_unwind.HExtlib.profile (unwind k e ens) t
+ ;;
+*)
+
+ let reduce ~delta ?(subst = []) context : config -> Cic.term =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ let rec reduce =
+ function
+ (k, e, _, C.Rel n, s) ->
+ let d =
+ try
+ Some (RS.from_env (List.nth e (n-1)))
+ with
+ _ ->
+ try
+ begin
+ match List.nth context (n - 1 - k) with
+ None -> assert false
+ | Some (_,C.Decl _) -> None
+ | Some (_,C.Def (x,_)) -> Some (S.lift (n - k) x)
+ end
+ with
+ _ -> None
+ in
+ (match d with
+ Some t' -> reduce (0,[],[],t',s)
+ | None ->
+ if s = [] then
+ C.Rel (n-k)
+ else C.Appl (C.Rel (n-k)::(RS.from_stack_list ~unwind s))
+ )
+ | (k, e, ens, (C.Var (uri,exp_named_subst) as t), s) ->
+ if List.exists (function (uri',_) -> UriManager.eq uri' uri) ens then
+ reduce (0, [], [], RS.from_ens (List.assq uri ens), s)
+ else
+ ( let o,_ =
+ CicEnvironment.get_cooked_obj CicUniv.empty_ugraph uri
+ in
+ match o with
+ C.Constant _ -> raise ReferenceToConstant
+ | C.CurrentProof _ -> raise ReferenceToCurrentProof
+ | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+ | C.Variable (_,None,_,_,_) ->
+ let t' = unwind k e ens t in
+ if s = [] then t' else
+ C.Appl (t'::(RS.from_stack_list ~unwind s))
+ | C.Variable (_,Some body,_,_,_) ->
+ let ens' = push_exp_named_subst k e ens exp_named_subst in
+ reduce (0, [], ens', body, s)
+ )
+ | (k, e, ens, (C.Meta (n,l) as t), s) ->
+ (try
+ let (_, term,_) = CicUtil.lookup_subst n subst in
+ reduce (k, e, ens,CicSubstitution.subst_meta l term,s)
+ with CicUtil.Subst_not_found _ ->
+ let t' = unwind k e ens t in
+ if s = [] then t' else C.Appl (t'::(RS.from_stack_list ~unwind s)))
+ | (k, e, _, (C.Sort _ as t), s) -> t (* s should be empty *)
+ | (k, e, _, (C.Implicit _ as t), s) -> t (* s should be empty *)
+ | (k, e, ens, C.Cast (te,ty), s) ->
+ reduce (k, e, ens, te, s) (* s should be empty *)
+ | (k, e, ens, (C.Prod _ as t), s) ->
+ unwind k e ens t (* s should be empty *)
+ | (k, e, ens, (C.Lambda (_,_,t) as t'), []) -> unwind k e ens t'
+ | (k, e, ens, C.Lambda (_,_,t), p::s) ->
+ reduce (k+1, (RS.stack_to_env ~reduce ~unwind p)::e, ens, t,s)
+ | (k, e, ens, C.LetIn (_,m,t), s) ->
+ let m' = RS.compute_to_env ~reduce ~unwind k e ens m in
+ reduce (k+1, m'::e, ens, t, s)
+ | (_, _, _, C.Appl [], _) -> assert false
+ | (k, e, ens, C.Appl (he::tl), s) ->
+ let tl' =
+ List.map
+ (function t -> RS.compute_to_stack ~reduce ~unwind k e ens t) tl
+ in
+ reduce (k, e, ens, he, (List.append tl') s)
+ (* CSC: Old Dead Code
+ | (k, e, ens, C.Appl ((C.Lambda _ as he)::tl), s)
+ | (k, e, ens, C.Appl ((C.Const _ as he)::tl), s)
+ | (k, e, ens, C.Appl ((C.MutCase _ as he)::tl), s)
+ | (k, e, ens, C.Appl ((C.Fix _ as he)::tl), s) ->
+ (* strict evaluation, but constants are NOT unfolded *)
+ let red =
+ function
+ C.Const _ as t -> unwind k e ens t
+ | t -> reduce (k,e,ens,t,[])
+ in
+ let tl' = List.map red tl in
+ reduce (k, e, ens, he , List.append tl' s)
+ | (k, e, ens, C.Appl l, s) ->
+ C.Appl (List.append (List.map (unwind k e ens) l) s)
+ *)
+ | (k, e, ens, (C.Const (uri,exp_named_subst) as t), s) when delta=false->
+ let t' = unwind k e ens t in
+ if s = [] then t' else C.Appl (t'::(RS.from_stack_list ~unwind s))
+ | (k, e, ens, (C.Const (uri,exp_named_subst) as t), s) ->
+ (let o,_ =
+ CicEnvironment.get_cooked_obj CicUniv.empty_ugraph uri
+ in
+ match o with
+ C.Constant (_,Some body,_,_,_) ->
+ let ens' = push_exp_named_subst k e ens exp_named_subst in
+ (* constants are closed *)
+ reduce (0, [], ens', body, s)
+ | C.Constant (_,None,_,_,_) ->
+ let t' = unwind k e ens t in
+ if s = [] then t' else C.Appl (t'::(RS.from_stack_list ~unwind s))
+ | C.Variable _ -> raise ReferenceToVariable
+ | C.CurrentProof (_,_,body,_,_,_) ->
+ let ens' = push_exp_named_subst k e ens exp_named_subst in
+ (* constants are closed *)
+ reduce (0, [], ens', body, s)
+ | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+ )
+ | (k, e, ens, (C.MutInd _ as t),s) ->
+ let t' = unwind k e ens t in
+ if s = [] then t' else C.Appl (t'::(RS.from_stack_list ~unwind s))
+ | (k, e, ens, (C.MutConstruct _ as t),s) ->
+ let t' = unwind k e ens t in
+ if s = [] then t' else C.Appl (t'::(RS.from_stack_list ~unwind s))
+ | (k, e, ens, (C.MutCase (mutind,i,_,term,pl) as t),s) ->
+ let decofix =
+ function
+ C.CoFix (i,fl) ->
+ let (_,_,body) = List.nth fl i in
+ let body' =
+ let counter = ref (List.length fl) in
+ List.fold_right
+ (fun _ -> decr counter ; S.subst (C.CoFix (!counter,fl)))
+ fl
+ body
+ in
+ (* the term is the result of a reduction; *)
+ (* so it is already unwinded. *)
+ reduce (0,[],[],body',[])
+ | C.Appl (C.CoFix (i,fl) :: tl) ->
+ let (_,_,body) = List.nth fl i in
+ let body' =
+ let counter = ref (List.length fl) in
+ List.fold_right
+ (fun _ -> decr counter ; S.subst (C.CoFix (!counter,fl)))
+ fl
+ body
+ in
+ (* the term is the result of a reduction; *)
+ (* so it is already unwinded. *)
+ reduce (0,[],[],body',RS.to_stack_list tl)
+ | t -> t
+ in
+ (match decofix (reduce (k,e,ens,term,[])) with
+ C.MutConstruct (_,_,j,_) ->
+ reduce (k, e, ens, (List.nth pl (j-1)), s)
+ | C.Appl (C.MutConstruct (_,_,j,_) :: tl) ->
+ let (arity, r) =
+ let o,_ =
+ CicEnvironment.get_cooked_obj CicUniv.empty_ugraph mutind
+ in
+ match o with
+ C.InductiveDefinition (tl,ingredients,r,_) ->
+ let (_,_,arity,_) = List.nth tl i in
+ (arity,r)
+ | _ -> raise WrongUriToInductiveDefinition
+ in
+ let ts =
+ let num_to_eat = r in
+ let rec eat_first =
+ function
+ (0,l) -> l
+ | (n,he::tl) when n > 0 -> eat_first (n - 1, tl)
+ | _ -> raise (Impossible 5)
+ in
+ eat_first (num_to_eat,tl)
+ in
+ (* ts are already unwinded because they are a sublist of tl *)
+ reduce (k, e, ens, (List.nth pl (j-1)), (RS.to_stack_list ts)@s)
+ | C.Cast _ | C.Implicit _ ->
+ raise (Impossible 2) (* we don't trust our whd ;-) *)
+ | _ ->
+ let t' = unwind k e ens t in
+ if s = [] then t' else C.Appl (t'::(RS.from_stack_list ~unwind s))
+ )
+ | (k, e, ens, (C.Fix (i,fl) as t), s) ->
+ let (_,recindex,_,body) = List.nth fl i in
+ let recparam =
+ try
+ Some (RS.from_stack ~unwind (List.nth s recindex))
+ with
+ _ -> None
+ in
+ (match recparam with
+ Some recparam ->
+ (match reduce (0,[],[],recparam,[]) with
+ (* match recparam with *)
+ C.MutConstruct _
+ | C.Appl ((C.MutConstruct _)::_) ->
+ (* OLD
+ let body' =
+ let counter = ref (List.length fl) in
+ List.fold_right
+ (fun _ -> decr counter ; S.subst (C.Fix (!counter,fl)))
+ fl
+ body
+ in
+ reduce (k, e, ens, body', s) *)
+ (* NEW *)
+ let leng = List.length fl in
+ let fl' =
+ let unwind_fl (name,recindex,typ,body) =
+ (name,recindex,unwind k e ens typ,
+ unwind' leng k e ens body)
+ in
+ List.map unwind_fl fl
+ in
+ let new_env =
+ let counter = ref 0 in
+ let rec build_env e =
+ if !counter = leng then e
+ else
+ (incr counter ;
+ build_env ((RS.to_env (C.Fix (!counter -1, fl')))::e))
+ in
+ build_env e
+ in
+ reduce (k+leng, new_env, ens, body, s)
+ | _ ->
+ let t' = unwind k e ens t in
+ if s = [] then t' else
+ C.Appl (t'::(RS.from_stack_list ~unwind s))
+ )
+ | None ->
+ let t' = unwind k e ens t in
+ if s = [] then t' else
+ C.Appl (t'::(RS.from_stack_list ~unwind s))
+ )
+ | (k, e, ens, (C.CoFix (i,fl) as t),s) ->
+ let t' = unwind k e ens t in
+ if s = [] then t' else C.Appl (t'::(RS.from_stack_list ~unwind s))
+ and push_exp_named_subst k e ens =
+ function
+ [] -> ens
+ | (uri,t)::tl ->
+ push_exp_named_subst k e ((uri,RS.to_ens (unwind k e ens t))::ens) tl
+ in
+ reduce
+ ;;
+ (*
+ let rec whd context t =
+ try
+ reduce context (0, [], [], t, [])
+ with Not_found ->
+ debug_print (lazy (CicPp.ppterm t)) ;
+ raise Not_found
+ ;;
+ *)
+
+ let rec whd ?(delta=true) ?(subst=[]) context t =
+ reduce ~delta ~subst context (0, [], [], t, [])
+ ;;
+
+
+ end
+;;
+
+
+(* ROTTO = rompe l'unificazione poiche' riduce gli argomenti di un'applicazione
+ senza ridurre la testa
+module R = Reduction CallByNameStrategy;; OK 56.368s
+module R = Reduction CallByValueStrategy;; ROTTO
+module R = Reduction CallByValueStrategyByNameOnConstants;; ROTTO
+module R = Reduction LazyCallByValueStrategy;; ROTTO
+module R = Reduction LazyCallByValueStrategyByNameOnConstants;; ROTTO
+module R = Reduction LazyCallByNameStrategy;; OK 0m56.398s
+module R = Reduction
+ LazyCallByValueByNameOnConstantsWhenFromStack_ByNameStrategyWhenFromEnvOrEns;;
+ OK 59.058s
+module R = Reduction ClosuresOnStackByValueFromEnvOrEnsStrategy;; OK 58.583s
+module R = Reduction
+ ClosuresOnStackByValueFromEnvOrEnsByNameOnConstantsStrategy;; OK 58.094s
+module R = Reduction(ClosuresOnStackByValueFromEnvOrEnsStrategy);; OK 58.127s
+*)
+module R = Reduction(ClosuresOnStackByValueFromEnvOrEnsStrategy);;
+module U = UriManager;;
+
+let whd = R.whd
+
+(*
+let whd =
+ let profiler_whd = HExtlib.profile ~enable:profile "are_convertible.whd" in
+ fun ?(delta=true) ?(subst=[]) context t ->
+ profiler_whd.HExtlib.profile (whd ~delta ~subst context) t
+*)
+
+ (* mimic ocaml (<< 3.08) "=" behaviour. Tests physical equality first then
+ * fallbacks to structural equality *)
+let (===) x y =
+ Pervasives.compare x y = 0
+
+(* t1, t2 must be well-typed *)
+let are_convertible whd ?(subst=[]) ?(metasenv=[]) =
+ let rec aux test_equality_only context t1 t2 ugraph =
+ let aux2 test_equality_only t1 t2 ugraph =
+
+ (* this trivial euristic cuts down the total time of about five times ;-) *)
+ (* this because most of the time t1 and t2 are "sintactically" the same *)
+ if t1 === t2 then
+ true,ugraph
+ else
+ begin
+ let module C = Cic in
+ match (t1,t2) with
+ (C.Rel n1, C.Rel n2) -> (n1 = n2),ugraph
+ | (C.Var (uri1,exp_named_subst1), C.Var (uri2,exp_named_subst2)) ->
+ if U.eq uri1 uri2 then
+ (try
+ List.fold_right2
+ (fun (uri1,x) (uri2,y) (b,ugraph) ->
+ let b',ugraph' = aux test_equality_only context x y ugraph in
+ (U.eq uri1 uri2 && b' && b),ugraph'
+ ) exp_named_subst1 exp_named_subst2 (true,ugraph)
+ with
+ Invalid_argument _ -> false,ugraph
+ )
+ else
+ false,ugraph
+ | (C.Meta (n1,l1), C.Meta (n2,l2)) ->
+ if n1 = n2 then
+ let b2, ugraph1 =
+ let l1 = CicUtil.clean_up_local_context subst metasenv n1 l1 in
+ let l2 = CicUtil.clean_up_local_context subst metasenv n2 l2 in
+ List.fold_left2
+ (fun (b,ugraph) t1 t2 ->
+ if b then
+ match t1,t2 with
+ None,_
+ | _,None -> true,ugraph
+ | Some t1',Some t2' ->
+ aux test_equality_only context t1' t2' ugraph
+ else
+ false,ugraph
+ ) (true,ugraph) l1 l2
+ in
+ if b2 then true,ugraph1 else false,ugraph
+ else
+ false,ugraph
+ (* TASSI: CONSTRAINTS *)
+ | (C.Sort (C.Type t1), C.Sort (C.Type t2)) when test_equality_only ->
+ true,(CicUniv.add_eq t2 t1 ugraph)
+ (* TASSI: CONSTRAINTS *)
+ | (C.Sort (C.Type t1), C.Sort (C.Type t2)) ->
+ true,(CicUniv.add_ge t2 t1 ugraph)
+ (* TASSI: CONSTRAINTS *)
+ | (C.Sort s1, C.Sort (C.Type _)) -> (not test_equality_only),ugraph
+ (* TASSI: CONSTRAINTS *)
+ | (C.Sort s1, C.Sort s2) -> (s1 = s2),ugraph
+ | (C.Prod (name1,s1,t1), C.Prod(_,s2,t2)) ->
+ let b',ugraph' = aux true context s1 s2 ugraph in
+ if b' then
+ aux test_equality_only ((Some (name1, (C.Decl s1)))::context)
+ t1 t2 ugraph'
+ else
+ false,ugraph
+ | (C.Lambda (name1,s1,t1), C.Lambda(_,s2,t2)) ->
+ let b',ugraph' = aux test_equality_only context s1 s2 ugraph in
+ if b' then
+ aux test_equality_only ((Some (name1, (C.Decl s1)))::context)
+ t1 t2 ugraph'
+ else
+ false,ugraph
+ | (C.LetIn (name1,s1,t1), C.LetIn(_,s2,t2)) ->
+ let b',ugraph' = aux test_equality_only context s1 s2 ugraph in
+ if b' then
+ aux test_equality_only
+ ((Some (name1, (C.Def (s1,None))))::context) t1 t2 ugraph'
+ else
+ false,ugraph
+ | (C.Appl l1, C.Appl l2) ->
+ (try
+ List.fold_right2
+ (fun x y (b,ugraph) ->
+ if b then
+ aux test_equality_only context x y ugraph
+ else
+ false,ugraph) l1 l2 (true,ugraph)
+ with
+ Invalid_argument _ -> false,ugraph
+ )
+ | (C.Const (uri1,exp_named_subst1), C.Const (uri2,exp_named_subst2)) ->
+ let b' = U.eq uri1 uri2 in
+ if b' then
+ (try
+ List.fold_right2
+ (fun (uri1,x) (uri2,y) (b,ugraph) ->
+ if b && U.eq uri1 uri2 then
+ aux test_equality_only context x y ugraph
+ else
+ false,ugraph
+ ) exp_named_subst1 exp_named_subst2 (true,ugraph)
+ with
+ Invalid_argument _ -> false,ugraph
+ )
+ else
+ false,ugraph
+ | (C.MutInd (uri1,i1,exp_named_subst1),
+ C.MutInd (uri2,i2,exp_named_subst2)
+ ) ->
+ let b' = U.eq uri1 uri2 && i1 = i2 in
+ if b' then
+ (try
+ List.fold_right2
+ (fun (uri1,x) (uri2,y) (b,ugraph) ->
+ if b && U.eq uri1 uri2 then
+ aux test_equality_only context x y ugraph
+ else
+ false,ugraph
+ ) exp_named_subst1 exp_named_subst2 (true,ugraph)
+ with
+ Invalid_argument _ -> false,ugraph
+ )
+ else
+ false,ugraph
+ | (C.MutConstruct (uri1,i1,j1,exp_named_subst1),
+ C.MutConstruct (uri2,i2,j2,exp_named_subst2)
+ ) ->
+ let b' = U.eq uri1 uri2 && i1 = i2 && j1 = j2 in
+ if b' then
+ (try
+ List.fold_right2
+ (fun (uri1,x) (uri2,y) (b,ugraph) ->
+ if b && U.eq uri1 uri2 then
+ aux test_equality_only context x y ugraph
+ else
+ false,ugraph
+ ) exp_named_subst1 exp_named_subst2 (true,ugraph)
+ with
+ Invalid_argument _ -> false,ugraph
+ )
+ else
+ false,ugraph
+ | (C.MutCase (uri1,i1,outtype1,term1,pl1),
+ C.MutCase (uri2,i2,outtype2,term2,pl2)) ->
+ let b' = U.eq uri1 uri2 && i1 = i2 in
+ if b' then
+ let b'',ugraph''=aux test_equality_only context
+ outtype1 outtype2 ugraph in
+ if b'' then
+ let b''',ugraph'''= aux test_equality_only context
+ term1 term2 ugraph'' in
+ List.fold_right2
+ (fun x y (b,ugraph) ->
+ if b then
+ aux test_equality_only context x y ugraph
+ else
+ false,ugraph)
+ pl1 pl2 (b''',ugraph''')
+ else
+ false,ugraph
+ else
+ false,ugraph
+ | (C.Fix (i1,fl1), C.Fix (i2,fl2)) ->
+ let tys =
+ List.map (function (n,_,ty,_) -> Some (C.Name n,(C.Decl ty))) fl1
+ in
+ if i1 = i2 then
+ List.fold_right2
+ (fun (_,recindex1,ty1,bo1) (_,recindex2,ty2,bo2) (b,ugraph) ->
+ if b && recindex1 = recindex2 then
+ let b',ugraph' = aux test_equality_only context ty1 ty2
+ ugraph in
+ if b' then
+ aux test_equality_only (tys@context) bo1 bo2 ugraph'
+ else
+ false,ugraph
+ else
+ false,ugraph)
+ fl1 fl2 (true,ugraph)
+ else
+ false,ugraph
+ | (C.CoFix (i1,fl1), C.CoFix (i2,fl2)) ->
+ let tys =
+ List.map (function (n,ty,_) -> Some (C.Name n,(C.Decl ty))) fl1
+ in
+ if i1 = i2 then
+ List.fold_right2
+ (fun (_,ty1,bo1) (_,ty2,bo2) (b,ugraph) ->
+ if b then
+ let b',ugraph' = aux test_equality_only context ty1 ty2
+ ugraph in
+ if b' then
+ aux test_equality_only (tys@context) bo1 bo2 ugraph'
+ else
+ false,ugraph
+ else
+ false,ugraph)
+ fl1 fl2 (true,ugraph)
+ else
+ false,ugraph
+ | (C.Cast _, _) | (_, C.Cast _)
+ | (C.Implicit _, _) | (_, C.Implicit _) -> assert false
+ | (_,_) -> false,ugraph
+ end
+ in
+ begin
+ debug t1 [t2] "PREWHD";
+ (*
+ (match t1 with
+ Cic.Meta _ ->
+ debug_print (lazy (CicPp.ppterm t1));
+ debug_print (lazy (CicPp.ppterm (whd ~subst context t1)));
+ debug_print (lazy (CicPp.ppterm t2));
+ debug_print (lazy (CicPp.ppterm (whd ~subst context t2)))
+ | _ -> ()); *)
+ let t1' = whd ?delta:(Some true) ?subst:(Some subst) context t1 in
+ let t2' = whd ?delta:(Some true) ?subst:(Some subst) context t2 in
+ debug t1' [t2'] "POSTWHD";
+ aux2 test_equality_only t1' t2' ugraph
+ end
+ in
+ aux false (*c t1 t2 ugraph *)
+;;
+
+(* DEBUGGING ONLY
+let whd ?(delta=true) ?(subst=[]) context t =
+ let res = whd ~delta ~subst context t in
+ let rescsc = CicReductionNaif.whd ~delta ~subst context t in
+ if not (fst (are_convertible CicReductionNaif.whd ~subst context res rescsc CicUniv.empty_ugraph)) then
+ begin
+ debug_print (lazy ("PRIMA: " ^ CicPp.ppterm t)) ;
+ flush stderr ;
+ debug_print (lazy ("DOPO: " ^ CicPp.ppterm res)) ;
+ flush stderr ;
+ debug_print (lazy ("CSC: " ^ CicPp.ppterm rescsc)) ;
+ flush stderr ;
+fdebug := 0 ;
+let _ = are_convertible CicReductionNaif.whd ~subst context res rescsc CicUniv.empty_ugraph in
+ assert false ;
+ end
+ else
+ res
+;;
+*)
+
+let are_convertible = are_convertible whd
+
+let whd = R.whd
+
+(*
+let profiler_other_whd = HExtlib.profile ~enable:profile "~are_convertible.whd"
+let whd ?(delta=true) ?(subst=[]) context t =
+ let foo () =
+ whd ~delta ~subst context t
+ in
+ profiler_other_whd.HExtlib.profile foo ()
+*)
+
+let rec normalize ?(delta=true) ?(subst=[]) ctx term =
+ let module C = Cic in
+ let t = whd ~delta ~subst ctx term in
+ let aux = normalize ~delta ~subst in
+ let decl name t = Some (name, C.Decl t) in
+ match t with
+ | C.Rel n -> t
+ | C.Var (uri,exp_named_subst) ->
+ C.Var (uri, List.map (fun (n,t) -> n,aux ctx t) exp_named_subst)
+ | C.Meta (i,l) ->
+ C.Meta (i,List.map (function Some t -> Some (aux ctx t) | None -> None) l)
+ | C.Sort _ -> t
+ | C.Implicit _ -> t
+ | C.Cast (te,ty) -> C.Cast (aux ctx te, aux ctx ty)
+ | C.Prod (n,s,t) ->
+ let s' = aux ctx s in
+ C.Prod (n, s', aux ((decl n s')::ctx) t)
+ | C.Lambda (n,s,t) ->
+ let s' = aux ctx s in
+ C.Lambda (n, s', aux ((decl n s')::ctx) t)
+ | C.LetIn (n,s,t) ->
+ (* the term is already in weak head normal form *)
+ assert false
+ | C.Appl (h::l) -> C.Appl (h::(List.map (aux ctx) l))
+ | C.Appl [] -> assert false
+ | C.Const (uri,exp_named_subst) ->
+ C.Const (uri, List.map (fun (n,t) -> n,aux ctx t) exp_named_subst)
+ | C.MutInd (uri,typeno,exp_named_subst) ->
+ C.MutInd (uri,typeno, List.map (fun (n,t) -> n,aux ctx t) exp_named_subst)
+ | C.MutConstruct (uri,typeno,consno,exp_named_subst) ->
+ C.MutConstruct (uri, typeno, consno,
+ List.map (fun (n,t) -> n,aux ctx t) exp_named_subst)
+ | C.MutCase (sp,i,outt,t,pl) ->
+ C.MutCase (sp,i, aux ctx outt, aux ctx t, List.map (aux ctx) pl)
+(*CSC: to be completed, I suppose *)
+ | C.Fix _ -> t
+ | C.CoFix _ -> t
+
+let normalize ?delta ?subst ctx term =
+(* prerr_endline ("NORMALIZE:" ^ CicPp.ppterm term); *)
+ let t = normalize ?delta ?subst ctx term in
+(* prerr_endline ("NORMALIZED:" ^ CicPp.ppterm t); *)
+ t
+
+
+(* performs an head beta/cast reduction *)
+let rec head_beta_reduce =
+ function
+ (Cic.Appl (Cic.Lambda (_,_,t)::he'::tl')) ->
+ let he'' = CicSubstitution.subst he' t in
+ if tl' = [] then
+ he''
+ else
+ let he''' =
+ match he'' with
+ Cic.Appl l -> Cic.Appl (l@tl')
+ | _ -> Cic.Appl (he''::tl')
+ in
+ head_beta_reduce he'''
+ | Cic.Cast (te,_) -> head_beta_reduce te
+ | t -> t
diff --git a/helm/ocaml/cic_proof_checking/cicReduction.mli b/helm/ocaml/cic_proof_checking/cicReduction.mli
new file mode 100644
index 000000000..e3619053d
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/cicReduction.mli
@@ -0,0 +1,42 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+exception WrongUriToInductiveDefinition
+exception ReferenceToConstant
+exception ReferenceToVariable
+exception ReferenceToCurrentProof
+exception ReferenceToInductiveDefinition
+val fdebug : int ref
+val whd :
+ ?delta:bool -> ?subst:Cic.substitution -> Cic.context -> Cic.term -> Cic.term
+val are_convertible :
+ ?subst:Cic.substitution -> ?metasenv:Cic.metasenv ->
+ Cic.context -> Cic.term -> Cic.term -> CicUniv.universe_graph ->
+ bool * CicUniv.universe_graph
+val normalize:
+ ?delta:bool -> ?subst:Cic.substitution -> Cic.context -> Cic.term -> Cic.term
+
+(* performs an head beta/cast reduction *)
+val head_beta_reduce: Cic.term -> Cic.term
diff --git a/helm/ocaml/cic_proof_checking/cicSubstitution.ml b/helm/ocaml/cic_proof_checking/cicSubstitution.ml
new file mode 100644
index 000000000..372c66fb8
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/cicSubstitution.ml
@@ -0,0 +1,427 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+exception CannotSubstInMeta;;
+exception RelToHiddenHypothesis;;
+exception ReferenceToVariable;;
+exception ReferenceToConstant;;
+exception ReferenceToCurrentProof;;
+exception ReferenceToInductiveDefinition;;
+
+let debug_print = fun _ -> ()
+
+let lift_from k n =
+ let rec liftaux k =
+ let module C = Cic in
+ function
+ C.Rel m ->
+ if m < k then
+ C.Rel m
+ else
+ C.Rel (m + n)
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,liftaux k t)) exp_named_subst
+ in
+ C.Var (uri,exp_named_subst')
+ | C.Meta (i,l) ->
+ let l' =
+ List.map
+ (function
+ None -> None
+ | Some t -> Some (liftaux k t)
+ ) l
+ in
+ C.Meta(i,l')
+ | C.Sort _ as t -> t
+ | C.Implicit _ as t -> t
+ | C.Cast (te,ty) -> C.Cast (liftaux k te, liftaux k ty)
+ | C.Prod (n,s,t) -> C.Prod (n, liftaux k s, liftaux (k+1) t)
+ | C.Lambda (n,s,t) -> C.Lambda (n, liftaux k s, liftaux (k+1) t)
+ | C.LetIn (n,s,t) -> C.LetIn (n, liftaux k s, liftaux (k+1) t)
+ | C.Appl l -> C.Appl (List.map (liftaux k) l)
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,liftaux k t)) exp_named_subst
+ in
+ C.Const (uri,exp_named_subst')
+ | C.MutInd (uri,tyno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,liftaux k t)) exp_named_subst
+ in
+ C.MutInd (uri,tyno,exp_named_subst')
+ | C.MutConstruct (uri,tyno,consno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,liftaux k t)) exp_named_subst
+ in
+ C.MutConstruct (uri,tyno,consno,exp_named_subst')
+ | C.MutCase (sp,i,outty,t,pl) ->
+ C.MutCase (sp, i, liftaux k outty, liftaux k t,
+ List.map (liftaux k) pl)
+ | C.Fix (i, fl) ->
+ let len = List.length fl in
+ let liftedfl =
+ List.map
+ (fun (name, i, ty, bo) -> (name, i, liftaux k ty, liftaux (k+len) bo))
+ fl
+ in
+ C.Fix (i, liftedfl)
+ | C.CoFix (i, fl) ->
+ let len = List.length fl in
+ let liftedfl =
+ List.map
+ (fun (name, ty, bo) -> (name, liftaux k ty, liftaux (k+len) bo))
+ fl
+ in
+ C.CoFix (i, liftedfl)
+ in
+ liftaux k
+
+let lift n t =
+ if n = 0 then
+ t
+ else
+ lift_from 1 n t
+;;
+
+let subst arg =
+ let rec substaux k =
+ let module C = Cic in
+ function
+ C.Rel n as t ->
+ (match n with
+ n when n = k -> lift (k - 1) arg
+ | n when n < k -> t
+ | _ -> C.Rel (n - 1)
+ )
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,substaux k t)) exp_named_subst
+ in
+ C.Var (uri,exp_named_subst')
+ | C.Meta (i, l) ->
+ let l' =
+ List.map
+ (function
+ None -> None
+ | Some t -> Some (substaux k t)
+ ) l
+ in
+ C.Meta(i,l')
+ | C.Sort _ as t -> t
+ | C.Implicit _ as t -> t
+ | C.Cast (te,ty) -> C.Cast (substaux k te, substaux k ty)
+ | C.Prod (n,s,t) -> C.Prod (n, substaux k s, substaux (k + 1) t)
+ | C.Lambda (n,s,t) -> C.Lambda (n, substaux k s, substaux (k + 1) t)
+ | C.LetIn (n,s,t) -> C.LetIn (n, substaux k s, substaux (k + 1) t)
+ | C.Appl (he::tl) ->
+ (* Invariant: no Appl applied to another Appl *)
+ let tl' = List.map (substaux k) tl in
+ begin
+ match substaux k he with
+ C.Appl l -> C.Appl (l@tl')
+ | _ as he' -> C.Appl (he'::tl')
+ end
+ | C.Appl _ -> assert false
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,substaux k t)) exp_named_subst
+ in
+ C.Const (uri,exp_named_subst')
+ | C.MutInd (uri,typeno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,substaux k t)) exp_named_subst
+ in
+ C.MutInd (uri,typeno,exp_named_subst')
+ | C.MutConstruct (uri,typeno,consno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,substaux k t)) exp_named_subst
+ in
+ C.MutConstruct (uri,typeno,consno,exp_named_subst')
+ | C.MutCase (sp,i,outt,t,pl) ->
+ C.MutCase (sp,i,substaux k outt, substaux k t,
+ List.map (substaux k) pl)
+ | C.Fix (i,fl) ->
+ let len = List.length fl in
+ let substitutedfl =
+ List.map
+ (fun (name,i,ty,bo) -> (name, i, substaux k ty, substaux (k+len) bo))
+ fl
+ in
+ C.Fix (i, substitutedfl)
+ | C.CoFix (i,fl) ->
+ let len = List.length fl in
+ let substitutedfl =
+ List.map
+ (fun (name,ty,bo) -> (name, substaux k ty, substaux (k+len) bo))
+ fl
+ in
+ C.CoFix (i, substitutedfl)
+ in
+ substaux 1
+;;
+
+(*CSC: i controlli di tipo debbono essere svolti da destra a *)
+(*CSC: sinistra: i{B/A;b/a} ==> a{B/A;b/a} ==> a{b/a{B/A}} ==> b *)
+(*CSC: la sostituzione ora e' implementata in maniera simultanea, ma *)
+(*CSC: dovrebbe diventare da sinistra verso destra: *)
+(*CSC: t{a=a/A;b/a} ==> \H:a=a.H{b/a} ==> \H:b=b.H *)
+(*CSC: per la roba che proviene da Coq questo non serve! *)
+let subst_vars exp_named_subst =
+(*
+debug_print (lazy ("@@@POSSIBLE BUG: SUBSTITUTION IS NOT SIMULTANEOUS")) ;
+*)
+ let rec substaux k =
+ let module C = Cic in
+ function
+ C.Rel _ as t -> t
+ | C.Var (uri,exp_named_subst') ->
+ (try
+ let (_,arg) =
+ List.find
+ (function (varuri,_) -> UriManager.eq uri varuri) exp_named_subst
+ in
+ lift (k -1) arg
+ with
+ Not_found ->
+ let params =
+ let obj,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ (match obj with
+ C.Constant _ -> raise ReferenceToConstant
+ | C.Variable (_,_,_,params,_) -> params
+ | C.CurrentProof _ -> raise ReferenceToCurrentProof
+ | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+ )
+ in
+(*
+debug_print (lazy "\n\n---- BEGIN ") ;
+debug_print (lazy ("----params: " ^ String.concat " ; " (List.map UriManager.string_of_uri params))) ;
+debug_print (lazy ("----S(" ^ UriManager.string_of_uri uri ^ "): " ^ String.concat " ; " (List.map (function (uri,_) -> UriManager.string_of_uri uri) exp_named_subst))) ;
+debug_print (lazy ("----P: " ^ String.concat " ; " (List.map (function (uri,_) -> UriManager.string_of_uri uri) exp_named_subst'))) ;
+*)
+ let exp_named_subst'' =
+ substaux_in_exp_named_subst uri k exp_named_subst' params
+ in
+(*
+debug_print (lazy ("----D: " ^ String.concat " ; " (List.map (function (uri,_) -> UriManager.string_of_uri uri) exp_named_subst''))) ;
+debug_print (lazy "---- END\n\n ") ;
+*)
+ C.Var (uri,exp_named_subst'')
+ )
+ | C.Meta (i, l) ->
+ let l' =
+ List.map
+ (function
+ None -> None
+ | Some t -> Some (substaux k t)
+ ) l
+ in
+ C.Meta(i,l')
+ | C.Sort _ as t -> t
+ | C.Implicit _ as t -> t
+ | C.Cast (te,ty) -> C.Cast (substaux k te, substaux k ty)
+ | C.Prod (n,s,t) -> C.Prod (n, substaux k s, substaux (k + 1) t)
+ | C.Lambda (n,s,t) -> C.Lambda (n, substaux k s, substaux (k + 1) t)
+ | C.LetIn (n,s,t) -> C.LetIn (n, substaux k s, substaux (k + 1) t)
+ | C.Appl (he::tl) ->
+ (* Invariant: no Appl applied to another Appl *)
+ let tl' = List.map (substaux k) tl in
+ begin
+ match substaux k he with
+ C.Appl l -> C.Appl (l@tl')
+ | _ as he' -> C.Appl (he'::tl')
+ end
+ | C.Appl _ -> assert false
+ | C.Const (uri,exp_named_subst') ->
+ let params =
+ let obj,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ (match obj with
+ C.Constant (_,_,_,params,_) -> params
+ | C.Variable _ -> raise ReferenceToVariable
+ | C.CurrentProof (_,_,_,_,params,_) -> params
+ | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+ )
+ in
+ let exp_named_subst'' =
+ substaux_in_exp_named_subst uri k exp_named_subst' params
+ in
+ C.Const (uri,exp_named_subst'')
+ | C.MutInd (uri,typeno,exp_named_subst') ->
+ let params =
+ let obj,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ (match obj with
+ C.Constant _ -> raise ReferenceToConstant
+ | C.Variable _ -> raise ReferenceToVariable
+ | C.CurrentProof _ -> raise ReferenceToCurrentProof
+ | C.InductiveDefinition (_,params,_,_) -> params
+ )
+ in
+ let exp_named_subst'' =
+ substaux_in_exp_named_subst uri k exp_named_subst' params
+ in
+ C.MutInd (uri,typeno,exp_named_subst'')
+ | C.MutConstruct (uri,typeno,consno,exp_named_subst') ->
+ let params =
+ let obj,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ (match obj with
+ C.Constant _ -> raise ReferenceToConstant
+ | C.Variable _ -> raise ReferenceToVariable
+ | C.CurrentProof _ -> raise ReferenceToCurrentProof
+ | C.InductiveDefinition (_,params,_,_) -> params
+ )
+ in
+ let exp_named_subst'' =
+ substaux_in_exp_named_subst uri k exp_named_subst' params
+ in
+ C.MutConstruct (uri,typeno,consno,exp_named_subst'')
+ | C.MutCase (sp,i,outt,t,pl) ->
+ C.MutCase (sp,i,substaux k outt, substaux k t,
+ List.map (substaux k) pl)
+ | C.Fix (i,fl) ->
+ let len = List.length fl in
+ let substitutedfl =
+ List.map
+ (fun (name,i,ty,bo) -> (name, i, substaux k ty, substaux (k+len) bo))
+ fl
+ in
+ C.Fix (i, substitutedfl)
+ | C.CoFix (i,fl) ->
+ let len = List.length fl in
+ let substitutedfl =
+ List.map
+ (fun (name,ty,bo) -> (name, substaux k ty, substaux (k+len) bo))
+ fl
+ in
+ C.CoFix (i, substitutedfl)
+ and substaux_in_exp_named_subst uri k exp_named_subst' params =
+(*CSC: invece di concatenare sarebbe meglio rispettare l'ordine dei params *)
+(*CSC: e' vero???? una veloce prova non sembra confermare la teoria *)
+ let rec filter_and_lift =
+ function
+ [] -> []
+ | (uri,t)::tl when
+ List.for_all
+ (function (uri',_) -> not (UriManager.eq uri uri')) exp_named_subst'
+ &&
+ List.mem uri params
+ ->
+ (uri,lift (k-1) t)::(filter_and_lift tl)
+ | _::tl -> filter_and_lift tl
+(*
+ | (uri,_)::tl ->
+debug_print (lazy ("---- SKIPPO " ^ UriManager.string_of_uri uri)) ;
+if List.for_all (function (uri',_) -> not (UriManager.eq uri uri'))
+exp_named_subst' then debug_print (lazy "---- OK1") ;
+debug_print (lazy ("++++ uri " ^ UriManager.string_of_uri uri ^ " not in " ^ String.concat " ; " (List.map UriManager.string_of_uri params))) ;
+if List.mem uri params then debug_print (lazy "---- OK2") ;
+ filter_and_lift tl
+*)
+ in
+ List.map (function (uri,t) -> (uri,substaux k t)) exp_named_subst' @
+ (filter_and_lift exp_named_subst)
+ in
+ substaux 1
+;;
+
+(* subst_meta [t_1 ; ... ; t_n] t *)
+(* returns the term [t] where [Rel i] is substituted with [t_i] *)
+(* [t_i] is lifted as usual when it crosses an abstraction *)
+let subst_meta l t =
+ let module C = Cic in
+ if l = [] then t else
+ let rec aux k = function
+ C.Rel n as t ->
+ if n <= k then t else
+ (try
+ match List.nth l (n-k-1) with
+ None -> raise RelToHiddenHypothesis
+ | Some t -> lift k t
+ with
+ (Failure _) -> assert false
+ )
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,aux k t)) exp_named_subst
+ in
+ C.Var (uri,exp_named_subst')
+ | C.Meta (i,l) ->
+ let l' =
+ List.map
+ (function
+ None -> None
+ | Some t ->
+ try
+ Some (aux k t)
+ with
+ RelToHiddenHypothesis -> None
+ ) l
+ in
+ C.Meta(i,l')
+ | C.Sort _ as t -> t
+ | C.Implicit _ as t -> t
+ | C.Cast (te,ty) -> C.Cast (aux k te, aux k ty) (*CSC ??? *)
+ | C.Prod (n,s,t) -> C.Prod (n, aux k s, aux (k + 1) t)
+ | C.Lambda (n,s,t) -> C.Lambda (n, aux k s, aux (k + 1) t)
+ | C.LetIn (n,s,t) -> C.LetIn (n, aux k s, aux (k + 1) t)
+ | C.Appl l -> C.Appl (List.map (aux k) l)
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,aux k t)) exp_named_subst
+ in
+ C.Const (uri,exp_named_subst')
+ | C.MutInd (uri,typeno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,aux k t)) exp_named_subst
+ in
+ C.MutInd (uri,typeno,exp_named_subst')
+ | C.MutConstruct (uri,typeno,consno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,aux k t)) exp_named_subst
+ in
+ C.MutConstruct (uri,typeno,consno,exp_named_subst')
+ | C.MutCase (sp,i,outt,t,pl) ->
+ C.MutCase (sp,i,aux k outt, aux k t, List.map (aux k) pl)
+ | C.Fix (i,fl) ->
+ let len = List.length fl in
+ let substitutedfl =
+ List.map
+ (fun (name,i,ty,bo) -> (name, i, aux k ty, aux (k+len) bo))
+ fl
+ in
+ C.Fix (i, substitutedfl)
+ | C.CoFix (i,fl) ->
+ let len = List.length fl in
+ let substitutedfl =
+ List.map
+ (fun (name,ty,bo) -> (name, aux k ty, aux (k+len) bo))
+ fl
+ in
+ C.CoFix (i, substitutedfl)
+ in
+ aux 0 t
+;;
+
diff --git a/helm/ocaml/cic_proof_checking/cicSubstitution.mli b/helm/ocaml/cic_proof_checking/cicSubstitution.mli
new file mode 100644
index 000000000..21a1f5d0e
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/cicSubstitution.mli
@@ -0,0 +1,56 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+exception CannotSubstInMeta;;
+exception RelToHiddenHypothesis;;
+exception ReferenceToVariable;;
+exception ReferenceToConstant;;
+exception ReferenceToInductiveDefinition;;
+
+(* lift n t *)
+(* lifts [t] of [n] *)
+(* NOTE: the opposite function (delift_rels) is defined in CicMetaSubst *)
+(* since it needs to restrict the metavariables in case of failure *)
+val lift : int -> Cic.term -> Cic.term
+
+
+(* lift from n t *)
+(* as lift but lifts only indexes >= from *)
+val lift_from: int -> int -> Cic.term -> Cic.term
+
+(* subst t1 t2 *)
+(* substitutes [t1] for [Rel 1] in [t2] *)
+val subst : Cic.term -> Cic.term -> Cic.term
+
+(* subst_vars exp_named_subst t2 *)
+(* applies [exp_named_subst] to [t2] *)
+val subst_vars :
+ Cic.term Cic.explicit_named_substitution -> Cic.term -> Cic.term
+
+(* subst_meta [t_1 ; ... ; t_n] t *)
+(* returns the term [t] where [Rel i] is substituted with [t_i] *)
+(* [t_i] is lifted as usual when it crosses an abstraction *)
+val subst_meta : (Cic.term option) list -> Cic.term -> Cic.term
+
diff --git a/helm/ocaml/cic_proof_checking/cicTypeChecker.ml b/helm/ocaml/cic_proof_checking/cicTypeChecker.ml
new file mode 100644
index 000000000..cd742d4cd
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/cicTypeChecker.ml
@@ -0,0 +1,2167 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+(* TODO factorize functions to frequent errors (e.g. "Unknwon mutual inductive
+ * ...") *)
+
+open Printf
+
+exception AssertFailure of string Lazy.t;;
+exception TypeCheckerFailure of string Lazy.t;;
+
+let fdebug = ref 0;;
+let debug t context =
+ let rec debug_aux t i =
+ let module C = Cic in
+ let module U = UriManager in
+ CicPp.ppobj (C.Variable ("DEBUG", None, t, [], [])) ^ "\n" ^ i
+ in
+ if !fdebug = 0 then
+ raise (TypeCheckerFailure (lazy (List.fold_right debug_aux (t::context) "")))
+;;
+
+let debug_print = fun _ -> () ;;
+
+let rec split l n =
+ match (l,n) with
+ (l,0) -> ([], l)
+ | (he::tl, n) -> let (l1,l2) = split tl (n-1) in (he::l1,l2)
+ | (_,_) ->
+ raise (TypeCheckerFailure (lazy "Parameters number < left parameters number"))
+;;
+
+let debrujin_constructor ?(cb=fun _ _ -> ()) uri number_of_types =
+ let rec aux k t =
+ let module C = Cic in
+ let res =
+ match t with
+ C.Rel n as t when n <= k -> t
+ | C.Rel _ ->
+ raise (TypeCheckerFailure (lazy "unbound variable found in constructor type"))
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,aux k t)) exp_named_subst
+ in
+ C.Var (uri,exp_named_subst')
+ | C.Meta (i,l) ->
+ let l' = List.map (function None -> None | Some t -> Some (aux k t)) l in
+ C.Meta (i,l')
+ | C.Sort _
+ | C.Implicit _ as t -> t
+ | C.Cast (te,ty) -> C.Cast (aux k te, aux k ty)
+ | C.Prod (n,s,t) -> C.Prod (n, aux k s, aux (k+1) t)
+ | C.Lambda (n,s,t) -> C.Lambda (n, aux k s, aux (k+1) t)
+ | C.LetIn (n,s,t) -> C.LetIn (n, aux k s, aux (k+1) t)
+ | C.Appl l -> C.Appl (List.map (aux k) l)
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,aux k t)) exp_named_subst
+ in
+ C.Const (uri,exp_named_subst')
+ | C.MutInd (uri',tyno,exp_named_subst) when UriManager.eq uri uri' ->
+ if exp_named_subst != [] then
+ raise (TypeCheckerFailure
+ (lazy ("non-empty explicit named substitution is applied to "^
+ "a mutual inductive type which is being defined"))) ;
+ C.Rel (k + number_of_types - tyno) ;
+ | C.MutInd (uri',tyno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,aux k t)) exp_named_subst
+ in
+ C.MutInd (uri',tyno,exp_named_subst')
+ | C.MutConstruct (uri,tyno,consno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> (uri,aux k t)) exp_named_subst
+ in
+ C.MutConstruct (uri,tyno,consno,exp_named_subst')
+ | C.MutCase (sp,i,outty,t,pl) ->
+ C.MutCase (sp, i, aux k outty, aux k t,
+ List.map (aux k) pl)
+ | C.Fix (i, fl) ->
+ let len = List.length fl in
+ let liftedfl =
+ List.map
+ (fun (name, i, ty, bo) -> (name, i, aux k ty, aux (k+len) bo))
+ fl
+ in
+ C.Fix (i, liftedfl)
+ | C.CoFix (i, fl) ->
+ let len = List.length fl in
+ let liftedfl =
+ List.map
+ (fun (name, ty, bo) -> (name, aux k ty, aux (k+len) bo))
+ fl
+ in
+ C.CoFix (i, liftedfl)
+ in
+ cb t res;
+ res
+ in
+ aux 0
+;;
+
+exception CicEnvironmentError;;
+
+let rec type_of_constant ~logger uri ugraph =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+ let cobj,ugraph =
+ match CicEnvironment.is_type_checked ~trust:true ugraph uri with
+ CicEnvironment.CheckedObj (cobj,ugraph') -> cobj,ugraph'
+ | CicEnvironment.UncheckedObj uobj ->
+ logger#log (`Start_type_checking uri) ;
+ (* let's typecheck the uncooked obj *)
+
+(****************************************************************
+ TASSI: FIXME qui e' inutile ricordarselo,
+ tanto poi lo richiediamo alla cache che da quello su disco
+*****************************************************************)
+
+ let ugraph_dust =
+ (match uobj with
+ C.Constant (_,Some te,ty,_,_) ->
+ let _,ugraph = type_of ~logger ty ugraph in
+ let type_of_te,ugraph' = type_of ~logger te ugraph in
+ let b',ugraph'' = (R.are_convertible [] type_of_te ty ugraph') in
+ if not b' then
+ raise (TypeCheckerFailure (lazy (sprintf
+ "the constant %s is not well typed because the type %s of the body is not convertible to the declared type %s"
+ (U.string_of_uri uri) (CicPp.ppterm type_of_te)
+ (CicPp.ppterm ty))))
+ else
+ ugraph'
+ | C.Constant (_,None,ty,_,_) ->
+ (* only to check that ty is well-typed *)
+ let _,ugraph' = type_of ~logger ty ugraph in
+ ugraph'
+ | C.CurrentProof (_,conjs,te,ty,_,_) ->
+ let _,ugraph1 =
+ List.fold_left
+ (fun (metasenv,ugraph) ((_,context,ty) as conj) ->
+ let _,ugraph' =
+ type_of_aux' ~logger metasenv context ty ugraph
+ in
+ (metasenv @ [conj],ugraph')
+ ) ([],ugraph) conjs
+ in
+ let _,ugraph2 = type_of_aux' ~logger conjs [] ty ugraph1 in
+ let type_of_te,ugraph3 =
+ type_of_aux' ~logger conjs [] te ugraph2
+ in
+ let b,ugraph4 = (R.are_convertible [] type_of_te ty ugraph3) in
+ if not b then
+ raise (TypeCheckerFailure (lazy (sprintf
+ "the current proof %s is not well typed because the type %s of the body is not convertible to the declared type %s"
+ (U.string_of_uri uri) (CicPp.ppterm type_of_te)
+ (CicPp.ppterm ty))))
+ else
+ ugraph4
+ | _ ->
+ raise
+ (TypeCheckerFailure (lazy ("Unknown constant:" ^ U.string_of_uri uri))))
+ in
+ try
+ CicEnvironment.set_type_checking_info uri;
+ logger#log (`Type_checking_completed uri) ;
+ match CicEnvironment.is_type_checked ~trust:false ugraph uri with
+ CicEnvironment.CheckedObj (cobj,ugraph') -> cobj,ugraph'
+ | CicEnvironment.UncheckedObj _ -> raise CicEnvironmentError
+ with Invalid_argument s ->
+ (*debug_print (lazy s);*)
+ uobj,ugraph_dust
+ in
+ match cobj,ugraph with
+ (C.Constant (_,_,ty,_,_)),g -> ty,g
+ | (C.CurrentProof (_,_,_,ty,_,_)),g -> ty,g
+ | _ ->
+ raise (TypeCheckerFailure (lazy ("Unknown constant:" ^ U.string_of_uri uri)))
+
+and type_of_variable ~logger uri ugraph =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+ (* 0 because a variable is never cooked => no partial cooking at one level *)
+ match CicEnvironment.is_type_checked ~trust:true ugraph uri with
+ CicEnvironment.CheckedObj ((C.Variable (_,_,ty,_,_)),ugraph') -> ty,ugraph'
+ | CicEnvironment.UncheckedObj (C.Variable (_,bo,ty,_,_)) ->
+ logger#log (`Start_type_checking uri) ;
+ (* only to check that ty is well-typed *)
+ let _,ugraph1 = type_of ~logger ty ugraph in
+ let ugraph2 =
+ (match bo with
+ None -> ugraph
+ | Some bo ->
+ let ty_bo,ugraph' = type_of ~logger bo ugraph1 in
+ let b,ugraph'' = (R.are_convertible [] ty_bo ty ugraph') in
+ if not b then
+ raise (TypeCheckerFailure
+ (lazy ("Unknown variable:" ^ U.string_of_uri uri)))
+ else
+ ugraph'')
+ in
+ (try
+ CicEnvironment.set_type_checking_info uri ;
+ logger#log (`Type_checking_completed uri) ;
+ match CicEnvironment.is_type_checked ~trust:false ugraph uri with
+ CicEnvironment.CheckedObj ((C.Variable (_,_,ty,_,_)),ugraph') ->
+ ty,ugraph'
+ | CicEnvironment.CheckedObj _
+ | CicEnvironment.UncheckedObj _ -> raise CicEnvironmentError
+ with Invalid_argument s ->
+ (*debug_print (lazy s);*)
+ ty,ugraph2)
+ | _ ->
+ raise (TypeCheckerFailure (lazy ("Unknown variable:" ^ U.string_of_uri uri)))
+
+and does_not_occur ?(subst=[]) context n nn te =
+ let module C = Cic in
+ (*CSC: whd sembra essere superflua perche' un caso in cui l'occorrenza *)
+ (*CSC: venga mangiata durante la whd sembra presentare problemi di *)
+ (*CSC: universi *)
+ match CicReduction.whd ~subst context te with
+ C.Rel m when m > n && m <= nn -> false
+ | C.Rel _
+ | C.Sort _
+ | C.Implicit _ -> true
+ | C.Meta (_,l) ->
+ List.fold_right
+ (fun x i ->
+ match x with
+ None -> i
+ | Some x -> i && does_not_occur ~subst context n nn x) l true
+ | C.Cast (te,ty) ->
+ does_not_occur ~subst context n nn te && does_not_occur ~subst context n nn ty
+ | C.Prod (name,so,dest) ->
+ does_not_occur ~subst context n nn so &&
+ does_not_occur ~subst ((Some (name,(C.Decl so)))::context) (n + 1)
+ (nn + 1) dest
+ | C.Lambda (name,so,dest) ->
+ does_not_occur ~subst context n nn so &&
+ does_not_occur ~subst ((Some (name,(C.Decl so)))::context) (n + 1) (nn + 1)
+ dest
+ | C.LetIn (name,so,dest) ->
+ does_not_occur ~subst context n nn so &&
+ does_not_occur ~subst ((Some (name,(C.Def (so,None))))::context)
+ (n + 1) (nn + 1) dest
+ | C.Appl l ->
+ List.fold_right (fun x i -> i && does_not_occur ~subst context n nn x) l true
+ | C.Var (_,exp_named_subst)
+ | C.Const (_,exp_named_subst)
+ | C.MutInd (_,_,exp_named_subst)
+ | C.MutConstruct (_,_,_,exp_named_subst) ->
+ List.fold_right (fun (_,x) i -> i && does_not_occur ~subst context n nn x)
+ exp_named_subst true
+ | C.MutCase (_,_,out,te,pl) ->
+ does_not_occur ~subst context n nn out && does_not_occur ~subst context n nn te &&
+ List.fold_right (fun x i -> i && does_not_occur ~subst context n nn x) pl true
+ | C.Fix (_,fl) ->
+ let len = List.length fl in
+ let n_plus_len = n + len in
+ let nn_plus_len = nn + len in
+ let tys =
+ List.map (fun (n,_,ty,_) -> Some (C.Name n,(Cic.Decl ty))) fl
+ in
+ List.fold_right
+ (fun (_,_,ty,bo) i ->
+ i && does_not_occur ~subst context n nn ty &&
+ does_not_occur ~subst (tys @ context) n_plus_len nn_plus_len bo
+ ) fl true
+ | C.CoFix (_,fl) ->
+ let len = List.length fl in
+ let n_plus_len = n + len in
+ let nn_plus_len = nn + len in
+ let tys =
+ List.map (fun (n,ty,_) -> Some (C.Name n,(Cic.Decl ty))) fl
+ in
+ List.fold_right
+ (fun (_,ty,bo) i ->
+ i && does_not_occur ~subst context n nn ty &&
+ does_not_occur ~subst (tys @ context) n_plus_len nn_plus_len bo
+ ) fl true
+
+(*CSC l'indice x dei tipi induttivi e' t.c. n < x <= nn *)
+(*CSC questa funzione e' simile alla are_all_occurrences_positive, ma fa *)
+(*CSC dei controlli leggermente diversi. Viene invocata solamente dalla *)
+(*CSC strictly_positive *)
+(*CSC definizione (giusta???) tratta dalla mail di Hugo ;-) *)
+and weakly_positive context n nn uri te =
+ let module C = Cic in
+(*CSC: Che schifo! Bisogna capire meglio e trovare una soluzione ragionevole!*)
+ let dummy_mutind =
+ C.MutInd (HelmLibraryObjects.Datatypes.nat_URI,0,[])
+ in
+ (*CSC: mettere in cicSubstitution *)
+ let rec subst_inductive_type_with_dummy_mutind =
+ function
+ C.MutInd (uri',0,_) when UriManager.eq uri' uri ->
+ dummy_mutind
+ | C.Appl ((C.MutInd (uri',0,_))::tl) when UriManager.eq uri' uri ->
+ dummy_mutind
+ | C.Cast (te,ty) -> subst_inductive_type_with_dummy_mutind te
+ | C.Prod (name,so,ta) ->
+ C.Prod (name, subst_inductive_type_with_dummy_mutind so,
+ subst_inductive_type_with_dummy_mutind ta)
+ | C.Lambda (name,so,ta) ->
+ C.Lambda (name, subst_inductive_type_with_dummy_mutind so,
+ subst_inductive_type_with_dummy_mutind ta)
+ | C.Appl tl ->
+ C.Appl (List.map subst_inductive_type_with_dummy_mutind tl)
+ | C.MutCase (uri,i,outtype,term,pl) ->
+ C.MutCase (uri,i,
+ subst_inductive_type_with_dummy_mutind outtype,
+ subst_inductive_type_with_dummy_mutind term,
+ List.map subst_inductive_type_with_dummy_mutind pl)
+ | C.Fix (i,fl) ->
+ C.Fix (i,List.map (fun (name,i,ty,bo) -> (name,i,
+ subst_inductive_type_with_dummy_mutind ty,
+ subst_inductive_type_with_dummy_mutind bo)) fl)
+ | C.CoFix (i,fl) ->
+ C.CoFix (i,List.map (fun (name,ty,bo) -> (name,
+ subst_inductive_type_with_dummy_mutind ty,
+ subst_inductive_type_with_dummy_mutind bo)) fl)
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map
+ (function (uri,t) -> (uri,subst_inductive_type_with_dummy_mutind t))
+ exp_named_subst
+ in
+ C.Const (uri,exp_named_subst')
+ | C.MutInd (uri,typeno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map
+ (function (uri,t) -> (uri,subst_inductive_type_with_dummy_mutind t))
+ exp_named_subst
+ in
+ C.MutInd (uri,typeno,exp_named_subst')
+ | C.MutConstruct (uri,typeno,consno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map
+ (function (uri,t) -> (uri,subst_inductive_type_with_dummy_mutind t))
+ exp_named_subst
+ in
+ C.MutConstruct (uri,typeno,consno,exp_named_subst')
+ | t -> t
+ in
+ match CicReduction.whd context te with
+ C.Appl ((C.MutInd (uri',0,_))::tl) when UriManager.eq uri' uri -> true
+ | C.MutInd (uri',0,_) when UriManager.eq uri' uri -> true
+ | C.Prod (C.Anonymous,source,dest) ->
+ strictly_positive context n nn
+ (subst_inductive_type_with_dummy_mutind source) &&
+ weakly_positive ((Some (C.Anonymous,(C.Decl source)))::context)
+ (n + 1) (nn + 1) uri dest
+ | C.Prod (name,source,dest) when
+ does_not_occur ((Some (name,(C.Decl source)))::context) 0 n dest ->
+ (* dummy abstraction, so we behave as in the anonimous case *)
+ strictly_positive context n nn
+ (subst_inductive_type_with_dummy_mutind source) &&
+ weakly_positive ((Some (name,(C.Decl source)))::context)
+ (n + 1) (nn + 1) uri dest
+ | C.Prod (name,source,dest) ->
+ does_not_occur context n nn
+ (subst_inductive_type_with_dummy_mutind source)&&
+ weakly_positive ((Some (name,(C.Decl source)))::context)
+ (n + 1) (nn + 1) uri dest
+ | _ ->
+ raise (TypeCheckerFailure (lazy "Malformed inductive constructor type"))
+
+(* instantiate_parameters ps (x1:T1)...(xn:Tn)C *)
+(* returns ((x_|ps|:T_|ps|)...(xn:Tn)C){ps_1 / x1 ; ... ; ps_|ps| / x_|ps|} *)
+and instantiate_parameters params c =
+ let module C = Cic in
+ match (c,params) with
+ (c,[]) -> c
+ | (C.Prod (_,_,ta), he::tl) ->
+ instantiate_parameters tl
+ (CicSubstitution.subst he ta)
+ | (C.Cast (te,_), _) -> instantiate_parameters params te
+ | (t,l) -> raise (AssertFailure (lazy "1"))
+
+and strictly_positive context n nn te =
+ let module C = Cic in
+ let module U = UriManager in
+ match CicReduction.whd context te with
+ C.Rel _ -> true
+ | C.Cast (te,ty) ->
+ (*CSC: bisogna controllare ty????*)
+ strictly_positive context n nn te
+ | C.Prod (name,so,ta) ->
+ does_not_occur context n nn so &&
+ strictly_positive ((Some (name,(C.Decl so)))::context) (n+1) (nn+1) ta
+ | C.Appl ((C.Rel m)::tl) when m > n && m <= nn ->
+ List.fold_right (fun x i -> i && does_not_occur context n nn x) tl true
+ | C.Appl ((C.MutInd (uri,i,exp_named_subst))::tl) ->
+ let (ok,paramsno,ity,cl,name) =
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ C.InductiveDefinition (tl,_,paramsno,_) ->
+ let (name,_,ity,cl) = List.nth tl i in
+ (List.length tl = 1, paramsno, ity, cl, name)
+ | _ ->
+ raise (TypeCheckerFailure
+ (lazy ("Unknown inductive type:" ^ U.string_of_uri uri)))
+ in
+ let (params,arguments) = split tl paramsno in
+ let lifted_params = List.map (CicSubstitution.lift 1) params in
+ let cl' =
+ List.map
+ (fun (_,te) ->
+ instantiate_parameters lifted_params
+ (CicSubstitution.subst_vars exp_named_subst te)
+ ) cl
+ in
+ ok &&
+ List.fold_right
+ (fun x i -> i && does_not_occur context n nn x)
+ arguments true &&
+ (*CSC: MEGAPATCH3 (sara' quella giusta?)*)
+ List.fold_right
+ (fun x i ->
+ i &&
+ weakly_positive
+ ((Some (C.Name name,(Cic.Decl ity)))::context) (n+1) (nn+1) uri
+ x
+ ) cl' true
+ | t -> does_not_occur context n nn t
+
+(* the inductive type indexes are s.t. n < x <= nn *)
+and are_all_occurrences_positive context uri indparamsno i n nn te =
+ let module C = Cic in
+ match CicReduction.whd context te with
+ C.Appl ((C.Rel m)::tl) when m = i ->
+ (*CSC: riscrivere fermandosi a 0 *)
+ (* let's check if the inductive type is applied at least to *)
+ (* indparamsno parameters *)
+ let last =
+ List.fold_left
+ (fun k x ->
+ if k = 0 then 0
+ else
+ match CicReduction.whd context x with
+ C.Rel m when m = n - (indparamsno - k) -> k - 1
+ | _ ->
+ raise (TypeCheckerFailure
+ (lazy
+ ("Non-positive occurence in mutual inductive definition(s) [1]" ^
+ UriManager.string_of_uri uri)))
+ ) indparamsno tl
+ in
+ if last = 0 then
+ List.fold_right (fun x i -> i && does_not_occur context n nn x) tl true
+ else
+ raise (TypeCheckerFailure
+ (lazy ("Non-positive occurence in mutual inductive definition(s) [2]"^
+ UriManager.string_of_uri uri)))
+ | C.Rel m when m = i ->
+ if indparamsno = 0 then
+ true
+ else
+ raise (TypeCheckerFailure
+ (lazy ("Non-positive occurence in mutual inductive definition(s) [3]"^
+ UriManager.string_of_uri uri)))
+ | C.Prod (C.Anonymous,source,dest) ->
+ strictly_positive context n nn source &&
+ are_all_occurrences_positive
+ ((Some (C.Anonymous,(C.Decl source)))::context) uri indparamsno
+ (i+1) (n + 1) (nn + 1) dest
+ | C.Prod (name,source,dest) when
+ does_not_occur ((Some (name,(C.Decl source)))::context) 0 n dest ->
+ (* dummy abstraction, so we behave as in the anonimous case *)
+ strictly_positive context n nn source &&
+ are_all_occurrences_positive
+ ((Some (name,(C.Decl source)))::context) uri indparamsno
+ (i+1) (n + 1) (nn + 1) dest
+ | C.Prod (name,source,dest) ->
+ does_not_occur context n nn source &&
+ are_all_occurrences_positive ((Some (name,(C.Decl source)))::context)
+ uri indparamsno (i+1) (n + 1) (nn + 1) dest
+ | _ ->
+ raise
+ (TypeCheckerFailure (lazy ("Malformed inductive constructor type " ^
+ (UriManager.string_of_uri uri))))
+
+(* Main function to checks the correctness of a mutual *)
+(* inductive block definition. This is the function *)
+(* exported to the proof-engine. *)
+and typecheck_mutual_inductive_defs ~logger uri (itl,_,indparamsno) ugraph =
+ let module U = UriManager in
+ (* let's check if the arity of the inductive types are well *)
+ (* formed *)
+ let ugrap1 = List.fold_left
+ (fun ugraph (_,_,x,_) -> let _,ugraph' =
+ type_of ~logger x ugraph in ugraph')
+ ugraph itl in
+
+ (* let's check if the types of the inductive constructors *)
+ (* are well formed. *)
+ (* In order not to use type_of_aux we put the types of the *)
+ (* mutual inductive types at the head of the types of the *)
+ (* constructors using Prods *)
+ let len = List.length itl in
+ let tys =
+ List.map (fun (n,_,ty,_) -> Some (Cic.Name n,(Cic.Decl ty))) itl in
+ let _,ugraph2 =
+ List.fold_right
+ (fun (_,_,_,cl) (i,ugraph) ->
+ let ugraph'' =
+ List.fold_left
+ (fun ugraph (name,te) ->
+ let debrujinedte = debrujin_constructor uri len te in
+ let augmented_term =
+ List.fold_right
+ (fun (name,_,ty,_) i -> Cic.Prod (Cic.Name name, ty, i))
+ itl debrujinedte
+ in
+ let _,ugraph' = type_of ~logger augmented_term ugraph in
+ (* let's check also the positivity conditions *)
+ if
+ not
+ (are_all_occurrences_positive tys uri indparamsno i 0 len
+ debrujinedte)
+ then
+ raise
+ (TypeCheckerFailure
+ (lazy ("Non positive occurence in " ^ U.string_of_uri uri)))
+ else
+ ugraph'
+ ) ugraph cl in
+ (i + 1),ugraph''
+ ) itl (1,ugrap1)
+ in
+ ugraph2
+
+(* Main function to checks the correctness of a mutual *)
+(* inductive block definition. *)
+and check_mutual_inductive_defs uri obj ugraph =
+ match obj with
+ Cic.InductiveDefinition (itl, params, indparamsno, _) ->
+ typecheck_mutual_inductive_defs uri (itl,params,indparamsno) ugraph
+ | _ ->
+ raise (TypeCheckerFailure (
+ lazy ("Unknown mutual inductive definition:" ^
+ UriManager.string_of_uri uri)))
+
+and type_of_mutual_inductive_defs ~logger uri i ugraph =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+ let cobj,ugraph1 =
+ match CicEnvironment.is_type_checked ~trust:true ugraph uri with
+ CicEnvironment.CheckedObj (cobj,ugraph') -> cobj,ugraph'
+ | CicEnvironment.UncheckedObj uobj ->
+ logger#log (`Start_type_checking uri) ;
+ let ugraph1_dust =
+ check_mutual_inductive_defs ~logger uri uobj ugraph
+ in
+ (* TASSI: FIXME: check ugraph1 == ugraph ritornato da env *)
+ try
+ CicEnvironment.set_type_checking_info uri ;
+ logger#log (`Type_checking_completed uri) ;
+ (match CicEnvironment.is_type_checked ~trust:false ugraph uri with
+ CicEnvironment.CheckedObj (cobj,ugraph') -> (cobj,ugraph')
+ | CicEnvironment.UncheckedObj _ -> raise CicEnvironmentError
+ )
+ with
+ Invalid_argument s ->
+ (*debug_print (lazy s);*)
+ uobj,ugraph1_dust
+ in
+ match cobj with
+ C.InductiveDefinition (dl,_,_,_) ->
+ let (_,_,arity,_) = List.nth dl i in
+ arity,ugraph1
+ | _ ->
+ raise (TypeCheckerFailure
+ (lazy ("Unknown mutual inductive definition:" ^ U.string_of_uri uri)))
+
+and type_of_mutual_inductive_constr ~logger uri i j ugraph =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+ let cobj,ugraph1 =
+ match CicEnvironment.is_type_checked ~trust:true ugraph uri with
+ CicEnvironment.CheckedObj (cobj,ugraph') -> cobj,ugraph'
+ | CicEnvironment.UncheckedObj uobj ->
+ logger#log (`Start_type_checking uri) ;
+ let ugraph1_dust =
+ check_mutual_inductive_defs ~logger uri uobj ugraph
+ in
+ (* check ugraph1 validity ??? == ugraph' *)
+ try
+ CicEnvironment.set_type_checking_info uri ;
+ logger#log (`Type_checking_completed uri) ;
+ (match
+ CicEnvironment.is_type_checked ~trust:false ugraph uri
+ with
+ CicEnvironment.CheckedObj (cobj,ugraph') -> cobj,ugraph'
+ | CicEnvironment.UncheckedObj _ ->
+ raise CicEnvironmentError)
+ with
+ Invalid_argument s ->
+ (*debug_print (lazy s);*)
+ uobj,ugraph1_dust
+ in
+ match cobj with
+ C.InductiveDefinition (dl,_,_,_) ->
+ let (_,_,_,cl) = List.nth dl i in
+ let (_,ty) = List.nth cl (j-1) in
+ ty,ugraph1
+ | _ ->
+ raise (TypeCheckerFailure
+ (lazy ("Unknown mutual inductive definition:" ^ UriManager.string_of_uri uri)))
+
+and recursive_args context n nn te =
+ let module C = Cic in
+ match CicReduction.whd context te with
+ C.Rel _ -> []
+ | C.Var _
+ | C.Meta _
+ | C.Sort _
+ | C.Implicit _
+ | C.Cast _ (*CSC ??? *) ->
+ raise (AssertFailure (lazy "3")) (* due to type-checking *)
+ | C.Prod (name,so,de) ->
+ (not (does_not_occur context n nn so)) ::
+ (recursive_args ((Some (name,(C.Decl so)))::context) (n+1) (nn + 1) de)
+ | C.Lambda _
+ | C.LetIn _ ->
+ raise (AssertFailure (lazy "4")) (* due to type-checking *)
+ | C.Appl _ -> []
+ | C.Const _ -> raise (AssertFailure (lazy "5"))
+ | C.MutInd _
+ | C.MutConstruct _
+ | C.MutCase _
+ | C.Fix _
+ | C.CoFix _ -> raise (AssertFailure (lazy "6")) (* due to type-checking *)
+
+and get_new_safes ~subst context p c rl safes n nn x =
+ let module C = Cic in
+ let module U = UriManager in
+ let module R = CicReduction in
+ match (R.whd ~subst context c, R.whd ~subst context p, rl) with
+ (C.Prod (_,so,ta1), C.Lambda (name,_,ta2), b::tl) ->
+ (* we are sure that the two sources are convertible because we *)
+ (* have just checked this. So let's go along ... *)
+ let safes' =
+ List.map (fun x -> x + 1) safes
+ in
+ let safes'' =
+ if b then 1::safes' else safes'
+ in
+ get_new_safes ~subst ((Some (name,(C.Decl so)))::context)
+ ta2 ta1 tl safes'' (n+1) (nn+1) (x+1)
+ | (C.Prod _, (C.MutConstruct _ as e), _)
+ | (C.Prod _, (C.Rel _ as e), _)
+ | (C.MutInd _, e, [])
+ | (C.Appl _, e, []) -> (e,safes,n,nn,x,context)
+ | (c,p,l) ->
+ (* CSC: If the next exception is raised, it just means that *)
+ (* CSC: the proof-assistant allows to use very strange things *)
+ (* CSC: as a branch of a case whose type is a Prod. In *)
+ (* CSC: particular, this means that a new (C.Prod, x,_) case *)
+ (* CSC: must be considered in this match. (e.g. x = MutCase) *)
+ raise
+ (AssertFailure (lazy
+ (Printf.sprintf "Get New Safes: c=%s ; p=%s"
+ (CicPp.ppterm c) (CicPp.ppterm p))))
+
+and split_prods ~subst context n te =
+ let module C = Cic in
+ let module R = CicReduction in
+ match (n, R.whd ~subst context te) with
+ (0, _) -> context,te
+ | (n, C.Prod (name,so,ta)) when n > 0 ->
+ split_prods ~subst ((Some (name,(C.Decl so)))::context) (n - 1) ta
+ | (_, _) -> raise (AssertFailure (lazy "8"))
+
+and eat_lambdas ~subst context n te =
+ let module C = Cic in
+ let module R = CicReduction in
+ match (n, R.whd ~subst context te) with
+ (0, _) -> (te, 0, context)
+ | (n, C.Lambda (name,so,ta)) when n > 0 ->
+ let (te, k, context') =
+ eat_lambdas ~subst ((Some (name,(C.Decl so)))::context) (n - 1) ta
+ in
+ (te, k + 1, context')
+ | (n, te) ->
+ raise (AssertFailure (lazy (sprintf "9 (%d, %s)" n (CicPp.ppterm te))))
+
+(*CSC: Tutto quello che segue e' l'intuzione di luca ;-) *)
+and check_is_really_smaller_arg ~subst context n nn kl x safes te =
+ (*CSC: forse la whd si puo' fare solo quando serve veramente. *)
+ (*CSC: cfr guarded_by_destructors *)
+ let module C = Cic in
+ let module U = UriManager in
+ match CicReduction.whd ~subst context te with
+ C.Rel m when List.mem m safes -> true
+ | C.Rel _ -> false
+ | C.Var _
+ | C.Meta _
+ | C.Sort _
+ | C.Implicit _
+ | C.Cast _
+(* | C.Cast (te,ty) ->
+ check_is_really_smaller_arg ~subst n nn kl x safes te &&
+ check_is_really_smaller_arg ~subst n nn kl x safes ty*)
+(* | C.Prod (_,so,ta) ->
+ check_is_really_smaller_arg ~subst n nn kl x safes so &&
+ check_is_really_smaller_arg ~subst (n+1) (nn+1) kl (x+1)
+ (List.map (fun x -> x + 1) safes) ta*)
+ | C.Prod _ -> raise (AssertFailure (lazy "10"))
+ | C.Lambda (name,so,ta) ->
+ check_is_really_smaller_arg ~subst context n nn kl x safes so &&
+ check_is_really_smaller_arg ~subst ((Some (name,(C.Decl so)))::context)
+ (n+1) (nn+1) kl (x+1) (List.map (fun x -> x + 1) safes) ta
+ | C.LetIn (name,so,ta) ->
+ check_is_really_smaller_arg ~subst context n nn kl x safes so &&
+ check_is_really_smaller_arg ~subst ((Some (name,(C.Def (so,None))))::context)
+ (n+1) (nn+1) kl (x+1) (List.map (fun x -> x + 1) safes) ta
+ | C.Appl (he::_) ->
+ (*CSC: sulla coda ci vogliono dei controlli? secondo noi no, ma *)
+ (*CSC: solo perche' non abbiamo trovato controesempi *)
+ check_is_really_smaller_arg ~subst context n nn kl x safes he
+ | C.Appl [] -> raise (AssertFailure (lazy "11"))
+ | C.Const _
+ | C.MutInd _ -> raise (AssertFailure (lazy "12"))
+ | C.MutConstruct _ -> false
+ | C.MutCase (uri,i,outtype,term,pl) ->
+ (match term with
+ C.Rel m when List.mem m safes || m = x ->
+ let (tys,len,isinductive,paramsno,cl) =
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ C.InductiveDefinition (tl,_,paramsno,_) ->
+ let tys =
+ List.map
+ (fun (n,_,ty,_) -> Some (Cic.Name n,(Cic.Decl ty))) tl
+ in
+ let (_,isinductive,_,cl) = List.nth tl i in
+ let cl' =
+ List.map
+ (fun (id,ty) ->
+ (id, snd (split_prods ~subst tys paramsno ty))) cl
+ in
+ (tys,List.length tl,isinductive,paramsno,cl')
+ | _ ->
+ raise (TypeCheckerFailure
+ (lazy ("Unknown mutual inductive definition:" ^
+ UriManager.string_of_uri uri)))
+ in
+ if not isinductive then
+ List.fold_right
+ (fun p i ->
+ i && check_is_really_smaller_arg ~subst context n nn kl x safes p)
+ pl true
+ else
+ let pl_and_cl =
+ try
+ List.combine pl cl
+ with
+ Invalid_argument _ ->
+ raise (TypeCheckerFailure (lazy "not enough patterns"))
+ in
+ List.fold_right
+ (fun (p,(_,c)) i ->
+ let rl' =
+ let debrujinedte = debrujin_constructor uri len c in
+ recursive_args tys 0 len debrujinedte
+ in
+ let (e,safes',n',nn',x',context') =
+ get_new_safes ~subst context p c rl' safes n nn x
+ in
+ i &&
+ check_is_really_smaller_arg ~subst context' n' nn' kl x' safes' e
+ ) pl_and_cl true
+ | C.Appl ((C.Rel m)::tl) when List.mem m safes || m = x ->
+ let (tys,len,isinductive,paramsno,cl) =
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ C.InductiveDefinition (tl,_,paramsno,_) ->
+ let (_,isinductive,_,cl) = List.nth tl i in
+ let tys =
+ List.map (fun (n,_,ty,_) ->
+ Some(Cic.Name n,(Cic.Decl ty))) tl
+ in
+ let cl' =
+ List.map
+ (fun (id,ty) ->
+ (id, snd (split_prods ~subst tys paramsno ty))) cl
+ in
+ (tys,List.length tl,isinductive,paramsno,cl')
+ | _ ->
+ raise (TypeCheckerFailure
+ (lazy ("Unknown mutual inductive definition:" ^
+ UriManager.string_of_uri uri)))
+ in
+ if not isinductive then
+ List.fold_right
+ (fun p i ->
+ i && check_is_really_smaller_arg ~subst context n nn kl x safes p)
+ pl true
+ else
+ let pl_and_cl =
+ try
+ List.combine pl cl
+ with
+ Invalid_argument _ ->
+ raise (TypeCheckerFailure (lazy "not enough patterns"))
+ in
+ (*CSC: supponiamo come prima che nessun controllo sia necessario*)
+ (*CSC: sugli argomenti di una applicazione *)
+ List.fold_right
+ (fun (p,(_,c)) i ->
+ let rl' =
+ let debrujinedte = debrujin_constructor uri len c in
+ recursive_args tys 0 len debrujinedte
+ in
+ let (e, safes',n',nn',x',context') =
+ get_new_safes ~subst context p c rl' safes n nn x
+ in
+ i &&
+ check_is_really_smaller_arg ~subst context' n' nn' kl x' safes' e
+ ) pl_and_cl true
+ | _ ->
+ List.fold_right
+ (fun p i ->
+ i && check_is_really_smaller_arg ~subst context n nn kl x safes p
+ ) pl true
+ )
+ | C.Fix (_, fl) ->
+ let len = List.length fl in
+ let n_plus_len = n + len
+ and nn_plus_len = nn + len
+ and x_plus_len = x + len
+ and tys = List.map (fun (n,_,ty,_) -> Some (C.Name n,(C.Decl ty))) fl
+ and safes' = List.map (fun x -> x + len) safes in
+ List.fold_right
+ (fun (_,_,ty,bo) i ->
+ i &&
+ check_is_really_smaller_arg ~subst (tys@context) n_plus_len nn_plus_len kl
+ x_plus_len safes' bo
+ ) fl true
+ | C.CoFix (_, fl) ->
+ let len = List.length fl in
+ let n_plus_len = n + len
+ and nn_plus_len = nn + len
+ and x_plus_len = x + len
+ and tys = List.map (fun (n,ty,_) -> Some (C.Name n,(C.Decl ty))) fl
+ and safes' = List.map (fun x -> x + len) safes in
+ List.fold_right
+ (fun (_,ty,bo) i ->
+ i &&
+ check_is_really_smaller_arg ~subst (tys@context) n_plus_len nn_plus_len kl
+ x_plus_len safes' bo
+ ) fl true
+
+and guarded_by_destructors ~subst context n nn kl x safes =
+ let module C = Cic in
+ let module U = UriManager in
+ function
+ C.Rel m when m > n && m <= nn -> false
+ | C.Rel m ->
+ (match List.nth context (n-1) with
+ Some (_,C.Decl _) -> true
+ | Some (_,C.Def (bo,_)) ->
+ guarded_by_destructors ~subst context m nn kl x safes
+ (CicSubstitution.lift m bo)
+ | None -> raise (TypeCheckerFailure (lazy "Reference to deleted hypothesis"))
+ )
+ | C.Meta _
+ | C.Sort _
+ | C.Implicit _ -> true
+ | C.Cast (te,ty) ->
+ guarded_by_destructors ~subst context n nn kl x safes te &&
+ guarded_by_destructors ~subst context n nn kl x safes ty
+ | C.Prod (name,so,ta) ->
+ guarded_by_destructors ~subst context n nn kl x safes so &&
+ guarded_by_destructors ~subst ((Some (name,(C.Decl so)))::context)
+ (n+1) (nn+1) kl (x+1) (List.map (fun x -> x + 1) safes) ta
+ | C.Lambda (name,so,ta) ->
+ guarded_by_destructors ~subst context n nn kl x safes so &&
+ guarded_by_destructors ~subst ((Some (name,(C.Decl so)))::context)
+ (n+1) (nn+1) kl (x+1) (List.map (fun x -> x + 1) safes) ta
+ | C.LetIn (name,so,ta) ->
+ guarded_by_destructors ~subst context n nn kl x safes so &&
+ guarded_by_destructors ~subst ((Some (name,(C.Def (so,None))))::context)
+ (n+1) (nn+1) kl (x+1) (List.map (fun x -> x + 1) safes) ta
+ | C.Appl ((C.Rel m)::tl) when m > n && m <= nn ->
+ let k = List.nth kl (m - n - 1) in
+ if not (List.length tl > k) then false
+ else
+ List.fold_right
+ (fun param i ->
+ i && guarded_by_destructors ~subst context n nn kl x safes param
+ ) tl true &&
+ check_is_really_smaller_arg ~subst context n nn kl x safes (List.nth tl k)
+ | C.Appl tl ->
+ List.fold_right
+ (fun t i -> i && guarded_by_destructors ~subst context n nn kl x safes t)
+ tl true
+ | C.Var (_,exp_named_subst)
+ | C.Const (_,exp_named_subst)
+ | C.MutInd (_,_,exp_named_subst)
+ | C.MutConstruct (_,_,_,exp_named_subst) ->
+ List.fold_right
+ (fun (_,t) i -> i && guarded_by_destructors ~subst context n nn kl x safes t)
+ exp_named_subst true
+ | C.MutCase (uri,i,outtype,term,pl) ->
+ (match CicReduction.whd ~subst context term with
+ C.Rel m when List.mem m safes || m = x ->
+ let (tys,len,isinductive,paramsno,cl) =
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ C.InductiveDefinition (tl,_,paramsno,_) ->
+ let len = List.length tl in
+ let (_,isinductive,_,cl) = List.nth tl i in
+ let tys =
+ List.map (fun (n,_,ty,_) ->
+ Some(Cic.Name n,(Cic.Decl ty))) tl
+ in
+ let cl' =
+ List.map
+ (fun (id,ty) ->
+ let debrujinedty = debrujin_constructor uri len ty in
+ (id, snd (split_prods ~subst tys paramsno ty),
+ snd (split_prods ~subst tys paramsno debrujinedty)
+ )) cl
+ in
+ (tys,len,isinductive,paramsno,cl')
+ | _ ->
+ raise (TypeCheckerFailure
+ (lazy ("Unknown mutual inductive definition:" ^
+ UriManager.string_of_uri uri)))
+ in
+ if not isinductive then
+ guarded_by_destructors ~subst context n nn kl x safes outtype &&
+ guarded_by_destructors ~subst context n nn kl x safes term &&
+ (*CSC: manca ??? il controllo sul tipo di term? *)
+ List.fold_right
+ (fun p i ->
+ i && guarded_by_destructors ~subst context n nn kl x safes p)
+ pl true
+ else
+ let pl_and_cl =
+ try
+ List.combine pl cl
+ with
+ Invalid_argument _ ->
+ raise (TypeCheckerFailure (lazy "not enough patterns"))
+ in
+ guarded_by_destructors ~subst context n nn kl x safes outtype &&
+ (*CSC: manca ??? il controllo sul tipo di term? *)
+ List.fold_right
+ (fun (p,(_,c,brujinedc)) i ->
+ let rl' = recursive_args tys 0 len brujinedc in
+ let (e,safes',n',nn',x',context') =
+ get_new_safes ~subst context p c rl' safes n nn x
+ in
+ i &&
+ guarded_by_destructors ~subst context' n' nn' kl x' safes' e
+ ) pl_and_cl true
+ | C.Appl ((C.Rel m)::tl) when List.mem m safes || m = x ->
+ let (tys,len,isinductive,paramsno,cl) =
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ C.InductiveDefinition (tl,_,paramsno,_) ->
+ let (_,isinductive,_,cl) = List.nth tl i in
+ let tys =
+ List.map
+ (fun (n,_,ty,_) -> Some(Cic.Name n,(Cic.Decl ty))) tl
+ in
+ let cl' =
+ List.map
+ (fun (id,ty) ->
+ (id, snd (split_prods ~subst tys paramsno ty))) cl
+ in
+ (tys,List.length tl,isinductive,paramsno,cl')
+ | _ ->
+ raise (TypeCheckerFailure
+ (lazy ("Unknown mutual inductive definition:" ^
+ UriManager.string_of_uri uri)))
+ in
+ if not isinductive then
+ guarded_by_destructors ~subst context n nn kl x safes outtype &&
+ guarded_by_destructors ~subst context n nn kl x safes term &&
+ (*CSC: manca ??? il controllo sul tipo di term? *)
+ List.fold_right
+ (fun p i ->
+ i && guarded_by_destructors ~subst context n nn kl x safes p)
+ pl true
+ else
+ let pl_and_cl =
+ try
+ List.combine pl cl
+ with
+ Invalid_argument _ ->
+ raise (TypeCheckerFailure (lazy "not enough patterns"))
+ in
+ guarded_by_destructors ~subst context n nn kl x safes outtype &&
+ (*CSC: manca ??? il controllo sul tipo di term? *)
+ List.fold_right
+ (fun t i ->
+ i && guarded_by_destructors ~subst context n nn kl x safes t)
+ tl true &&
+ List.fold_right
+ (fun (p,(_,c)) i ->
+ let rl' =
+ let debrujinedte = debrujin_constructor uri len c in
+ recursive_args tys 0 len debrujinedte
+ in
+ let (e, safes',n',nn',x',context') =
+ get_new_safes ~subst context p c rl' safes n nn x
+ in
+ i &&
+ guarded_by_destructors ~subst context' n' nn' kl x' safes' e
+ ) pl_and_cl true
+ | _ ->
+ guarded_by_destructors ~subst context n nn kl x safes outtype &&
+ guarded_by_destructors ~subst context n nn kl x safes term &&
+ (*CSC: manca ??? il controllo sul tipo di term? *)
+ List.fold_right
+ (fun p i -> i && guarded_by_destructors ~subst context n nn kl x safes p)
+ pl true
+ )
+ | C.Fix (_, fl) ->
+ let len = List.length fl in
+ let n_plus_len = n + len
+ and nn_plus_len = nn + len
+ and x_plus_len = x + len
+ and tys = List.map (fun (n,_,ty,_) -> Some (C.Name n,(C.Decl ty))) fl
+ and safes' = List.map (fun x -> x + len) safes in
+ List.fold_right
+ (fun (_,_,ty,bo) i ->
+ i && guarded_by_destructors ~subst context n nn kl x_plus_len safes' ty &&
+ guarded_by_destructors ~subst (tys@context) n_plus_len nn_plus_len kl
+ x_plus_len safes' bo
+ ) fl true
+ | C.CoFix (_, fl) ->
+ let len = List.length fl in
+ let n_plus_len = n + len
+ and nn_plus_len = nn + len
+ and x_plus_len = x + len
+ and tys = List.map (fun (n,ty,_) -> Some (C.Name n,(C.Decl ty))) fl
+ and safes' = List.map (fun x -> x + len) safes in
+ List.fold_right
+ (fun (_,ty,bo) i ->
+ i &&
+ guarded_by_destructors ~subst context n nn kl x_plus_len safes' ty &&
+ guarded_by_destructors ~subst (tys@context) n_plus_len nn_plus_len kl
+ x_plus_len safes' bo
+ ) fl true
+
+(* the boolean h means already protected *)
+(* args is the list of arguments the type of the constructor that may be *)
+(* found in head position must be applied to. *)
+and guarded_by_constructors ~subst context n nn h te args coInductiveTypeURI =
+ let module C = Cic in
+ (*CSC: There is a lot of code replication between the cases X and *)
+ (*CSC: (C.Appl X tl). Maybe it will be better to define a function *)
+ (*CSC: that maps X into (C.Appl X []) when X is not already a C.Appl *)
+ match CicReduction.whd ~subst context te with
+ C.Rel m when m > n && m <= nn -> h
+ | C.Rel _ -> true
+ | C.Meta _
+ | C.Sort _
+ | C.Implicit _
+ | C.Cast _
+ | C.Prod _
+ | C.LetIn _ ->
+ (* the term has just been type-checked *)
+ raise (AssertFailure (lazy "17"))
+ | C.Lambda (name,so,de) ->
+ does_not_occur ~subst context n nn so &&
+ guarded_by_constructors ~subst ((Some (name,(C.Decl so)))::context)
+ (n + 1) (nn + 1) h de args coInductiveTypeURI
+ | C.Appl ((C.Rel m)::tl) when m > n && m <= nn ->
+ h &&
+ List.fold_right (fun x i -> i && does_not_occur ~subst context n nn x) tl true
+ | C.Appl ((C.MutConstruct (uri,i,j,exp_named_subst))::tl) ->
+ let consty =
+ let obj,_ =
+ try
+ CicEnvironment.get_cooked_obj ~trust:false CicUniv.empty_ugraph uri
+ with Not_found -> assert false
+ in
+ match obj with
+ C.InductiveDefinition (itl,_,_,_) ->
+ let (_,_,_,cl) = List.nth itl i in
+ let (_,cons) = List.nth cl (j - 1) in
+ CicSubstitution.subst_vars exp_named_subst cons
+ | _ ->
+ raise (TypeCheckerFailure
+ (lazy ("Unknown mutual inductive definition:" ^ UriManager.string_of_uri uri)))
+ in
+ let rec analyse_branch context ty te =
+ match CicReduction.whd ~subst context ty with
+ C.Meta _ -> raise (AssertFailure (lazy "34"))
+ | C.Rel _
+ | C.Var _
+ | C.Sort _ ->
+ does_not_occur ~subst context n nn te
+ | C.Implicit _
+ | C.Cast _ ->
+ raise (AssertFailure (lazy "24"))(* due to type-checking *)
+ | C.Prod (name,so,de) ->
+ analyse_branch ((Some (name,(C.Decl so)))::context) de te
+ | C.Lambda _
+ | C.LetIn _ ->
+ raise (AssertFailure (lazy "25"))(* due to type-checking *)
+ | C.Appl ((C.MutInd (uri,_,_))::_) when uri == coInductiveTypeURI ->
+ guarded_by_constructors ~subst context n nn true te []
+ coInductiveTypeURI
+ | C.Appl ((C.MutInd (uri,_,_))::_) ->
+ guarded_by_constructors ~subst context n nn true te tl
+ coInductiveTypeURI
+ | C.Appl _ ->
+ does_not_occur ~subst context n nn te
+ | C.Const _ -> raise (AssertFailure (lazy "26"))
+ | C.MutInd (uri,_,_) when uri == coInductiveTypeURI ->
+ guarded_by_constructors ~subst context n nn true te []
+ coInductiveTypeURI
+ | C.MutInd _ ->
+ does_not_occur ~subst context n nn te
+ | C.MutConstruct _ -> raise (AssertFailure (lazy "27"))
+ (*CSC: we do not consider backbones with a MutCase, Fix, Cofix *)
+ (*CSC: in head position. *)
+ | C.MutCase _
+ | C.Fix _
+ | C.CoFix _ ->
+ raise (AssertFailure (lazy "28"))(* due to type-checking *)
+ in
+ let rec analyse_instantiated_type context ty l =
+ match CicReduction.whd ~subst context ty with
+ C.Rel _
+ | C.Var _
+ | C.Meta _
+ | C.Sort _
+ | C.Implicit _
+ | C.Cast _ -> raise (AssertFailure (lazy "29"))(* due to type-checking *)
+ | C.Prod (name,so,de) ->
+ begin
+ match l with
+ [] -> true
+ | he::tl ->
+ analyse_branch context so he &&
+ analyse_instantiated_type
+ ((Some (name,(C.Decl so)))::context) de tl
+ end
+ | C.Lambda _
+ | C.LetIn _ ->
+ raise (AssertFailure (lazy "30"))(* due to type-checking *)
+ | C.Appl _ ->
+ List.fold_left
+ (fun i x -> i && does_not_occur ~subst context n nn x) true l
+ | C.Const _ -> raise (AssertFailure (lazy "31"))
+ | C.MutInd _ ->
+ List.fold_left
+ (fun i x -> i && does_not_occur ~subst context n nn x) true l
+ | C.MutConstruct _ -> raise (AssertFailure (lazy "32"))
+ (*CSC: we do not consider backbones with a MutCase, Fix, Cofix *)
+ (*CSC: in head position. *)
+ | C.MutCase _
+ | C.Fix _
+ | C.CoFix _ ->
+ raise (AssertFailure (lazy "33"))(* due to type-checking *)
+ in
+ let rec instantiate_type args consty =
+ function
+ [] -> true
+ | tlhe::tltl as l ->
+ let consty' = CicReduction.whd ~subst context consty in
+ match args with
+ he::tl ->
+ begin
+ match consty' with
+ C.Prod (_,_,de) ->
+ let instantiated_de = CicSubstitution.subst he de in
+ (*CSC: siamo sicuri che non sia troppo forte? *)
+ does_not_occur ~subst context n nn tlhe &
+ instantiate_type tl instantiated_de tltl
+ | _ ->
+ (*CSC:We do not consider backbones with a MutCase, a *)
+ (*CSC:FixPoint, a CoFixPoint and so on in head position.*)
+ raise (AssertFailure (lazy "23"))
+ end
+ | [] -> analyse_instantiated_type context consty' l
+ (* These are all the other cases *)
+ in
+ instantiate_type args consty tl
+ | C.Appl ((C.CoFix (_,fl))::tl) ->
+ List.fold_left (fun i x -> i && does_not_occur ~subst context n nn x) true tl &&
+ let len = List.length fl in
+ let n_plus_len = n + len
+ and nn_plus_len = nn + len
+ (*CSC: Is a Decl of the ty ok or should I use Def of a Fix? *)
+ and tys = List.map (fun (n,ty,_) -> Some (C.Name n,(C.Decl ty))) fl in
+ List.fold_right
+ (fun (_,ty,bo) i ->
+ i && does_not_occur ~subst context n nn ty &&
+ guarded_by_constructors ~subst (tys@context) n_plus_len nn_plus_len
+ h bo args coInductiveTypeURI
+ ) fl true
+ | C.Appl ((C.MutCase (_,_,out,te,pl))::tl) ->
+ List.fold_left (fun i x -> i && does_not_occur ~subst context n nn x) true tl &&
+ does_not_occur ~subst context n nn out &&
+ does_not_occur ~subst context n nn te &&
+ List.fold_right
+ (fun x i ->
+ i &&
+ guarded_by_constructors ~subst context n nn h x args
+ coInductiveTypeURI
+ ) pl true
+ | C.Appl l ->
+ List.fold_right (fun x i -> i && does_not_occur ~subst context n nn x) l true
+ | C.Var (_,exp_named_subst)
+ | C.Const (_,exp_named_subst) ->
+ List.fold_right
+ (fun (_,x) i -> i && does_not_occur ~subst context n nn x) exp_named_subst true
+ | C.MutInd _ -> assert false
+ | C.MutConstruct (_,_,_,exp_named_subst) ->
+ List.fold_right
+ (fun (_,x) i -> i && does_not_occur ~subst context n nn x) exp_named_subst true
+ | C.MutCase (_,_,out,te,pl) ->
+ does_not_occur ~subst context n nn out &&
+ does_not_occur ~subst context n nn te &&
+ List.fold_right
+ (fun x i ->
+ i &&
+ guarded_by_constructors ~subst context n nn h x args
+ coInductiveTypeURI
+ ) pl true
+ | C.Fix (_,fl) ->
+ let len = List.length fl in
+ let n_plus_len = n + len
+ and nn_plus_len = nn + len
+ (*CSC: Is a Decl of the ty ok or should I use Def of a Fix? *)
+ and tys = List.map (fun (n,_,ty,_)-> Some (C.Name n,(C.Decl ty))) fl in
+ List.fold_right
+ (fun (_,_,ty,bo) i ->
+ i && does_not_occur ~subst context n nn ty &&
+ does_not_occur ~subst (tys@context) n_plus_len nn_plus_len bo
+ ) fl true
+ | C.CoFix (_,fl) ->
+ let len = List.length fl in
+ let n_plus_len = n + len
+ and nn_plus_len = nn + len
+ (*CSC: Is a Decl of the ty ok or should I use Def of a Fix? *)
+ and tys = List.map (fun (n,ty,_) -> Some (C.Name n,(C.Decl ty))) fl in
+ List.fold_right
+ (fun (_,ty,bo) i ->
+ i && does_not_occur ~subst context n nn ty &&
+ guarded_by_constructors ~subst (tys@context) n_plus_len nn_plus_len
+ h bo
+ args coInductiveTypeURI
+ ) fl true
+
+and check_allowed_sort_elimination ~subst ~metasenv ~logger context uri i
+ need_dummy ind arity1 arity2 ugraph =
+ let module C = Cic in
+ let module U = UriManager in
+ let arity1 = CicReduction.whd ~subst context arity1 in
+ let rec check_allowed_sort_elimination_aux ugraph context arity2 need_dummy =
+ match arity1, CicReduction.whd ~subst context arity2 with
+ (C.Prod (_,so1,de1), C.Prod (_,so2,de2)) ->
+ let b,ugraph1 =
+ CicReduction.are_convertible ~subst ~metasenv context so1 so2 ugraph in
+ if b then
+ check_allowed_sort_elimination ~subst ~metasenv ~logger context uri i
+ need_dummy (C.Appl [CicSubstitution.lift 1 ind ; C.Rel 1]) de1 de2
+ ugraph1
+ else
+ false,ugraph1
+ | (C.Sort _, C.Prod (name,so,ta)) when not need_dummy ->
+ let b,ugraph1 =
+ CicReduction.are_convertible ~subst ~metasenv context so ind ugraph in
+ if not b then
+ false,ugraph1
+ else
+ check_allowed_sort_elimination_aux ugraph1
+ ((Some (name,C.Decl so))::context) ta true
+ | (C.Sort C.Prop, C.Sort C.Prop) when need_dummy -> true,ugraph
+ | (C.Sort C.Prop, C.Sort C.Set)
+ | (C.Sort C.Prop, C.Sort C.CProp)
+ | (C.Sort C.Prop, C.Sort (C.Type _) ) when need_dummy ->
+ (let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ C.InductiveDefinition (itl,_,paramsno,_) ->
+ let itl_len = List.length itl in
+ let (name,_,ty,cl) = List.nth itl i in
+ let cl_len = List.length cl in
+ if (cl_len = 0 || (itl_len = 1 && cl_len = 1)) then
+ let non_informative,ugraph =
+ if cl_len = 0 then true,ugraph
+ else
+ is_non_informative ~logger [Some (C.Name name,C.Decl ty)]
+ paramsno (snd (List.nth cl 0)) ugraph
+ in
+ (* is it a singleton or empty non recursive and non informative
+ definition? *)
+ non_informative, ugraph
+ else
+ false,ugraph
+ | _ ->
+ raise (TypeCheckerFailure
+ (lazy ("Unknown mutual inductive definition:" ^
+ UriManager.string_of_uri uri)))
+ )
+ | (C.Sort C.Set, C.Sort C.Prop) when need_dummy -> true , ugraph
+ | (C.Sort C.CProp, C.Sort C.Prop) when need_dummy -> true , ugraph
+ | (C.Sort C.Set, C.Sort C.Set) when need_dummy -> true , ugraph
+ | (C.Sort C.Set, C.Sort C.CProp) when need_dummy -> true , ugraph
+ | (C.Sort C.CProp, C.Sort C.Set) when need_dummy -> true , ugraph
+ | (C.Sort C.CProp, C.Sort C.CProp) when need_dummy -> true , ugraph
+ | ((C.Sort C.Set, C.Sort (C.Type _)) | (C.Sort C.CProp, C.Sort (C.Type _)))
+ when need_dummy ->
+ (let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ C.InductiveDefinition (itl,_,paramsno,_) ->
+ let tys =
+ List.map (fun (n,_,ty,_) -> Some (Cic.Name n,(Cic.Decl ty))) itl
+ in
+ let (_,_,_,cl) = List.nth itl i in
+ (List.fold_right
+ (fun (_,x) (i,ugraph) ->
+ if i then
+ is_small ~logger tys paramsno x ugraph
+ else
+ false,ugraph
+ ) cl (true,ugraph))
+ | _ ->
+ raise (TypeCheckerFailure
+ (lazy ("Unknown mutual inductive definition:" ^
+ UriManager.string_of_uri uri)))
+ )
+ | (C.Sort (C.Type _), C.Sort _) when need_dummy -> true , ugraph
+ | (_,_) -> false,ugraph
+ in
+ check_allowed_sort_elimination_aux ugraph context arity2 need_dummy
+
+and type_of_branch ~subst context argsno need_dummy outtype term constype =
+ let module C = Cic in
+ let module R = CicReduction in
+ match R.whd ~subst context constype with
+ C.MutInd (_,_,_) ->
+ if need_dummy then
+ outtype
+ else
+ C.Appl [outtype ; term]
+ | C.Appl (C.MutInd (_,_,_)::tl) ->
+ let (_,arguments) = split tl argsno
+ in
+ if need_dummy && arguments = [] then
+ outtype
+ else
+ C.Appl (outtype::arguments@(if need_dummy then [] else [term]))
+ | C.Prod (name,so,de) ->
+ let term' =
+ match CicSubstitution.lift 1 term with
+ C.Appl l -> C.Appl (l@[C.Rel 1])
+ | t -> C.Appl [t ; C.Rel 1]
+ in
+ C.Prod (C.Anonymous,so,type_of_branch ~subst
+ ((Some (name,(C.Decl so)))::context) argsno need_dummy
+ (CicSubstitution.lift 1 outtype) term' de)
+ | _ -> raise (AssertFailure (lazy "20"))
+
+(* check_metasenv_consistency checks that the "canonical" context of a
+metavariable is consitent - up to relocation via the relocation list l -
+with the actual context *)
+
+
+and check_metasenv_consistency ~logger ~subst metasenv context
+ canonical_context l ugraph
+=
+ let module C = Cic in
+ let module R = CicReduction in
+ let module S = CicSubstitution in
+ let lifted_canonical_context =
+ let rec aux i =
+ function
+ [] -> []
+ | (Some (n,C.Decl t))::tl ->
+ (Some (n,C.Decl (S.subst_meta l (S.lift i t))))::(aux (i+1) tl)
+ | (Some (n,C.Def (t,None)))::tl ->
+ (Some (n,C.Def ((S.subst_meta l (S.lift i t)),None)))::(aux (i+1) tl)
+ | None::tl -> None::(aux (i+1) tl)
+ | (Some (n,C.Def (t,Some ty)))::tl ->
+ (Some (n,C.Def ((S.subst_meta l (S.lift i t)),Some (S.subst_meta l (S.lift i ty)))))::(aux (i+1) tl)
+ in
+ aux 1 canonical_context
+ in
+ List.fold_left2
+ (fun ugraph t ct ->
+ match (t,ct) with
+ | _,None -> ugraph
+ | Some t,Some (_,C.Def (ct,_)) ->
+ let b,ugraph1 =
+ R.are_convertible ~subst ~metasenv context t ct ugraph
+ in
+ if not b then
+ raise
+ (TypeCheckerFailure
+ (lazy (sprintf "Not well typed metavariable local context: expected a term convertible with %s, found %s" (CicPp.ppterm ct) (CicPp.ppterm t))))
+ else
+ ugraph1
+ | Some t,Some (_,C.Decl ct) ->
+ let type_t,ugraph1 =
+ type_of_aux' ~logger ~subst metasenv context t ugraph
+ in
+ let b,ugraph2 =
+ R.are_convertible ~subst ~metasenv context type_t ct ugraph1
+ in
+ if not b then
+ raise (TypeCheckerFailure
+ (lazy (sprintf "Not well typed metavariable local context: expected a term of type %s, found %s of type %s"
+ (CicPp.ppterm ct) (CicPp.ppterm t)
+ (CicPp.ppterm type_t))))
+ else
+ ugraph2
+ | None, _ ->
+ raise (TypeCheckerFailure
+ (lazy ("Not well typed metavariable local context: "^
+ "an hypothesis, that is not hidden, is not instantiated")))
+ ) ugraph l lifted_canonical_context
+
+
+(*
+ type_of_aux' is just another name (with a different scope)
+ for type_of_aux
+*)
+
+and type_of_aux' ~logger ?(subst = []) metasenv context t ugraph =
+ let rec type_of_aux ~logger context t ugraph =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module S = CicSubstitution in
+ let module U = UriManager in
+ match t with
+ C.Rel n ->
+ (try
+ match List.nth context (n - 1) with
+ Some (_,C.Decl t) -> S.lift n t,ugraph
+ | Some (_,C.Def (_,Some ty)) -> S.lift n ty,ugraph
+ | Some (_,C.Def (bo,None)) ->
+ debug_print (lazy "##### CASO DA INVESTIGARE E CAPIRE") ;
+ type_of_aux ~logger context (S.lift n bo) ugraph
+ | None -> raise
+ (TypeCheckerFailure (lazy "Reference to deleted hypothesis"))
+ with
+ _ ->
+ raise (TypeCheckerFailure (lazy "unbound variable"))
+ )
+ | C.Var (uri,exp_named_subst) ->
+ incr fdebug ;
+ let ugraph1 =
+ check_exp_named_subst ~logger ~subst context exp_named_subst ugraph
+ in
+ let ty,ugraph2 = type_of_variable ~logger uri ugraph1 in
+ let ty1 = CicSubstitution.subst_vars exp_named_subst ty in
+ decr fdebug ;
+ ty1,ugraph2
+ | C.Meta (n,l) ->
+ (try
+ let (canonical_context,term,ty) = CicUtil.lookup_subst n subst in
+ let ugraph1 =
+ check_metasenv_consistency ~logger
+ ~subst metasenv context canonical_context l ugraph
+ in
+ (* assuming subst is well typed !!!!! *)
+ ((CicSubstitution.subst_meta l ty), ugraph1)
+ (* type_of_aux context (CicSubstitution.subst_meta l term) *)
+ with CicUtil.Subst_not_found _ ->
+ let (_,canonical_context,ty) = CicUtil.lookup_meta n metasenv in
+ let ugraph1 =
+ check_metasenv_consistency ~logger
+ ~subst metasenv context canonical_context l ugraph
+ in
+ ((CicSubstitution.subst_meta l ty),ugraph1))
+ (* TASSI: CONSTRAINTS *)
+ | C.Sort (C.Type t) ->
+ let t' = CicUniv.fresh() in
+ let ugraph1 = CicUniv.add_gt t' t ugraph in
+ (C.Sort (C.Type t')),ugraph1
+ (* TASSI: CONSTRAINTS *)
+ | C.Sort s -> (C.Sort (C.Type (CicUniv.fresh ()))),ugraph
+ | C.Implicit _ -> raise (AssertFailure (lazy "21"))
+ | C.Cast (te,ty) as t ->
+ let _,ugraph1 = type_of_aux ~logger context ty ugraph in
+ let ty_te,ugraph2 = type_of_aux ~logger context te ugraph1 in
+ let b,ugraph3 =
+ R.are_convertible ~subst ~metasenv context ty_te ty ugraph2
+ in
+ if b then
+ ty,ugraph3
+ else
+ raise (TypeCheckerFailure
+ (lazy (sprintf "Invalid cast %s" (CicPp.ppterm t))))
+ | C.Prod (name,s,t) ->
+ let sort1,ugraph1 = type_of_aux ~logger context s ugraph in
+ let sort2,ugraph2 =
+ type_of_aux ~logger ((Some (name,(C.Decl s)))::context) t ugraph1
+ in
+ sort_of_prod ~subst context (name,s) (sort1,sort2) ugraph2
+ | C.Lambda (n,s,t) ->
+ let sort1,ugraph1 = type_of_aux ~logger context s ugraph in
+ (match R.whd ~subst context sort1 with
+ C.Meta _
+ | C.Sort _ -> ()
+ | _ ->
+ raise
+ (TypeCheckerFailure (lazy (sprintf
+ "Not well-typed lambda-abstraction: the source %s should be a type; instead it is a term of type %s" (CicPp.ppterm s)
+ (CicPp.ppterm sort1))))
+ ) ;
+ let type2,ugraph2 =
+ type_of_aux ~logger ((Some (n,(C.Decl s)))::context) t ugraph1
+ in
+ (C.Prod (n,s,type2)),ugraph2
+ | C.LetIn (n,s,t) ->
+ (* only to check if s is well-typed *)
+ let ty,ugraph1 = type_of_aux ~logger context s ugraph in
+ (* The type of a LetIn is a LetIn. Extremely slow since the computed
+ LetIn is later reduced and maybe also re-checked.
+ (C.LetIn (n,s, type_of_aux ((Some (n,(C.Def s)))::context) t))
+ *)
+ (* The type of the LetIn is reduced. Much faster than the previous
+ solution. Moreover the inferred type is probably very different
+ from the expected one.
+ (CicReduction.whd ~subst context
+ (C.LetIn (n,s, type_of_aux ((Some (n,(C.Def s)))::context) t)))
+ *)
+ (* One-step LetIn reduction. Even faster than the previous solution.
+ Moreover the inferred type is closer to the expected one. *)
+ let ty1,ugraph2 =
+ type_of_aux ~logger
+ ((Some (n,(C.Def (s,Some ty))))::context) t ugraph1
+ in
+ (CicSubstitution.subst s ty1),ugraph2
+ | C.Appl (he::tl) when List.length tl > 0 ->
+ let hetype,ugraph1 = type_of_aux ~logger context he ugraph in
+ let tlbody_and_type,ugraph2 =
+ List.fold_right (
+ fun x (l,ugraph) ->
+ let ty,ugraph1 = type_of_aux ~logger context x ugraph in
+ let _,ugraph1 = type_of_aux ~logger context ty ugraph1 in
+ ((x,ty)::l,ugraph1))
+ tl ([],ugraph1)
+ in
+ (* TASSI: questa c'era nel mio... ma non nel CVS... *)
+ (* let _,ugraph2 = type_of_aux context hetype ugraph2 in *)
+ eat_prods ~subst context hetype tlbody_and_type ugraph2
+ | C.Appl _ -> raise (AssertFailure (lazy "Appl: no arguments"))
+ | C.Const (uri,exp_named_subst) ->
+ incr fdebug ;
+ let ugraph1 =
+ check_exp_named_subst ~logger ~subst context exp_named_subst ugraph
+ in
+ let cty,ugraph2 = type_of_constant ~logger uri ugraph1 in
+ let cty1 =
+ CicSubstitution.subst_vars exp_named_subst cty
+ in
+ decr fdebug ;
+ cty1,ugraph2
+ | C.MutInd (uri,i,exp_named_subst) ->
+ incr fdebug ;
+ let ugraph1 =
+ check_exp_named_subst ~logger ~subst context exp_named_subst ugraph
+ in
+ (* TASSI: da me c'era anche questa, ma in CVS no *)
+ let mty,ugraph2 = type_of_mutual_inductive_defs ~logger uri i ugraph1 in
+ (* fine parte dubbia *)
+ let cty =
+ CicSubstitution.subst_vars exp_named_subst mty
+ in
+ decr fdebug ;
+ cty,ugraph2
+ | C.MutConstruct (uri,i,j,exp_named_subst) ->
+ let ugraph1 =
+ check_exp_named_subst ~logger ~subst context exp_named_subst ugraph
+ in
+ (* TASSI: idem come sopra *)
+ let mty,ugraph2 =
+ type_of_mutual_inductive_constr ~logger uri i j ugraph1
+ in
+ let cty =
+ CicSubstitution.subst_vars exp_named_subst mty
+ in
+ cty,ugraph2
+ | C.MutCase (uri,i,outtype,term,pl) ->
+ let outsort,ugraph1 = type_of_aux ~logger context outtype ugraph in
+ let (need_dummy, k) =
+ let rec guess_args context t =
+ let outtype = CicReduction.whd ~subst context t in
+ match outtype with
+ C.Sort _ -> (true, 0)
+ | C.Prod (name, s, t) ->
+ let (b, n) =
+ guess_args ((Some (name,(C.Decl s)))::context) t in
+ if n = 0 then
+ (* last prod before sort *)
+ match CicReduction.whd ~subst context s with
+(*CSC: for _ see comment below about the missing named_exp_subst ?????????? *)
+ C.MutInd (uri',i',_) when U.eq uri' uri && i' = i ->
+ (false, 1)
+(*CSC: for _ see comment below about the missing named_exp_subst ?????????? *)
+ | C.Appl ((C.MutInd (uri',i',_)) :: _)
+ when U.eq uri' uri && i' = i -> (false, 1)
+ | _ -> (true, 1)
+ else
+ (b, n + 1)
+ | _ ->
+ raise
+ (TypeCheckerFailure
+ (lazy (sprintf
+ "Malformed case analasys' output type %s"
+ (CicPp.ppterm outtype))))
+ in
+(*
+ let (parameters, arguments, exp_named_subst),ugraph2 =
+ let ty,ugraph2 = type_of_aux context term ugraph1 in
+ match R.whd ~subst context ty with
+ (*CSC manca il caso dei CAST *)
+(*CSC: ma servono i parametri (uri,i)? Se si', perche' non serve anche il *)
+(*CSC: parametro exp_named_subst? Se no, perche' non li togliamo? *)
+(*CSC: Hint: nella DTD servono per gli stylesheet. *)
+ C.MutInd (uri',i',exp_named_subst) as typ ->
+ if U.eq uri uri' && i = i' then
+ ([],[],exp_named_subst),ugraph2
+ else
+ raise
+ (TypeCheckerFailure
+ (lazy (sprintf
+ ("Case analysys: analysed term type is %s, but is expected to be (an application of) %s#1/%d{_}")
+ (CicPp.ppterm typ) (U.string_of_uri uri) i)))
+ | C.Appl
+ ((C.MutInd (uri',i',exp_named_subst) as typ):: tl) as typ' ->
+ if U.eq uri uri' && i = i' then
+ let params,args =
+ split tl (List.length tl - k)
+ in (params,args,exp_named_subst),ugraph2
+ else
+ raise
+ (TypeCheckerFailure
+ (lazy (sprintf
+ ("Case analysys: analysed term type is %s, "^
+ "but is expected to be (an application of) "^
+ "%s#1/%d{_}")
+ (CicPp.ppterm typ') (U.string_of_uri uri) i)))
+ | _ ->
+ raise
+ (TypeCheckerFailure
+ (lazy (sprintf
+ ("Case analysis: "^
+ "analysed term %s is not an inductive one")
+ (CicPp.ppterm term))))
+*)
+ let (b, k) = guess_args context outsort in
+ if not b then (b, k - 1) else (b, k) in
+ let (parameters, arguments, exp_named_subst),ugraph2 =
+ let ty,ugraph2 = type_of_aux ~logger context term ugraph1 in
+ match R.whd ~subst context ty with
+ C.MutInd (uri',i',exp_named_subst) as typ ->
+ if U.eq uri uri' && i = i' then
+ ([],[],exp_named_subst),ugraph2
+ else raise
+ (TypeCheckerFailure
+ (lazy (sprintf
+ ("Case analysys: analysed term type is %s (%s#1/%d{_}), but is expected to be (an application of) %s#1/%d{_}")
+ (CicPp.ppterm typ) (U.string_of_uri uri') i' (U.string_of_uri uri) i)))
+ | C.Appl ((C.MutInd (uri',i',exp_named_subst) as typ):: tl) ->
+ if U.eq uri uri' && i = i' then
+ let params,args =
+ split tl (List.length tl - k)
+ in (params,args,exp_named_subst),ugraph2
+ else raise
+ (TypeCheckerFailure
+ (lazy (sprintf
+ ("Case analysys: analysed term type is %s (%s#1/%d{_}), but is expected to be (an application of) %s#1/%d{_}")
+ (CicPp.ppterm typ) (U.string_of_uri uri') i' (U.string_of_uri uri) i)))
+ | _ ->
+ raise
+ (TypeCheckerFailure
+ (lazy (sprintf
+ "Case analysis: analysed term %s is not an inductive one"
+ (CicPp.ppterm term))))
+ in
+ (*
+ let's control if the sort elimination is allowed:
+ [(I q1 ... qr)|B]
+ *)
+ let sort_of_ind_type =
+ if parameters = [] then
+ C.MutInd (uri,i,exp_named_subst)
+ else
+ C.Appl ((C.MutInd (uri,i,exp_named_subst))::parameters)
+ in
+ let type_of_sort_of_ind_ty,ugraph3 =
+ type_of_aux ~logger context sort_of_ind_type ugraph2 in
+ let b,ugraph4 =
+ check_allowed_sort_elimination ~subst ~metasenv ~logger context uri i
+ need_dummy sort_of_ind_type type_of_sort_of_ind_ty outsort ugraph3
+ in
+ if not b then
+ raise
+ (TypeCheckerFailure (lazy ("Case analasys: sort elimination not allowed")));
+ (* let's check if the type of branches are right *)
+ let parsno =
+ let obj,_ =
+ try
+ CicEnvironment.get_cooked_obj ~trust:false CicUniv.empty_ugraph uri
+ with Not_found -> assert false
+ in
+ match obj with
+ C.InductiveDefinition (_,_,parsno,_) -> parsno
+ | _ ->
+ raise (TypeCheckerFailure
+ (lazy ("Unknown mutual inductive definition:" ^
+ UriManager.string_of_uri uri)))
+ in
+ let (_,branches_ok,ugraph5) =
+ List.fold_left
+ (fun (j,b,ugraph) p ->
+ if b then
+ let cons =
+ if parameters = [] then
+ (C.MutConstruct (uri,i,j,exp_named_subst))
+ else
+ (C.Appl
+ (C.MutConstruct (uri,i,j,exp_named_subst)::parameters))
+ in
+ let ty_p,ugraph1 = type_of_aux ~logger context p ugraph in
+ let ty_cons,ugraph3 = type_of_aux ~logger context cons ugraph1 in
+ (* 2 is skipped *)
+ let ty_branch =
+ type_of_branch ~subst context parsno need_dummy outtype cons
+ ty_cons in
+ let b1,ugraph4 =
+ R.are_convertible
+ ~subst ~metasenv context ty_p ty_branch ugraph3
+ in
+ if not b1 then
+ debug_print (lazy
+ ("#### " ^ CicPp.ppterm ty_p ^
+ " <==> " ^ CicPp.ppterm ty_branch));
+ (j + 1,b1,ugraph4)
+ else
+ (j,false,ugraph)
+ ) (1,true,ugraph4) pl
+ in
+ if not branches_ok then
+ raise
+ (TypeCheckerFailure (lazy "Case analysys: wrong branch type"));
+ let arguments' =
+ if not need_dummy then outtype::arguments@[term]
+ else outtype::arguments in
+ let outtype =
+ if need_dummy && arguments = [] then outtype
+ else CicReduction.head_beta_reduce (C.Appl arguments')
+ in
+ outtype,ugraph5
+ | C.Fix (i,fl) ->
+ let types_times_kl,ugraph1 =
+ (* WAS: list rev list map *)
+ List.fold_left
+ (fun (l,ugraph) (n,k,ty,_) ->
+ let _,ugraph1 = type_of_aux ~logger context ty ugraph in
+ ((Some (C.Name n,(C.Decl ty)),k)::l,ugraph1)
+ ) ([],ugraph) fl
+ in
+ let (types,kl) = List.split types_times_kl in
+ let len = List.length types in
+ let ugraph2 =
+ List.fold_left
+ (fun ugraph (name,x,ty,bo) ->
+ let ty_bo,ugraph1 =
+ type_of_aux ~logger (types@context) bo ugraph
+ in
+ let b,ugraph2 =
+ R.are_convertible ~subst ~metasenv (types@context)
+ ty_bo (CicSubstitution.lift len ty) ugraph1 in
+ if b then
+ begin
+ let (m, eaten, context') =
+ eat_lambdas ~subst (types @ context) (x + 1) bo
+ in
+ (*
+ let's control the guarded by
+ destructors conditions D{f,k,x,M}
+ *)
+ if not (guarded_by_destructors ~subst context' eaten
+ (len + eaten) kl 1 [] m) then
+ raise
+ (TypeCheckerFailure
+ (lazy ("Fix: not guarded by destructors")))
+ else
+ ugraph2
+ end
+ else
+ raise (TypeCheckerFailure (lazy ("Fix: ill-typed bodies")))
+ ) ugraph1 fl in
+ (*CSC: controlli mancanti solo su D{f,k,x,M} *)
+ let (_,_,ty,_) = List.nth fl i in
+ ty,ugraph2
+ | C.CoFix (i,fl) ->
+ let types,ugraph1 =
+ List.fold_left
+ (fun (l,ugraph) (n,ty,_) ->
+ let _,ugraph1 =
+ type_of_aux ~logger context ty ugraph in
+ (Some (C.Name n,(C.Decl ty))::l,ugraph1)
+ ) ([],ugraph) fl
+ in
+ let len = List.length types in
+ let ugraph2 =
+ List.fold_left
+ (fun ugraph (_,ty,bo) ->
+ let ty_bo,ugraph1 =
+ type_of_aux ~logger (types @ context) bo ugraph
+ in
+ let b,ugraph2 =
+ R.are_convertible ~subst ~metasenv (types @ context) ty_bo
+ (CicSubstitution.lift len ty) ugraph1
+ in
+ if b then
+ begin
+ (* let's control that the returned type is coinductive *)
+ match returns_a_coinductive ~subst context ty with
+ None ->
+ raise
+ (TypeCheckerFailure
+ (lazy "CoFix: does not return a coinductive type"))
+ | Some uri ->
+ (*
+ let's control the guarded by constructors
+ conditions C{f,M}
+ *)
+ if not (guarded_by_constructors ~subst
+ (types @ context) 0 len false bo [] uri) then
+ raise
+ (TypeCheckerFailure
+ (lazy "CoFix: not guarded by constructors"))
+ else
+ ugraph2
+ end
+ else
+ raise
+ (TypeCheckerFailure (lazy "CoFix: ill-typed bodies"))
+ ) ugraph1 fl
+ in
+ let (_,ty,_) = List.nth fl i in
+ ty,ugraph2
+
+ and check_exp_named_subst ~logger ~subst context ugraph =
+ let rec check_exp_named_subst_aux ~logger esubsts l ugraph =
+ match l with
+ [] -> ugraph
+ | ((uri,t) as item)::tl ->
+ let ty_uri,ugraph1 = type_of_variable ~logger uri ugraph in
+ let typeofvar =
+ CicSubstitution.subst_vars esubsts ty_uri in
+ let typeoft,ugraph2 = type_of_aux ~logger context t ugraph1 in
+ let b,ugraph3 =
+ CicReduction.are_convertible ~subst ~metasenv
+ context typeoft typeofvar ugraph2
+ in
+ if b then
+ check_exp_named_subst_aux ~logger (esubsts@[item]) tl ugraph3
+ else
+ begin
+ CicReduction.fdebug := 0 ;
+ ignore
+ (CicReduction.are_convertible
+ ~subst ~metasenv context typeoft typeofvar ugraph2) ;
+ fdebug := 0 ;
+ debug typeoft [typeofvar] ;
+ raise (TypeCheckerFailure (lazy "Wrong Explicit Named Substitution"))
+ end
+ in
+ check_exp_named_subst_aux ~logger [] ugraph
+
+ and sort_of_prod ~subst context (name,s) (t1, t2) ugraph =
+ let module C = Cic in
+ let t1' = CicReduction.whd ~subst context t1 in
+ let t2' = CicReduction.whd ~subst ((Some (name,C.Decl s))::context) t2 in
+ match (t1', t2') with
+ (C.Sort s1, C.Sort s2)
+ when (s2 = C.Prop or s2 = C.Set or s2 = C.CProp) ->
+ (* different from Coq manual!!! *)
+ C.Sort s2,ugraph
+ | (C.Sort (C.Type t1), C.Sort (C.Type t2)) ->
+ (* TASSI: CONSRTAINTS: the same in doubletypeinference, cicrefine *)
+ let t' = CicUniv.fresh() in
+ let ugraph1 = CicUniv.add_ge t' t1 ugraph in
+ let ugraph2 = CicUniv.add_ge t' t2 ugraph1 in
+ C.Sort (C.Type t'),ugraph2
+ | (C.Sort _,C.Sort (C.Type t1)) ->
+ (* TASSI: CONSRTAINTS: the same in doubletypeinference, cicrefine *)
+ C.Sort (C.Type t1),ugraph (* c'e' bisogno di un fresh? *)
+ | (C.Meta _, C.Sort _) -> t2',ugraph
+ | (C.Meta _, (C.Meta (_,_) as t))
+ | (C.Sort _, (C.Meta (_,_) as t)) when CicUtil.is_closed t ->
+ t2',ugraph
+ | (_,_) -> raise (TypeCheckerFailure (lazy (sprintf
+ "Prod: expected two sorts, found = %s, %s" (CicPp.ppterm t1')
+ (CicPp.ppterm t2'))))
+
+ and eat_prods ~subst context hetype l ugraph =
+ (*CSC: siamo sicuri che le are_convertible non lavorino con termini non *)
+ (*CSC: cucinati *)
+ match l with
+ [] -> hetype,ugraph
+ | (hete, hety)::tl ->
+ (match (CicReduction.whd ~subst context hetype) with
+ Cic.Prod (n,s,t) ->
+ let b,ugraph1 =
+ CicReduction.are_convertible
+ ~subst ~metasenv context hety s ugraph
+ in
+ if b then
+ begin
+ CicReduction.fdebug := -1 ;
+ eat_prods ~subst context
+ (CicSubstitution.subst hete t) tl ugraph1
+ (*TASSI: not sure *)
+ end
+ else
+ begin
+ CicReduction.fdebug := 0 ;
+ ignore (CicReduction.are_convertible
+ ~subst ~metasenv context s hety ugraph) ;
+ fdebug := 0 ;
+ debug s [hety] ;
+ raise
+ (TypeCheckerFailure
+ (lazy (sprintf
+ ("Appl: wrong parameter-type, expected %s, found %s")
+ (CicPp.ppterm hetype) (CicPp.ppterm s))))
+ end
+ | _ ->
+ raise (TypeCheckerFailure
+ (lazy "Appl: this is not a function, it cannot be applied"))
+ )
+
+ and returns_a_coinductive ~subst context ty =
+ let module C = Cic in
+ match CicReduction.whd ~subst context ty with
+ C.MutInd (uri,i,_) ->
+ (*CSC: definire una funzioncina per questo codice sempre replicato *)
+ let obj,_ =
+ try
+ CicEnvironment.get_cooked_obj ~trust:false CicUniv.empty_ugraph uri
+ with Not_found -> assert false
+ in
+ (match obj with
+ C.InductiveDefinition (itl,_,_,_) ->
+ let (_,is_inductive,_,_) = List.nth itl i in
+ if is_inductive then None else (Some uri)
+ | _ ->
+ raise (TypeCheckerFailure
+ (lazy ("Unknown mutual inductive definition:" ^
+ UriManager.string_of_uri uri)))
+ )
+ | C.Appl ((C.MutInd (uri,i,_))::_) ->
+ (let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ C.InductiveDefinition (itl,_,_,_) ->
+ let (_,is_inductive,_,_) = List.nth itl i in
+ if is_inductive then None else (Some uri)
+ | _ ->
+ raise (TypeCheckerFailure
+ (lazy ("Unknown mutual inductive definition:" ^
+ UriManager.string_of_uri uri)))
+ )
+ | C.Prod (n,so,de) ->
+ returns_a_coinductive ~subst ((Some (n,C.Decl so))::context) de
+ | _ -> None
+
+ in
+(*CSC
+debug_print (lazy ("INIZIO TYPE_OF_AUX " ^ CicPp.ppterm t)) ; flush stderr ;
+let res =
+*)
+ type_of_aux ~logger context t ugraph
+(*
+in debug_print (lazy "FINE TYPE_OF_AUX") ; flush stderr ; res
+*)
+
+(* is a small constructor? *)
+(*CSC: ottimizzare calcolando staticamente *)
+and is_small_or_non_informative ~condition ~logger context paramsno c ugraph =
+ let rec is_small_or_non_informative_aux ~logger context c ugraph =
+ let module C = Cic in
+ match CicReduction.whd context c with
+ C.Prod (n,so,de) ->
+ let s,ugraph1 = type_of_aux' ~logger [] context so ugraph in
+ let b = condition s in
+ if b then
+ is_small_or_non_informative_aux
+ ~logger ((Some (n,(C.Decl so)))::context) de ugraph1
+ else
+ false,ugraph1
+ | _ -> true,ugraph (*CSC: we trust the type-checker *)
+ in
+ let (context',dx) = split_prods ~subst:[] context paramsno c in
+ is_small_or_non_informative_aux ~logger context' dx ugraph
+
+and is_small ~logger =
+ is_small_or_non_informative
+ ~condition:(fun s -> s=Cic.Sort Cic.Prop || s=Cic.Sort Cic.Set)
+ ~logger
+
+and is_non_informative ~logger =
+ is_small_or_non_informative
+ ~condition:(fun s -> s=Cic.Sort Cic.Prop)
+ ~logger
+
+and type_of ~logger t ugraph =
+(*CSC
+debug_print (lazy ("INIZIO TYPE_OF_AUX' " ^ CicPp.ppterm t)) ; flush stderr ;
+let res =
+*)
+ type_of_aux' ~logger [] [] t ugraph
+(*CSC
+in debug_print (lazy "FINE TYPE_OF_AUX'") ; flush stderr ; res
+*)
+;;
+
+let typecheck_obj0 ~logger uri ugraph =
+ let module C = Cic in
+ function
+ C.Constant (_,Some te,ty,_,_) ->
+ let _,ugraph = type_of ~logger ty ugraph in
+ let ty_te,ugraph = type_of ~logger te ugraph in
+ let b,ugraph = (CicReduction.are_convertible [] ty_te ty ugraph) in
+ if not b then
+ raise (TypeCheckerFailure
+ (lazy "the type of the body is not the one expected"))
+ else
+ ugraph
+ | C.Constant (_,None,ty,_,_) ->
+ (* only to check that ty is well-typed *)
+ let _,ugraph = type_of ~logger ty ugraph in
+ ugraph
+ | C.CurrentProof (_,conjs,te,ty,_,_) ->
+ let _,ugraph =
+ List.fold_left
+ (fun (metasenv,ugraph) ((_,context,ty) as conj) ->
+ let _,ugraph =
+ type_of_aux' ~logger metasenv context ty ugraph
+ in
+ metasenv @ [conj],ugraph
+ ) ([],ugraph) conjs
+ in
+ let _,ugraph = type_of_aux' ~logger conjs [] ty ugraph in
+ let type_of_te,ugraph =
+ type_of_aux' ~logger conjs [] te ugraph
+ in
+ let b,ugraph = CicReduction.are_convertible [] type_of_te ty ugraph in
+ if not b then
+ raise (TypeCheckerFailure (lazy (sprintf
+ "the current proof is not well typed because the type %s of the body is not convertible to the declared type %s"
+ (CicPp.ppterm type_of_te) (CicPp.ppterm ty))))
+ else
+ ugraph
+ | C.Variable (_,bo,ty,_,_) ->
+ (* only to check that ty is well-typed *)
+ let _,ugraph = type_of ~logger ty ugraph in
+ (match bo with
+ None -> ugraph
+ | Some bo ->
+ let ty_bo,ugraph = type_of ~logger bo ugraph in
+ let b,ugraph = CicReduction.are_convertible [] ty_bo ty ugraph in
+ if not b then
+ raise (TypeCheckerFailure
+ (lazy "the body is not the one expected"))
+ else
+ ugraph
+ )
+ | (C.InductiveDefinition _ as obj) ->
+ check_mutual_inductive_defs ~logger uri obj ugraph
+
+let typecheck uri =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+ let logger = new CicLogger.logger in
+ (* ??? match CicEnvironment.is_type_checked ~trust:true uri with ???? *)
+ match CicEnvironment.is_type_checked ~trust:false CicUniv.empty_ugraph uri with
+ CicEnvironment.CheckedObj (cobj,ugraph') ->
+ (* debug_print (lazy ("NON-INIZIO A TYPECHECKARE " ^ U.string_of_uri uri));*)
+ cobj,ugraph'
+ | CicEnvironment.UncheckedObj uobj ->
+ (* let's typecheck the uncooked object *)
+ logger#log (`Start_type_checking uri) ;
+ (* debug_print (lazy ("INIZIO A TYPECHECKARE " ^ U.string_of_uri uri)); *)
+ let ugraph = typecheck_obj0 ~logger uri CicUniv.empty_ugraph uobj in
+ try
+ CicEnvironment.set_type_checking_info uri;
+ logger#log (`Type_checking_completed uri);
+ match CicEnvironment.is_type_checked ~trust:false ugraph uri with
+ CicEnvironment.CheckedObj (cobj,ugraph') -> cobj,ugraph'
+ | _ -> raise CicEnvironmentError
+ with
+ (*
+ this is raised if set_type_checking_info is called on an object
+ that has no associated universe file. If we are in univ_maker
+ phase this is OK since univ_maker will properly commit the
+ object.
+ *)
+ Invalid_argument s ->
+ (*debug_print (lazy s);*)
+ uobj,ugraph
+;;
+
+let typecheck_obj ~logger uri obj =
+ let ugraph = typecheck_obj0 ~logger uri CicUniv.empty_ugraph obj in
+ let ugraph, univlist, obj = CicUnivUtils.clean_and_fill uri obj ugraph in
+ CicEnvironment.add_type_checked_obj uri (obj,ugraph,univlist)
+
+(** wrappers which instantiate fresh loggers *)
+
+let type_of_aux' ?(subst = []) metasenv context t ugraph =
+ let logger = new CicLogger.logger in
+ type_of_aux' ~logger ~subst metasenv context t ugraph
+
+let typecheck_obj uri obj =
+ let logger = new CicLogger.logger in
+ typecheck_obj ~logger uri obj
+
+(* check_allowed_sort_elimination uri i s1 s2
+ This function is used outside the kernel to determine in advance whether
+ a MutCase will be allowed or not.
+ [uri,i] is the type of the term to match
+ [s1] is the sort of the term to eliminate (i.e. the head of the arity
+ of the inductive type [uri,i])
+ [s2] is the sort of the goal (i.e. the head of the type of the outtype
+ of the MutCase) *)
+let check_allowed_sort_elimination uri i s1 s2 =
+ fst (check_allowed_sort_elimination ~subst:[] ~metasenv:[]
+ ~logger:(new CicLogger.logger) [] uri i true
+ (Cic.Implicit None) (* never used *) (Cic.Sort s1) (Cic.Sort s2)
+ CicUniv.empty_ugraph)
diff --git a/helm/ocaml/cic_proof_checking/cicTypeChecker.mli b/helm/ocaml/cic_proof_checking/cicTypeChecker.mli
new file mode 100644
index 000000000..e9419171e
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/cicTypeChecker.mli
@@ -0,0 +1,61 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* These are the only exceptions that will be raised *)
+exception TypeCheckerFailure of string Lazy.t
+exception AssertFailure of string Lazy.t
+
+(* this function is exported to be used also by the refiner;
+ the callback function (defaul value: ignore) is invoked on each
+ processed subterm; its first argument is the undebrujined term (the
+ input); its second argument the corresponding debrujined term (the
+ output). The callback is used to relocalize the error messages *)
+val debrujin_constructor :
+ ?cb:(Cic.term -> Cic.term -> unit) ->
+ UriManager.uri -> int -> Cic.term -> Cic.term
+
+val typecheck : UriManager.uri -> Cic.obj * CicUniv.universe_graph
+
+(* FUNCTIONS USED ONLY IN THE TOPLEVEL *)
+
+(* type_of_aux' metasenv context term *)
+val type_of_aux':
+ ?subst:Cic.substitution -> Cic.metasenv -> Cic.context ->
+ Cic.term -> CicUniv.universe_graph ->
+ Cic.term * CicUniv.universe_graph
+
+(* typechecks the obj and puts it in the environment *)
+val typecheck_obj : UriManager.uri -> Cic.obj -> unit
+
+(* check_allowed_sort_elimination uri i s1 s2
+ This function is used outside the kernel to determine in advance whether
+ a MutCase will be allowed or not.
+ [uri,i] is the type of the term to match
+ [s1] is the sort of the term to eliminate (i.e. the head of the arity
+ of the inductive type [uri,i])
+ [s2] is the sort of the goal (i.e. the head of the type of the outtype
+ of the MutCase) *)
+val check_allowed_sort_elimination:
+ UriManager.uri -> int -> Cic.sort -> Cic.sort -> bool
diff --git a/helm/ocaml/cic_proof_checking/cicUnivUtils.ml b/helm/ocaml/cic_proof_checking/cicUnivUtils.ml
new file mode 100644
index 000000000..cd1aeba32
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/cicUnivUtils.ml
@@ -0,0 +1,153 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(*****************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Enrico Tassi <tassi@cs.unibo.it> *)
+(* 23/04/2004 *)
+(* *)
+(* This module implements some useful function regarding univers graphs *)
+(* *)
+(*****************************************************************************)
+
+(* $Id$ *)
+
+module C = Cic
+module H = UriManager.UriHashtbl
+let eq = UriManager.eq
+
+(* uri is the uri of the actual object that must be 'skipped' *)
+let universes_of_obj uri t =
+ (* don't the same work twice *)
+ let visited_objs = H.create 31 in
+ let visited u = H.replace visited_objs u true in
+ let is_not_visited u = not (H.mem visited_objs u) in
+ visited uri;
+ (* the result *)
+ let results = ref [] in
+ let add_result l = results := l :: !results in
+ (* the iterators *)
+ let rec aux = function
+ | C.Const (u,exp_named_subst) when is_not_visited u ->
+ aux_uri u;
+ visited u;
+ C.Const (u, List.map (fun (x,t) -> x,aux t) exp_named_subst)
+ | C.Var (u,exp_named_subst) when is_not_visited u ->
+ aux_uri u;
+ visited u;
+ C.Var (u, List.map (fun (x,t) -> x,aux t) exp_named_subst)
+ | C.Const (u,exp_named_subst) ->
+ C.Const (u, List.map (fun (x,t) -> x,aux t) exp_named_subst)
+ | C.Var (u,exp_named_subst) ->
+ C.Var (u, List.map (fun (x,t) -> x,aux t) exp_named_subst)
+ | C.MutInd (u,x,exp_named_subst) when is_not_visited u ->
+ aux_uri u;
+ visited u;
+ C.MutInd (u,x,List.map (fun (x,t) -> x,aux t) exp_named_subst)
+ | C.MutInd (u,x,exp_named_subst) ->
+ C.MutInd (u,x, List.map (fun (x,t) -> x,aux t) exp_named_subst)
+ | C.MutConstruct (u,x,y,exp_named_subst) when is_not_visited u ->
+ aux_uri u;
+ visited u;
+ C.MutConstruct (u,x,y,List.map (fun (x,t) -> x,aux t) exp_named_subst)
+ | C.MutConstruct (x,y,z,exp_named_subst) ->
+ C.MutConstruct (x,y,z,List.map (fun (x,t) -> x,aux t) exp_named_subst)
+ | C.Meta (n,l1) -> C.Meta (n, List.map (HExtlib.map_option aux) l1)
+ | C.Sort (C.Type i) -> add_result [i];
+ C.Sort (C.Type (CicUniv.name_universe i uri))
+ | C.Rel _
+ | C.Sort _
+ | C.Implicit _ as x -> x
+ | C.Cast (v,t) -> C.Cast (aux v, aux t)
+ | C.Prod (b,s,t) -> C.Prod (b,aux s, aux t)
+ | C.Lambda (b,s,t) -> C.Lambda (b,aux s, aux t)
+ | C.LetIn (b,s,t) -> C.LetIn (b,aux s, aux t)
+ | C.Appl li -> C.Appl (List.map aux li)
+ | C.MutCase (uri,n1,ty,te,patterns) ->
+ C.MutCase (uri,n1,aux ty,aux te, List.map aux patterns)
+ | C.Fix (no, funs) ->
+ C.Fix(no, List.map (fun (x,y,b,c) -> (x,y,aux b,aux c)) funs)
+ | C.CoFix (no,funs) ->
+ C.CoFix(no, List.map (fun (x,b,c) -> (x,aux b,aux c)) funs)
+ and aux_uri u =
+ if is_not_visited u then
+ let _, _, l =
+ CicEnvironment.get_cooked_obj_with_univlist CicUniv.empty_ugraph u in
+ add_result l
+ and aux_obj = function
+ | C.Constant (x,Some te,ty,v,y) ->
+ List.iter aux_uri v;
+ C.Constant (x,Some (aux te),aux ty,v,y)
+ | C.Variable (x,Some te,ty,v,y) ->
+ List.iter aux_uri v;
+ C.Variable (x,Some (aux te),aux ty,v,y)
+ | C.Constant (x,None, ty, v,y) ->
+ List.iter aux_uri v;
+ C.Constant (x,None, aux ty, v,y)
+ | C.Variable (x,None, ty, v,y) ->
+ List.iter aux_uri v;
+ C.Variable (x,None, aux ty, v,y)
+ | C.CurrentProof (_,conjs,te,ty,v,_) -> assert false
+ | C.InductiveDefinition (l,v,x,y) ->
+ List.iter aux_uri v;
+ C.InductiveDefinition (
+ List.map
+ (fun (x,y,t,l') ->
+ (x,y,aux t, List.map (fun (x,t) -> x,aux t) l'))
+ l,v,x,y)
+ in
+ let o = aux_obj t in
+ List.flatten !results, o
+
+let rec list_uniq = function
+ | [] -> []
+ | h::[] -> [h]
+ | h1::h2::tl when CicUniv.eq h1 h2 -> list_uniq (h2 :: tl)
+ | h1::tl (* when h1 <> h2 *) -> h1 :: list_uniq tl
+
+let list_uniq l =
+ list_uniq (List.fast_sort CicUniv.compare l)
+
+let profiler = (HExtlib.profile "clean_and_fill").HExtlib.profile
+
+let clean_and_fill uri obj ugraph =
+ (* universes of obj fills the universes of the obj with the right uri *)
+ let list_of_universes, obj = universes_of_obj uri obj in
+ let list_of_universes = list_uniq list_of_universes in
+(* CicUniv.print_ugraph ugraph;*)
+(* List.iter (fun u -> prerr_endline (CicUniv.string_of_universe u))*)
+(* list_of_universes;*)
+ let ugraph = CicUniv.clean_ugraph ugraph list_of_universes in
+(* CicUniv.print_ugraph ugraph;*)
+ let ugraph, list_of_universes =
+ CicUniv.fill_empty_nodes_with_uri ugraph list_of_universes uri
+ in
+ ugraph, list_of_universes, obj
+
+let clean_and_fill u o g =
+ profiler (clean_and_fill u o) g
+
diff --git a/helm/ocaml/cic_proof_checking/cicUnivUtils.mli b/helm/ocaml/cic_proof_checking/cicUnivUtils.mli
new file mode 100644
index 000000000..eb55a47eb
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/cicUnivUtils.mli
@@ -0,0 +1,32 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+ (** cleans the universe graph for a given object and fills universes with URI.
+ * to be used on qed
+ *)
+val clean_and_fill:
+ UriManager.uri -> Cic.obj -> CicUniv.universe_graph ->
+ CicUniv.universe_graph * CicUniv.universe list * Cic.obj
+
diff --git a/helm/ocaml/cic_proof_checking/doc/inductive.txt b/helm/ocaml/cic_proof_checking/doc/inductive.txt
new file mode 100644
index 000000000..f2e49d398
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/doc/inductive.txt
@@ -0,0 +1,41 @@
+Table of allowed eliminations:
+
+ +--------------------+----------------------------------+
+ | Inductive Type | Elimination to |
+ +--------------------+----------------------------------+
+ | Sort | "Smallness" | Prop | SetI | SetP | CProp| Type |
+ +--------------------+----------------------------------+
+ | Prop empty | yes yes yes yes yes |
+ | Prop unit | yes yes yes yes yes |
+ | Prop small | yes no2 no2 no2 no12 |
+ | Prop | yes no2 no2 no2 no12 |
+ | SetI empty | yes yes -- yes yes |
+ | SetI small | yes yes -- yes yes |
+ | SetI | yes yes -- no1 no1 |
+ | SetP empty | yes -- yes yes yes |
+ | SetP small | yes -- yes yes yes |
+ | SetP | na3 na3 na3 na3 na3 |
+ | CProp empty | yes yes yes yes yes |
+ | CProp small | yes yes yes yes yes |
+ | CProp | yes yes yes yes yes |
+ | Type | yes yes yes yes yes |
+ +--------------------+----------------------------------+
+
+Legenda:
+ no: elimination not allowed
+ na: not allowed, the inductive definition is rejected
+
+ 1 : due to paradoxes a la Hurkens
+ 2 : due to code extraction + proof irreleveance incompatibility
+ (if you define Bool in Prop, you will be able to prove true<>false)
+ 3 : inductive type is rejected due to universe inconsistency
+
+ SetP : Predicative Set
+ SetI : Impredicative Set
+
+ non-informative : Constructor arguments are in Prop only
+ small : Constructor arguments are not in Type and SetP and CProp
+ unit : Non (mutually) recursive /\ only one constructor /\ non-informative
+ empty : in Coq: no constructors and non mutually recursive
+ in Matita: no constructors (but eventually mutually recursive
+ with non-empty types)
diff --git a/helm/ocaml/cic_proof_checking/freshNamesGenerator.ml b/helm/ocaml/cic_proof_checking/freshNamesGenerator.ml
new file mode 100755
index 000000000..99c9e4d76
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/freshNamesGenerator.ml
@@ -0,0 +1,354 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+let debug_print = fun _ -> ()
+
+let rec higher_name arity =
+ function
+ Cic.Sort Cic.Prop
+ | Cic.Sort Cic.CProp ->
+ if arity = 0 then "A" (* propositions *)
+ else if arity = 1 then "P" (* predicates *)
+ else "R" (*relations *)
+ | Cic.Sort Cic.Set
+ -> if arity = 0 then "S" else "F"
+ | Cic.Sort (Cic.Type _ ) ->
+ if arity = 0 then "T" else "F"
+ | Cic.Prod (_,_,t) -> higher_name (arity+1) t
+ | _ -> "f"
+
+let get_initial s =
+ if String.length s = 0 then "_"
+ else
+ let head = String.sub s 0 1 in
+ String.lowercase head
+
+(* only used when the sort is not Prop or CProp *)
+let rec guess_a_name context ty =
+ match ty with
+ Cic.Rel n ->
+ (match List.nth context (n-1) with
+ None -> assert false
+ | Some (Cic.Anonymous,_) -> "eccomi_qua"
+ | Some (Cic.Name s,_) -> get_initial s)
+ | Cic.Var (uri,_) -> get_initial (UriManager.name_of_uri uri)
+ | Cic.Sort _ -> higher_name 0 ty
+ | Cic.Implicit _ -> assert false
+ | Cic.Cast (t1,t2) -> guess_a_name context t1
+ | Cic.Prod (na_,_,t) -> higher_name 1 t
+ | Cic.Lambda _ -> assert false
+ | Cic.LetIn (_,s,t) -> guess_a_name context (CicSubstitution.subst s t)
+ | Cic.Appl [] -> assert false
+ | Cic.Appl (he::_) -> guess_a_name context he
+ | Cic.Const (uri,_)
+ | Cic.MutInd (uri,_,_)
+ | Cic.MutConstruct (uri,_,_,_) -> get_initial (UriManager.name_of_uri uri)
+ | _ -> "x"
+
+(* mk_fresh_name context name typ *)
+(* returns an identifier which is fresh in the context *)
+(* and that resembles [name] as much as possible. *)
+(* [typ] will be the type of the variable *)
+let mk_fresh_name ~subst metasenv context name ~typ =
+ let module C = Cic in
+ let basename =
+ match name with
+ C.Anonymous ->
+ (try
+ let ty,_ =
+ CicTypeChecker.type_of_aux' ~subst metasenv context typ
+ CicUniv.empty_ugraph in
+ (match ty with
+ C.Sort C.Prop
+ | C.Sort C.CProp -> "H"
+ | _ -> guess_a_name context typ
+ )
+ with CicTypeChecker.TypeCheckerFailure _ -> "H"
+ )
+ | C.Name name ->
+ Str.global_replace (Str.regexp "[0-9]*$") "" name
+ in
+ let already_used name =
+ List.exists (function Some (n,_) -> n=name | _ -> false) context
+ in
+ if name <> C.Anonymous && not (already_used name) then
+ name
+ else if not (already_used (C.Name basename)) then
+ C.Name basename
+ else
+ let rec try_next n =
+ let name' = C.Name (basename ^ string_of_int n) in
+ if already_used name' then
+ try_next (n+1)
+ else
+ name'
+ in
+ try_next 1
+;;
+
+(* let mk_fresh_names ~subst metasenv context t *)
+let rec mk_fresh_names ~subst metasenv context t =
+ match t with
+ Cic.Rel _ -> t
+ | Cic.Var (uri,exp_named_subst) ->
+ let ens =
+ List.map
+ (fun (uri,t) ->
+ (uri,mk_fresh_names ~subst metasenv context t)) exp_named_subst in
+ Cic.Var (uri,ens)
+ | Cic.Meta (i,l) ->
+ let l' =
+ List.map
+ (fun t ->
+ match t with
+ None -> None
+ | Some t -> Some (mk_fresh_names ~subst metasenv context t)) l in
+ Cic.Meta(i,l')
+ | Cic.Sort _
+ | Cic.Implicit _ -> t
+ | Cic.Cast (te,ty) ->
+ let te' = mk_fresh_names ~subst metasenv context te in
+ let ty' = mk_fresh_names ~subst metasenv context ty in
+ Cic.Cast (te', ty')
+ | Cic.Prod (n,s,t) ->
+ let s' = mk_fresh_names ~subst metasenv context s in
+ let n' =
+ match n with
+ Cic.Anonymous -> Cic.Anonymous
+ | Cic.Name "matita_dummy" ->
+ mk_fresh_name ~subst metasenv context Cic.Anonymous ~typ:s'
+ | _ -> n in
+ let t' = mk_fresh_names ~subst metasenv (Some(n',Cic.Decl s')::context) t in
+ Cic.Prod (n',s',t')
+ | Cic.Lambda (n,s,t) ->
+ let s' = mk_fresh_names ~subst metasenv context s in
+ let n' =
+ match n with
+ Cic.Anonymous -> Cic.Anonymous
+ | Cic.Name "matita_dummy" ->
+ mk_fresh_name ~subst metasenv context Cic.Anonymous ~typ:s'
+ | _ -> n in
+ let t' = mk_fresh_names ~subst metasenv (Some(n',Cic.Decl s')::context) t in
+ Cic.Lambda (n',s',t')
+ | Cic.LetIn (n,s,t) ->
+ let s' = mk_fresh_names ~subst metasenv context s in
+ let n' =
+ match n with
+ Cic.Anonymous -> Cic.Anonymous
+ | Cic.Name "matita_dummy" ->
+ mk_fresh_name ~subst metasenv context Cic.Anonymous ~typ:s'
+ | _ -> n in
+ let t' = mk_fresh_names ~subst metasenv (Some(n',Cic.Def (s',None))::context) t in
+ Cic.LetIn (n',s',t')
+ | Cic.Appl l ->
+ Cic.Appl (List.map (mk_fresh_names ~subst metasenv context) l)
+ | Cic.Const (uri,exp_named_subst) ->
+ let ens =
+ List.map
+ (fun (uri,t) ->
+ (uri,mk_fresh_names ~subst metasenv context t)) exp_named_subst in
+ Cic.Const(uri,ens)
+ | Cic.MutInd (uri,tyno,exp_named_subst) ->
+ let ens =
+ List.map
+ (fun (uri,t) ->
+ (uri,mk_fresh_names ~subst metasenv context t)) exp_named_subst in
+ Cic.MutInd (uri,tyno,ens)
+ | Cic.MutConstruct (uri,tyno,consno,exp_named_subst) ->
+ let ens =
+ List.map
+ (fun (uri,t) ->
+ (uri,mk_fresh_names ~subst metasenv context t)) exp_named_subst in
+ Cic.MutConstruct (uri,tyno,consno, ens)
+ | Cic.MutCase (sp,i,outty,t,pl) ->
+ let outty' = mk_fresh_names ~subst metasenv context outty in
+ let t' = mk_fresh_names ~subst metasenv context t in
+ let pl' = List.map (mk_fresh_names ~subst metasenv context) pl in
+ Cic.MutCase (sp, i, outty', t', pl')
+ | Cic.Fix (i, fl) ->
+ let tys = List.map
+ (fun (n,_,ty,_) ->
+ Some (Cic.Name n,(Cic.Decl ty))) fl in
+ let fl' = List.map
+ (fun (n,i,ty,bo) ->
+ let ty' = mk_fresh_names ~subst metasenv context ty in
+ let bo' = mk_fresh_names ~subst metasenv (tys@context) bo in
+ (n,i,ty',bo')) fl in
+ Cic.Fix (i, fl')
+ | Cic.CoFix (i, fl) ->
+ let tys = List.map
+ (fun (n,_,ty) ->
+ Some (Cic.Name n,(Cic.Decl ty))) fl in
+ let fl' = List.map
+ (fun (n,ty,bo) ->
+ let ty' = mk_fresh_names ~subst metasenv context ty in
+ let bo' = mk_fresh_names ~subst metasenv (tys@context) bo in
+ (n,ty',bo')) fl in
+ Cic.CoFix (i, fl')
+;;
+
+(* clean_dummy_dependent_types term *)
+(* returns a copy of [term] where every dummy dependent product *)
+(* have been replaced with a non-dependent product and where *)
+(* dummy let-ins have been removed. *)
+let clean_dummy_dependent_types t =
+ let module C = Cic in
+ let rec aux k =
+ function
+ C.Rel m as t -> t,[k - m]
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst',rels =
+ List.fold_right
+ (fun (uri,t) (exp_named_subst,rels) ->
+ let t',rels' = aux k t in
+ (uri,t')::exp_named_subst, rels' @ rels
+ ) exp_named_subst ([],[])
+ in
+ C.Var (uri,exp_named_subst'),rels
+ | C.Meta (i,l) ->
+ let l',rels =
+ List.fold_right
+ (fun t (l,rels) ->
+ let t',rels' =
+ match t with
+ None -> None,[]
+ | Some t ->
+ let t',rels' = aux k t in
+ Some t', rels'
+ in
+ t'::l, rels' @ rels
+ ) l ([],[])
+ in
+ C.Meta(i,l'),rels
+ | C.Sort _ as t -> t,[]
+ | C.Implicit _ as t -> t,[]
+ | C.Cast (te,ty) ->
+ let te',rels1 = aux k te in
+ let ty',rels2 = aux k ty in
+ C.Cast (te', ty'), rels1@rels2
+ | C.Prod (n,s,t) ->
+ let s',rels1 = aux k s in
+ let t',rels2 = aux (k+1) t in
+ let n' =
+ match n with
+ C.Anonymous ->
+ if List.mem k rels2 then
+(
+ debug_print (lazy "If this happens often, we can do something about it (i.e. we can generate a new fresh name; problem: we need the metasenv and context ;-(. Alternative solution: mk_implicit does not generate entries for the elements in the context that have no name") ;
+ C.Anonymous
+)
+ else
+ C.Anonymous
+ | C.Name _ as n ->
+ if List.mem k rels2 then n else C.Anonymous
+ in
+ C.Prod (n', s', t'), rels1@rels2
+ | C.Lambda (n,s,t) ->
+ let s',rels1 = aux k s in
+ let t',rels2 = aux (k+1) t in
+ C.Lambda (n, s', t'), rels1@rels2
+ | C.LetIn (n,s,t) ->
+ let s',rels1 = aux k s in
+ let t',rels2 = aux (k+1) t in
+ let rels = rels1 @ rels2 in
+ if List.mem k rels2 then
+ C.LetIn (n, s', t'), rels
+ else
+ (* (C.Rel 1) is just a dummy term; any term would fit *)
+ CicSubstitution.subst (C.Rel 1) t', rels
+ | C.Appl l ->
+ let l',rels =
+ List.fold_right
+ (fun t (exp_named_subst,rels) ->
+ let t',rels' = aux k t in
+ t'::exp_named_subst, rels' @ rels
+ ) l ([],[])
+ in
+ C.Appl l', rels
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst',rels =
+ List.fold_right
+ (fun (uri,t) (exp_named_subst,rels) ->
+ let t',rels' = aux k t in
+ (uri,t')::exp_named_subst, rels' @ rels
+ ) exp_named_subst ([],[])
+ in
+ C.Const (uri,exp_named_subst'),rels
+ | C.MutInd (uri,tyno,exp_named_subst) ->
+ let exp_named_subst',rels =
+ List.fold_right
+ (fun (uri,t) (exp_named_subst,rels) ->
+ let t',rels' = aux k t in
+ (uri,t')::exp_named_subst, rels' @ rels
+ ) exp_named_subst ([],[])
+ in
+ C.MutInd (uri,tyno,exp_named_subst'),rels
+ | C.MutConstruct (uri,tyno,consno,exp_named_subst) ->
+ let exp_named_subst',rels =
+ List.fold_right
+ (fun (uri,t) (exp_named_subst,rels) ->
+ let t',rels' = aux k t in
+ (uri,t')::exp_named_subst, rels' @ rels
+ ) exp_named_subst ([],[])
+ in
+ C.MutConstruct (uri,tyno,consno,exp_named_subst'),rels
+ | C.MutCase (sp,i,outty,t,pl) ->
+ let outty',rels1 = aux k outty in
+ let t',rels2 = aux k t in
+ let pl',rels3 =
+ List.fold_right
+ (fun t (exp_named_subst,rels) ->
+ let t',rels' = aux k t in
+ t'::exp_named_subst, rels' @ rels
+ ) pl ([],[])
+ in
+ C.MutCase (sp, i, outty', t', pl'), rels1 @ rels2 @rels3
+ | C.Fix (i, fl) ->
+ let len = List.length fl in
+ let fl',rels =
+ List.fold_right
+ (fun (name,i,ty,bo) (fl,rels) ->
+ let ty',rels1 = aux k ty in
+ let bo',rels2 = aux (k + len) bo in
+ (name,i,ty',bo')::fl, rels1 @ rels2 @ rels
+ ) fl ([],[])
+ in
+ C.Fix (i, fl'),rels
+ | C.CoFix (i, fl) ->
+ let len = List.length fl in
+ let fl',rels =
+ List.fold_right
+ (fun (name,ty,bo) (fl,rels) ->
+ let ty',rels1 = aux k ty in
+ let bo',rels2 = aux (k + len) bo in
+ (name,ty',bo')::fl, rels1 @ rels2 @ rels
+ ) fl ([],[])
+ in
+ C.CoFix (i, fl'),rels
+ in
+ fst (aux 0 t)
+;;
diff --git a/helm/ocaml/cic_proof_checking/freshNamesGenerator.mli b/helm/ocaml/cic_proof_checking/freshNamesGenerator.mli
new file mode 100644
index 000000000..b90c0f2f5
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/freshNamesGenerator.mli
@@ -0,0 +1,46 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* mk_fresh_name metasenv context name typ *)
+(* returns an identifier which is fresh in the context *)
+(* and that resembles [name] as much as possible. *)
+(* [typ] will be the type of the variable *)
+val mk_fresh_name :
+ subst:Cic.substitution ->
+ Cic.metasenv -> Cic.context -> Cic.name -> typ:Cic.term -> Cic.name
+
+(* mk_fresh_names metasenv context term *)
+(* returns a term t' convertible with term where all *)
+(* matita_dummies have been replaced by fresh names *)
+
+val mk_fresh_names :
+ subst:Cic.substitution ->
+ Cic.metasenv -> Cic.context -> Cic.term -> Cic.term
+
+(* clean_dummy_dependent_types term *)
+(* returns a copy of [term] where every dummy dependent product *)
+(* have been replaced with a non-dependent product and where *)
+(* dummy let-ins have been removed. *)
+val clean_dummy_dependent_types : Cic.term -> Cic.term
diff --git a/helm/ocaml/cic_proof_checking/utilities/Makefile b/helm/ocaml/cic_proof_checking/utilities/Makefile
new file mode 100644
index 000000000..2cd98f894
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/utilities/Makefile
@@ -0,0 +1,15 @@
+UTILITIES = create_environment parse_library list_uris
+UTILITIES_OPT = $(patsubst %,%.opt,$(UTILITIES))
+LINKOPTS = -linkpkg -thread
+LIBS = helm-cic_proof_checking
+OCAMLC = ocamlfind ocamlc $(LINKOPTS) -package $(LIBS)
+OCAMLOPT = ocamlfind opt $(LINKOPTS) -package $(LIBS)
+all: $(UTILITIES)
+opt: $(UTILITIES_OPT)
+%: %.ml
+ $(OCAMLC) -o $@ $<
+%.opt: %.ml
+ $(OCAMLOPT) -o $@ $<
+clean:
+ rm -f $(UTILITIES) $(UTILITIES_OPT) *.cm[iox] *.o
+
diff --git a/helm/ocaml/cic_proof_checking/utilities/create_environment.ml b/helm/ocaml/cic_proof_checking/utilities/create_environment.ml
new file mode 100644
index 000000000..8a8524d24
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/utilities/create_environment.ml
@@ -0,0 +1,73 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+let trust = true
+
+let outfname =
+ match Sys.argv.(1) with
+ | "-help" | "--help" | "-h" | "--h" ->
+ print_endline
+ ("Usage: create_environment <dumpfile> <uri_index>\n" ^
+ " <dumpfile> is the file where environment will be dumped\n" ^
+ " <uri_index> is the file containing the URIs, one per line,\n" ^
+ " that will be typechecked. Could be \"-\" for\n" ^
+ " standard input");
+ flush stdout;
+ exit 0
+ | f -> f
+let _ =
+ CicEnvironment.set_trust (fun _ -> trust);
+ Helm_registry.set "getter.mode" "remote";
+ Helm_registry.set "getter.url" "http://mowgli.cs.unibo.it:58081/";
+ Sys.catch_break true;
+ if Sys.file_exists outfname then begin
+ let ic = open_in outfname in
+ CicEnvironment.restore_from_channel ic;
+ close_in ic
+ end
+let urifname =
+ try
+ Sys.argv.(2)
+ with Invalid_argument _ -> "-"
+let ic =
+ match urifname with
+ | "-" -> stdin
+ | fname -> open_in fname
+let _ =
+ try
+ while true do
+(* try *)
+ let uri = input_line ic in
+ print_endline uri;
+ flush stdout;
+ let uri = UriManager.uri_of_string uri in
+ ignore (CicTypeChecker.typecheck uri)
+(* with Sys.Break -> () *)
+ done
+ with End_of_file | Sys.Break ->
+ let oc = open_out outfname in
+ CicEnvironment.dump_to_channel oc;
+ close_out oc
+
diff --git a/helm/ocaml/cic_proof_checking/utilities/list_uris.ml b/helm/ocaml/cic_proof_checking/utilities/list_uris.ml
new file mode 100644
index 000000000..90ea51616
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/utilities/list_uris.ml
@@ -0,0 +1,30 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+let ic = open_in Sys.argv.(1) in
+CicEnvironment.restore_from_channel ic;
+List.iter
+ (fun uri -> print_endline (UriManager.string_of_uri uri))
+ (CicEnvironment.list_uri ())
diff --git a/helm/ocaml/cic_proof_checking/utilities/parse_library.ml b/helm/ocaml/cic_proof_checking/utilities/parse_library.ml
new file mode 100644
index 000000000..1d65291cb
--- /dev/null
+++ b/helm/ocaml/cic_proof_checking/utilities/parse_library.ml
@@ -0,0 +1,54 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+let trust = true
+
+let _ =
+ CicEnvironment.set_trust (fun _ -> trust);
+ Helm_registry.set "getter.mode" "remote";
+ Helm_registry.set "getter.url" "http://mowgli.cs.unibo.it:58081/"
+let urifname =
+ try
+ Sys.argv.(1)
+ with Invalid_argument _ -> "-"
+let ic =
+ match urifname with
+ | "-" -> stdin
+ | fname -> open_in fname
+let _ =
+ try
+ while true do
+ try
+ let uri = input_line ic in
+ prerr_endline uri;
+ let uri = UriManager.uri_of_string uri in
+ ignore (CicEnvironment.get_obj CicUniv.empty_ugraph uri)
+(* with Sys.Break -> () *)
+ with
+ | End_of_file -> raise End_of_file
+ | exn -> ()
+ done
+ with End_of_file -> Unix.sleep max_int
+
diff --git a/helm/ocaml/cic_unification/.depend b/helm/ocaml/cic_unification/.depend
new file mode 100644
index 000000000..a442c1d4d
--- /dev/null
+++ b/helm/ocaml/cic_unification/.depend
@@ -0,0 +1,10 @@
+cicMetaSubst.cmo: cicMetaSubst.cmi
+cicMetaSubst.cmx: cicMetaSubst.cmi
+cicMkImplicit.cmo: cicMkImplicit.cmi
+cicMkImplicit.cmx: cicMkImplicit.cmi
+cicUnification.cmo: cicMetaSubst.cmi cicUnification.cmi
+cicUnification.cmx: cicMetaSubst.cmx cicUnification.cmi
+cicRefine.cmo: cicUnification.cmi cicMkImplicit.cmi cicMetaSubst.cmi \
+ cicRefine.cmi
+cicRefine.cmx: cicUnification.cmx cicMkImplicit.cmx cicMetaSubst.cmx \
+ cicRefine.cmi
diff --git a/helm/ocaml/cic_unification/Makefile b/helm/ocaml/cic_unification/Makefile
new file mode 100644
index 000000000..3db00fe5c
--- /dev/null
+++ b/helm/ocaml/cic_unification/Makefile
@@ -0,0 +1,12 @@
+PACKAGE = cic_unification
+PREDICATES =
+
+INTERFACE_FILES = \
+ cicMetaSubst.mli \
+ cicMkImplicit.mli \
+ cicUnification.mli \
+ cicRefine.mli
+IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml)
+EXTRA_OBJECTS_TO_INSTALL =
+
+include ../Makefile.common
diff --git a/helm/ocaml/cic_unification/cicMetaSubst.ml b/helm/ocaml/cic_unification/cicMetaSubst.ml
new file mode 100644
index 000000000..afd74d756
--- /dev/null
+++ b/helm/ocaml/cic_unification/cicMetaSubst.ml
@@ -0,0 +1,898 @@
+(* Copyright (C) 2003, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+(* PROFILING *)
+(*
+let deref_counter = ref 0
+let apply_subst_context_counter = ref 0
+let apply_subst_metasenv_counter = ref 0
+let lift_counter = ref 0
+let subst_counter = ref 0
+let whd_counter = ref 0
+let are_convertible_counter = ref 0
+let metasenv_length = ref 0
+let context_length = ref 0
+let reset_counters () =
+ apply_subst_counter := 0;
+ apply_subst_context_counter := 0;
+ apply_subst_metasenv_counter := 0;
+ lift_counter := 0;
+ subst_counter := 0;
+ whd_counter := 0;
+ are_convertible_counter := 0;
+ metasenv_length := 0;
+ context_length := 0
+let print_counters () =
+ debug_print (lazy (Printf.sprintf
+"apply_subst: %d
+apply_subst_context: %d
+apply_subst_metasenv: %d
+lift: %d
+subst: %d
+whd: %d
+are_convertible: %d
+metasenv length: %d (avg = %.2f)
+context length: %d (avg = %.2f)
+"
+ !apply_subst_counter !apply_subst_context_counter
+ !apply_subst_metasenv_counter !lift_counter !subst_counter !whd_counter
+ !are_convertible_counter !metasenv_length
+ ((float !metasenv_length) /. (float !apply_subst_metasenv_counter))
+ !context_length
+ ((float !context_length) /. (float !apply_subst_context_counter))
+ ))*)
+
+
+
+exception MetaSubstFailure of string Lazy.t
+exception Uncertain of string Lazy.t
+exception AssertFailure of string Lazy.t
+exception DeliftingARelWouldCaptureAFreeVariable;;
+
+let debug_print = fun _ -> ()
+
+type substitution = (int * (Cic.context * Cic.term)) list
+
+(*
+let rec deref subst =
+ let third _,_,a = a in
+ function
+ Cic.Meta(n,l) as t ->
+ (try
+ deref subst
+ (CicSubstitution.subst_meta
+ l (third (CicUtil.lookup_subst n subst)))
+ with
+ CicUtil.Subst_not_found _ -> t)
+ | t -> t
+;;
+*)
+
+let lookup_subst = CicUtil.lookup_subst
+;;
+
+
+(* clean_up_meta take a metasenv and a term and make every local context
+of each occurrence of a metavariable consistent with its canonical context,
+with respect to the hidden hipothesis *)
+
+(*
+let clean_up_meta subst metasenv t =
+ let module C = Cic in
+ let rec aux t =
+ match t with
+ C.Rel _
+ | C.Sort _ -> t
+ | C.Implicit _ -> assert false
+ | C.Meta (n,l) as t ->
+ let cc =
+ (try
+ let (cc,_) = lookup_subst n subst in cc
+ with CicUtil.Subst_not_found _ ->
+ try
+ let (_,cc,_) = CicUtil.lookup_meta n metasenv in cc
+ with CicUtil.Meta_not_found _ -> assert false) in
+ let l' =
+ (try
+ List.map2
+ (fun t1 t2 ->
+ match t1,t2 with
+ None , _ -> None
+ | _ , t -> t) cc l
+ with
+ Invalid_argument _ -> assert false) in
+ C.Meta (n, l')
+ | C.Cast (te,ty) -> C.Cast (aux te, aux ty)
+ | C.Prod (name,so,dest) -> C.Prod (name, aux so, aux dest)
+ | C.Lambda (name,so,dest) -> C.Lambda (name, aux so, aux dest)
+ | C.LetIn (name,so,dest) -> C.LetIn (name, aux so, aux dest)
+ | C.Appl l -> C.Appl (List.map aux l)
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (fun (uri,t) -> (uri, aux t)) exp_named_subst
+ in
+ C.Var (uri, exp_named_subst')
+ | C.Const (uri, exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (fun (uri,t) -> (uri, aux t)) exp_named_subst
+ in
+ C.Const (uri, exp_named_subst')
+ | C.MutInd (uri,tyno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (fun (uri,t) -> (uri, aux t)) exp_named_subst
+ in
+ C.MutInd (uri, tyno, exp_named_subst')
+ | C.MutConstruct (uri,tyno,consno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (fun (uri,t) -> (uri, aux t)) exp_named_subst
+ in
+ C.MutConstruct (uri, tyno, consno, exp_named_subst')
+ | C.MutCase (uri,tyno,out,te,pl) ->
+ C.MutCase (uri, tyno, aux out, aux te, List.map aux pl)
+ | C.Fix (i,fl) ->
+ let fl' =
+ List.map
+ (fun (name,j,ty,bo) -> (name, j, aux ty, aux bo)) fl
+ in
+ C.Fix (i, fl')
+ | C.CoFix (i,fl) ->
+ let fl' =
+ List.map
+ (fun (name,ty,bo) -> (name, aux ty, aux bo)) fl
+ in
+ C.CoFix (i, fl')
+ in
+ aux t *)
+
+(*** Functions to apply a substitution ***)
+
+let apply_subst_gen ~appl_fun subst term =
+ let rec um_aux =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ function
+ C.Rel _ as t -> t
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (fun (uri, t) -> (uri, um_aux t)) exp_named_subst
+ in
+ C.Var (uri, exp_named_subst')
+ | C.Meta (i, l) ->
+ (try
+ let (_, t,_) = lookup_subst i subst in
+ um_aux (S.subst_meta l t)
+ with CicUtil.Subst_not_found _ ->
+ (* unconstrained variable, i.e. free in subst*)
+ let l' =
+ List.map (function None -> None | Some t -> Some (um_aux t)) l
+ in
+ C.Meta (i,l'))
+ | C.Sort _
+ | C.Implicit _ as t -> t
+ | C.Cast (te,ty) -> C.Cast (um_aux te, um_aux ty)
+ | C.Prod (n,s,t) -> C.Prod (n, um_aux s, um_aux t)
+ | C.Lambda (n,s,t) -> C.Lambda (n, um_aux s, um_aux t)
+ | C.LetIn (n,s,t) -> C.LetIn (n, um_aux s, um_aux t)
+ | C.Appl (hd :: tl) -> appl_fun um_aux hd tl
+ | C.Appl _ -> assert false
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (fun (uri, t) -> (uri, um_aux t)) exp_named_subst
+ in
+ C.Const (uri, exp_named_subst')
+ | C.MutInd (uri,typeno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (fun (uri, t) -> (uri, um_aux t)) exp_named_subst
+ in
+ C.MutInd (uri,typeno,exp_named_subst')
+ | C.MutConstruct (uri,typeno,consno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (fun (uri, t) -> (uri, um_aux t)) exp_named_subst
+ in
+ C.MutConstruct (uri,typeno,consno,exp_named_subst')
+ | C.MutCase (sp,i,outty,t,pl) ->
+ let pl' = List.map um_aux pl in
+ C.MutCase (sp, i, um_aux outty, um_aux t, pl')
+ | C.Fix (i, fl) ->
+ let fl' =
+ List.map (fun (name, i, ty, bo) -> (name, i, um_aux ty, um_aux bo)) fl
+ in
+ C.Fix (i, fl')
+ | C.CoFix (i, fl) ->
+ let fl' =
+ List.map (fun (name, ty, bo) -> (name, um_aux ty, um_aux bo)) fl
+ in
+ C.CoFix (i, fl')
+ in
+ um_aux term
+;;
+
+let apply_subst =
+ let appl_fun um_aux he tl =
+ let tl' = List.map um_aux tl in
+ let t' =
+ match um_aux he with
+ Cic.Appl l -> Cic.Appl (l@tl')
+ | he' -> Cic.Appl (he'::tl')
+ in
+ begin
+ match he with
+ Cic.Meta (m,_) -> CicReduction.head_beta_reduce t'
+ | _ -> t'
+ end
+ in
+ fun s t ->
+(* incr apply_subst_counter; *)
+ apply_subst_gen ~appl_fun s t
+;;
+
+let rec apply_subst_context subst context =
+(*
+ incr apply_subst_context_counter;
+ context_length := !context_length + List.length context;
+*)
+ List.fold_right
+ (fun item context ->
+ match item with
+ | Some (n, Cic.Decl t) ->
+ let t' = apply_subst subst t in
+ Some (n, Cic.Decl t') :: context
+ | Some (n, Cic.Def (t, ty)) ->
+ let ty' =
+ match ty with
+ | None -> None
+ | Some ty -> Some (apply_subst subst ty)
+ in
+ let t' = apply_subst subst t in
+ Some (n, Cic.Def (t', ty')) :: context
+ | None -> None :: context)
+ context []
+
+let apply_subst_metasenv subst metasenv =
+(*
+ incr apply_subst_metasenv_counter;
+ metasenv_length := !metasenv_length + List.length metasenv;
+*)
+ List.map
+ (fun (n, context, ty) ->
+ (n, apply_subst_context subst context, apply_subst subst ty))
+ (List.filter
+ (fun (i, _, _) -> not (List.mem_assoc i subst))
+ metasenv)
+
+(***** Pretty printing functions ******)
+
+let ppterm subst term = CicPp.ppterm (apply_subst subst term)
+
+let ppterm_in_name_context subst term name_context =
+ CicPp.pp (apply_subst subst term) name_context
+
+let ppterm_in_context subst term context =
+ let name_context =
+ List.map (function None -> None | Some (n,_) -> Some n) context
+ in
+ ppterm_in_name_context subst term name_context
+
+let ppcontext' ?(sep = "\n") subst context =
+ let separate s = if s = "" then "" else s ^ sep in
+ List.fold_right
+ (fun context_entry (i,name_context) ->
+ match context_entry with
+ Some (n,Cic.Decl t) ->
+ sprintf "%s%s : %s" (separate i) (CicPp.ppname n)
+ (ppterm_in_name_context subst t name_context), (Some n)::name_context
+ | Some (n,Cic.Def (bo,ty)) ->
+ sprintf "%s%s : %s := %s" (separate i) (CicPp.ppname n)
+ (match ty with
+ None -> "_"
+ | Some ty -> ppterm_in_name_context subst ty name_context)
+ (ppterm_in_name_context subst bo name_context), (Some n)::name_context
+ | None ->
+ sprintf "%s_ :? _" (separate i), None::name_context
+ ) context ("",[])
+
+let ppsubst_unfolded subst =
+ String.concat "\n"
+ (List.map
+ (fun (idx, (c, t,_)) ->
+ let context,name_context = ppcontext' ~sep:"; " subst c in
+ sprintf "%s |- ?%d:= %s" context idx
+ (ppterm_in_name_context subst t name_context))
+ subst)
+(*
+ Printf.sprintf "?%d := %s" idx (CicPp.ppterm term))
+ subst) *)
+;;
+
+let ppsubst subst =
+ String.concat "\n"
+ (List.map
+ (fun (idx, (c, t, _)) ->
+ let context,name_context = ppcontext' ~sep:"; " [] c in
+ sprintf "%s |- ?%d:= %s" context idx
+ (ppterm_in_name_context [] t name_context))
+ subst)
+;;
+
+let ppcontext ?sep subst context = fst (ppcontext' ?sep subst context)
+
+let ppmetasenv ?(sep = "\n") subst metasenv =
+ String.concat sep
+ (List.map
+ (fun (i, c, t) ->
+ let context,name_context = ppcontext' ~sep:"; " subst c in
+ sprintf "%s |- ?%d: %s" context i
+ (ppterm_in_name_context subst t name_context))
+ (List.filter
+ (fun (i, _, _) -> not (List.mem_assoc i subst))
+ metasenv))
+
+let tempi_type_of_aux_subst = ref 0.0;;
+let tempi_subst = ref 0.0;;
+let tempi_type_of_aux = ref 0.0;;
+
+(**** DELIFT ****)
+(* the delift function takes in input a metavariable index, an ordered list of
+ * optional terms [t1,...,tn] and a term t, and substitutes every tk = Some
+ * (rel(nk)) with rel(k). Typically, the list of optional terms is the explicit
+ * substitution that is applied to a metavariable occurrence and the result of
+ * the delift function is a term the implicit variable can be substituted with
+ * to make the term [t] unifiable with the metavariable occurrence. In general,
+ * the problem is undecidable if we consider equivalence in place of alpha
+ * convertibility. Our implementation, though, is even weaker than alpha
+ * convertibility, since it replace the term [tk] if and only if [tk] is a Rel
+ * (missing all the other cases). Does this matter in practice?
+ * The metavariable index is the index of the metavariable that must not occur
+ * in the term (for occur check).
+ *)
+
+exception NotInTheList;;
+
+let position n =
+ let rec aux k =
+ function
+ [] -> raise NotInTheList
+ | (Some (Cic.Rel m))::_ when m=n -> k
+ | _::tl -> aux (k+1) tl in
+ aux 1
+;;
+
+exception Occur;;
+
+let rec force_does_not_occur subst to_be_restricted t =
+ let module C = Cic in
+ let more_to_be_restricted = ref [] in
+ let rec aux k = function
+ C.Rel r when List.mem (r - k) to_be_restricted -> raise Occur
+ | C.Rel _
+ | C.Sort _ as t -> t
+ | C.Implicit _ -> assert false
+ | C.Meta (n, l) ->
+ (* we do not retrieve the term associated to ?n in subst since *)
+ (* in this way we can restrict if something goes wrong *)
+ let l' =
+ let i = ref 0 in
+ List.map
+ (function t ->
+ incr i ;
+ match t with
+ None -> None
+ | Some t ->
+ try
+ Some (aux k t)
+ with Occur ->
+ more_to_be_restricted := (n,!i) :: !more_to_be_restricted;
+ None)
+ l
+ in
+ C.Meta (n, l')
+ | C.Cast (te,ty) -> C.Cast (aux k te, aux k ty)
+ | C.Prod (name,so,dest) -> C.Prod (name, aux k so, aux (k+1) dest)
+ | C.Lambda (name,so,dest) -> C.Lambda (name, aux k so, aux (k+1) dest)
+ | C.LetIn (name,so,dest) -> C.LetIn (name, aux k so, aux (k+1) dest)
+ | C.Appl l -> C.Appl (List.map (aux k) l)
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (fun (uri,t) -> (uri, aux k t)) exp_named_subst
+ in
+ C.Var (uri, exp_named_subst')
+ | C.Const (uri, exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (fun (uri,t) -> (uri, aux k t)) exp_named_subst
+ in
+ C.Const (uri, exp_named_subst')
+ | C.MutInd (uri,tyno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (fun (uri,t) -> (uri, aux k t)) exp_named_subst
+ in
+ C.MutInd (uri, tyno, exp_named_subst')
+ | C.MutConstruct (uri,tyno,consno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (fun (uri,t) -> (uri, aux k t)) exp_named_subst
+ in
+ C.MutConstruct (uri, tyno, consno, exp_named_subst')
+ | C.MutCase (uri,tyno,out,te,pl) ->
+ C.MutCase (uri, tyno, aux k out, aux k te, List.map (aux k) pl)
+ | C.Fix (i,fl) ->
+ let len = List.length fl in
+ let k_plus_len = k + len in
+ let fl' =
+ List.map
+ (fun (name,j,ty,bo) -> (name, j, aux k ty, aux k_plus_len bo)) fl
+ in
+ C.Fix (i, fl')
+ | C.CoFix (i,fl) ->
+ let len = List.length fl in
+ let k_plus_len = k + len in
+ let fl' =
+ List.map
+ (fun (name,ty,bo) -> (name, aux k ty, aux k_plus_len bo)) fl
+ in
+ C.CoFix (i, fl')
+ in
+ let res = aux 0 t in
+ (!more_to_be_restricted, res)
+
+let rec restrict subst to_be_restricted metasenv =
+ let names_of_context_indexes context indexes =
+ String.concat ", "
+ (List.map
+ (fun i ->
+ try
+ match List.nth context (i-1) with
+ | None -> assert false
+ | Some (n, _) -> CicPp.ppname n
+ with
+ Failure _ -> assert false
+ ) indexes)
+ in
+ let force_does_not_occur_in_context to_be_restricted = function
+ | None -> [], None
+ | Some (name, Cic.Decl t) ->
+ let (more_to_be_restricted, t') =
+ force_does_not_occur subst to_be_restricted t
+ in
+ more_to_be_restricted, Some (name, Cic.Decl t')
+ | Some (name, Cic.Def (bo, ty)) ->
+ let (more_to_be_restricted, bo') =
+ force_does_not_occur subst to_be_restricted bo
+ in
+ let more_to_be_restricted, ty' =
+ match ty with
+ | None -> more_to_be_restricted, None
+ | Some ty ->
+ let more_to_be_restricted', ty' =
+ force_does_not_occur subst to_be_restricted ty
+ in
+ more_to_be_restricted @ more_to_be_restricted',
+ Some ty'
+ in
+ more_to_be_restricted, Some (name, Cic.Def (bo', ty'))
+ in
+ let rec erase i to_be_restricted n = function
+ | [] -> [], to_be_restricted, []
+ | hd::tl ->
+ let more_to_be_restricted,restricted,tl' =
+ erase (i+1) to_be_restricted n tl
+ in
+ let restrict_me = List.mem i restricted in
+ if restrict_me then
+ more_to_be_restricted, restricted, None:: tl'
+ else
+ (try
+ let more_to_be_restricted', hd' =
+ let delifted_restricted =
+ let rec aux =
+ function
+ [] -> []
+ | j::tl when j > i -> (j - i)::aux tl
+ | _::tl -> aux tl
+ in
+ aux restricted
+ in
+ force_does_not_occur_in_context delifted_restricted hd
+ in
+ more_to_be_restricted @ more_to_be_restricted',
+ restricted, hd' :: tl'
+ with Occur ->
+ more_to_be_restricted, (i :: restricted), None :: tl')
+ in
+ let (more_to_be_restricted, metasenv) = (* restrict metasenv *)
+ List.fold_right
+ (fun (n, context, t) (more, metasenv) ->
+ let to_be_restricted =
+ List.map snd (List.filter (fun (m, _) -> m = n) to_be_restricted)
+ in
+ let (more_to_be_restricted, restricted, context') =
+ (* just an optimization *)
+ if to_be_restricted = [] then
+ [],[],context
+ else
+ erase 1 to_be_restricted n context
+ in
+ try
+ let more_to_be_restricted', t' =
+ force_does_not_occur subst restricted t
+ in
+ let metasenv' = (n, context', t') :: metasenv in
+ (more @ more_to_be_restricted @ more_to_be_restricted',
+ metasenv')
+ with Occur ->
+ raise (MetaSubstFailure (lazy (sprintf
+ "Cannot restrict the context of the metavariable ?%d over the hypotheses %s since metavariable's type depends on at least one of them"
+ n (names_of_context_indexes context to_be_restricted)))))
+ metasenv ([], [])
+ in
+ let (more_to_be_restricted', subst) = (* restrict subst *)
+ List.fold_right
+ (* TODO: cambiare dopo l'aggiunta del ty *)
+ (fun (n, (context, term,ty)) (more, subst') ->
+ let to_be_restricted =
+ List.map snd (List.filter (fun (m, _) -> m = n) to_be_restricted)
+ in
+ (try
+ let (more_to_be_restricted, restricted, context') =
+ (* just an optimization *)
+ if to_be_restricted = [] then
+ [], [], context
+ else
+ erase 1 to_be_restricted n context
+ in
+ let more_to_be_restricted', term' =
+ force_does_not_occur subst restricted term
+ in
+ let more_to_be_restricted'', ty' =
+ force_does_not_occur subst restricted ty in
+ let subst' = (n, (context', term',ty')) :: subst' in
+ let more =
+ more @ more_to_be_restricted
+ @ more_to_be_restricted'@more_to_be_restricted'' in
+ (more, subst')
+ with Occur ->
+ let error_msg = lazy (sprintf
+ "Cannot restrict the context of the metavariable ?%d over the hypotheses %s since ?%d is already instantiated with %s and at least one of the hypotheses occurs in the substituted term"
+ n (names_of_context_indexes context to_be_restricted) n
+ (ppterm subst term))
+ in
+ (* DEBUG
+ debug_print (lazy error_msg);
+ debug_print (lazy ("metasenv = \n" ^ (ppmetasenv metasenv subst)));
+ debug_print (lazy ("subst = \n" ^ (ppsubst subst)));
+ debug_print (lazy ("context = \n" ^ (ppcontext subst context))); *)
+ raise (MetaSubstFailure error_msg)))
+ subst ([], [])
+ in
+ match more_to_be_restricted @ more_to_be_restricted' with
+ | [] -> (metasenv, subst)
+ | l -> restrict subst l metasenv
+;;
+
+(*CSC: maybe we should rename delift in abstract, as I did in my dissertation *)(*Andrea: maybe not*)
+
+let delift n subst context metasenv l t =
+(* INVARIANT: we suppose that t is not another occurrence of Meta(n,_),
+ otherwise the occur check does not make sense *)
+
+(*
+ debug_print (lazy ("sto deliftando il termine " ^ (CicPp.ppterm t) ^ " rispetto
+ al contesto locale " ^ (CicPp.ppterm (Cic.Meta(0,l)))));
+*)
+
+ let module S = CicSubstitution in
+ let l =
+ let (_, canonical_context, _) = CicUtil.lookup_meta n metasenv in
+ List.map2 (fun ct lt ->
+ match (ct, lt) with
+ | None, _ -> None
+ | Some _, _ -> lt)
+ canonical_context l
+ in
+ let to_be_restricted = ref [] in
+ let rec deliftaux k =
+ let module C = Cic in
+ function
+ C.Rel m ->
+ if m <=k then
+ C.Rel m (*CSC: che succede se c'e' un Def? Dovrebbe averlo gia' *)
+ (*CSC: deliftato la regola per il LetIn *)
+ (*CSC: FALSO! La regola per il LetIn non lo fa *)
+ else
+ (try
+ match List.nth context (m-k-1) with
+ Some (_,C.Def (t,_)) ->
+ (*CSC: Hmmm. This bit of reduction is not in the spirit of *)
+ (*CSC: first order unification. Does it help or does it harm? *)
+ deliftaux k (S.lift m t)
+ | Some (_,C.Decl t) ->
+ C.Rel ((position (m-k) l) + k)
+ | None -> raise (MetaSubstFailure (lazy "RelToHiddenHypothesis"))
+ with
+ Failure _ ->
+ raise (MetaSubstFailure (lazy "Unbound variable found in deliftaux"))
+ )
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> uri,deliftaux k t) exp_named_subst
+ in
+ C.Var (uri,exp_named_subst')
+ | C.Meta (i, l1) as t ->
+ (try
+ let (_,t,_) = CicUtil.lookup_subst i subst in
+ deliftaux k (CicSubstitution.subst_meta l1 t)
+ with CicUtil.Subst_not_found _ ->
+ (* see the top level invariant *)
+ if (i = n) then
+ raise (MetaSubstFailure (lazy (sprintf
+ "Cannot unify the metavariable ?%d with a term that has as subterm %s in which the same metavariable occurs (occur check)"
+ i (ppterm subst t))))
+ else
+ begin
+ (* I do not consider the term associated to ?i in subst since *)
+ (* in this way I can restrict if something goes wrong. *)
+ let rec deliftl j =
+ function
+ [] -> []
+ | None::tl -> None::(deliftl (j+1) tl)
+ | (Some t)::tl ->
+ let l1' = (deliftl (j+1) tl) in
+ try
+ Some (deliftaux k t)::l1'
+ with
+ NotInTheList
+ | MetaSubstFailure _ ->
+ to_be_restricted :=
+ (i,j)::!to_be_restricted ; None::l1'
+ in
+ let l' = deliftl 1 l1 in
+ C.Meta(i,l')
+ end)
+ | C.Sort _ as t -> t
+ | C.Implicit _ as t -> t
+ | C.Cast (te,ty) -> C.Cast (deliftaux k te, deliftaux k ty)
+ | C.Prod (n,s,t) -> C.Prod (n, deliftaux k s, deliftaux (k+1) t)
+ | C.Lambda (n,s,t) -> C.Lambda (n, deliftaux k s, deliftaux (k+1) t)
+ | C.LetIn (n,s,t) -> C.LetIn (n, deliftaux k s, deliftaux (k+1) t)
+ | C.Appl l -> C.Appl (List.map (deliftaux k) l)
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> uri,deliftaux k t) exp_named_subst
+ in
+ C.Const (uri,exp_named_subst')
+ | C.MutInd (uri,typeno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> uri,deliftaux k t) exp_named_subst
+ in
+ C.MutInd (uri,typeno,exp_named_subst')
+ | C.MutConstruct (uri,typeno,consno,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> uri,deliftaux k t) exp_named_subst
+ in
+ C.MutConstruct (uri,typeno,consno,exp_named_subst')
+ | C.MutCase (sp,i,outty,t,pl) ->
+ C.MutCase (sp, i, deliftaux k outty, deliftaux k t,
+ List.map (deliftaux k) pl)
+ | C.Fix (i, fl) ->
+ let len = List.length fl in
+ let liftedfl =
+ List.map
+ (fun (name, i, ty, bo) ->
+ (name, i, deliftaux k ty, deliftaux (k+len) bo))
+ fl
+ in
+ C.Fix (i, liftedfl)
+ | C.CoFix (i, fl) ->
+ let len = List.length fl in
+ let liftedfl =
+ List.map
+ (fun (name, ty, bo) -> (name, deliftaux k ty, deliftaux (k+len) bo))
+ fl
+ in
+ C.CoFix (i, liftedfl)
+ in
+ let res =
+ try
+ deliftaux 0 t
+ with
+ NotInTheList ->
+ (* This is the case where we fail even first order unification. *)
+ (* The reason is that our delift function is weaker than first *)
+ (* order (in the sense of alpha-conversion). See comment above *)
+ (* related to the delift function. *)
+(* debug_print (lazy "First Order UnificationFailure during delift") ;
+debug_print(lazy (sprintf
+ "Error trying to abstract %s over [%s]: the algorithm only tried to abstract over bound variables"
+ (ppterm subst t)
+ (String.concat "; "
+ (List.map
+ (function Some t -> ppterm subst t | None -> "_") l
+ )))); *)
+ raise (Uncertain (lazy (sprintf
+ "Error trying to abstract %s over [%s]: the algorithm only tried to abstract over bound variables"
+ (ppterm subst t)
+ (String.concat "; "
+ (List.map
+ (function Some t -> ppterm subst t | None -> "_")
+ l)))))
+ in
+ let (metasenv, subst) = restrict subst !to_be_restricted metasenv in
+ res, metasenv, subst
+;;
+
+(* delifts a term t of n levels strating from k, that is changes (Rel m)
+ * to (Rel (m - n)) when m > (k + n). if k <= m < k + n delift fails
+ *)
+let delift_rels_from subst metasenv k n =
+ let rec liftaux subst metasenv k =
+ let module C = Cic in
+ function
+ C.Rel m ->
+ if m < k then
+ C.Rel m, subst, metasenv
+ else if m < k + n then
+ raise DeliftingARelWouldCaptureAFreeVariable
+ else
+ C.Rel (m - n), subst, metasenv
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst',subst,metasenv =
+ List.fold_right
+ (fun (uri,t) (l,subst,metasenv) ->
+ let t',subst,metasenv = liftaux subst metasenv k t in
+ (uri,t')::l,subst,metasenv) exp_named_subst ([],subst,metasenv)
+ in
+ C.Var (uri,exp_named_subst'),subst,metasenv
+ | C.Meta (i,l) ->
+ (try
+ let (_, t,_) = lookup_subst i subst in
+ liftaux subst metasenv k (CicSubstitution.subst_meta l t)
+ with CicUtil.Subst_not_found _ ->
+ let l',to_be_restricted,subst,metasenv =
+ let rec aux con l subst metasenv =
+ match l with
+ [] -> [],[],subst,metasenv
+ | he::tl ->
+ let tl',to_be_restricted,subst,metasenv =
+ aux (con + 1) tl subst metasenv in
+ let he',more_to_be_restricted,subst,metasenv =
+ match he with
+ None -> None,[],subst,metasenv
+ | Some t ->
+ try
+ let t',subst,metasenv = liftaux subst metasenv k t in
+ Some t',[],subst,metasenv
+ with
+ DeliftingARelWouldCaptureAFreeVariable ->
+ None,[i,con],subst,metasenv
+ in
+ he'::tl',more_to_be_restricted@to_be_restricted,subst,metasenv
+ in
+ aux 1 l subst metasenv in
+ let metasenv,subst = restrict subst to_be_restricted metasenv in
+ C.Meta(i,l'),subst,metasenv)
+ | C.Sort _ as t -> t,subst,metasenv
+ | C.Implicit _ as t -> t,subst,metasenv
+ | C.Cast (te,ty) ->
+ let te',subst,metasenv = liftaux subst metasenv k te in
+ let ty',subst,metasenv = liftaux subst metasenv k ty in
+ C.Cast (te',ty'),subst,metasenv
+ | C.Prod (n,s,t) ->
+ let s',subst,metasenv = liftaux subst metasenv k s in
+ let t',subst,metasenv = liftaux subst metasenv (k+1) t in
+ C.Prod (n,s',t'),subst,metasenv
+ | C.Lambda (n,s,t) ->
+ let s',subst,metasenv = liftaux subst metasenv k s in
+ let t',subst,metasenv = liftaux subst metasenv (k+1) t in
+ C.Lambda (n,s',t'),subst,metasenv
+ | C.LetIn (n,s,t) ->
+ let s',subst,metasenv = liftaux subst metasenv k s in
+ let t',subst,metasenv = liftaux subst metasenv (k+1) t in
+ C.LetIn (n,s',t'),subst,metasenv
+ | C.Appl l ->
+ let l',subst,metasenv =
+ List.fold_right
+ (fun t (l,subst,metasenv) ->
+ let t',subst,metasenv = liftaux subst metasenv k t in
+ t'::l,subst,metasenv) l ([],subst,metasenv) in
+ C.Appl l',subst,metasenv
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst',subst,metasenv =
+ List.fold_right
+ (fun (uri,t) (l,subst,metasenv) ->
+ let t',subst,metasenv = liftaux subst metasenv k t in
+ (uri,t')::l,subst,metasenv) exp_named_subst ([],subst,metasenv)
+ in
+ C.Const (uri,exp_named_subst'),subst,metasenv
+ | C.MutInd (uri,tyno,exp_named_subst) ->
+ let exp_named_subst',subst,metasenv =
+ List.fold_right
+ (fun (uri,t) (l,subst,metasenv) ->
+ let t',subst,metasenv = liftaux subst metasenv k t in
+ (uri,t')::l,subst,metasenv) exp_named_subst ([],subst,metasenv)
+ in
+ C.MutInd (uri,tyno,exp_named_subst'),subst,metasenv
+ | C.MutConstruct (uri,tyno,consno,exp_named_subst) ->
+ let exp_named_subst',subst,metasenv =
+ List.fold_right
+ (fun (uri,t) (l,subst,metasenv) ->
+ let t',subst,metasenv = liftaux subst metasenv k t in
+ (uri,t')::l,subst,metasenv) exp_named_subst ([],subst,metasenv)
+ in
+ C.MutConstruct (uri,tyno,consno,exp_named_subst'),subst,metasenv
+ | C.MutCase (sp,i,outty,t,pl) ->
+ let outty',subst,metasenv = liftaux subst metasenv k outty in
+ let t',subst,metasenv = liftaux subst metasenv k t in
+ let pl',subst,metasenv =
+ List.fold_right
+ (fun t (l,subst,metasenv) ->
+ let t',subst,metasenv = liftaux subst metasenv k t in
+ t'::l,subst,metasenv) pl ([],subst,metasenv)
+ in
+ C.MutCase (sp,i,outty',t',pl'),subst,metasenv
+ | C.Fix (i, fl) ->
+ let len = List.length fl in
+ let liftedfl,subst,metasenv =
+ List.fold_right
+ (fun (name, i, ty, bo) (l,subst,metasenv) ->
+ let ty',subst,metasenv = liftaux subst metasenv k ty in
+ let bo',subst,metasenv = liftaux subst metasenv (k+len) bo in
+ (name,i,ty',bo')::l,subst,metasenv
+ ) fl ([],subst,metasenv)
+ in
+ C.Fix (i, liftedfl),subst,metasenv
+ | C.CoFix (i, fl) ->
+ let len = List.length fl in
+ let liftedfl,subst,metasenv =
+ List.fold_right
+ (fun (name, ty, bo) (l,subst,metasenv) ->
+ let ty',subst,metasenv = liftaux subst metasenv k ty in
+ let bo',subst,metasenv = liftaux subst metasenv (k+len) bo in
+ (name,ty',bo')::l,subst,metasenv
+ ) fl ([],subst,metasenv)
+ in
+ C.CoFix (i, liftedfl),subst,metasenv
+ in
+ liftaux subst metasenv k
+
+let delift_rels subst metasenv n t =
+ delift_rels_from subst metasenv 1 n t
+
+
+(**** END OF DELIFT ****)
+
+
+(** {2 Format-like pretty printers} *)
+
+let fpp_gen ppf s =
+ Format.pp_print_string ppf s;
+ Format.pp_print_newline ppf ();
+ Format.pp_print_flush ppf ()
+
+let fppsubst ppf subst = fpp_gen ppf (ppsubst subst)
+let fppterm ppf term = fpp_gen ppf (CicPp.ppterm term)
+let fppmetasenv ppf metasenv = fpp_gen ppf (ppmetasenv [] metasenv)
+
diff --git a/helm/ocaml/cic_unification/cicMetaSubst.mli b/helm/ocaml/cic_unification/cicMetaSubst.mli
new file mode 100644
index 000000000..96f87205f
--- /dev/null
+++ b/helm/ocaml/cic_unification/cicMetaSubst.mli
@@ -0,0 +1,92 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+exception MetaSubstFailure of string Lazy.t
+exception Uncertain of string Lazy.t
+exception AssertFailure of string Lazy.t
+exception DeliftingARelWouldCaptureAFreeVariable;;
+
+(* The entry (i,t) in a substitution means that *)
+(* (META i) have been instantiated with t. *)
+(* type substitution = (int * (Cic.context * Cic.term)) list *)
+
+ (** @raise SubstNotFound *)
+
+(* apply_subst subst t *)
+(* applies the substitution [subst] to [t] *)
+(* [subst] must be already unwinded *)
+
+val apply_subst : Cic.substitution -> Cic.term -> Cic.term
+val apply_subst_context : Cic.substitution -> Cic.context -> Cic.context
+val apply_subst_metasenv: Cic.substitution -> Cic.metasenv -> Cic.metasenv
+
+(*** delifting ***)
+
+val delift :
+ int -> Cic.substitution -> Cic.context -> Cic.metasenv ->
+ (Cic.term option) list -> Cic.term ->
+ Cic.term * Cic.metasenv * Cic.substitution
+val restrict :
+ Cic.substitution -> (int * int) list -> Cic.metasenv ->
+ Cic.metasenv * Cic.substitution
+
+(** delifts the Rels in t of n
+ * @raise DeliftingARelWouldCaptureAFreeVariable
+ *)
+val delift_rels :
+ Cic.substitution -> Cic.metasenv -> int -> Cic.term ->
+ Cic.term * Cic.substitution * Cic.metasenv
+
+(** {2 Pretty printers} *)
+
+val ppsubst_unfolded: Cic.substitution -> string
+val ppsubst: Cic.substitution -> string
+val ppterm: Cic.substitution -> Cic.term -> string
+val ppcontext: ?sep: string -> Cic.substitution -> Cic.context -> string
+val ppterm_in_name_context:
+ Cic.substitution -> Cic.term -> (Cic.name option) list -> string
+val ppterm_in_context:
+ Cic.substitution -> Cic.term -> Cic.context -> string
+val ppmetasenv: ?sep: string -> Cic.substitution -> Cic.metasenv -> string
+
+(** {2 Format-like pretty printers}
+ * As above with prototypes suitable for toplevel/ocamldebug printers. No
+ * subsitutions are applied here since such printers are required to be invoked
+ * with only one argument.
+ *)
+
+val fppsubst: Format.formatter -> Cic.substitution -> unit
+val fppterm: Format.formatter -> Cic.term -> unit
+val fppmetasenv: Format.formatter -> Cic.metasenv -> unit
+
+(*
+(* DEBUG *)
+val print_counters: unit -> unit
+val reset_counters: unit -> unit
+*)
+
+(* val clean_up_meta :
+ Cic.substitution -> Cic.metasenv -> Cic.term -> Cic.term
+*)
diff --git a/helm/ocaml/cic_unification/cicMkImplicit.ml b/helm/ocaml/cic_unification/cicMkImplicit.ml
new file mode 100644
index 000000000..36679223c
--- /dev/null
+++ b/helm/ocaml/cic_unification/cicMkImplicit.ml
@@ -0,0 +1,122 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+(* identity_relocation_list_for_metavariable i canonical_context *)
+(* returns the identity relocation list, which is the list [1 ; ... ; n] *)
+(* where n = List.length [canonical_context] *)
+(*CSC: ma mi basta la lunghezza del contesto canonico!!!*)
+let identity_relocation_list_for_metavariable ?(start = 1) canonical_context =
+ let rec aux =
+ function
+ (_,[]) -> []
+ | (n,None::tl) -> None::(aux ((n+1),tl))
+ | (n,_::tl) -> (Some (Cic.Rel n))::(aux ((n+1),tl))
+ in
+ aux (start,canonical_context)
+
+(* Returns the first meta whose number is above the *)
+(* number of the higher meta. *)
+let new_meta metasenv subst =
+ let rec aux =
+ function
+ None, [] -> 1
+ | Some n, [] -> n
+ | None, n::tl -> aux (Some n,tl)
+ | Some m, n::tl -> if n > m then aux (Some n,tl) else aux (Some m,tl)
+ in
+ let indexes =
+ (List.map (fun (i, _, _) -> i) metasenv) @ (List.map fst subst)
+ in
+ 1 + aux (None, indexes)
+
+(* let apply_subst_context = CicMetaSubst.apply_subst_context;; *)
+(* questa o la precedente sembrano essere equivalenti come tempi *)
+let apply_subst_context _ context = context ;;
+
+let mk_implicit metasenv subst context =
+ let newmeta = new_meta metasenv subst in
+ let newuniv = CicUniv.fresh () in
+ let irl = identity_relocation_list_for_metavariable context in
+ (* in the following mk_* functions we apply substitution to canonical
+ * context since we have the invariant that the metasenv has already been
+ * instantiated with subst *)
+ let context = apply_subst_context subst context in
+ ([ newmeta, [], Cic.Sort (Cic.Type newuniv) ;
+ (* TASSI: ?? *)
+ newmeta + 1, context, Cic.Meta (newmeta, []);
+ newmeta + 2, context, Cic.Meta (newmeta + 1,irl) ] @ metasenv,
+ newmeta + 2)
+
+let mk_implicit_type metasenv subst context =
+ let newmeta = new_meta metasenv subst in
+ let newuniv = CicUniv.fresh () in
+ let context = apply_subst_context subst context in
+ ([ newmeta, [], Cic.Sort (Cic.Type newuniv);
+ (* TASSI: ?? *)
+ newmeta + 1, context, Cic.Meta (newmeta, []) ] @metasenv,
+ newmeta + 1)
+
+let mk_implicit_sort metasenv subst =
+ let newmeta = new_meta metasenv subst in
+ let newuniv = CicUniv.fresh () in
+ ([ newmeta, [], Cic.Sort (Cic.Type newuniv)] @ metasenv, newmeta)
+ (* TASSI: ?? *)
+
+let n_fresh_metas metasenv subst context n =
+ if n = 0 then metasenv, []
+ else
+ let irl = identity_relocation_list_for_metavariable context in
+ let context = apply_subst_context subst context in
+ let newmeta = new_meta metasenv subst in
+ let newuniv = CicUniv.fresh () in
+ let rec aux newmeta n =
+ if n = 0 then metasenv, []
+ else
+ let metasenv', l = aux (newmeta + 3) (n-1) in
+ (* TASSI: ?? *)
+ (newmeta, context, Cic.Sort (Cic.Type newuniv))::
+ (newmeta + 1, context, Cic.Meta (newmeta, irl))::
+ (newmeta + 2, context, Cic.Meta (newmeta + 1,irl))::metasenv',
+ Cic.Meta(newmeta+2,irl)::l in
+ aux newmeta n
+
+let fresh_subst metasenv subst context uris =
+ let irl = identity_relocation_list_for_metavariable context in
+ let context = apply_subst_context subst context in
+ let newmeta = new_meta metasenv subst in
+ let newuniv = CicUniv.fresh () in
+ let rec aux newmeta = function
+ [] -> metasenv, []
+ | uri::tl ->
+ let metasenv', l = aux (newmeta + 3) tl in
+ (* TASSI: ?? *)
+ (newmeta, context, Cic.Sort (Cic.Type newuniv))::
+ (newmeta + 1, context, Cic.Meta (newmeta, irl))::
+ (newmeta + 2, context, Cic.Meta (newmeta + 1,irl))::metasenv',
+ (uri,Cic.Meta(newmeta+2,irl))::l in
+ aux newmeta uris
+
diff --git a/helm/ocaml/cic_unification/cicMkImplicit.mli b/helm/ocaml/cic_unification/cicMkImplicit.mli
new file mode 100644
index 000000000..476270144
--- /dev/null
+++ b/helm/ocaml/cic_unification/cicMkImplicit.mli
@@ -0,0 +1,60 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+
+(* identity_relocation_list_for_metavariable i canonical_context *)
+(* returns the identity relocation list, which is the list *)
+(* [Rel 1 ; ... ; Rel n] where n = List.length [canonical_context] *)
+val identity_relocation_list_for_metavariable :
+ ?start: int -> 'a option list -> Cic.term option list
+
+(* Returns the first meta whose number is above the *)
+(* number of the higher meta. *)
+val new_meta : Cic.metasenv -> Cic.substitution -> int
+
+(** [mk_implicit metasenv context]
+ * add a fresh metavariable to the given metasenv, using given context
+ * @return the new metasenv and the index of the added conjecture *)
+val mk_implicit: Cic.metasenv -> Cic.substitution -> Cic.context -> Cic.metasenv * int
+
+(** as above, but the fresh metavariable represents a type *)
+val mk_implicit_type: Cic.metasenv -> Cic.substitution -> Cic.context -> Cic.metasenv * int
+
+(** as above, but the fresh metavariable represents a sort *)
+val mk_implicit_sort: Cic.metasenv -> Cic.substitution -> Cic.metasenv * int
+
+(** [mk_implicit metasenv context] create n fresh metavariables *)
+val n_fresh_metas:
+ Cic.metasenv -> Cic.substitution -> Cic.context -> int -> Cic.metasenv * Cic.term list
+
+(** [fresh_subst metasenv context uris] takes in input a list of uri and
+creates a fresh explicit substitution *)
+val fresh_subst:
+ Cic.metasenv ->
+ Cic.substitution ->
+ Cic.context ->
+ UriManager.uri list ->
+ Cic.metasenv * (Cic.term Cic.explicit_named_substitution)
+
diff --git a/helm/ocaml/cic_unification/cicRefine.ml b/helm/ocaml/cic_unification/cicRefine.ml
new file mode 100644
index 000000000..f03752d10
--- /dev/null
+++ b/helm/ocaml/cic_unification/cicRefine.ml
@@ -0,0 +1,1379 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+exception RefineFailure of string Lazy.t;;
+exception Uncertain of string Lazy.t;;
+exception AssertFailure of string Lazy.t;;
+
+let insert_coercions = ref true
+
+let debug_print = fun _ -> ()
+
+let profiler = HExtlib.profile "CicRefine.fo_unif"
+
+let fo_unif_subst subst context metasenv t1 t2 ugraph =
+ try
+let foo () =
+ CicUnification.fo_unif_subst subst context metasenv t1 t2 ugraph
+in profiler.HExtlib.profile foo ()
+ with
+ (CicUnification.UnificationFailure msg) -> raise (RefineFailure msg)
+ | (CicUnification.Uncertain msg) -> raise (Uncertain msg)
+;;
+
+let enrich localization_tbl t ?(f = fun msg -> msg) exn =
+ let exn' =
+ match exn with
+ RefineFailure msg -> RefineFailure (f msg)
+ | Uncertain msg -> Uncertain (f msg)
+ | _ -> assert false in
+ let loc =
+ try
+ Cic.CicHash.find localization_tbl t
+ with Not_found ->
+ prerr_endline ("!!! NOT LOCALIZED: " ^ CicPp.ppterm t);
+ assert false
+ in
+ raise (HExtlib.Localized (loc,exn'))
+
+let relocalize localization_tbl oldt newt =
+ try
+ let infos = Cic.CicHash.find localization_tbl oldt in
+ Cic.CicHash.remove localization_tbl oldt;
+ Cic.CicHash.add localization_tbl newt infos;
+ with
+ Not_found -> ()
+;;
+
+let rec split l n =
+ match (l,n) with
+ (l,0) -> ([], l)
+ | (he::tl, n) -> let (l1,l2) = split tl (n-1) in (he::l1,l2)
+ | (_,_) -> raise (AssertFailure (lazy "split: list too short"))
+;;
+
+let exp_impl metasenv subst context =
+ function
+ | Some `Type ->
+ let (metasenv', idx) = CicMkImplicit.mk_implicit_type metasenv subst context in
+ let irl = CicMkImplicit.identity_relocation_list_for_metavariable context in
+ metasenv', Cic.Meta (idx, irl)
+ | Some `Closed ->
+ let (metasenv', idx) = CicMkImplicit.mk_implicit metasenv subst [] in
+ metasenv', Cic.Meta (idx, [])
+ | None ->
+ let (metasenv', idx) = CicMkImplicit.mk_implicit metasenv subst context in
+ let irl = CicMkImplicit.identity_relocation_list_for_metavariable context in
+ metasenv', Cic.Meta (idx, irl)
+ | _ -> assert false
+;;
+
+
+let rec type_of_constant uri ugraph =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+ let _ = CicTypeChecker.typecheck uri in
+ let obj,u =
+ try
+ CicEnvironment.get_cooked_obj ugraph uri
+ with Not_found -> assert false
+ in
+ match obj with
+ C.Constant (_,_,ty,_,_) -> ty,u
+ | C.CurrentProof (_,_,_,ty,_,_) -> ty,u
+ | _ ->
+ raise
+ (RefineFailure (lazy ("Unknown constant definition " ^ U.string_of_uri uri)))
+
+and type_of_variable uri ugraph =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+ let _ = CicTypeChecker.typecheck uri in
+ let obj,u =
+ try
+ CicEnvironment.get_cooked_obj ugraph uri
+ with Not_found -> assert false
+ in
+ match obj with
+ C.Variable (_,_,ty,_,_) -> ty,u
+ | _ ->
+ raise
+ (RefineFailure
+ (lazy ("Unknown variable definition " ^ UriManager.string_of_uri uri)))
+
+and type_of_mutual_inductive_defs uri i ugraph =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+ let _ = CicTypeChecker.typecheck uri in
+ let obj,u =
+ try
+ CicEnvironment.get_cooked_obj ugraph uri
+ with Not_found -> assert false
+ in
+ match obj with
+ C.InductiveDefinition (dl,_,_,_) ->
+ let (_,_,arity,_) = List.nth dl i in
+ arity,u
+ | _ ->
+ raise
+ (RefineFailure
+ (lazy ("Unknown mutual inductive definition " ^ U.string_of_uri uri)))
+
+and type_of_mutual_inductive_constr uri i j ugraph =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+ let _ = CicTypeChecker.typecheck uri in
+ let obj,u =
+ try
+ CicEnvironment.get_cooked_obj ugraph uri
+ with Not_found -> assert false
+ in
+ match obj with
+ C.InductiveDefinition (dl,_,_,_) ->
+ let (_,_,_,cl) = List.nth dl i in
+ let (_,ty) = List.nth cl (j-1) in
+ ty,u
+ | _ ->
+ raise
+ (RefineFailure
+ (lazy
+ ("Unkown mutual inductive definition " ^ U.string_of_uri uri)))
+
+
+(* type_of_aux' is just another name (with a different scope) for type_of_aux *)
+
+(* the check_branch function checks if a branch of a case is refinable.
+ It returns a pair (outype_instance,args), a subst and a metasenv.
+ outype_instance is the expected result of applying the case outtype
+ to args.
+ The problem is that outype is in general unknown, and we should
+ try to synthesize it from the above information, that is in general
+ a second order unification problem. *)
+
+and check_branch n context metasenv subst left_args_no actualtype term expectedtype ugraph =
+ let module C = Cic in
+ (* let module R = CicMetaSubst in *)
+ let module R = CicReduction in
+ match R.whd ~subst context expectedtype with
+ C.MutInd (_,_,_) ->
+ (n,context,actualtype, [term]), subst, metasenv, ugraph
+ | C.Appl (C.MutInd (_,_,_)::tl) ->
+ let (_,arguments) = split tl left_args_no in
+ (n,context,actualtype, arguments@[term]), subst, metasenv, ugraph
+ | C.Prod (name,so,de) ->
+ (* we expect that the actual type of the branch has the due
+ number of Prod *)
+ (match R.whd ~subst context actualtype with
+ C.Prod (name',so',de') ->
+ let subst, metasenv, ugraph1 =
+ fo_unif_subst subst context metasenv so so' ugraph in
+ let term' =
+ (match CicSubstitution.lift 1 term with
+ C.Appl l -> C.Appl (l@[C.Rel 1])
+ | t -> C.Appl [t ; C.Rel 1]) in
+ (* we should also check that the name variable is anonymous in
+ the actual type de' ?? *)
+ check_branch (n+1)
+ ((Some (name,(C.Decl so)))::context)
+ metasenv subst left_args_no de' term' de ugraph1
+ | _ -> raise (AssertFailure (lazy "Wrong number of arguments")))
+ | _ -> raise (AssertFailure (lazy "Prod or MutInd expected"))
+
+and type_of_aux' ?(localization_tbl = Cic.CicHash.create 1) metasenv context t
+ ugraph
+=
+ let rec type_of_aux subst metasenv context t ugraph =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ let module U = UriManager in
+ let (t',_,_,_,_) as res =
+ match t with
+ (* function *)
+ C.Rel n ->
+ (try
+ match List.nth context (n - 1) with
+ Some (_,C.Decl ty) ->
+ t,S.lift n ty,subst,metasenv, ugraph
+ | Some (_,C.Def (_,Some ty)) ->
+ t,S.lift n ty,subst,metasenv, ugraph
+ | Some (_,C.Def (bo,None)) ->
+ let ty,ugraph =
+ (* if it is in the context it must be already well-typed*)
+ CicTypeChecker.type_of_aux' ~subst metasenv context
+ (S.lift n bo) ugraph
+ in
+ t,ty,subst,metasenv,ugraph
+ | None ->
+ enrich localization_tbl t
+ (RefineFailure (lazy "Rel to hidden hypothesis"))
+ with
+ _ ->
+ enrich localization_tbl t
+ (RefineFailure (lazy "Not a close term")))
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst',subst',metasenv',ugraph1 =
+ check_exp_named_subst
+ subst metasenv context exp_named_subst ugraph
+ in
+ let ty_uri,ugraph1 = type_of_variable uri ugraph in
+ let ty =
+ CicSubstitution.subst_vars exp_named_subst' ty_uri
+ in
+ C.Var (uri,exp_named_subst'),ty,subst',metasenv',ugraph1
+ | C.Meta (n,l) ->
+ (try
+ let (canonical_context, term,ty) =
+ CicUtil.lookup_subst n subst
+ in
+ let l',subst',metasenv',ugraph1 =
+ check_metasenv_consistency n subst metasenv context
+ canonical_context l ugraph
+ in
+ (* trust or check ??? *)
+ C.Meta (n,l'),CicSubstitution.subst_meta l' ty,
+ subst', metasenv', ugraph1
+ (* type_of_aux subst metasenv
+ context (CicSubstitution.subst_meta l term) *)
+ with CicUtil.Subst_not_found _ ->
+ let (_,canonical_context,ty) = CicUtil.lookup_meta n metasenv in
+ let l',subst',metasenv', ugraph1 =
+ check_metasenv_consistency n subst metasenv context
+ canonical_context l ugraph
+ in
+ C.Meta (n,l'),CicSubstitution.subst_meta l' ty,
+ subst', metasenv',ugraph1)
+ | C.Sort (C.Type tno) ->
+ let tno' = CicUniv.fresh() in
+ let ugraph1 = CicUniv.add_gt tno' tno ugraph in
+ t,(C.Sort (C.Type tno')),subst,metasenv,ugraph1
+ | C.Sort _ ->
+ t,C.Sort (C.Type (CicUniv.fresh())),subst,metasenv,ugraph
+ | C.Implicit infos ->
+ let metasenv',t' = exp_impl metasenv subst context infos in
+ type_of_aux subst metasenv' context t' ugraph
+ | C.Cast (te,ty) ->
+ let ty',_,subst',metasenv',ugraph1 =
+ type_of_aux subst metasenv context ty ugraph
+ in
+ let te',inferredty,subst'',metasenv'',ugraph2 =
+ type_of_aux subst' metasenv' context te ugraph1
+ in
+ (try
+ let subst''',metasenv''',ugraph3 =
+ fo_unif_subst subst'' context metasenv''
+ inferredty ty' ugraph2
+ in
+ C.Cast (te',ty'),ty',subst''',metasenv''',ugraph3
+ with
+ exn ->
+ enrich localization_tbl te'
+ ~f:(fun _ ->
+ lazy ("The term " ^
+ CicMetaSubst.ppterm_in_context subst'' te'
+ context ^ " has type " ^
+ CicMetaSubst.ppterm_in_context subst'' inferredty
+ context ^ " but is here used with type " ^
+ CicMetaSubst.ppterm_in_context subst'' ty' context)) exn
+ )
+ | C.Prod (name,s,t) ->
+ let carr t subst context = CicMetaSubst.apply_subst subst t in
+ let coerce_to_sort in_source tgt_sort t type_to_coerce
+ subst context metasenv uragph
+ =
+ if not !insert_coercions then
+ t,type_to_coerce,subst,metasenv,ugraph
+ else
+ let coercion_src = carr type_to_coerce subst context in
+ match coercion_src with
+ | Cic.Sort _ ->
+ t,type_to_coerce,subst,metasenv,ugraph
+ | Cic.Meta _ as meta ->
+ t, meta, subst, metasenv, ugraph
+ | Cic.Cast _ as cast ->
+ t, cast, subst, metasenv, ugraph
+ | term ->
+ let coercion_tgt = carr (Cic.Sort tgt_sort) subst context in
+ let search = CoercGraph.look_for_coercion in
+ let boh = search coercion_src coercion_tgt in
+ (match boh with
+ | CoercGraph.NoCoercion
+ | CoercGraph.NotHandled _ ->
+ enrich localization_tbl t
+ (RefineFailure
+ (lazy ("The term " ^
+ CicMetaSubst.ppterm_in_context subst t context ^
+ " is not a type since it has type " ^
+ CicMetaSubst.ppterm_in_context
+ subst coercion_src context ^ " that is not a sort")))
+ | CoercGraph.NotMetaClosed ->
+ enrich localization_tbl t
+ (Uncertain
+ (lazy ("The term " ^
+ CicMetaSubst.ppterm_in_context subst t context ^
+ " is not a type since it has type " ^
+ CicMetaSubst.ppterm_in_context
+ subst coercion_src context ^ " that is not a sort")))
+ | CoercGraph.SomeCoercion c ->
+ let newt, tty, subst, metasenv, ugraph =
+ avoid_double_coercion
+ subst metasenv ugraph
+ (Cic.Appl[c;t]) coercion_tgt
+ in
+ newt, tty, subst, metasenv, ugraph)
+ in
+ let s',sort1,subst',metasenv',ugraph1 =
+ type_of_aux subst metasenv context s ugraph
+ in
+ let s',sort1,subst', metasenv',ugraph1 =
+ coerce_to_sort true (Cic.Type(CicUniv.fresh()))
+ s' sort1 subst' context metasenv' ugraph1
+ in
+ let context_for_t = ((Some (name,(C.Decl s')))::context) in
+ let t',sort2,subst'',metasenv'',ugraph2 =
+ type_of_aux subst' metasenv'
+ context_for_t t ugraph1
+ in
+ let t',sort2,subst'',metasenv'',ugraph2 =
+ coerce_to_sort false (Cic.Type(CicUniv.fresh()))
+ t' sort2 subst'' context_for_t metasenv'' ugraph2
+ in
+ let sop,subst''',metasenv''',ugraph3 =
+ sort_of_prod subst'' metasenv''
+ context (name,s') (sort1,sort2) ugraph2
+ in
+ C.Prod (name,s',t'),sop,subst''',metasenv''',ugraph3
+ | C.Lambda (n,s,t) ->
+
+ let s',sort1,subst',metasenv',ugraph1 =
+ type_of_aux subst metasenv context s ugraph in
+ let s',sort1,subst',metasenv',ugraph1 =
+ if not !insert_coercions then
+ s',sort1, subst', metasenv', ugraph1
+ else
+ match CicReduction.whd ~subst:subst' context sort1 with
+ | C.Meta _ | C.Sort _ -> s',sort1, subst', metasenv', ugraph1
+ | coercion_src ->
+ let coercion_tgt = Cic.Sort (Cic.Type (CicUniv.fresh())) in
+ let search = CoercGraph.look_for_coercion in
+ let boh = search coercion_src coercion_tgt in
+ match boh with
+ | CoercGraph.SomeCoercion c ->
+ let newt, tty, subst', metasenv', ugraph1 =
+ avoid_double_coercion
+ subst' metasenv' ugraph1
+ (Cic.Appl[c;s']) coercion_tgt
+ in
+ newt, tty, subst', metasenv', ugraph1
+ | CoercGraph.NoCoercion
+ | CoercGraph.NotHandled _ ->
+ enrich localization_tbl s'
+ (RefineFailure
+ (lazy ("The term " ^
+ CicMetaSubst.ppterm_in_context subst s' context ^
+ " is not a type since it has type " ^
+ CicMetaSubst.ppterm_in_context
+ subst coercion_src context ^ " that is not a sort")))
+ | CoercGraph.NotMetaClosed ->
+ enrich localization_tbl s'
+ (Uncertain
+ (lazy ("The term " ^
+ CicMetaSubst.ppterm_in_context subst s' context ^
+ " is not a type since it has type " ^
+ CicMetaSubst.ppterm_in_context
+ subst coercion_src context ^ " that is not a sort")))
+ in
+ let context_for_t = ((Some (n,(C.Decl s')))::context) in
+ let t',type2,subst'',metasenv'',ugraph2 =
+ type_of_aux subst' metasenv' context_for_t t ugraph1
+ in
+ C.Lambda (n,s',t'),C.Prod (n,s',type2),
+ subst'',metasenv'',ugraph2
+ | C.LetIn (n,s,t) ->
+ (* only to check if s is well-typed *)
+ let s',ty,subst',metasenv',ugraph1 =
+ type_of_aux subst metasenv context s ugraph
+ in
+ let context_for_t = ((Some (n,(C.Def (s',Some ty))))::context) in
+
+ let t',inferredty,subst'',metasenv'',ugraph2 =
+ type_of_aux subst' metasenv'
+ context_for_t t ugraph1
+ in
+ (* One-step LetIn reduction.
+ * Even faster than the previous solution.
+ * Moreover the inferred type is closer to the expected one.
+ *)
+ C.LetIn (n,s',t'),CicSubstitution.subst s' inferredty,
+ subst'',metasenv'',ugraph2
+ | C.Appl (he::((_::_) as tl)) ->
+ let he',hetype,subst',metasenv',ugraph1 =
+ type_of_aux subst metasenv context he ugraph
+ in
+ let tlbody_and_type,subst'',metasenv'',ugraph2 =
+ List.fold_right
+ (fun x (res,subst,metasenv,ugraph) ->
+ let x',ty,subst',metasenv',ugraph1 =
+ type_of_aux subst metasenv context x ugraph
+ in
+ (x', ty)::res,subst',metasenv',ugraph1
+ ) tl ([],subst',metasenv',ugraph1)
+ in
+ let tl',applty,subst''',metasenv''',ugraph3 =
+ eat_prods true subst'' metasenv'' context
+ hetype tlbody_and_type ugraph2
+ in
+ avoid_double_coercion
+ subst''' metasenv''' ugraph3 (C.Appl (he'::tl')) applty
+ | C.Appl _ -> assert false
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst',subst',metasenv',ugraph1 =
+ check_exp_named_subst subst metasenv context
+ exp_named_subst ugraph in
+ let ty_uri,ugraph2 = type_of_constant uri ugraph1 in
+ let cty =
+ CicSubstitution.subst_vars exp_named_subst' ty_uri
+ in
+ C.Const (uri,exp_named_subst'),cty,subst',metasenv',ugraph2
+ | C.MutInd (uri,i,exp_named_subst) ->
+ let exp_named_subst',subst',metasenv',ugraph1 =
+ check_exp_named_subst subst metasenv context
+ exp_named_subst ugraph
+ in
+ let ty_uri,ugraph2 = type_of_mutual_inductive_defs uri i ugraph1 in
+ let cty =
+ CicSubstitution.subst_vars exp_named_subst' ty_uri in
+ C.MutInd (uri,i,exp_named_subst'),cty,subst',metasenv',ugraph2
+ | C.MutConstruct (uri,i,j,exp_named_subst) ->
+ let exp_named_subst',subst',metasenv',ugraph1 =
+ check_exp_named_subst subst metasenv context
+ exp_named_subst ugraph
+ in
+ let ty_uri,ugraph2 =
+ type_of_mutual_inductive_constr uri i j ugraph1
+ in
+ let cty =
+ CicSubstitution.subst_vars exp_named_subst' ty_uri
+ in
+ C.MutConstruct (uri,i,j,exp_named_subst'),cty,subst',
+ metasenv',ugraph2
+ | C.MutCase (uri, i, outtype, term, pl) ->
+ (* first, get the inductive type (and noparams)
+ * in the environment *)
+ let (_,b,arity,constructors), expl_params, no_left_params,ugraph =
+ let _ = CicTypeChecker.typecheck uri in
+ let obj,u = CicEnvironment.get_cooked_obj ugraph uri in
+ match obj with
+ C.InductiveDefinition (l,expl_params,parsno,_) ->
+ List.nth l i , expl_params, parsno, u
+ | _ ->
+ enrich localization_tbl t
+ (RefineFailure
+ (lazy ("Unkown mutual inductive definition " ^
+ U.string_of_uri uri)))
+ in
+ let rec count_prod t =
+ match CicReduction.whd ~subst context t with
+ C.Prod (_, _, t) -> 1 + (count_prod t)
+ | _ -> 0
+ in
+ let no_args = count_prod arity in
+ (* now, create a "generic" MutInd *)
+ let metasenv,left_args =
+ CicMkImplicit.n_fresh_metas metasenv subst context no_left_params
+ in
+ let metasenv,right_args =
+ let no_right_params = no_args - no_left_params in
+ if no_right_params < 0 then assert false
+ else CicMkImplicit.n_fresh_metas
+ metasenv subst context no_right_params
+ in
+ let metasenv,exp_named_subst =
+ CicMkImplicit.fresh_subst metasenv subst context expl_params in
+ let expected_type =
+ if no_args = 0 then
+ C.MutInd (uri,i,exp_named_subst)
+ else
+ C.Appl
+ (C.MutInd (uri,i,exp_named_subst)::(left_args @ right_args))
+ in
+ (* check consistency with the actual type of term *)
+ let term',actual_type,subst,metasenv,ugraph1 =
+ type_of_aux subst metasenv context term ugraph in
+ let expected_type',_, subst, metasenv,ugraph2 =
+ type_of_aux subst metasenv context expected_type ugraph1
+ in
+ let actual_type = CicReduction.whd ~subst context actual_type in
+ let subst,metasenv,ugraph3 =
+ try
+ fo_unif_subst subst context metasenv
+ expected_type' actual_type ugraph2
+ with
+ exn ->
+ enrich localization_tbl term' exn
+ ~f:(function _ ->
+ lazy ("The term " ^
+ CicMetaSubst.ppterm_in_context subst term'
+ context ^ " has type " ^
+ CicMetaSubst.ppterm_in_context subst actual_type
+ context ^ " but is here used with type " ^
+ CicMetaSubst.ppterm_in_context subst expected_type' context))
+ in
+ let rec instantiate_prod t =
+ function
+ [] -> t
+ | he::tl ->
+ match CicReduction.whd ~subst context t with
+ C.Prod (_,_,t') ->
+ instantiate_prod (CicSubstitution.subst he t') tl
+ | _ -> assert false
+ in
+ let arity_instantiated_with_left_args =
+ instantiate_prod arity left_args in
+ (* TODO: check if the sort elimination
+ * is allowed: [(I q1 ... qr)|B] *)
+ let (pl',_,outtypeinstances,subst,metasenv,ugraph4) =
+ List.fold_left
+ (fun (pl,j,outtypeinstances,subst,metasenv,ugraph) p ->
+ let constructor =
+ if left_args = [] then
+ (C.MutConstruct (uri,i,j,exp_named_subst))
+ else
+ (C.Appl
+ (C.MutConstruct (uri,i,j,exp_named_subst)::left_args))
+ in
+ let p',actual_type,subst,metasenv,ugraph1 =
+ type_of_aux subst metasenv context p ugraph
+ in
+ let constructor',expected_type, subst, metasenv,ugraph2 =
+ type_of_aux subst metasenv context constructor ugraph1
+ in
+ let outtypeinstance,subst,metasenv,ugraph3 =
+ check_branch 0 context metasenv subst no_left_params
+ actual_type constructor' expected_type ugraph2
+ in
+ (pl @ [p'],j+1,
+ outtypeinstance::outtypeinstances,subst,metasenv,ugraph3))
+ ([],1,[],subst,metasenv,ugraph3) pl
+ in
+
+ (* we are left to check that the outype matches his instances.
+ The easy case is when the outype is specified, that amount
+ to a trivial check. Otherwise, we should guess a type from
+ its instances
+ *)
+
+ let outtype,outtypety, subst, metasenv,ugraph4 =
+ type_of_aux subst metasenv context outtype ugraph4 in
+ (match outtype with
+ | C.Meta (n,l) ->
+ (let candidate,ugraph5,metasenv,subst =
+ let exp_name_subst, metasenv =
+ let o,_ =
+ CicEnvironment.get_cooked_obj CicUniv.empty_ugraph uri
+ in
+ let uris = CicUtil.params_of_obj o in
+ List.fold_right (
+ fun uri (acc,metasenv) ->
+ let metasenv',new_meta =
+ CicMkImplicit.mk_implicit metasenv subst context
+ in
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable
+ context
+ in
+ (uri, Cic.Meta(new_meta,irl))::acc, metasenv'
+ ) uris ([],metasenv)
+ in
+ let ty =
+ match left_args,right_args with
+ [],[] -> Cic.MutInd(uri, i, exp_name_subst)
+ | _,_ ->
+ let rec mk_right_args =
+ function
+ 0 -> []
+ | n -> (Cic.Rel n)::(mk_right_args (n - 1))
+ in
+ let right_args_no = List.length right_args in
+ let lifted_left_args =
+ List.map (CicSubstitution.lift right_args_no) left_args
+ in
+ Cic.Appl (Cic.MutInd(uri,i,exp_name_subst)::
+ (lifted_left_args @ mk_right_args right_args_no))
+ in
+ let fresh_name =
+ FreshNamesGenerator.mk_fresh_name ~subst metasenv
+ context Cic.Anonymous ~typ:ty
+ in
+ match outtypeinstances with
+ | [] ->
+ let extended_context =
+ let rec add_right_args =
+ function
+ Cic.Prod (name,ty,t) ->
+ Some (name,Cic.Decl ty)::(add_right_args t)
+ | _ -> []
+ in
+ (Some (fresh_name,Cic.Decl ty))::
+ (List.rev
+ (add_right_args arity_instantiated_with_left_args))@
+ context
+ in
+ let metasenv,new_meta =
+ CicMkImplicit.mk_implicit metasenv subst extended_context
+ in
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable
+ extended_context
+ in
+ let rec add_lambdas b =
+ function
+ Cic.Prod (name,ty,t) ->
+ Cic.Lambda (name,ty,(add_lambdas b t))
+ | _ -> Cic.Lambda (fresh_name, ty, b)
+ in
+ let candidate =
+ add_lambdas (Cic.Meta (new_meta,irl))
+ arity_instantiated_with_left_args
+ in
+ (Some candidate),ugraph4,metasenv,subst
+ | (constructor_args_no,_,instance,_)::tl ->
+ try
+ let instance',subst,metasenv =
+ CicMetaSubst.delift_rels subst metasenv
+ constructor_args_no instance
+ in
+ let candidate,ugraph,metasenv,subst =
+ List.fold_left (
+ fun (candidate_oty,ugraph,metasenv,subst)
+ (constructor_args_no,_,instance,_) ->
+ match candidate_oty with
+ | None -> None,ugraph,metasenv,subst
+ | Some ty ->
+ try
+ let instance',subst,metasenv =
+ CicMetaSubst.delift_rels subst metasenv
+ constructor_args_no instance
+ in
+ let subst,metasenv,ugraph =
+ fo_unif_subst subst context metasenv
+ instance' ty ugraph
+ in
+ candidate_oty,ugraph,metasenv,subst
+ with
+ CicMetaSubst.DeliftingARelWouldCaptureAFreeVariable
+ | CicUnification.UnificationFailure _
+ | CicUnification.Uncertain _ ->
+ None,ugraph,metasenv,subst
+ ) (Some instance',ugraph4,metasenv,subst) tl
+ in
+ match candidate with
+ | None -> None, ugraph,metasenv,subst
+ | Some t ->
+ let rec add_lambdas n b =
+ function
+ Cic.Prod (name,ty,t) ->
+ Cic.Lambda (name,ty,(add_lambdas (n + 1) b t))
+ | _ ->
+ Cic.Lambda (fresh_name, ty,
+ CicSubstitution.lift (n + 1) t)
+ in
+ Some
+ (add_lambdas 0 t arity_instantiated_with_left_args),
+ ugraph,metasenv,subst
+ with CicMetaSubst.DeliftingARelWouldCaptureAFreeVariable ->
+ None,ugraph4,metasenv,subst
+ in
+ match candidate with
+ | None -> raise (Uncertain (lazy "can't solve an higher order unification problem"))
+ | Some candidate ->
+ let subst,metasenv,ugraph =
+ fo_unif_subst subst context metasenv
+ candidate outtype ugraph5
+ in
+ C.MutCase (uri, i, outtype, term', pl'),
+ CicReduction.head_beta_reduce
+ (CicMetaSubst.apply_subst subst
+ (Cic.Appl (outtype::right_args@[term']))),
+ subst,metasenv,ugraph)
+ | _ -> (* easy case *)
+ let tlbody_and_type,subst,metasenv,ugraph4 =
+ List.fold_right
+ (fun x (res,subst,metasenv,ugraph) ->
+ let x',ty,subst',metasenv',ugraph1 =
+ type_of_aux subst metasenv context x ugraph
+ in
+ (x', ty)::res,subst',metasenv',ugraph1
+ ) (right_args @ [term']) ([],subst,metasenv,ugraph4)
+ in
+ let _,_,subst,metasenv,ugraph4 =
+ eat_prods false subst metasenv context
+ outtypety tlbody_and_type ugraph4
+ in
+ let _,_, subst, metasenv,ugraph5 =
+ type_of_aux subst metasenv context
+ (C.Appl ((outtype :: right_args) @ [term'])) ugraph4
+ in
+ let (subst,metasenv,ugraph6) =
+ List.fold_left
+ (fun (subst,metasenv,ugraph)
+ (constructor_args_no,context,instance,args) ->
+ let instance' =
+ let appl =
+ let outtype' =
+ CicSubstitution.lift constructor_args_no outtype
+ in
+ C.Appl (outtype'::args)
+ in
+ CicReduction.whd ~subst context appl
+ in
+ fo_unif_subst subst context metasenv
+ instance instance' ugraph)
+ (subst,metasenv,ugraph5) outtypeinstances
+ in
+ C.MutCase (uri, i, outtype, term', pl'),
+ CicReduction.head_beta_reduce
+ (CicMetaSubst.apply_subst subst
+ (C.Appl(outtype::right_args@[term]))),
+ subst,metasenv,ugraph6)
+ | C.Fix (i,fl) ->
+ let fl_ty',subst,metasenv,types,ugraph1 =
+ List.fold_left
+ (fun (fl,subst,metasenv,types,ugraph) (n,_,ty,_) ->
+ let ty',_,subst',metasenv',ugraph1 =
+ type_of_aux subst metasenv context ty ugraph
+ in
+ fl @ [ty'],subst',metasenv',
+ Some (C.Name n,(C.Decl ty')) :: types, ugraph
+ ) ([],subst,metasenv,[],ugraph) fl
+ in
+ let len = List.length types in
+ let context' = types@context in
+ let fl_bo',subst,metasenv,ugraph2 =
+ List.fold_left
+ (fun (fl,subst,metasenv,ugraph) ((name,x,_,bo),ty) ->
+ let bo',ty_of_bo,subst,metasenv,ugraph1 =
+ type_of_aux subst metasenv context' bo ugraph
+ in
+ let subst',metasenv',ugraph' =
+ fo_unif_subst subst context' metasenv
+ ty_of_bo (CicSubstitution.lift len ty) ugraph1
+ in
+ fl @ [bo'] , subst',metasenv',ugraph'
+ ) ([],subst,metasenv,ugraph1) (List.combine fl fl_ty')
+ in
+ let ty = List.nth fl_ty' i in
+ (* now we have the new ty in fl_ty', the new bo in fl_bo',
+ * and we want the new fl with bo' and ty' injected in the right
+ * place.
+ *)
+ let rec map3 f l1 l2 l3 =
+ match l1,l2,l3 with
+ | [],[],[] -> []
+ | h1::tl1,h2::tl2,h3::tl3 -> (f h1 h2 h3) :: (map3 f tl1 tl2 tl3)
+ | _ -> assert false
+ in
+ let fl'' = map3 (fun ty' bo' (name,x,ty,bo) -> (name,x,ty',bo') )
+ fl_ty' fl_bo' fl
+ in
+ C.Fix (i,fl''),ty,subst,metasenv,ugraph2
+ | C.CoFix (i,fl) ->
+ let fl_ty',subst,metasenv,types,ugraph1 =
+ List.fold_left
+ (fun (fl,subst,metasenv,types,ugraph) (n,ty,_) ->
+ let ty',_,subst',metasenv',ugraph1 =
+ type_of_aux subst metasenv context ty ugraph
+ in
+ fl @ [ty'],subst',metasenv',
+ Some (C.Name n,(C.Decl ty')) :: types, ugraph1
+ ) ([],subst,metasenv,[],ugraph) fl
+ in
+ let len = List.length types in
+ let context' = types@context in
+ let fl_bo',subst,metasenv,ugraph2 =
+ List.fold_left
+ (fun (fl,subst,metasenv,ugraph) ((name,_,bo),ty) ->
+ let bo',ty_of_bo,subst,metasenv,ugraph1 =
+ type_of_aux subst metasenv context' bo ugraph
+ in
+ let subst',metasenv',ugraph' =
+ fo_unif_subst subst context' metasenv
+ ty_of_bo (CicSubstitution.lift len ty) ugraph1
+ in
+ fl @ [bo'],subst',metasenv',ugraph'
+ ) ([],subst,metasenv,ugraph1) (List.combine fl fl_ty')
+ in
+ let ty = List.nth fl_ty' i in
+ (* now we have the new ty in fl_ty', the new bo in fl_bo',
+ * and we want the new fl with bo' and ty' injected in the right
+ * place.
+ *)
+ let rec map3 f l1 l2 l3 =
+ match l1,l2,l3 with
+ | [],[],[] -> []
+ | h1::tl1,h2::tl2,h3::tl3 -> (f h1 h2 h3) :: (map3 f tl1 tl2 tl3)
+ | _ -> assert false
+ in
+ let fl'' = map3 (fun ty' bo' (name,ty,bo) -> (name,ty',bo') )
+ fl_ty' fl_bo' fl
+ in
+ C.CoFix (i,fl''),ty,subst,metasenv,ugraph2
+ in
+ relocalize localization_tbl t t';
+ res
+
+ and avoid_double_coercion subst metasenv ugraph t ty =
+ match t with
+ | (Cic.Appl [ c1 ; (Cic.Appl [c2; head]) ]) as t when
+ CoercGraph.is_a_coercion c1 && CoercGraph.is_a_coercion c2 ->
+ let source_carr = CoercGraph.source_of c2 in
+ let tgt_carr = CicMetaSubst.apply_subst subst ty in
+ (match CoercGraph.look_for_coercion source_carr tgt_carr
+ with
+ | CoercGraph.SomeCoercion c ->
+ Cic.Appl [ c ; head ], ty, subst,metasenv,ugraph
+ | _ -> assert false) (* the composite coercion must exist *)
+ | _ -> t, ty, subst, metasenv, ugraph
+
+ (* check_metasenv_consistency checks that the "canonical" context of a
+ metavariable is consitent - up to relocation via the relocation list l -
+ with the actual context *)
+ and check_metasenv_consistency
+ metano subst metasenv context canonical_context l ugraph
+ =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module S = CicSubstitution in
+ let lifted_canonical_context =
+ let rec aux i =
+ function
+ [] -> []
+ | (Some (n,C.Decl t))::tl ->
+ (Some (n,C.Decl (S.subst_meta l (S.lift i t))))::(aux (i+1) tl)
+ | (Some (n,C.Def (t,None)))::tl ->
+ (Some (n,C.Def ((S.subst_meta l (S.lift i t)),None)))::(aux (i+1) tl)
+ | None::tl -> None::(aux (i+1) tl)
+ | (Some (n,C.Def (t,Some ty)))::tl ->
+ (Some (n,
+ C.Def ((S.subst_meta l (S.lift i t)),
+ Some (S.subst_meta l (S.lift i ty))))) :: (aux (i+1) tl)
+ in
+ aux 1 canonical_context
+ in
+ try
+ List.fold_left2
+ (fun (l,subst,metasenv,ugraph) t ct ->
+ match (t,ct) with
+ _,None ->
+ l @ [None],subst,metasenv,ugraph
+ | Some t,Some (_,C.Def (ct,_)) ->
+ let subst',metasenv',ugraph' =
+ (try
+ fo_unif_subst subst context metasenv t ct ugraph
+ with e -> raise (RefineFailure (lazy (sprintf "The local context is not consistent with the canonical context, since %s cannot be unified with %s. Reason: %s" (CicMetaSubst.ppterm subst t) (CicMetaSubst.ppterm subst ct) (match e with AssertFailure msg -> Lazy.force msg | _ -> (Printexc.to_string e))))))
+ in
+ l @ [Some t],subst',metasenv',ugraph'
+ | Some t,Some (_,C.Decl ct) ->
+ let t',inferredty,subst',metasenv',ugraph1 =
+ type_of_aux subst metasenv context t ugraph
+ in
+ let subst'',metasenv'',ugraph2 =
+ (try
+ fo_unif_subst
+ subst' context metasenv' inferredty ct ugraph1
+ with e -> raise (RefineFailure (lazy (sprintf "The local context is not consistent with the canonical context, since the type %s of %s cannot be unified with the expected type %s. Reason: %s" (CicMetaSubst.ppterm subst' inferredty) (CicMetaSubst.ppterm subst' t) (CicMetaSubst.ppterm subst' ct) (match e with AssertFailure msg -> Lazy.force msg | RefineFailure msg -> Lazy.force msg | _ -> (Printexc.to_string e))))))
+ in
+ l @ [Some t'], subst'',metasenv'',ugraph2
+ | None, Some _ ->
+ raise (RefineFailure (lazy (sprintf "Not well typed metavariable instance %s: the local context does not instantiate an hypothesis even if the hypothesis is not restricted in the canonical context %s" (CicMetaSubst.ppterm subst (Cic.Meta (metano, l))) (CicMetaSubst.ppcontext subst canonical_context))))) ([],subst,metasenv,ugraph) l lifted_canonical_context
+ with
+ Invalid_argument _ ->
+ raise
+ (RefineFailure
+ (lazy (sprintf
+ "Not well typed metavariable instance %s: the length of the local context does not match the length of the canonical context %s"
+ (CicMetaSubst.ppterm subst (Cic.Meta (metano, l)))
+ (CicMetaSubst.ppcontext subst canonical_context))))
+
+ and check_exp_named_subst metasubst metasenv context tl ugraph =
+ let rec check_exp_named_subst_aux metasubst metasenv substs tl ugraph =
+ match tl with
+ [] -> [],metasubst,metasenv,ugraph
+ | (uri,t)::tl ->
+ let ty_uri,ugraph1 = type_of_variable uri ugraph in
+ let typeofvar =
+ CicSubstitution.subst_vars substs ty_uri in
+ (* CSC: why was this code here? it is wrong
+ (match CicEnvironment.get_cooked_obj ~trust:false uri with
+ Cic.Variable (_,Some bo,_,_) ->
+ raise
+ (RefineFailure (lazy
+ "A variable with a body can not be explicit substituted"))
+ | Cic.Variable (_,None,_,_) -> ()
+ | _ ->
+ raise
+ (RefineFailure (lazy
+ ("Unkown variable definition " ^ UriManager.string_of_uri uri)))
+ ) ;
+ *)
+ let t',typeoft,metasubst',metasenv',ugraph2 =
+ type_of_aux metasubst metasenv context t ugraph1 in
+ let subst = uri,t' in
+ let metasubst'',metasenv'',ugraph3 =
+ try
+ fo_unif_subst
+ metasubst' context metasenv' typeoft typeofvar ugraph2
+ with _ ->
+ raise (RefineFailure (lazy
+ ("Wrong Explicit Named Substitution: " ^
+ CicMetaSubst.ppterm metasubst' typeoft ^
+ " not unifiable with " ^
+ CicMetaSubst.ppterm metasubst' typeofvar)))
+ in
+ (* FIXME: no mere tail recursive! *)
+ let exp_name_subst, metasubst''', metasenv''', ugraph4 =
+ check_exp_named_subst_aux
+ metasubst'' metasenv'' (substs@[subst]) tl ugraph3
+ in
+ ((uri,t')::exp_name_subst), metasubst''', metasenv''', ugraph4
+ in
+ check_exp_named_subst_aux metasubst metasenv [] tl ugraph
+
+
+ and sort_of_prod subst metasenv context (name,s) (t1, t2) ugraph =
+ let module C = Cic in
+ let context_for_t2 = (Some (name,C.Decl s))::context in
+ let t1'' = CicReduction.whd ~subst context t1 in
+ let t2'' = CicReduction.whd ~subst context_for_t2 t2 in
+ match (t1'', t2'') with
+ (C.Sort s1, C.Sort s2)
+ when (s2 = C.Prop or s2 = C.Set or s2 = C.CProp) ->
+ (* different than Coq manual!!! *)
+ C.Sort s2,subst,metasenv,ugraph
+ | (C.Sort (C.Type t1), C.Sort (C.Type t2)) ->
+ let t' = CicUniv.fresh() in
+ let ugraph1 = CicUniv.add_ge t' t1 ugraph in
+ let ugraph2 = CicUniv.add_ge t' t2 ugraph1 in
+ C.Sort (C.Type t'),subst,metasenv,ugraph2
+ | (C.Sort _,C.Sort (C.Type t1)) ->
+ C.Sort (C.Type t1),subst,metasenv,ugraph
+ | (C.Meta _, C.Sort _) -> t2'',subst,metasenv,ugraph
+ | (C.Sort _,C.Meta _) | (C.Meta _,C.Meta _) ->
+ (* TODO how can we force the meta to become a sort? If we don't we
+ * brake the invariant that refine produce only well typed terms *)
+ (* TODO if we check the non meta term and if it is a sort then we
+ * are likely to know the exact value of the result e.g. if the rhs
+ * is a Sort (Prop | Set | CProp) then the result is the rhs *)
+ let (metasenv,idx) =
+ CicMkImplicit.mk_implicit_sort metasenv subst in
+ let (subst, metasenv,ugraph1) =
+ fo_unif_subst subst context_for_t2 metasenv
+ (C.Meta (idx,[])) t2'' ugraph
+ in
+ t2'',subst,metasenv,ugraph1
+ | _,_ ->
+ raise
+ (RefineFailure
+ (lazy
+ (sprintf
+ ("Two sorts were expected, found %s " ^^
+ "(that reduces to %s) and %s (that reduces to %s)")
+ (CicPp.ppterm t1) (CicPp.ppterm t1'') (CicPp.ppterm t2)
+ (CicPp.ppterm t2''))))
+
+ and eat_prods
+ allow_coercions subst metasenv context hetype tlbody_and_type ugraph
+ =
+ let rec mk_prod metasenv context =
+ function
+ [] ->
+ let (metasenv, idx) =
+ CicMkImplicit.mk_implicit_type metasenv subst context
+ in
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context
+ in
+ metasenv,Cic.Meta (idx, irl)
+ | (_,argty)::tl ->
+ let (metasenv, idx) =
+ CicMkImplicit.mk_implicit_type metasenv subst context
+ in
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context
+ in
+ let meta = Cic.Meta (idx,irl) in
+ let name =
+ (* The name must be fresh for context. *)
+ (* Nevertheless, argty is well-typed only in context. *)
+ (* Thus I generate a name (name_hint) in context and *)
+ (* then I generate a name --- using the hint name_hint *)
+ (* --- that is fresh in (context'@context). *)
+ let name_hint =
+ (* Cic.Name "pippo" *)
+ FreshNamesGenerator.mk_fresh_name ~subst metasenv
+ (* (CicMetaSubst.apply_subst_metasenv subst metasenv) *)
+ (CicMetaSubst.apply_subst_context subst context)
+ Cic.Anonymous
+ ~typ:(CicMetaSubst.apply_subst subst argty)
+ in
+ (* [] and (Cic.Sort Cic.prop) are dummy: they will not be used *)
+ FreshNamesGenerator.mk_fresh_name ~subst
+ [] context name_hint ~typ:(Cic.Sort Cic.Prop)
+ in
+ let metasenv,target =
+ mk_prod metasenv ((Some (name, Cic.Decl meta))::context) tl
+ in
+ metasenv,Cic.Prod (name,meta,target)
+ in
+ let metasenv,hetype' = mk_prod metasenv context tlbody_and_type in
+ let (subst, metasenv,ugraph1) =
+ try
+ fo_unif_subst subst context metasenv hetype hetype' ugraph
+ with exn ->
+ debug_print (lazy (Printf.sprintf "hetype=%s\nhetype'=%s\nmetasenv=%s\nsubst=%s"
+ (CicPp.ppterm hetype)
+ (CicPp.ppterm hetype')
+ (CicMetaSubst.ppmetasenv [] metasenv)
+ (CicMetaSubst.ppsubst subst)));
+ raise exn
+
+ in
+ let rec eat_prods metasenv subst context hetype ugraph =
+ function
+ | [] -> [],metasenv,subst,hetype,ugraph
+ | (hete, hety)::tl ->
+ (match hetype with
+ Cic.Prod (n,s,t) ->
+ let arg,subst,metasenv,ugraph1 =
+ try
+ let subst,metasenv,ugraph1 =
+ fo_unif_subst subst context metasenv hety s ugraph
+ in
+ hete,subst,metasenv,ugraph1
+ with exn when allow_coercions && !insert_coercions ->
+ (* we search a coercion from hety to s *)
+ let coer, tgt_carr =
+ let carr t subst context =
+ CicMetaSubst.apply_subst subst t
+ in
+ let c_hety = carr hety subst context in
+ let c_s = carr s subst context in
+ CoercGraph.look_for_coercion c_hety c_s, c_s
+ in
+ (match coer with
+ | CoercGraph.NoCoercion
+ | CoercGraph.NotHandled _ ->
+ enrich localization_tbl hete
+ (RefineFailure
+ (lazy ("The term " ^
+ CicMetaSubst.ppterm_in_context subst hete
+ context ^ " has type " ^
+ CicMetaSubst.ppterm_in_context subst hety
+ context ^ " but is here used with type " ^
+ CicMetaSubst.ppterm_in_context subst s context
+ (* "\nReason: " ^ Lazy.force e*))))
+ | CoercGraph.NotMetaClosed ->
+ enrich localization_tbl hete
+ (Uncertain
+ (lazy ("The term " ^
+ CicMetaSubst.ppterm_in_context subst hete
+ context ^ " has type " ^
+ CicMetaSubst.ppterm_in_context subst hety
+ context ^ " but is here used with type " ^
+ CicMetaSubst.ppterm_in_context subst s context
+ (* "\nReason: " ^ Lazy.force e*))))
+ | CoercGraph.SomeCoercion c ->
+ let newt, _, subst, metasenv, ugraph =
+ avoid_double_coercion
+ subst metasenv ugraph
+ (Cic.Appl[c;hete]) tgt_carr
+ in
+ newt, subst, metasenv, ugraph)
+ | exn ->
+ enrich localization_tbl hete
+ ~f:(fun _ ->
+ (lazy ("The term " ^
+ CicMetaSubst.ppterm_in_context subst hete
+ context ^ " has type " ^
+ CicMetaSubst.ppterm_in_context subst hety
+ context ^ " but is here used with type " ^
+ CicMetaSubst.ppterm_in_context subst s context
+ (* "\nReason: " ^ Lazy.force e*)))) exn
+ in
+ let coerced_args,metasenv',subst',t',ugraph2 =
+ eat_prods metasenv subst context
+ (CicSubstitution.subst arg t) ugraph1 tl
+ in
+ arg::coerced_args,metasenv',subst',t',ugraph2
+ | _ -> assert false
+ )
+ in
+ let coerced_args,metasenv,subst,t,ugraph2 =
+ eat_prods metasenv subst context hetype' ugraph1 tlbody_and_type
+ in
+ coerced_args,t,subst,metasenv,ugraph2
+ in
+
+ (* eat prods ends here! *)
+
+ let t',ty,subst',metasenv',ugraph1 =
+ type_of_aux [] metasenv context t ugraph
+ in
+ let substituted_t = CicMetaSubst.apply_subst subst' t' in
+ let substituted_ty = CicMetaSubst.apply_subst subst' ty in
+ (* Andrea: ho rimesso qui l'applicazione della subst al
+ metasenv dopo che ho droppato l'invariante che il metsaenv
+ e' sempre istanziato *)
+ let substituted_metasenv =
+ CicMetaSubst.apply_subst_metasenv subst' metasenv' in
+ (* metasenv' *)
+ (* substituted_t,substituted_ty,substituted_metasenv *)
+ (* ANDREA: spostare tutta questa robaccia da un altra parte *)
+ let cleaned_t =
+ FreshNamesGenerator.clean_dummy_dependent_types substituted_t in
+ let cleaned_ty =
+ FreshNamesGenerator.clean_dummy_dependent_types substituted_ty in
+ let cleaned_metasenv =
+ List.map
+ (function (n,context,ty) ->
+ let ty' = FreshNamesGenerator.clean_dummy_dependent_types ty in
+ let context' =
+ List.map
+ (function
+ None -> None
+ | Some (n, Cic.Decl t) ->
+ Some (n,
+ Cic.Decl (FreshNamesGenerator.clean_dummy_dependent_types t))
+ | Some (n, Cic.Def (bo,ty)) ->
+ let bo' = FreshNamesGenerator.clean_dummy_dependent_types bo in
+ let ty' =
+ match ty with
+ None -> None
+ | Some ty ->
+ Some (FreshNamesGenerator.clean_dummy_dependent_types ty)
+ in
+ Some (n, Cic.Def (bo',ty'))
+ ) context
+ in
+ (n,context',ty')
+ ) substituted_metasenv
+ in
+ (cleaned_t,cleaned_ty,cleaned_metasenv,ugraph1)
+;;
+
+let type_of_aux' ?localization_tbl metasenv context term ugraph =
+ try
+ type_of_aux' ?localization_tbl metasenv context term ugraph
+ with
+ CicUniv.UniverseInconsistency msg -> raise (RefineFailure (lazy msg))
+
+let undebrujin uri typesno tys t =
+ snd
+ (List.fold_right
+ (fun (name,_,_,_) (i,t) ->
+ (* here the explicit_named_substituion is assumed to be *)
+ (* of length 0 *)
+ let t' = Cic.MutInd (uri,i,[]) in
+ let t = CicSubstitution.subst t' t in
+ i - 1,t
+ ) tys (typesno - 1,t))
+
+let map_first_n n start f g l =
+ let rec aux acc k l =
+ if k < n then
+ match l with
+ | [] -> raise (Invalid_argument "map_first_n")
+ | hd :: tl -> f hd k (aux acc (k+1) tl)
+ else
+ g acc l
+ in
+ aux start 0 l
+
+(*CSC: this is a very rough approximation; to be finished *)
+let are_all_occurrences_positive metasenv ugraph uri tys leftno =
+ let subst,metasenv,ugraph,tys =
+ List.fold_right
+ (fun (name,ind,arity,cl) (subst,metasenv,ugraph,acc) ->
+ let subst,metasenv,ugraph,cl =
+ List.fold_right
+ (fun (name,ty) (subst,metasenv,ugraph,acc) ->
+ let rec aux ctx k subst = function
+ | Cic.Appl((Cic.MutInd (uri',_,_)as hd)::tl) when uri = uri'->
+ let subst,metasenv,ugraph,tl =
+ map_first_n leftno
+ (subst,metasenv,ugraph,[])
+ (fun t n (subst,metasenv,ugraph,acc) ->
+ let subst,metasenv,ugraph =
+ fo_unif_subst
+ subst ctx metasenv t (Cic.Rel (k-n)) ugraph
+ in
+ subst,metasenv,ugraph,(t::acc))
+ (fun (s,m,g,acc) tl -> assert(acc=[]);(s,m,g,tl))
+ tl
+ in
+ subst,metasenv,ugraph,(Cic.Appl (hd::tl))
+ | Cic.MutInd(uri',_,_) as t when uri = uri'->
+ subst,metasenv,ugraph,t
+ | Cic.Prod (name,s,t) ->
+ let ctx = (Some (name,Cic.Decl s))::ctx in
+ let subst,metasenv,ugraph,t = aux ctx (k+1) subst t in
+ subst,metasenv,ugraph,Cic.Prod (name,s,t)
+ | _ ->
+ raise
+ (RefineFailure
+ (lazy "not well formed constructor type"))
+ in
+ let subst,metasenv,ugraph,ty = aux [] 0 subst ty in
+ subst,metasenv,ugraph,(name,ty) :: acc)
+ cl (subst,metasenv,ugraph,[])
+ in
+ subst,metasenv,ugraph,(name,ind,arity,cl)::acc)
+ tys ([],metasenv,ugraph,[])
+ in
+ let substituted_tys =
+ List.map
+ (fun (name,ind,arity,cl) ->
+ let cl =
+ List.map (fun (name, ty) -> name,CicMetaSubst.apply_subst subst ty) cl
+ in
+ name,ind,CicMetaSubst.apply_subst subst arity,cl)
+ tys
+ in
+ metasenv,ugraph,substituted_tys
+
+let typecheck metasenv uri obj ~localization_tbl =
+ let ugraph = CicUniv.empty_ugraph in
+ match obj with
+ Cic.Constant (name,Some bo,ty,args,attrs) ->
+ let bo',boty,metasenv,ugraph =
+ type_of_aux' ~localization_tbl metasenv [] bo ugraph in
+ let ty',_,metasenv,ugraph =
+ type_of_aux' ~localization_tbl metasenv [] ty ugraph in
+ let subst,metasenv,ugraph = fo_unif_subst [] [] metasenv boty ty' ugraph in
+ let bo' = CicMetaSubst.apply_subst subst bo' in
+ let ty' = CicMetaSubst.apply_subst subst ty' in
+ let metasenv = CicMetaSubst.apply_subst_metasenv subst metasenv in
+ Cic.Constant (name,Some bo',ty',args,attrs),metasenv,ugraph
+ | Cic.Constant (name,None,ty,args,attrs) ->
+ let ty',_,metasenv,ugraph =
+ type_of_aux' ~localization_tbl metasenv [] ty ugraph
+ in
+ Cic.Constant (name,None,ty',args,attrs),metasenv,ugraph
+ | Cic.CurrentProof (name,metasenv',bo,ty,args,attrs) ->
+ assert (metasenv' = metasenv);
+ (* Here we do not check the metasenv for correctness *)
+ let bo',boty,metasenv,ugraph =
+ type_of_aux' ~localization_tbl metasenv [] bo ugraph in
+ let ty',sort,metasenv,ugraph =
+ type_of_aux' ~localization_tbl metasenv [] ty ugraph in
+ begin
+ match sort with
+ Cic.Sort _
+ (* instead of raising Uncertain, let's hope that the meta will become
+ a sort *)
+ | Cic.Meta _ -> ()
+ | _ -> raise (RefineFailure (lazy "The term provided is not a type"))
+ end;
+ let subst,metasenv,ugraph = fo_unif_subst [] [] metasenv boty ty' ugraph in
+ let bo' = CicMetaSubst.apply_subst subst bo' in
+ let ty' = CicMetaSubst.apply_subst subst ty' in
+ let metasenv = CicMetaSubst.apply_subst_metasenv subst metasenv in
+ Cic.CurrentProof (name,metasenv,bo',ty',args,attrs),metasenv,ugraph
+ | Cic.Variable _ -> assert false (* not implemented *)
+ | Cic.InductiveDefinition (tys,args,paramsno,attrs) ->
+ (*CSC: this code is greately simplified and many many checks are missing *)
+ (*CSC: e.g. the constructors are not required to build their own types, *)
+ (*CSC: the arities are not required to have as type a sort, etc. *)
+ let uri = match uri with Some uri -> uri | None -> assert false in
+ let typesno = List.length tys in
+ (* first phase: we fix only the types *)
+ let metasenv,ugraph,tys =
+ List.fold_right
+ (fun (name,b,ty,cl) (metasenv,ugraph,res) ->
+ let ty',_,metasenv,ugraph =
+ type_of_aux' ~localization_tbl metasenv [] ty ugraph
+ in
+ metasenv,ugraph,(name,b,ty',cl)::res
+ ) tys (metasenv,ugraph,[]) in
+ let con_context =
+ List.rev_map (fun (name,_,ty,_)-> Some (Cic.Name name,Cic.Decl ty)) tys in
+ (* second phase: we fix only the constructors *)
+ let metasenv,ugraph,tys =
+ List.fold_right
+ (fun (name,b,ty,cl) (metasenv,ugraph,res) ->
+ let metasenv,ugraph,cl' =
+ List.fold_right
+ (fun (name,ty) (metasenv,ugraph,res) ->
+ let ty =
+ CicTypeChecker.debrujin_constructor
+ ~cb:(relocalize localization_tbl) uri typesno ty in
+ let ty',_,metasenv,ugraph =
+ type_of_aux' ~localization_tbl metasenv con_context ty ugraph in
+ let ty' = undebrujin uri typesno tys ty' in
+ metasenv,ugraph,(name,ty')::res
+ ) cl (metasenv,ugraph,[])
+ in
+ metasenv,ugraph,(name,b,ty,cl')::res
+ ) tys (metasenv,ugraph,[]) in
+ (* third phase: we check the positivity condition *)
+ let metasenv,ugraph,tys =
+ are_all_occurrences_positive metasenv ugraph uri tys paramsno
+ in
+ Cic.InductiveDefinition (tys,args,paramsno,attrs),metasenv,ugraph
+
+(* DEBUGGING ONLY
+let type_of_aux' metasenv context term =
+ try
+ let (t,ty,m) =
+ type_of_aux' metasenv context term in
+ debug_print (lazy
+ ("@@@ REFINE SUCCESSFUL: " ^ CicPp.ppterm t ^ " : " ^ CicPp.ppterm ty));
+ debug_print (lazy
+ ("@@@ REFINE SUCCESSFUL (metasenv):\n" ^ CicMetaSubst.ppmetasenv ~sep:";" m []));
+ (t,ty,m)
+ with
+ | RefineFailure msg as e ->
+ debug_print (lazy ("@@@ REFINE FAILED: " ^ msg));
+ raise e
+ | Uncertain msg as e ->
+ debug_print (lazy ("@@@ REFINE UNCERTAIN: " ^ msg));
+ raise e
+;; *)
+
+let profiler2 = HExtlib.profile "CicRefine"
+
+let type_of_aux' ?localization_tbl metasenv context term ugraph =
+ profiler2.HExtlib.profile
+ (type_of_aux' ?localization_tbl metasenv context term) ugraph
+
+let typecheck ~localization_tbl metasenv uri obj =
+ profiler2.HExtlib.profile (typecheck ~localization_tbl metasenv uri) obj
diff --git a/helm/ocaml/cic_unification/cicRefine.mli b/helm/ocaml/cic_unification/cicRefine.mli
new file mode 100644
index 000000000..224a7586c
--- /dev/null
+++ b/helm/ocaml/cic_unification/cicRefine.mli
@@ -0,0 +1,48 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+exception RefineFailure of string Lazy.t;;
+exception Uncertain of string Lazy.t;;
+exception AssertFailure of string Lazy.t;;
+
+(* type_of_aux' metasenv context term graph *)
+(* refines [term] and returns the refined form of [term], *)
+(* its type, the new metasenv and universe graph. *)
+val type_of_aux':
+ ?localization_tbl:Token.flocation Cic.CicHash.t ->
+ Cic.metasenv -> Cic.context -> Cic.term -> CicUniv.universe_graph ->
+ Cic.term * Cic.term * Cic.metasenv * CicUniv.universe_graph
+
+(* typecheck metasenv uri obj graph *)
+(* refines [obj] and returns the refined form of [obj], *)
+(* the new metasenv and universe graph. *)
+(* the [uri] is required only for inductive definitions *)
+val typecheck :
+ localization_tbl:Token.flocation Cic.CicHash.t ->
+ Cic.metasenv -> UriManager.uri option -> Cic.obj ->
+ Cic.obj * Cic.metasenv * CicUniv.universe_graph
+
+val insert_coercions: bool ref (* initially true *)
+
diff --git a/helm/ocaml/cic_unification/cicUnification.ml b/helm/ocaml/cic_unification/cicUnification.ml
new file mode 100644
index 000000000..b1ef27f4e
--- /dev/null
+++ b/helm/ocaml/cic_unification/cicUnification.ml
@@ -0,0 +1,750 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+exception UnificationFailure of string Lazy.t;;
+exception Uncertain of string Lazy.t;;
+exception AssertFailure of string Lazy.t;;
+
+let verbose = false;;
+let debug_print = fun _ -> ()
+
+let profiler_toa = HExtlib.profile "fo_unif_subst.type_of_aux'"
+let profiler_beta_expand = HExtlib.profile "fo_unif_subst.beta_expand"
+let profiler_deref = HExtlib.profile "fo_unif_subst.deref'"
+let profiler_are_convertible = HExtlib.profile "fo_unif_subst.are_convertible"
+
+let type_of_aux' metasenv subst context term ugraph =
+let foo () =
+ try
+ CicTypeChecker.type_of_aux' ~subst metasenv context term ugraph
+ with
+ CicTypeChecker.TypeCheckerFailure msg ->
+ let msg =
+ lazy
+ (sprintf
+ "Kernel Type checking error:
+%s\n%s\ncontext=\n%s\nmetasenv=\n%s\nsubstitution=\n%s\nException:\n%s.\nToo bad."
+ (CicMetaSubst.ppterm subst term)
+ (CicMetaSubst.ppterm [] term)
+ (CicMetaSubst.ppcontext subst context)
+ (CicMetaSubst.ppmetasenv subst metasenv)
+ (CicMetaSubst.ppsubst subst) (Lazy.force msg)) in
+ raise (AssertFailure msg)
+ | CicTypeChecker.AssertFailure msg ->
+ let msg = lazy
+ (sprintf
+ "Kernel Type checking assertion failure:
+%s\n%s\ncontext=\n%s\nmetasenv=\n%s\nsubstitution=\n%s\nException:\n%s.\nToo bad."
+ (CicMetaSubst.ppterm subst term)
+ (CicMetaSubst.ppterm [] term)
+ (CicMetaSubst.ppcontext subst context)
+ (CicMetaSubst.ppmetasenv subst metasenv)
+ (CicMetaSubst.ppsubst subst) (Lazy.force msg)) in
+ raise (AssertFailure msg)
+in profiler_toa.HExtlib.profile foo ()
+;;
+
+let exists_a_meta l =
+ List.exists (function Cic.Meta _ -> true | _ -> false) l
+
+let rec deref subst t =
+ let snd (_,a,_) = a in
+ match t with
+ Cic.Meta(n,l) ->
+ (try
+ deref subst
+ (CicSubstitution.subst_meta
+ l (snd (CicUtil.lookup_subst n subst)))
+ with
+ CicUtil.Subst_not_found _ -> t)
+ | Cic.Appl(Cic.Meta(n,l)::args) ->
+ (match deref subst (Cic.Meta(n,l)) with
+ | Cic.Lambda _ as t ->
+ deref subst (CicReduction.head_beta_reduce (Cic.Appl(t::args)))
+ | r -> Cic.Appl(r::args))
+ | Cic.Appl(((Cic.Lambda _) as t)::args) ->
+ deref subst (CicReduction.head_beta_reduce (Cic.Appl(t::args)))
+ | t -> t
+;;
+
+let deref subst t =
+ let foo () = deref subst t
+ in profiler_deref.HExtlib.profile foo ()
+
+exception WrongShape;;
+let eta_reduce after_beta_expansion after_beta_expansion_body
+ before_beta_expansion
+ =
+ try
+ match before_beta_expansion,after_beta_expansion_body with
+ Cic.Appl l, Cic.Appl l' ->
+ let rec all_but_last check_last =
+ function
+ [] -> assert false
+ | [Cic.Rel 1] -> []
+ | [_] -> if check_last then raise WrongShape else []
+ | he::tl -> he::(all_but_last check_last tl)
+ in
+ let all_but_last check_last l =
+ match all_but_last check_last l with
+ [] -> assert false
+ | [he] -> he
+ | l -> Cic.Appl l
+ in
+ let t = CicSubstitution.subst (Cic.Rel (-1)) (all_but_last true l') in
+ let all_but_last = all_but_last false l in
+ (* here we should test alpha-equivalence; however we know by
+ construction that here alpha_equivalence is equivalent to = *)
+ if t = all_but_last then
+ all_but_last
+ else
+ after_beta_expansion
+ | _,_ -> after_beta_expansion
+ with
+ WrongShape -> after_beta_expansion
+
+let rec beta_expand test_equality_only metasenv subst context t arg ugraph =
+ let module S = CicSubstitution in
+ let module C = Cic in
+let foo () =
+ let rec aux metasenv subst n context t' ugraph =
+ try
+
+ let subst,metasenv,ugraph1 =
+ fo_unif_subst test_equality_only subst context metasenv
+ (CicSubstitution.lift n arg) t' ugraph
+
+ in
+ subst,metasenv,C.Rel (1 + n),ugraph1
+ with
+ Uncertain _
+ | UnificationFailure _ ->
+ match t' with
+ | C.Rel m -> subst,metasenv,
+ (if m <= n then C.Rel m else C.Rel (m+1)),ugraph
+ | C.Var (uri,exp_named_subst) ->
+ let subst,metasenv,exp_named_subst',ugraph1 =
+ aux_exp_named_subst metasenv subst n context exp_named_subst ugraph
+ in
+ subst,metasenv,C.Var (uri,exp_named_subst'),ugraph1
+ | C.Meta (i,l) ->
+ (* andrea: in general, beta_expand can create badly typed
+ terms. This happens quite seldom in practice, UNLESS we
+ iterate on the local context. For this reason, we renounce
+ to iterate and just lift *)
+ let l =
+ List.map
+ (function
+ Some t -> Some (CicSubstitution.lift 1 t)
+ | None -> None) l in
+ subst, metasenv, C.Meta (i,l), ugraph
+ | C.Sort _
+ | C.Implicit _ as t -> subst,metasenv,t,ugraph
+ | C.Cast (te,ty) ->
+ let subst,metasenv,te',ugraph1 =
+ aux metasenv subst n context te ugraph in
+ let subst,metasenv,ty',ugraph2 =
+ aux metasenv subst n context ty ugraph1 in
+ (* TASSI: sure this is in serial? *)
+ subst,metasenv,(C.Cast (te', ty')),ugraph2
+ | C.Prod (nn,s,t) ->
+ let subst,metasenv,s',ugraph1 =
+ aux metasenv subst n context s ugraph in
+ let subst,metasenv,t',ugraph2 =
+ aux metasenv subst (n+1) ((Some (nn, C.Decl s))::context) t
+ ugraph1
+ in
+ (* TASSI: sure this is in serial? *)
+ subst,metasenv,(C.Prod (nn, s', t')),ugraph2
+ | C.Lambda (nn,s,t) ->
+ let subst,metasenv,s',ugraph1 =
+ aux metasenv subst n context s ugraph in
+ let subst,metasenv,t',ugraph2 =
+ aux metasenv subst (n+1) ((Some (nn, C.Decl s))::context) t ugraph1
+ in
+ (* TASSI: sure this is in serial? *)
+ subst,metasenv,(C.Lambda (nn, s', t')),ugraph2
+ | C.LetIn (nn,s,t) ->
+ let subst,metasenv,s',ugraph1 =
+ aux metasenv subst n context s ugraph in
+ let subst,metasenv,t',ugraph2 =
+ aux metasenv subst (n+1) ((Some (nn, C.Def (s,None)))::context) t
+ ugraph1
+ in
+ (* TASSI: sure this is in serial? *)
+ subst,metasenv,(C.LetIn (nn, s', t')),ugraph2
+ | C.Appl l ->
+ let subst,metasenv,revl',ugraph1 =
+ List.fold_left
+ (fun (subst,metasenv,appl,ugraph) t ->
+ let subst,metasenv,t',ugraph1 =
+ aux metasenv subst n context t ugraph in
+ subst,metasenv,(t'::appl),ugraph1
+ ) (subst,metasenv,[],ugraph) l
+ in
+ subst,metasenv,(C.Appl (List.rev revl')),ugraph1
+ | C.Const (uri,exp_named_subst) ->
+ let subst,metasenv,exp_named_subst',ugraph1 =
+ aux_exp_named_subst metasenv subst n context exp_named_subst ugraph
+ in
+ subst,metasenv,(C.Const (uri,exp_named_subst')),ugraph1
+ | C.MutInd (uri,i,exp_named_subst) ->
+ let subst,metasenv,exp_named_subst',ugraph1 =
+ aux_exp_named_subst metasenv subst n context exp_named_subst ugraph
+ in
+ subst,metasenv,(C.MutInd (uri,i,exp_named_subst')),ugraph1
+ | C.MutConstruct (uri,i,j,exp_named_subst) ->
+ let subst,metasenv,exp_named_subst',ugraph1 =
+ aux_exp_named_subst metasenv subst n context exp_named_subst ugraph
+ in
+ subst,metasenv,(C.MutConstruct (uri,i,j,exp_named_subst')),ugraph1
+ | C.MutCase (sp,i,outt,t,pl) ->
+ let subst,metasenv,outt',ugraph1 =
+ aux metasenv subst n context outt ugraph in
+ let subst,metasenv,t',ugraph2 =
+ aux metasenv subst n context t ugraph1 in
+ let subst,metasenv,revpl',ugraph3 =
+ List.fold_left
+ (fun (subst,metasenv,pl,ugraph) t ->
+ let subst,metasenv,t',ugraph1 =
+ aux metasenv subst n context t ugraph in
+ subst,metasenv,(t'::pl),ugraph1
+ ) (subst,metasenv,[],ugraph2) pl
+ in
+ subst,metasenv,(C.MutCase (sp,i,outt', t', List.rev revpl')),ugraph3
+ (* TASSI: not sure this is serial *)
+ | C.Fix (i,fl) ->
+(*CSC: not implemented
+ let tylen = List.length fl in
+ let substitutedfl =
+ List.map
+ (fun (name,i,ty,bo) -> (name, i, aux n ty, aux (n+tylen) bo))
+ fl
+ in
+ C.Fix (i, substitutedfl)
+*)
+ subst,metasenv,(CicSubstitution.lift 1 t' ),ugraph
+ | C.CoFix (i,fl) ->
+(*CSC: not implemented
+ let tylen = List.length fl in
+ let substitutedfl =
+ List.map
+ (fun (name,ty,bo) -> (name, aux n ty, aux (n+tylen) bo))
+ fl
+ in
+ C.CoFix (i, substitutedfl)
+
+*)
+ subst,metasenv,(CicSubstitution.lift 1 t'), ugraph
+
+ and aux_exp_named_subst metasenv subst n context ens ugraph =
+ List.fold_right
+ (fun (uri,t) (subst,metasenv,l,ugraph) ->
+ let subst,metasenv,t',ugraph1 = aux metasenv subst n context t ugraph in
+ subst,metasenv,((uri,t')::l),ugraph1) ens (subst,metasenv,[],ugraph)
+ in
+ let argty,ugraph1 = type_of_aux' metasenv subst context arg ugraph in
+ let fresh_name =
+ FreshNamesGenerator.mk_fresh_name ~subst
+ metasenv context (Cic.Name "Hbeta") ~typ:argty
+ in
+ let subst,metasenv,t',ugraph2 = aux metasenv subst 0 context t ugraph1 in
+ let t'' = eta_reduce (C.Lambda (fresh_name,argty,t')) t' t in
+ subst, metasenv, t'', ugraph2
+in profiler_beta_expand.HExtlib.profile foo ()
+
+
+and beta_expand_many test_equality_only metasenv subst context t args ugraph =
+ let subst,metasenv,hd,ugraph =
+ List.fold_right
+ (fun arg (subst,metasenv,t,ugraph) ->
+ let subst,metasenv,t,ugraph1 =
+ beta_expand test_equality_only
+ metasenv subst context t arg ugraph
+ in
+ subst,metasenv,t,ugraph1
+ ) args (subst,metasenv,t,ugraph)
+ in
+ subst,metasenv,hd,ugraph
+
+
+(* NUOVA UNIFICAZIONE *)
+(* A substitution is a (int * Cic.term) list that associates a
+ metavariable i with its body.
+ A metaenv is a (int * Cic.term) list that associate a metavariable
+ i with is type.
+ fo_unif_new takes a metasenv, a context, two terms t1 and t2 and gives back
+ a new substitution which is _NOT_ unwinded. It must be unwinded before
+ applying it. *)
+
+and fo_unif_subst test_equality_only subst context metasenv t1 t2 ugraph =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module S = CicSubstitution in
+ let t1 = deref subst t1 in
+ let t2 = deref subst t2 in
+ let b,ugraph =
+let foo () =
+ R.are_convertible ~subst ~metasenv context t1 t2 ugraph
+in profiler_are_convertible.HExtlib.profile foo ()
+ in
+ if b then
+ subst, metasenv, ugraph
+ else
+ match (t1, t2) with
+ | (C.Meta (n,ln), C.Meta (m,lm)) when n=m ->
+ let _,subst,metasenv,ugraph1 =
+ (try
+ List.fold_left2
+ (fun (j,subst,metasenv,ugraph) t1 t2 ->
+ match t1,t2 with
+ None,_
+ | _,None -> j+1,subst,metasenv,ugraph
+ | Some t1', Some t2' ->
+ (* First possibility: restriction *)
+ (* Second possibility: unification *)
+ (* Third possibility: convertibility *)
+ let b, ugraph1 =
+ R.are_convertible
+ ~subst ~metasenv context t1' t2' ugraph
+ in
+ if b then
+ j+1,subst,metasenv, ugraph1
+ else
+ (try
+ let subst,metasenv,ugraph2 =
+ fo_unif_subst
+ test_equality_only
+ subst context metasenv t1' t2' ugraph
+ in
+ j+1,subst,metasenv,ugraph2
+ with
+ Uncertain _
+ | UnificationFailure _ ->
+debug_print (lazy ("restringo Meta n." ^ (string_of_int n) ^ "on variable n." ^ (string_of_int j)));
+ let metasenv, subst =
+ CicMetaSubst.restrict
+ subst [(n,j)] metasenv in
+ j+1,subst,metasenv,ugraph1)
+ ) (1,subst,metasenv,ugraph) ln lm
+ with
+ Exit ->
+ raise
+ (UnificationFailure (lazy "1"))
+ (*
+ (sprintf
+ "Error trying to unify %s with %s: the algorithm tried to check whether the two substitutions are convertible; if they are not, it tried to unify the two substitutions. No restriction was attempted."
+ (CicMetaSubst.ppterm subst t1)
+ (CicMetaSubst.ppterm subst t2))) *)
+ | Invalid_argument _ ->
+ raise
+ (UnificationFailure (lazy "2")))
+ (*
+ (sprintf
+ "Error trying to unify %s with %s: the lengths of the two local contexts do not match."
+ (CicMetaSubst.ppterm subst t1)
+ (CicMetaSubst.ppterm subst t2)))) *)
+ in subst,metasenv,ugraph1
+ | (C.Meta (n,_), C.Meta (m,_)) when n>m ->
+ fo_unif_subst test_equality_only subst context metasenv t2 t1 ugraph
+ | (C.Meta (n,l), t)
+ | (t, C.Meta (n,l)) ->
+ let swap =
+ match t1,t2 with
+ C.Meta (n,_), C.Meta (m,_) when n < m -> false
+ | _, C.Meta _ -> false
+ | _,_ -> true
+ in
+ let lower = fun x y -> if swap then y else x in
+ let upper = fun x y -> if swap then x else y in
+ let fo_unif_subst_ordered
+ test_equality_only subst context metasenv m1 m2 ugraph =
+ fo_unif_subst test_equality_only subst context metasenv
+ (lower m1 m2) (upper m1 m2) ugraph
+ in
+ begin
+ let subst,metasenv,ugraph1 =
+ let (_,_,meta_type) = CicUtil.lookup_meta n metasenv in
+ (try
+ let tyt,ugraph1 =
+ type_of_aux' metasenv subst context t ugraph
+ in
+ fo_unif_subst
+ test_equality_only
+ subst context metasenv tyt (S.subst_meta l meta_type) ugraph1
+ with
+ UnificationFailure _ as e -> raise e
+ | Uncertain msg -> raise (UnificationFailure msg)
+ | AssertFailure _ ->
+ debug_print (lazy "siamo allo huge hack");
+ (* TODO huge hack!!!!
+ * we keep on unifying/refining in the hope that
+ * the problem will be eventually solved.
+ * In the meantime we're breaking a big invariant:
+ * the terms that we are unifying are no longer well
+ * typed in the current context (in the worst case
+ * we could even diverge) *)
+ (subst, metasenv,ugraph)) in
+ let t',metasenv,subst =
+ try
+ CicMetaSubst.delift n subst context metasenv l t
+ with
+ (CicMetaSubst.MetaSubstFailure msg)->
+ raise (UnificationFailure msg)
+ | (CicMetaSubst.Uncertain msg) -> raise (Uncertain msg)
+ in
+ let t'',ugraph2 =
+ match t' with
+ C.Sort (C.Type u) when not test_equality_only ->
+ let u' = CicUniv.fresh () in
+ let s = C.Sort (C.Type u') in
+ let ugraph2 =
+ CicUniv.add_ge (upper u u') (lower u u') ugraph1
+ in
+ s,ugraph2
+ | _ -> t',ugraph1
+ in
+ (* Unifying the types may have already instantiated n. Let's check *)
+ try
+ let (_, oldt,_) = CicUtil.lookup_subst n subst in
+ let lifted_oldt = S.subst_meta l oldt in
+ fo_unif_subst_ordered
+ test_equality_only subst context metasenv t lifted_oldt ugraph2
+ with
+ CicUtil.Subst_not_found _ ->
+ let (_, context, ty) = CicUtil.lookup_meta n metasenv in
+ let subst = (n, (context, t'',ty)) :: subst in
+ let metasenv =
+ List.filter (fun (m,_,_) -> not (n = m)) metasenv in
+ subst, metasenv, ugraph2
+ end
+ | (C.Var (uri1,exp_named_subst1),C.Var (uri2,exp_named_subst2))
+ | (C.Const (uri1,exp_named_subst1),C.Const (uri2,exp_named_subst2)) ->
+ if UriManager.eq uri1 uri2 then
+ fo_unif_subst_exp_named_subst test_equality_only subst context metasenv
+ exp_named_subst1 exp_named_subst2 ugraph
+ else
+ raise (UnificationFailure (lazy
+ (sprintf
+ "Can't unify %s with %s due to different constants"
+ (CicMetaSubst.ppterm subst t1)
+ (CicMetaSubst.ppterm subst t2))))
+ | C.MutInd (uri1,i1,exp_named_subst1),C.MutInd (uri2,i2,exp_named_subst2) ->
+ if UriManager.eq uri1 uri2 && i1 = i2 then
+ fo_unif_subst_exp_named_subst
+ test_equality_only
+ subst context metasenv exp_named_subst1 exp_named_subst2 ugraph
+ else
+ raise (UnificationFailure (lazy "4"))
+ (* (sprintf
+ "Can't unify %s with %s due to different inductive principles"
+ (CicMetaSubst.ppterm subst t1)
+ (CicMetaSubst.ppterm subst t2))) *)
+ | C.MutConstruct (uri1,i1,j1,exp_named_subst1),
+ C.MutConstruct (uri2,i2,j2,exp_named_subst2) ->
+ if UriManager.eq uri1 uri2 && i1 = i2 && j1 = j2 then
+ fo_unif_subst_exp_named_subst
+ test_equality_only
+ subst context metasenv exp_named_subst1 exp_named_subst2 ugraph
+ else
+ raise (UnificationFailure (lazy "5"))
+ (* (sprintf
+ "Can't unify %s with %s due to different inductive constructors"
+ (CicMetaSubst.ppterm subst t1)
+ (CicMetaSubst.ppterm subst t2))) *)
+ | (C.Implicit _, _) | (_, C.Implicit _) -> assert false
+ | (C.Cast (te,ty), t2) -> fo_unif_subst test_equality_only
+ subst context metasenv te t2 ugraph
+ | (t1, C.Cast (te,ty)) -> fo_unif_subst test_equality_only
+ subst context metasenv t1 te ugraph
+ | (C.Prod (n1,s1,t1), C.Prod (_,s2,t2)) ->
+ let subst',metasenv',ugraph1 =
+ fo_unif_subst true subst context metasenv s1 s2 ugraph
+ in
+ fo_unif_subst test_equality_only
+ subst' ((Some (n1,(C.Decl s1)))::context) metasenv' t1 t2 ugraph1
+ | (C.Lambda (n1,s1,t1), C.Lambda (_,s2,t2)) ->
+ let subst',metasenv',ugraph1 =
+ fo_unif_subst test_equality_only subst context metasenv s1 s2 ugraph
+ in
+ fo_unif_subst test_equality_only
+ subst' ((Some (n1,(C.Decl s1)))::context) metasenv' t1 t2 ugraph1
+ | (C.LetIn (_,s1,t1), t2)
+ | (t2, C.LetIn (_,s1,t1)) ->
+ fo_unif_subst
+ test_equality_only subst context metasenv t2 (S.subst s1 t1) ugraph
+ | (C.Appl l1, C.Appl l2) ->
+ (* andrea: this case should be probably rewritten in the
+ spirit of deref *)
+ (match l1,l2 with
+ | C.Meta (i,_)::args1, C.Meta (j,_)::args2 when i = j ->
+ (try
+ List.fold_left2
+ (fun (subst,metasenv,ugraph) t1 t2 ->
+ fo_unif_subst
+ test_equality_only subst context metasenv t1 t2 ugraph)
+ (subst,metasenv,ugraph) l1 l2
+ with (Invalid_argument msg) ->
+ raise (UnificationFailure (lazy msg)))
+ | C.Meta (i,l)::args, _ when not(exists_a_meta args) ->
+ (* we verify that none of the args is a Meta,
+ since beta expanding with respoect to a metavariable
+ makes no sense *)
+ (*
+ (try
+ let (_,t,_) = CicUtil.lookup_subst i subst in
+ let lifted = S.subst_meta l t in
+ let reduced = CicReduction.head_beta_reduce (Cic.Appl (lifted::args)) in
+ fo_unif_subst
+ test_equality_only
+ subst context metasenv reduced t2 ugraph
+ with CicUtil.Subst_not_found _ -> *)
+ let subst,metasenv,beta_expanded,ugraph1 =
+ beta_expand_many
+ test_equality_only metasenv subst context t2 args ugraph
+ in
+ fo_unif_subst test_equality_only subst context metasenv
+ (C.Meta (i,l)) beta_expanded ugraph1
+ | _, C.Meta (i,l)::args when not(exists_a_meta args) ->
+ (* (try
+ let (_,t,_) = CicUtil.lookup_subst i subst in
+ let lifted = S.subst_meta l t in
+ let reduced = CicReduction.head_beta_reduce (Cic.Appl (lifted::args)) in
+ fo_unif_subst
+ test_equality_only
+ subst context metasenv t1 reduced ugraph
+ with CicUtil.Subst_not_found _ -> *)
+ let subst,metasenv,beta_expanded,ugraph1 =
+ beta_expand_many
+ test_equality_only
+ metasenv subst context t1 args ugraph
+ in
+ fo_unif_subst test_equality_only subst context metasenv
+ (C.Meta (i,l)) beta_expanded ugraph1
+ | _,_ ->
+ let lr1 = List.rev l1 in
+ let lr2 = List.rev l2 in
+ let rec
+ fo_unif_l test_equality_only subst metasenv (l1,l2) ugraph =
+ match (l1,l2) with
+ [],_
+ | _,[] -> assert false
+ | ([h1],[h2]) ->
+ fo_unif_subst
+ test_equality_only subst context metasenv h1 h2 ugraph
+ | ([h],l)
+ | (l,[h]) ->
+ fo_unif_subst test_equality_only subst context metasenv
+ h (C.Appl (List.rev l)) ugraph
+ | ((h1::l1),(h2::l2)) ->
+ let subst', metasenv',ugraph1 =
+ fo_unif_subst
+ test_equality_only
+ subst context metasenv h1 h2 ugraph
+ in
+ fo_unif_l
+ test_equality_only subst' metasenv' (l1,l2) ugraph1
+ in
+ fo_unif_l
+ test_equality_only subst metasenv (lr1, lr2) ugraph)
+ | (C.MutCase (_,_,outt1,t1',pl1), C.MutCase (_,_,outt2,t2',pl2))->
+ let subst', metasenv',ugraph1 =
+ fo_unif_subst test_equality_only subst context metasenv outt1 outt2
+ ugraph in
+ let subst'',metasenv'',ugraph2 =
+ fo_unif_subst test_equality_only subst' context metasenv' t1' t2'
+ ugraph1 in
+ (try
+ List.fold_left2
+ (fun (subst,metasenv,ugraph) t1 t2 ->
+ fo_unif_subst
+ test_equality_only subst context metasenv t1 t2 ugraph
+ ) (subst'',metasenv'',ugraph2) pl1 pl2
+ with
+ Invalid_argument _ ->
+ raise (UnificationFailure (lazy "6.1")))
+ (* (sprintf
+ "Error trying to unify %s with %s: the number of branches is not the same."
+ (CicMetaSubst.ppterm subst t1)
+ (CicMetaSubst.ppterm subst t2)))) *)
+ | (C.Rel _, _) | (_, C.Rel _) ->
+ if t1 = t2 then
+ subst, metasenv,ugraph
+ else
+ raise (UnificationFailure (lazy
+ (sprintf
+ "Can't unify %s with %s because they are not convertible"
+ (CicMetaSubst.ppterm subst t1)
+ (CicMetaSubst.ppterm subst t2))))
+ | (C.Appl (C.Meta(i,l)::args),t2) when not(exists_a_meta args) ->
+ let subst,metasenv,beta_expanded,ugraph1 =
+ beta_expand_many
+ test_equality_only metasenv subst context t2 args ugraph
+ in
+ fo_unif_subst test_equality_only subst context metasenv
+ (C.Meta (i,l)) beta_expanded ugraph1
+ | (t1,C.Appl (C.Meta(i,l)::args)) when not(exists_a_meta args) ->
+ let subst,metasenv,beta_expanded,ugraph1 =
+ beta_expand_many
+ test_equality_only metasenv subst context t1 args ugraph
+ in
+ fo_unif_subst test_equality_only subst context metasenv
+ beta_expanded (C.Meta (i,l)) ugraph1
+ | (C.Sort _ ,_) | (_, C.Sort _)
+ | (C.Const _, _) | (_, C.Const _)
+ | (C.MutInd _, _) | (_, C.MutInd _)
+ | (C.MutConstruct _, _) | (_, C.MutConstruct _)
+ | (C.Fix _, _) | (_, C.Fix _)
+ | (C.CoFix _, _) | (_, C.CoFix _) ->
+ if t1 = t2 then
+ subst, metasenv, ugraph
+ else
+ let b,ugraph1 =
+ R.are_convertible ~subst ~metasenv context t1 t2 ugraph
+ in
+ if b then
+ subst, metasenv, ugraph1
+ else
+ raise
+ (UnificationFailure (lazy (sprintf
+ "Can't unify %s with %s because they are not convertible"
+ (CicMetaSubst.ppterm subst t1)
+ (CicMetaSubst.ppterm subst t2))))
+ | (C.Prod _, t2) ->
+ let t2' = R.whd ~subst context t2 in
+ (match t2' with
+ C.Prod _ ->
+ fo_unif_subst test_equality_only
+ subst context metasenv t1 t2' ugraph
+ | _ -> raise (UnificationFailure (lazy "8")))
+ | (t1, C.Prod _) ->
+ let t1' = R.whd ~subst context t1 in
+ (match t1' with
+ C.Prod _ ->
+ fo_unif_subst test_equality_only
+ subst context metasenv t1' t2 ugraph
+ | _ -> (* raise (UnificationFailure "9")) *)
+ raise
+ (UnificationFailure (lazy (sprintf
+ "Can't unify %s with %s because they are not convertible"
+ (CicMetaSubst.ppterm subst t1)
+ (CicMetaSubst.ppterm subst t2)))))
+ | (_,_) ->
+ raise (UnificationFailure (lazy "10"))
+ (* (sprintf
+ "Can't unify %s with %s because they are not convertible"
+ (CicMetaSubst.ppterm subst t1)
+ (CicMetaSubst.ppterm subst t2))) *)
+
+and fo_unif_subst_exp_named_subst test_equality_only subst context metasenv
+ exp_named_subst1 exp_named_subst2 ugraph
+=
+ try
+ List.fold_left2
+ (fun (subst,metasenv,ugraph) (uri1,t1) (uri2,t2) ->
+ assert (uri1=uri2) ;
+ fo_unif_subst test_equality_only subst context metasenv t1 t2 ugraph
+ ) (subst,metasenv,ugraph) exp_named_subst1 exp_named_subst2
+ with
+ Invalid_argument _ ->
+ let print_ens ens =
+ String.concat " ; "
+ (List.map
+ (fun (uri,t) ->
+ UriManager.string_of_uri uri ^ " := " ^ (CicMetaSubst.ppterm subst t)
+ ) ens)
+ in
+ raise (UnificationFailure (lazy (sprintf
+ "Error trying to unify the two explicit named substitutions (local contexts) %s and %s: their lengths is different." (print_ens exp_named_subst1) (print_ens exp_named_subst2))))
+
+(* A substitution is a (int * Cic.term) list that associates a *)
+(* metavariable i with its body. *)
+(* metasenv is of type Cic.metasenv *)
+(* fo_unif takes a metasenv, a context, two terms t1 and t2 and gives back *)
+(* a new substitution which is already unwinded and ready to be applied and *)
+(* a new metasenv in which some hypothesis in the contexts of the *)
+(* metavariables may have been restricted. *)
+let fo_unif metasenv context t1 t2 ugraph =
+ fo_unif_subst false [] context metasenv t1 t2 ugraph ;;
+
+let enrich_msg msg subst context metasenv t1 t2 ugraph =
+ lazy (
+ if verbose then
+ sprintf "[Verbose] Unification error unifying %s of type %s with %s of type %s in context\n%s\nand metasenv\n%s\nand substitution\n%s\nbecause %s"
+ (CicMetaSubst.ppterm subst t1)
+ (try
+ let ty_t1,_ = type_of_aux' metasenv subst context t1 ugraph in
+ CicPp.ppterm ty_t1
+ with
+ | UnificationFailure s
+ | Uncertain s
+ | AssertFailure s -> sprintf "MALFORMED(t1): \n<BEGIN>%s\n<END>" (Lazy.force s))
+ (CicMetaSubst.ppterm subst t2)
+ (try
+ let ty_t2,_ = type_of_aux' metasenv subst context t2 ugraph in
+ CicPp.ppterm ty_t2
+ with
+ | UnificationFailure s
+ | Uncertain s
+ | AssertFailure s -> sprintf "MALFORMED(t2): \n<BEGIN>%s\n<END>" (Lazy.force s))
+ (CicMetaSubst.ppcontext subst context)
+ (CicMetaSubst.ppmetasenv subst metasenv)
+ (CicMetaSubst.ppsubst subst) (Lazy.force msg)
+ else
+ sprintf "Unification error unifying %s of type %s with %s of type %s in context\n%s\nand metasenv\n%s\nbecause %s"
+ (CicMetaSubst.ppterm_in_context subst t1 context)
+ (try
+ let ty_t1,_ = type_of_aux' metasenv subst context t1 ugraph in
+ CicMetaSubst.ppterm_in_context subst ty_t1 context
+ with
+ | UnificationFailure s
+ | Uncertain s
+ | AssertFailure s -> sprintf "MALFORMED(t1): \n<BEGIN>%s\n<END>" (Lazy.force s))
+ (CicMetaSubst.ppterm_in_context subst t2 context)
+ (try
+ let ty_t2,_ = type_of_aux' metasenv subst context t2 ugraph in
+ CicMetaSubst.ppterm_in_context subst ty_t2 context
+ with
+ | UnificationFailure s
+ | Uncertain s
+ | AssertFailure s -> sprintf "MALFORMED(t2): \n<BEGIN>%s\n<END>" (Lazy.force s))
+ (CicMetaSubst.ppcontext subst context)
+ (CicMetaSubst.ppmetasenv subst metasenv)
+ (Lazy.force msg)
+ )
+
+let fo_unif_subst subst context metasenv t1 t2 ugraph =
+ try
+ fo_unif_subst false subst context metasenv t1 t2 ugraph
+ with
+ | AssertFailure msg ->
+ raise (AssertFailure (enrich_msg msg subst context metasenv t1 t2 ugraph))
+ | UnificationFailure msg ->
+ raise (UnificationFailure (enrich_msg msg subst context metasenv t1 t2 ugraph))
+;;
diff --git a/helm/ocaml/cic_unification/cicUnification.mli b/helm/ocaml/cic_unification/cicUnification.mli
new file mode 100644
index 000000000..e1a6c2899
--- /dev/null
+++ b/helm/ocaml/cic_unification/cicUnification.mli
@@ -0,0 +1,58 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+exception UnificationFailure of string Lazy.t;;
+exception Uncertain of string Lazy.t;;
+exception AssertFailure of string Lazy.t;;
+
+(* fo_unif metasenv context t1 t2 *)
+(* unifies [t1] and [t2] in a context [context]. *)
+(* Only the metavariables declared in [metasenv] *)
+(* can be used in [t1] and [t2]. *)
+(* The returned substitution can be directly *)
+(* withouth first unwinding it. *)
+val fo_unif :
+ Cic.metasenv -> Cic.context ->
+ Cic.term -> Cic.term -> CicUniv.universe_graph ->
+ Cic.substitution * Cic.metasenv * CicUniv.universe_graph
+
+(* fo_unif_subst metasenv subst context t1 t2 *)
+(* unifies [t1] and [t2] in a context [context] *)
+(* and with [subst] as the current substitution *)
+(* (i.e. unifies ([subst] [t1]) and *)
+(* ([subst] [t2]) in a context *)
+(* ([subst] [context]) using the metasenv *)
+(* ([subst] [metasenv]) *)
+(* Only the metavariables declared in [metasenv] *)
+(* can be used in [t1] and [t2]. *)
+(* [subst] and the substitution returned are not *)
+(* unwinded. *)
+(*CSC: fare un tipo unione Unwinded o ToUnwind e fare gestire la
+ cosa all'apply_subst!!!*)
+val fo_unif_subst :
+ Cic.substitution -> Cic.context -> Cic.metasenv ->
+ Cic.term -> Cic.term -> CicUniv.universe_graph ->
+ Cic.substitution * Cic.metasenv * CicUniv.universe_graph
+
diff --git a/helm/ocaml/clusters.dot b/helm/ocaml/clusters.dot
new file mode 100644
index 000000000..3d22c6479
--- /dev/null
+++ b/helm/ocaml/clusters.dot
@@ -0,0 +1,58 @@
+// clusterrank = none;
+ fillcolor = "gray93";
+ fontsize = 24;
+ node [fontsize = 24];
+ /* libs clusters */
+ subgraph cluster_presentation {
+ label = "Terms at the content and presentation level";
+ labelloc = "b";
+ labeljust = "r";
+ style = "filled";
+ color = "white"
+ acic_content;
+ cic_disambiguation;
+ content_pres;
+ grafite_parser;
+ lexicon;
+ }
+ subgraph cluster_partially {
+ label = "Partially specified terms";
+ labelloc = "t";
+ labeljust = "l";
+ style = "filled";
+ color = "white"
+ cic_unification;
+ tactics;
+ paramodulation;
+ grafite;
+ grafite_engine;
+ }
+ subgraph cluster_fully {
+ label = "Fully specified terms";
+ labelloc = "b";
+ labeljust = "l";
+ style = "filled";
+ color = "white"
+ cic;
+ cic_proof_checking;
+ getter;
+ metadata;
+ urimanager;
+ whelp;
+ library;
+ cic_acic;
+ }
+ subgraph cluster_utilities {
+ label = "Utilities";
+ labelloc = "b";
+ labeljust = "r";
+ style = "filled";
+ color = "white"
+ extlib;
+ hgdome;
+ hmysql;
+ registry;
+ utf8_macros;
+ xml;
+ logger;
+ }
diff --git a/helm/ocaml/configure.ac b/helm/ocaml/configure.ac
new file mode 100644
index 000000000..357d1018f
--- /dev/null
+++ b/helm/ocaml/configure.ac
@@ -0,0 +1,60 @@
+AC_INIT(Makefile.in)
+
+AC_CHECK_PROG(HAVE_OCAMLC, ocamlc, yes, no)
+if test $HAVE_OCAMLC = "no"; then
+ AC_MSG_ERROR(could not find ocamlc in PATH, please make sure ocaml is installed)
+fi
+
+AC_CHECK_PROG(HAVE_OCAMLFIND, ocamlfind, yes, no)
+if test $HAVE_OCAMLFIND = "no"; then
+ AC_MSG_ERROR(could not find ocamlfind in PATH, please make sure findlib is installed)
+else
+ OCAMLFIND=ocamlfind
+fi
+
+OCAMLFIND_COMMANDS=""
+AC_CHECK_PROG(HAVE_OCAMLC_OPT, ocamlc.opt, yes, no)
+if test $HAVE_OCAMLC_OPT = "yes"; then
+ if test "$OCAMLFIND_COMMANDS" = ""; then
+ OCAMLFIND_COMMANDS="ocamlc=ocamlc.opt"
+ else
+ OCAMLFIND_COMMANDS="$OCAMLFIND_COMMANDS ocamlc=ocamlc.opt"
+ fi
+fi
+AC_CHECK_PROG(HAVE_OCAMLOPT_OPT, ocamlopt.opt, yes, no)
+if test $HAVE_OCAMLOPT_OPT = "yes"; then
+ if test "$OCAMLFIND_COMMANDS" = ""; then
+ OCAMLFIND_COMMANDS="ocamlopt=ocamlopt.opt"
+ else
+ OCAMLFIND_COMMANDS="$OCAMLFIND_COMMANDS ocamlopt=ocamlopt.opt"
+ fi
+fi
+AC_CHECK_PROG(HAVE_OCAMLDEP_OPT, ocamldep.opt, yes, no)
+if test $HAVE_OCAMLDEP_OPT = "yes"; then
+ if test "$OCAMLFIND_COMMANDS" = ""; then
+ OCAMLFIND_COMMANDS="ocamldep=ocamldep.opt"
+ else
+ OCAMLFIND_COMMANDS="$OCAMLFIND_COMMANDS ocamldep=ocamldep.opt"
+ fi
+fi
+if test "$OCAMLFIND_COMMANDS" != ""; then
+ OCAMLFIND="OCAMLFIND_COMMANDS='$OCAMLFIND_COMMANDS' $OCAMLFIND"
+fi
+
+AC_MSG_CHECKING("where to install the library")
+OCAMLFIND_DEST_DIR="/public/sacerdot/prova"
+AC_MSG_RESULT($OCAMLFIND_DEST_DIR)
+
+AC_MSG_CHECKING("where to install the META files")
+OCAMLFIND_META_DIR=`pwd`/METAS
+AC_MSG_RESULT($OCAMLFIND_META_DIR)
+
+AC_SUBST(OCAMLFIND)
+AC_SUBST(OCAMLFIND_DEST_DIR)
+AC_SUBST(OCAMLFIND_META_DIR)
+
+AC_OUTPUT([
+ Makefile
+ Makefile.common
+])
+
diff --git a/helm/ocaml/content_pres/.depend b/helm/ocaml/content_pres/.depend
new file mode 100644
index 000000000..60e25ecd8
--- /dev/null
+++ b/helm/ocaml/content_pres/.depend
@@ -0,0 +1,36 @@
+cicNotationPres.cmi: mpresentation.cmi box.cmi
+boxPp.cmi: cicNotationPres.cmi
+content2pres.cmi: cicNotationPres.cmi
+sequent2pres.cmi: cicNotationPres.cmi
+renderingAttrs.cmo: renderingAttrs.cmi
+renderingAttrs.cmx: renderingAttrs.cmi
+cicNotationLexer.cmo: cicNotationLexer.cmi
+cicNotationLexer.cmx: cicNotationLexer.cmi
+cicNotationParser.cmo: cicNotationLexer.cmi cicNotationParser.cmi
+cicNotationParser.cmx: cicNotationLexer.cmx cicNotationParser.cmi
+mpresentation.cmo: mpresentation.cmi
+mpresentation.cmx: mpresentation.cmi
+box.cmo: renderingAttrs.cmi box.cmi
+box.cmx: renderingAttrs.cmx box.cmi
+content2presMatcher.cmo: content2presMatcher.cmi
+content2presMatcher.cmx: content2presMatcher.cmi
+termContentPres.cmo: renderingAttrs.cmi content2presMatcher.cmi \
+ termContentPres.cmi
+termContentPres.cmx: renderingAttrs.cmx content2presMatcher.cmx \
+ termContentPres.cmi
+cicNotationPres.cmo: renderingAttrs.cmi mpresentation.cmi box.cmi \
+ cicNotationPres.cmi
+cicNotationPres.cmx: renderingAttrs.cmx mpresentation.cmx box.cmx \
+ cicNotationPres.cmi
+boxPp.cmo: renderingAttrs.cmi mpresentation.cmi cicNotationPres.cmi box.cmi \
+ boxPp.cmi
+boxPp.cmx: renderingAttrs.cmx mpresentation.cmx cicNotationPres.cmx box.cmx \
+ boxPp.cmi
+content2pres.cmo: termContentPres.cmi renderingAttrs.cmi mpresentation.cmi \
+ cicNotationPres.cmi box.cmi content2pres.cmi
+content2pres.cmx: termContentPres.cmx renderingAttrs.cmx mpresentation.cmx \
+ cicNotationPres.cmx box.cmx content2pres.cmi
+sequent2pres.cmo: termContentPres.cmi mpresentation.cmi cicNotationPres.cmi \
+ box.cmi sequent2pres.cmi
+sequent2pres.cmx: termContentPres.cmx mpresentation.cmx cicNotationPres.cmx \
+ box.cmx sequent2pres.cmi
diff --git a/helm/ocaml/content_pres/Makefile b/helm/ocaml/content_pres/Makefile
new file mode 100644
index 000000000..642e3ce0e
--- /dev/null
+++ b/helm/ocaml/content_pres/Makefile
@@ -0,0 +1,58 @@
+PACKAGE = content_pres
+PREDICATES =
+
+INTERFACE_FILES = \
+ renderingAttrs.mli \
+ cicNotationLexer.mli \
+ cicNotationParser.mli \
+ mpresentation.mli \
+ box.mli \
+ content2presMatcher.mli \
+ termContentPres.mli \
+ cicNotationPres.mli \
+ boxPp.mli \
+ content2pres.mli \
+ sequent2pres.mli \
+ $(NULL)
+IMPLEMENTATION_FILES = \
+ $(INTERFACE_FILES:%.mli=%.ml)
+
+cicNotationPres.cmi: OCAMLOPTIONS += -rectypes
+cicNotationPres.cmo: OCAMLOPTIONS += -rectypes
+cicNotationPres.cmx: OCAMLOPTIONS += -rectypes
+
+all: test_lexer
+clean: clean_tests
+
+LOCAL_LINKOPTS = -package helm-content_pres -linkpkg
+test: test_lexer
+test_lexer: test_lexer.ml $(PACKAGE).cma
+ $(OCAMLC) $(LOCAL_LINKOPTS) -o $@ $<
+
+clean_tests:
+ rm -f test_lexer{,.opt}
+
+cicNotationLexer.cmo: OCAMLC = $(OCAMLC_P4)
+cicNotationParser.cmo: OCAMLC = $(OCAMLC_P4)
+cicNotationLexer.cmx: OCAMLOPT = $(OCAMLOPT_P4)
+cicNotationParser.cmx: OCAMLOPT = $(OCAMLOPT_P4)
+cicNotationLexer.ml.annot: OCAMLC = $(OCAMLC_P4)
+cicNotationParser.ml.annot: OCAMLC = $(OCAMLC_P4)
+
+include ../Makefile.common
+
+# <cross> cross compatibility among ocaml 3.09 and ocaml 3.08, to be removed as
+# soon as we have ocaml 3.09 everywhere and "loc" occurrences are replaced by
+# "_loc" occurrences
+UTF8DIR := $(shell $(OCAMLFIND) query helm-utf8_macros)
+ULEXDIR := $(shell $(OCAMLFIND) query ulex)
+MY_SYNTAXOPTIONS = -pp "camlp4o -I $(UTF8DIR) -I $(ULEXDIR) pa_extend.cmo pa_ulex.cma pa_unicode_macro.cma -loc loc"
+cicNotationLexer.cmo: SYNTAXOPTIONS = $(MY_SYNTAXOPTIONS)
+cicNotationParser.cmo: SYNTAXOPTIONS = $(MY_SYNTAXOPTIONS)
+cicNotationLexer.cmx: SYNTAXOPTIONS = $(MY_SYNTAXOPTIONS)
+cicNotationParser.cmx: SYNTAXOPTIONS = $(MY_SYNTAXOPTIONS)
+cicNotationLexer.ml.annot: SYNTAXOPTIONS = $(MY_SYNTAXOPTIONS)
+cicNotationParser.ml.annot: SYNTAXOPTIONS = $(MY_SYNTAXOPTIONS)
+depend: SYNTAXOPTIONS = $(MY_SYNTAXOPTIONS)
+# </cross>
+
diff --git a/helm/ocaml/content_pres/box.ml b/helm/ocaml/content_pres/box.ml
new file mode 100644
index 000000000..8b992e041
--- /dev/null
+++ b/helm/ocaml/content_pres/box.ml
@@ -0,0 +1,152 @@
+(* Copyright (C) 2000-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(*************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Andrea Asperti <asperti@cs.unibo.it> *)
+(* 13/2/2004 *)
+(* *)
+(*************************************************************************)
+
+(* $Id$ *)
+
+type
+ 'expr box =
+ Text of attr * string
+ | Space of attr
+ | Ink of attr
+ | H of attr * ('expr box) list
+ | V of attr * ('expr box) list
+ | HV of attr * ('expr box) list
+ | HOV of attr * ('expr box) list
+ | Object of attr * 'expr
+ | Action of attr * ('expr box) list
+
+and attr = (string option * string * string) list
+
+let smallskip = Space([None,"width","0.5em"]);;
+let skip = Space([None,"width","1em"]);;
+
+let indent t = H([],[skip;t]);;
+
+(* BoxML prefix *)
+let prefix = "b";;
+
+let tag_of_box = function
+ | H _ -> "h"
+ | V _ -> "v"
+ | HV _ -> "hv"
+ | HOV _ -> "hov"
+ | _ -> assert false
+
+let box2xml ~obj2xml box =
+ let rec aux =
+ let module X = Xml in
+ function
+ Text (attr,s) -> X.xml_nempty ~prefix "text" attr (X.xml_cdata s)
+ | Space attr -> X.xml_empty ~prefix "space" attr
+ | Ink attr -> X.xml_empty ~prefix "ink" attr
+ | H (attr,l)
+ | V (attr,l)
+ | HV (attr,l)
+ | HOV (attr,l) as box ->
+ X.xml_nempty ~prefix (tag_of_box box) attr
+ [< (List.fold_right (fun x i -> [< (aux x) ; i >]) l [<>])
+ >]
+ | Object (attr,m) ->
+ X.xml_nempty ~prefix "obj" attr [< obj2xml m >]
+ | Action (attr,l) ->
+ X.xml_nempty ~prefix "action" attr
+ [< (List.fold_right (fun x i -> [< (aux x) ; i >]) l [<>]) >]
+ in
+ aux box
+;;
+
+let rec map f = function
+ | (Text _) as box -> box
+ | (Space _) as box -> box
+ | (Ink _) as box -> box
+ | H (attr, l) -> H (attr, List.map (map f) l)
+ | V (attr, l) -> V (attr, List.map (map f) l)
+ | HV (attr, l) -> HV (attr, List.map (map f) l)
+ | HOV (attr, l) -> HOV (attr, List.map (map f) l)
+ | Action (attr, l) -> Action (attr, List.map (map f) l)
+ | Object (attr, obj) -> Object (attr, f obj)
+;;
+
+(*
+let document_of_box ~obj2xml pres =
+ [< Xml.xml_cdata "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n" ;
+ Xml.xml_cdata "\n";
+ Xml.xml_nempty ~prefix "box"
+ [Some "xmlns","m","http://www.w3.org/1998/Math/MathML" ;
+ Some "xmlns","b","http://helm.cs.unibo.it/2003/BoxML" ;
+ Some "xmlns","helm","http://www.cs.unibo.it/helm" ;
+ Some "xmlns","xlink","http://www.w3.org/1999/xlink"
+ ] (print_box pres)
+ >]
+*)
+
+let b_h a b = H(a,b)
+let b_v a b = V(a,b)
+let b_hv a b = HV(a,b)
+let b_hov a b = HOV(a,b)
+let b_text a b = Text(a,b)
+let b_object b = Object ([],b)
+let b_indent = indent
+let b_space = Space [None, "width", "0.5em"]
+let b_kw = b_text (RenderingAttrs.object_keyword_attributes `BoxML)
+
+let pp_attr attr =
+ let pp (ns, n, v) =
+ Printf.sprintf "%s%s=%s" (match ns with None -> "" | Some s -> s ^ ":") n v
+ in
+ String.concat " " (List.map pp attr)
+
+let get_attr = function
+ | Text (attr, _)
+ | Space attr
+ | Ink attr
+ | H (attr, _)
+ | V (attr, _)
+ | HV (attr, _)
+ | HOV (attr, _)
+ | Object (attr, _)
+ | Action (attr, _) ->
+ attr
+
+let set_attr attr = function
+ | Text (_, x) -> Text (attr, x)
+ | Space _ -> Space attr
+ | Ink _ -> Ink attr
+ | H (_, x) -> H (attr, x)
+ | V (_, x) -> V (attr, x)
+ | HV (_, x) -> HV (attr, x)
+ | HOV (_, x) -> HOV (attr, x)
+ | Object (_, x) -> Object (attr, x)
+ | Action (_, x) -> Action (attr, x)
+
diff --git a/helm/ocaml/content_pres/box.mli b/helm/ocaml/content_pres/box.mli
new file mode 100644
index 000000000..56c086964
--- /dev/null
+++ b/helm/ocaml/content_pres/box.mli
@@ -0,0 +1,78 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(*************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Andrea Asperti <asperti@cs.unibo.it> *)
+(* 13/2/2004 *)
+(* *)
+(*************************************************************************)
+
+type
+ 'expr box =
+ Text of attr * string
+ | Space of attr
+ | Ink of attr
+ | H of attr * ('expr box) list
+ | V of attr * ('expr box) list
+ | HV of attr * ('expr box) list
+ | HOV of attr * ('expr box) list
+ | Object of attr * 'expr
+ | Action of attr * ('expr box) list
+
+and attr = (string option * string * string) list
+
+val get_attr: 'a box -> attr
+val set_attr: attr -> 'a box -> 'a box
+
+val smallskip : 'expr box
+val skip: 'expr box
+val indent : 'expr box -> 'expr box
+
+val box2xml:
+ obj2xml:('a -> Xml.token Stream.t) -> 'a box ->
+ Xml.token Stream.t
+
+val map: ('a -> 'b) -> 'a box -> 'b box
+
+(*
+val document_of_box :
+ ~obj2xml:('a -> Xml.token Stream.t) -> 'a box -> Xml.token Stream.t
+*)
+
+val b_h: attr -> 'expr box list -> 'expr box
+val b_v: attr -> 'expr box list -> 'expr box
+val b_hv: attr -> 'expr box list -> 'expr box (** default indent and spacing *)
+val b_hov: attr -> 'expr box list -> 'expr box (** default indent and spacing *)
+val b_text: attr -> string -> 'expr box
+val b_object: 'expr -> 'expr box
+val b_indent: 'expr box -> 'expr box
+val b_space: 'expr box
+val b_kw: string -> 'expr box
+
+val pp_attr: attr -> string
+
diff --git a/helm/ocaml/content_pres/boxPp.ml b/helm/ocaml/content_pres/boxPp.ml
new file mode 100644
index 000000000..7a2fa9912
--- /dev/null
+++ b/helm/ocaml/content_pres/boxPp.ml
@@ -0,0 +1,241 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+module Pres = Mpresentation
+
+(** {2 Pretty printing from BoxML to strings} *)
+
+let string_space = " "
+let string_space_len = String.length string_space
+let string_indent = string_space
+let string_indent_len = String.length string_indent
+let string_ink = "##"
+let string_ink_len = String.length string_ink
+
+let contains_attrs contained container =
+ List.for_all (fun attr -> List.mem attr container) contained
+
+let want_indent = contains_attrs (RenderingAttrs.indent_attributes `BoxML)
+let want_spacing = contains_attrs (RenderingAttrs.spacing_attributes `BoxML)
+
+let indent_string s = string_indent ^ s
+let indent_children (size, children) =
+ let children' = List.map indent_string children in
+ size + string_space_len, children'
+
+let choose_rendering size (best, other) =
+ let best_size, _ = best in
+ if size >= best_size then best else other
+
+let merge_columns sep cols =
+ let sep_len = String.length sep in
+ let indent = ref 0 in
+ let res_rows = ref [] in
+ let add_row ~continue row =
+ match !res_rows with
+ | last :: prev when continue ->
+ res_rows := (String.concat sep [last; row]) :: prev;
+ indent := !indent + String.length last + sep_len
+ | _ -> res_rows := (String.make !indent ' ' ^ row) :: !res_rows;
+ in
+ List.iter
+ (fun rows ->
+ match rows with
+ | hd :: tl ->
+ add_row ~continue:true hd;
+ List.iter (add_row ~continue:false) tl
+ | [] -> ())
+ cols;
+ List.rev !res_rows
+
+let max_len =
+ List.fold_left (fun max_size s -> max (String.length s) max_size) 0
+
+let render_row available_space spacing children =
+ let spacing_bonus = if spacing then string_space_len else 0 in
+ let rem_space = ref available_space in
+ let renderings = ref [] in
+ List.iter
+ (fun f ->
+ let occupied_space, rendering = f !rem_space in
+ renderings := rendering :: !renderings;
+ rem_space := !rem_space - (occupied_space + spacing_bonus))
+ children;
+ let sep = if spacing then string_space else "" in
+ let rendering = merge_columns sep (List.rev !renderings) in
+ max_len rendering, rendering
+
+let fixed_rendering s =
+ let s_len = String.length s in
+ (fun _ -> s_len, [s])
+
+let render_to_strings size markup =
+ let max_size = max_int in
+ let rec aux_box =
+ function
+ | Box.Text (_, t) -> fixed_rendering t
+ | Box.Space _ -> fixed_rendering string_space
+ | Box.Ink _ -> fixed_rendering string_ink
+ | Box.Action (_, []) -> assert false
+ | Box.Action (_, hd :: _) -> aux_box hd
+ | Box.Object (_, o) -> aux_mpres o
+ | Box.H (attrs, children) ->
+ let spacing = want_spacing attrs in
+ let children' = List.map aux_box children in
+ (fun size -> render_row size spacing children')
+ | Box.HV (attrs, children) ->
+ let spacing = want_spacing attrs in
+ let children' = List.map aux_box children in
+ (fun size ->
+ let (size', renderings) as res =
+ render_row max_size spacing children'
+ in
+ if size' <= size then (* children fit in a row *)
+ res
+ else (* break needed, re-render using a Box.V *)
+ aux_box (Box.V (attrs, children)) size)
+ | Box.V (attrs, []) -> assert false
+ | Box.V (attrs, [child]) -> aux_box child
+ | Box.V (attrs, hd :: tl) ->
+ let indent = want_indent attrs in
+ let hd_f = aux_box hd in
+ let tl_fs = List.map aux_box tl in
+ (fun size ->
+ let _, hd_rendering = hd_f size in
+ let children_size =
+ max 0 (if indent then size - string_indent_len else size)
+ in
+ let tl_renderings =
+ List.map
+ (fun f ->
+(* let indent_header = if indent then string_indent else "" in *)
+ snd (indent_children (f children_size)))
+ tl_fs
+ in
+ let rows = hd_rendering @ List.concat tl_renderings in
+ max_len rows, rows)
+ | Box.HOV (attrs, []) -> assert false
+ | Box.HOV (attrs, [child]) -> aux_box child
+ | Box.HOV (attrs, children) ->
+ let spacing = want_spacing attrs in
+ let indent = want_indent attrs in
+ let spacing_bonus = if spacing then string_space_len else 0 in
+ let indent_bonus = if indent then string_indent_len else 0 in
+ let sep = if spacing then string_space else "" in
+ let fs = List.map aux_box children in
+ (fun size ->
+ let rows = ref [] in
+ let renderings = ref [] in
+ let rem_space = ref size in
+ let first_row = ref true in
+ let use_rendering (space, rendering) =
+ let use_indent = !renderings = [] && not !first_row in
+ let rendering' =
+ if use_indent then List.map indent_string rendering
+ else rendering
+ in
+ renderings := rendering' :: !renderings;
+ let bonus = if use_indent then indent_bonus else spacing_bonus in
+ rem_space := !rem_space - (space + bonus)
+ in
+ let end_cluster () =
+ let new_rows = merge_columns sep (List.rev !renderings) in
+ rows := List.rev_append new_rows !rows;
+ rem_space := size - indent_bonus;
+ renderings := [];
+ first_row := false
+ in
+ List.iter
+ (fun f ->
+ let (best_space, _) as best = f max_size in
+ if best_space <= !rem_space then
+ use_rendering best
+ else begin
+ end_cluster ();
+ if best_space <= !rem_space then use_rendering best
+ else use_rendering (f size)
+ end)
+ fs;
+ if !renderings <> [] then end_cluster ();
+ max_len !rows, List.rev !rows)
+ and aux_mpres =
+ let text s = Pres.Mtext ([], s) in
+ let mrow c = Pres.Mrow ([], c) in
+ function
+ | Pres.Mi (_, s)
+ | Pres.Mn (_, s)
+ | Pres.Mtext (_, s)
+ | Pres.Ms (_, s)
+ | Pres.Mgliph (_, s) -> fixed_rendering s
+ | Pres.Mo (_, s) ->
+ let s =
+ if String.length s > 1 then
+ (* heuristic to guess which operators need to be expanded in their
+ * TeX like format *)
+ Utf8Macro.tex_of_unicode s ^ " "
+ else s
+ in
+ fixed_rendering s
+ | Pres.Mspace _ -> fixed_rendering string_space
+ | Pres.Mrow (attrs, children) ->
+ let children' = List.map aux_mpres children in
+ (fun size -> render_row size false children')
+ | Pres.Mfrac (_, m, n) ->
+ aux_mpres (mrow [ text "\\frac("; text ")"; text "("; n; text ")" ])
+ | Pres.Msqrt (_, m) -> aux_mpres (mrow [ text "\\sqrt("; m; text ")" ])
+ | Pres.Mroot (_, r, i) ->
+ aux_mpres (mrow [
+ text "\\root("; i; text ")"; text "\\of("; r; text ")" ])
+ | Pres.Mstyle (_, m)
+ | Pres.Merror (_, m)
+ | Pres.Mpadded (_, m)
+ | Pres.Mphantom (_, m)
+ | Pres.Menclose (_, m) -> aux_mpres m
+ | Pres.Mfenced (_, children) -> aux_mpres (mrow children)
+ | Pres.Maction (_, []) -> assert false
+ | Pres.Msub (_, m, n) ->
+ aux_mpres (mrow [ text "("; m; text ")\\sub("; n; text ")" ])
+ | Pres.Msup (_, m, n) ->
+ aux_mpres (mrow [ text "("; m; text ")\\sup("; n; text ")" ])
+ | Pres.Munder (_, m, n) ->
+ aux_mpres (mrow [ text "("; m; text ")\\below("; n; text ")" ])
+ | Pres.Mover (_, m, n) ->
+ aux_mpres (mrow [ text "("; m; text ")\\above("; n; text ")" ])
+ | Pres.Msubsup _
+ | Pres.Munderover _
+ | Pres.Mtable _ ->
+ prerr_endline
+ "MathML presentation element not yet available in concrete syntax";
+ assert false
+ | Pres.Maction (_, hd :: _) -> aux_mpres hd
+ | Pres.Mobject (_, o) -> aux_box (o: CicNotationPres.boxml_markup)
+ in
+ snd (aux_mpres markup size)
+
+let render_to_string size markup =
+ String.concat "\n" (render_to_strings size markup)
+
diff --git a/helm/ocaml/content_pres/boxPp.mli b/helm/ocaml/content_pres/boxPp.mli
new file mode 100644
index 000000000..6b7c3cec8
--- /dev/null
+++ b/helm/ocaml/content_pres/boxPp.mli
@@ -0,0 +1,33 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+ (** @return rows list of rows *)
+val render_to_strings: int -> CicNotationPres.markup -> string list
+
+ (** helper function
+ * @return s, concatenation of the return value of render_to_strings above
+ * with newlines as separators *)
+val render_to_string: int -> CicNotationPres.markup -> string
+
diff --git a/helm/ocaml/content_pres/cicNotationLexer.ml b/helm/ocaml/content_pres/cicNotationLexer.ml
new file mode 100644
index 000000000..8848a3ce5
--- /dev/null
+++ b/helm/ocaml/content_pres/cicNotationLexer.ml
@@ -0,0 +1,353 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+exception Error of int * int * string
+
+let regexp number = xml_digit+
+
+ (* ZACK: breaks unicode's binder followed by an ascii letter without blank *)
+(* let regexp ident_letter = xml_letter *)
+
+let regexp ident_letter = [ 'a' - 'z' 'A' - 'Z' ]
+
+ (* must be in sync with "is_ligature_char" below *)
+let regexp ligature_char = [ "'`~!?@*()[]<>-+=|:;.,/\"" ]
+let regexp ligature = ligature_char ligature_char+
+
+let is_ligature_char =
+ (* must be in sync with "regexp ligature_char" above *)
+ let chars = "'`~!?@*()[]<>-+=|:;.,/\"" in
+ (fun char ->
+ (try
+ ignore (String.index chars char);
+ true
+ with Not_found -> false))
+
+let regexp ident_decoration = '\'' | '?' | '`'
+let regexp ident_cont = ident_letter | xml_digit | '_'
+let regexp ident = ident_letter ident_cont* ident_decoration*
+
+let regexp tex_token = '\\' ident
+
+let regexp delim_begin = "\\["
+let regexp delim_end = "\\]"
+
+let regexp qkeyword = "'" ident "'"
+
+let regexp implicit = '?'
+let regexp placeholder = '%'
+let regexp meta = implicit number
+
+let regexp csymbol = '\'' ident
+
+let regexp begin_group = "@{" | "${"
+let regexp end_group = '}'
+let regexp wildcard = "$_"
+let regexp ast_ident = "@" ident
+let regexp ast_csymbol = "@" csymbol
+let regexp meta_ident = "$" ident
+let regexp meta_anonymous = "$_"
+let regexp qstring = '"' [^ '"']* '"'
+
+let regexp begincomment = "(**" xml_blank
+let regexp beginnote = "(*"
+let regexp endcomment = "*)"
+(* let regexp comment_char = [^'*'] | '*'[^')']
+let regexp note = "|+" ([^'*'] | "**") comment_char* "+|" *)
+
+let level1_layouts =
+ [ "sub"; "sup";
+ "below"; "above";
+ "over"; "atop"; "frac";
+ "sqrt"; "root"
+ ]
+
+let level1_keywords =
+ [ "hbox"; "hvbox"; "hovbox"; "vbox";
+ "break";
+ "list0"; "list1"; "sep";
+ "opt";
+ "term"; "ident"; "number"
+ ] @ level1_layouts
+
+let level2_meta_keywords =
+ [ "if"; "then"; "else";
+ "fold"; "left"; "right"; "rec";
+ "fail";
+ "default";
+ "anonymous"; "ident"; "number"; "term"; "fresh"
+ ]
+
+ (* (string, unit) Hashtbl.t, to exploit multiple bindings *)
+let level2_ast_keywords = Hashtbl.create 23
+let _ =
+ List.iter (fun k -> Hashtbl.add level2_ast_keywords k ())
+ [ "CProp"; "Prop"; "Type"; "Set"; "let"; "rec"; "corec"; "match";
+ "with"; "in"; "and"; "to"; "as"; "on"; "return" ]
+
+let add_level2_ast_keyword k = Hashtbl.add level2_ast_keywords k ()
+let remove_level2_ast_keyword k = Hashtbl.remove level2_ast_keywords k
+
+ (* (string, int) Hashtbl.t, with multiple bindings.
+ * int is the unicode codepoint *)
+let ligatures = Hashtbl.create 23
+let _ =
+ List.iter
+ (fun (ligature, symbol) -> Hashtbl.add ligatures ligature symbol)
+ [ ("->", <:unicode<to>>); ("=>", <:unicode<Rightarrow>>);
+ ("<=", <:unicode<leq>>); (">=", <:unicode<geq>>);
+ ("<>", <:unicode<neq>>); (":=", <:unicode<def>>);
+ ]
+
+let regexp uri_step = [ 'a' - 'z' 'A' - 'Z' '0' - '9' '_' '-' ]+
+
+let regexp uri =
+ ("cic:/" | "theory:/") (* schema *)
+(* ident ('/' ident)* |+ path +| *)
+ uri_step ('/' uri_step)* (* path *)
+ ('.' ident)+ (* ext *)
+ ("#xpointer(" number ('/' number)+ ")")? (* xpointer *)
+
+let error lexbuf msg =
+ let begin_cnum, end_cnum = Ulexing.loc lexbuf in
+ raise (Error (begin_cnum, end_cnum, msg))
+let error_at_end lexbuf msg =
+ let begin_cnum, end_cnum = Ulexing.loc lexbuf in
+ raise (Error (begin_cnum, end_cnum, msg))
+
+let return_with_loc token begin_cnum end_cnum =
+ (* TODO handle line/column numbers *)
+ let flocation_begin =
+ { Lexing.pos_fname = "";
+ Lexing.pos_lnum = -1; Lexing.pos_bol = -1;
+ Lexing.pos_cnum = begin_cnum }
+ in
+ let flocation_end = { flocation_begin with Lexing.pos_cnum = end_cnum } in
+ (token, (flocation_begin, flocation_end))
+
+let return lexbuf token =
+ let begin_cnum, end_cnum = Ulexing.loc lexbuf in
+ return_with_loc token begin_cnum end_cnum
+
+let return_lexeme lexbuf name = return lexbuf (name, Ulexing.utf8_lexeme lexbuf)
+
+let return_symbol lexbuf s = return lexbuf ("SYMBOL", s)
+let return_eoi lexbuf = return lexbuf ("EOI", "")
+
+let remove_quotes s = String.sub s 1 (String.length s - 2)
+
+let mk_lexer token =
+ let tok_func stream =
+(* let lexbuf = Ulexing.from_utf8_stream stream in *)
+(** XXX Obj.magic rationale.
+ * The problem.
+ * camlp4 constraints the tok_func field of Token.glexer to have type:
+ * Stream.t char -> (Stream.t 'te * flocation_function)
+ * In order to use ulex we have (in theory) to instantiate a new lexbuf each
+ * time a char Stream.t is passed, destroying the previous lexbuf which may
+ * have consumed a character from the old stream which is lost forever :-(
+ * The "solution".
+ * Instead of passing to camlp4 a char Stream.t we pass a lexbuf, casting it to
+ * char Stream.t with Obj.magic where needed.
+ *)
+ let lexbuf = Obj.magic stream in
+ Token.make_stream_and_flocation
+ (fun () ->
+ try
+ token lexbuf
+ with
+ | Ulexing.Error -> error_at_end lexbuf "Unexpected character"
+ | Ulexing.InvalidCodepoint p ->
+ error_at_end lexbuf (sprintf "Invalid code point: %d" p))
+ in
+ {
+ Token.tok_func = tok_func;
+ Token.tok_using = (fun _ -> ());
+ Token.tok_removing = (fun _ -> ());
+ Token.tok_match = Token.default_match;
+ Token.tok_text = Token.lexer_text;
+ Token.tok_comm = None;
+ }
+
+let expand_macro lexbuf =
+ let macro =
+ Ulexing.utf8_sub_lexeme lexbuf 1 (Ulexing.lexeme_length lexbuf - 1)
+ in
+ try
+ ("SYMBOL", Utf8Macro.expand macro)
+ with Utf8Macro.Macro_not_found _ -> "SYMBOL", Ulexing.utf8_lexeme lexbuf
+
+let remove_quotes s = String.sub s 1 (String.length s - 2)
+let remove_left_quote s = String.sub s 1 (String.length s - 1)
+
+let rec level2_pattern_token_group counter buffer =
+ lexer
+ | end_group ->
+ if (counter > 0) then
+ Buffer.add_string buffer (Ulexing.utf8_lexeme lexbuf) ;
+ snd (Ulexing.loc lexbuf)
+ | begin_group ->
+ Buffer.add_string buffer (Ulexing.utf8_lexeme lexbuf) ;
+ ignore (level2_pattern_token_group (counter + 1) buffer lexbuf) ;
+ level2_pattern_token_group counter buffer lexbuf
+ | _ ->
+ Buffer.add_string buffer (Ulexing.utf8_lexeme lexbuf) ;
+ level2_pattern_token_group counter buffer lexbuf
+
+let read_unparsed_group token_name lexbuf =
+ let buffer = Buffer.create 16 in
+ let begin_cnum, _ = Ulexing.loc lexbuf in
+ let end_cnum = level2_pattern_token_group 0 buffer lexbuf in
+ return_with_loc (token_name, Buffer.contents buffer) begin_cnum end_cnum
+
+let rec level2_meta_token =
+ lexer
+ | xml_blank+ -> level2_meta_token lexbuf
+ | ident ->
+ let s = Ulexing.utf8_lexeme lexbuf in
+ begin
+ if List.mem s level2_meta_keywords then
+ return lexbuf ("", s)
+ else
+ return lexbuf ("IDENT", s)
+ end
+ | "@{" -> read_unparsed_group "UNPARSED_AST" lexbuf
+ | ast_ident ->
+ return lexbuf ("UNPARSED_AST",
+ remove_left_quote (Ulexing.utf8_lexeme lexbuf))
+ | ast_csymbol ->
+ return lexbuf ("UNPARSED_AST",
+ remove_left_quote (Ulexing.utf8_lexeme lexbuf))
+ | eof -> return_eoi lexbuf
+
+let rec comment_token acc depth =
+ lexer
+ | beginnote ->
+ let acc = acc ^ Ulexing.utf8_lexeme lexbuf in
+ comment_token acc (depth + 1) lexbuf
+ | endcomment ->
+ let acc = acc ^ Ulexing.utf8_lexeme lexbuf in
+ if depth = 0
+ then acc
+ else comment_token acc (depth - 1) lexbuf
+ | _ ->
+ let acc = acc ^ Ulexing.utf8_lexeme lexbuf in
+ comment_token acc depth lexbuf
+
+ (** @param k continuation to be invoked when no ligature has been found *)
+let rec ligatures_token k =
+ lexer
+ | ligature ->
+ let lexeme = Ulexing.utf8_lexeme lexbuf in
+ (match List.rev (Hashtbl.find_all ligatures lexeme) with
+ | [] -> (* ligature not found, rollback and try default lexer *)
+ Ulexing.rollback lexbuf;
+ k lexbuf
+ | default_lig :: _ -> (* ligatures found, use the default one *)
+ return_symbol lexbuf default_lig)
+ | eof -> return_eoi lexbuf
+ | _ -> (* not a ligature, rollback and try default lexer *)
+ Ulexing.rollback lexbuf;
+ k lexbuf
+
+and level2_ast_token =
+ lexer
+ | xml_blank+ -> ligatures_token level2_ast_token lexbuf
+ | meta -> return lexbuf ("META", Ulexing.utf8_lexeme lexbuf)
+ | implicit -> return lexbuf ("IMPLICIT", "")
+ | placeholder -> return lexbuf ("PLACEHOLDER", "")
+ | ident ->
+ let lexeme = Ulexing.utf8_lexeme lexbuf in
+ if Hashtbl.mem level2_ast_keywords lexeme then
+ return lexbuf ("", lexeme)
+ else
+ return lexbuf ("IDENT", lexeme)
+ | number -> return lexbuf ("NUMBER", Ulexing.utf8_lexeme lexbuf)
+ | tex_token -> return lexbuf (expand_macro lexbuf)
+ | uri -> return lexbuf ("URI", Ulexing.utf8_lexeme lexbuf)
+ | qstring ->
+ return lexbuf ("QSTRING", remove_quotes (Ulexing.utf8_lexeme lexbuf))
+ | csymbol ->
+ return lexbuf ("CSYMBOL", remove_left_quote (Ulexing.utf8_lexeme lexbuf))
+ | "${" -> read_unparsed_group "UNPARSED_META" lexbuf
+ | "@{" -> read_unparsed_group "UNPARSED_AST" lexbuf
+ | '(' -> return lexbuf ("LPAREN", "")
+ | ')' -> return lexbuf ("RPAREN", "")
+ | meta_ident ->
+ return lexbuf ("UNPARSED_META",
+ remove_left_quote (Ulexing.utf8_lexeme lexbuf))
+ | meta_anonymous -> return lexbuf ("UNPARSED_META", "anonymous")
+ | beginnote ->
+ let _comment = comment_token (Ulexing.utf8_lexeme lexbuf) 0 lexbuf in
+(* let comment =
+ Ulexing.utf8_sub_lexeme lexbuf 2 (Ulexing.lexeme_length lexbuf - 4)
+ in
+ return lexbuf ("NOTE", comment) *)
+ ligatures_token level2_ast_token lexbuf
+ | begincomment -> return lexbuf ("BEGINCOMMENT","")
+ | endcomment -> return lexbuf ("ENDCOMMENT","")
+ | eof -> return_eoi lexbuf
+ | _ -> return_symbol lexbuf (Ulexing.utf8_lexeme lexbuf)
+
+and level1_pattern_token =
+ lexer
+ | xml_blank+ -> ligatures_token level1_pattern_token lexbuf
+ | number -> return lexbuf ("NUMBER", Ulexing.utf8_lexeme lexbuf)
+ | ident ->
+ let s = Ulexing.utf8_lexeme lexbuf in
+ begin
+ if List.mem s level1_keywords then
+ return lexbuf ("", s)
+ else
+ return lexbuf ("IDENT", s)
+ end
+ | tex_token -> return lexbuf (expand_macro lexbuf)
+ | qkeyword ->
+ return lexbuf ("QKEYWORD", remove_quotes (Ulexing.utf8_lexeme lexbuf))
+ | '(' -> return lexbuf ("LPAREN", "")
+ | ')' -> return lexbuf ("RPAREN", "")
+ | eof -> return_eoi lexbuf
+ | _ -> return_symbol lexbuf (Ulexing.utf8_lexeme lexbuf)
+
+let level1_pattern_token = ligatures_token level1_pattern_token
+let level2_ast_token = ligatures_token level2_ast_token
+
+(* API implementation *)
+
+let level1_pattern_lexer = mk_lexer level1_pattern_token
+let level2_ast_lexer = mk_lexer level2_ast_token
+let level2_meta_lexer = mk_lexer level2_meta_token
+
+let lookup_ligatures lexeme =
+ try
+ if lexeme.[0] = '\\'
+ then [ Utf8Macro.expand (String.sub lexeme 1 (String.length lexeme - 1)) ]
+ else List.rev (Hashtbl.find_all ligatures lexeme)
+ with Invalid_argument _ | Utf8Macro.Macro_not_found _ -> []
+
diff --git a/helm/ocaml/content_pres/cicNotationLexer.mli b/helm/ocaml/content_pres/cicNotationLexer.mli
new file mode 100644
index 000000000..cd5f0876d
--- /dev/null
+++ b/helm/ocaml/content_pres/cicNotationLexer.mli
@@ -0,0 +1,48 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+ (** begin of error offset (counted in unicode codepoint)
+ * end of error offset (counted as above)
+ * error message *)
+exception Error of int * int * string
+
+ (** XXX ZACK DEFCON 4 BEGIN: never use the tok_func field of the glexers below
+ * passing values of type char Stream.t, they should be in fact Ulexing.lexbuf
+ * casted with Obj.magic :-/ Read the comment in the .ml for the rationale *)
+
+val level1_pattern_lexer: (string * string) Token.glexer
+val level2_ast_lexer: (string * string) Token.glexer
+val level2_meta_lexer: (string * string) Token.glexer
+
+ (** XXX ZACK DEFCON 4 END *)
+
+val add_level2_ast_keyword: string -> unit (** non idempotent *)
+val remove_level2_ast_keyword: string -> unit (** non idempotent *)
+
+(** {2 Ligatures} *)
+
+val is_ligature_char: char -> bool
+val lookup_ligatures: string -> string list
+
diff --git a/helm/ocaml/content_pres/cicNotationParser.ml b/helm/ocaml/content_pres/cicNotationParser.ml
new file mode 100644
index 000000000..5750ad816
--- /dev/null
+++ b/helm/ocaml/content_pres/cicNotationParser.ml
@@ -0,0 +1,647 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+module Ast = CicNotationPt
+module Env = CicNotationEnv
+
+exception Parse_error of string
+exception Level_not_found of int
+
+let level1_pattern_grammar =
+ Grammar.gcreate CicNotationLexer.level1_pattern_lexer
+let level2_ast_grammar = Grammar.gcreate CicNotationLexer.level2_ast_lexer
+let level2_meta_grammar = Grammar.gcreate CicNotationLexer.level2_meta_lexer
+
+let min_precedence = 0
+let max_precedence = 100
+
+let level1_pattern =
+ Grammar.Entry.create level1_pattern_grammar "level1_pattern"
+let level2_ast = Grammar.Entry.create level2_ast_grammar "level2_ast"
+let term = Grammar.Entry.create level2_ast_grammar "term"
+let let_defs = Grammar.Entry.create level2_ast_grammar "let_defs"
+let level2_meta = Grammar.Entry.create level2_meta_grammar "level2_meta"
+
+let int_of_string s =
+ try
+ Pervasives.int_of_string s
+ with Failure _ ->
+ failwith (sprintf "Lexer failure: string_of_int \"%s\" failed" s)
+
+(** {2 Grammar extension} *)
+
+let gram_symbol s = Gramext.Stoken ("SYMBOL", s)
+let gram_ident s = Gramext.Stoken ("IDENT", s)
+let gram_number s = Gramext.Stoken ("NUMBER", s)
+let gram_keyword s = Gramext.Stoken ("", s)
+let gram_term = Gramext.Sself
+
+let gram_of_literal =
+ function
+ | `Symbol s -> gram_symbol s
+ | `Keyword s -> gram_keyword s
+ | `Number s -> gram_number s
+
+type binding =
+ | NoBinding
+ | Binding of string * Env.value_type
+ | Env of (string * Env.value_type) list
+
+let make_action action bindings =
+ let rec aux (vl : CicNotationEnv.t) =
+ function
+ [] -> Gramext.action (fun (loc: Ast.location) -> action vl loc)
+ | NoBinding :: tl -> Gramext.action (fun _ -> aux vl tl)
+ (* LUCA: DEFCON 3 BEGIN *)
+ | Binding (name, Env.TermType) :: tl ->
+ Gramext.action
+ (fun (v:Ast.term) ->
+ aux ((name, (Env.TermType, Env.TermValue v))::vl) tl)
+ | Binding (name, Env.StringType) :: tl ->
+ Gramext.action
+ (fun (v:string) ->
+ aux ((name, (Env.StringType, Env.StringValue v)) :: vl) tl)
+ | Binding (name, Env.NumType) :: tl ->
+ Gramext.action
+ (fun (v:string) ->
+ aux ((name, (Env.NumType, Env.NumValue v)) :: vl) tl)
+ | Binding (name, Env.OptType t) :: tl ->
+ Gramext.action
+ (fun (v:'a option) ->
+ aux ((name, (Env.OptType t, Env.OptValue v)) :: vl) tl)
+ | Binding (name, Env.ListType t) :: tl ->
+ Gramext.action
+ (fun (v:'a list) ->
+ aux ((name, (Env.ListType t, Env.ListValue v)) :: vl) tl)
+ | Env _ :: tl ->
+ Gramext.action (fun (v:CicNotationEnv.t) -> aux (v @ vl) tl)
+ (* LUCA: DEFCON 3 END *)
+ in
+ aux [] (List.rev bindings)
+
+let flatten_opt =
+ let rec aux acc =
+ function
+ [] -> List.rev acc
+ | NoBinding :: tl -> aux acc tl
+ | Env names :: tl -> aux (List.rev names @ acc) tl
+ | Binding (name, ty) :: tl -> aux ((name, ty) :: acc) tl
+ in
+ aux []
+
+ (* given a level 1 pattern computes the new RHS of "term" grammar entry *)
+let extract_term_production pattern =
+ let rec aux = function
+ | Ast.AttributedTerm (_, t) -> aux t
+ | Ast.Literal l -> aux_literal l
+ | Ast.Layout l -> aux_layout l
+ | Ast.Magic m -> aux_magic m
+ | Ast.Variable v -> aux_variable v
+ | t ->
+ prerr_endline (CicNotationPp.pp_term t);
+ assert false
+ and aux_literal =
+ function
+ | `Symbol s -> [NoBinding, gram_symbol s]
+ | `Keyword s ->
+ (* assumption: s will be registered as a keyword with the lexer *)
+ [NoBinding, gram_keyword s]
+ | `Number s -> [NoBinding, gram_number s]
+ and aux_layout = function
+ | Ast.Sub (p1, p2) -> aux p1 @ [NoBinding, gram_symbol "\\sub"] @ aux p2
+ | Ast.Sup (p1, p2) -> aux p1 @ [NoBinding, gram_symbol "\\sup"] @ aux p2
+ | Ast.Below (p1, p2) -> aux p1 @ [NoBinding, gram_symbol "\\below"] @ aux p2
+ | Ast.Above (p1, p2) -> aux p1 @ [NoBinding, gram_symbol "\\above"] @ aux p2
+ | Ast.Frac (p1, p2) -> aux p1 @ [NoBinding, gram_symbol "\\frac"] @ aux p2
+ | Ast.Atop (p1, p2) -> aux p1 @ [NoBinding, gram_symbol "\\atop"] @ aux p2
+ | Ast.Over (p1, p2) -> aux p1 @ [NoBinding, gram_symbol "\\over"] @ aux p2
+ | Ast.Root (p1, p2) ->
+ [NoBinding, gram_symbol "\\root"] @ aux p2
+ @ [NoBinding, gram_symbol "\\of"] @ aux p1
+ | Ast.Sqrt p -> [NoBinding, gram_symbol "\\sqrt"] @ aux p
+ | Ast.Break -> []
+ | Ast.Box (_, pl) -> List.flatten (List.map aux pl)
+ | Ast.Group pl -> List.flatten (List.map aux pl)
+ and aux_magic magic =
+ match magic with
+ | Ast.Opt p ->
+ let p_bindings, p_atoms, p_names, p_action = inner_pattern p in
+ let action (env_opt : CicNotationEnv.t option) (loc : Ast.location) =
+ match env_opt with
+ | Some env -> List.map Env.opt_binding_some env
+ | None -> List.map Env.opt_binding_of_name p_names
+ in
+ [ Env (List.map Env.opt_declaration p_names),
+ Gramext.srules
+ [ [ Gramext.Sopt (Gramext.srules [ p_atoms, p_action ]) ],
+ Gramext.action action ] ]
+ | Ast.List0 (p, _)
+ | Ast.List1 (p, _) ->
+ let p_bindings, p_atoms, p_names, p_action = inner_pattern p in
+(* let env0 = List.map list_binding_of_name p_names in
+ let grow_env_entry env n v =
+ List.map
+ (function
+ | (n', (ty, ListValue vl)) as entry ->
+ if n' = n then n', (ty, ListValue (v :: vl)) else entry
+ | _ -> assert false)
+ env
+ in
+ let grow_env env_i env =
+ List.fold_left
+ (fun env (n, (_, v)) -> grow_env_entry env n v)
+ env env_i
+ in *)
+ let action (env_list : CicNotationEnv.t list) (loc : Ast.location) =
+ CicNotationEnv.coalesce_env p_names env_list
+ in
+ let gram_of_list s =
+ match magic with
+ | Ast.List0 (_, None) -> Gramext.Slist0 s
+ | Ast.List1 (_, None) -> Gramext.Slist1 s
+ | Ast.List0 (_, Some l) -> Gramext.Slist0sep (s, gram_of_literal l)
+ | Ast.List1 (_, Some l) -> Gramext.Slist1sep (s, gram_of_literal l)
+ | _ -> assert false
+ in
+ [ Env (List.map Env.list_declaration p_names),
+ Gramext.srules
+ [ [ gram_of_list (Gramext.srules [ p_atoms, p_action ]) ],
+ Gramext.action action ] ]
+ | _ -> assert false
+ and aux_variable =
+ function
+ | Ast.NumVar s -> [Binding (s, Env.NumType), gram_number ""]
+ | Ast.TermVar s -> [Binding (s, Env.TermType), gram_term]
+ | Ast.IdentVar s -> [Binding (s, Env.StringType), gram_ident ""]
+ | Ast.Ascription (p, s) -> assert false (* TODO *)
+ | Ast.FreshVar _ -> assert false
+ and inner_pattern p =
+ let p_bindings, p_atoms = List.split (aux p) in
+ let p_names = flatten_opt p_bindings in
+ let action =
+ make_action (fun (env : CicNotationEnv.t) (loc : Ast.location) -> env)
+ p_bindings
+ in
+ p_bindings, p_atoms, p_names, action
+ in
+ aux pattern
+
+let level_of precedence associativity =
+ if precedence < min_precedence || precedence > max_precedence then
+ raise (Level_not_found precedence);
+ let assoc_string =
+ match associativity with
+ | Gramext.NonA -> "N"
+ | Gramext.LeftA -> "L"
+ | Gramext.RightA -> "R"
+ in
+ string_of_int precedence ^ assoc_string
+
+type rule_id = Token.t Gramext.g_symbol list
+
+ (* mapping: rule_id -> owned keywords. (rule_id, string list) Hashtbl.t *)
+let owned_keywords = Hashtbl.create 23
+
+let extend level1_pattern ~precedence ~associativity action =
+ let p_bindings, p_atoms =
+ List.split (extract_term_production level1_pattern)
+ in
+ let level = level_of precedence associativity in
+(* let p_names = flatten_opt p_bindings in *)
+ let _ =
+ Grammar.extend
+ [ Grammar.Entry.obj (term: 'a Grammar.Entry.e),
+ Some (Gramext.Level level),
+ [ None,
+ Some associativity,
+ [ p_atoms,
+ (make_action
+ (fun (env: CicNotationEnv.t) (loc: Ast.location) ->
+ (action env loc))
+ p_bindings) ]]]
+ in
+ let keywords = CicNotationUtil.keywords_of_term level1_pattern in
+ let rule_id = p_atoms in
+ List.iter CicNotationLexer.add_level2_ast_keyword keywords;
+ Hashtbl.add owned_keywords rule_id keywords; (* keywords may be [] *)
+ rule_id
+
+let delete rule_id =
+ let atoms = rule_id in
+ (try
+ let keywords = Hashtbl.find owned_keywords rule_id in
+ List.iter CicNotationLexer.remove_level2_ast_keyword keywords
+ with Not_found -> assert false);
+ Grammar.delete_rule term atoms
+
+(** {2 Grammar} *)
+
+let parse_level1_pattern_ref = ref (fun _ -> assert false)
+let parse_level2_ast_ref = ref (fun _ -> assert false)
+let parse_level2_meta_ref = ref (fun _ -> assert false)
+
+let fold_cluster binder terms ty body =
+ List.fold_right
+ (fun term body -> Ast.Binder (binder, (term, ty), body))
+ terms body (* terms are names: either Ident or FreshVar *)
+
+let fold_exists terms ty body =
+ List.fold_right
+ (fun term body ->
+ let lambda = Ast.Binder (`Lambda, (term, ty), body) in
+ Ast.Appl [ Ast.Symbol ("exists", 0); lambda ])
+ terms body
+
+let fold_binder binder pt_names body =
+ List.fold_right
+ (fun (names, ty) body -> fold_cluster binder names ty body)
+ pt_names body
+
+let return_term loc term = Ast.AttributedTerm (`Loc loc, term)
+
+ (* create empty precedence level for "term" *)
+let _ =
+ let dummy_action =
+ Gramext.action (fun _ ->
+ failwith "internal error, lexer generated a dummy token")
+ in
+ (* Needed since campl4 on "delete_rule" remove the precedence level if it gets
+ * empty after the deletion. The lexer never generate the Stoken below. *)
+ let dummy_prod = [ [ Gramext.Stoken ("DUMMY", "") ], dummy_action ] in
+ let mk_level_list first last =
+ let rec aux acc = function
+ | i when i < first -> acc
+ | i ->
+ aux
+ ((Some (string_of_int i ^ "N"), Some Gramext.NonA, dummy_prod)
+ :: (Some (string_of_int i ^ "L"), Some Gramext.LeftA, dummy_prod)
+ :: (Some (string_of_int i ^ "R"), Some Gramext.RightA, dummy_prod)
+ :: acc)
+ (i - 1)
+ in
+ aux [] last
+ in
+ Grammar.extend
+ [ Grammar.Entry.obj (term: 'a Grammar.Entry.e),
+ None,
+ mk_level_list min_precedence max_precedence ]
+
+(* {{{ Grammar for concrete syntax patterns, notation level 1 *)
+EXTEND
+ GLOBAL: level1_pattern;
+
+ level1_pattern: [ [ p = l1_pattern; EOI -> CicNotationUtil.boxify p ] ];
+ l1_pattern: [ [ p = LIST1 l1_simple_pattern -> p ] ];
+ literal: [
+ [ s = SYMBOL -> `Symbol s
+ | k = QKEYWORD -> `Keyword k
+ | n = NUMBER -> `Number n
+ ]
+ ];
+ sep: [ [ "sep"; sep = literal -> sep ] ];
+(* row_sep: [ [ "rowsep"; sep = literal -> sep ] ];
+ field_sep: [ [ "fieldsep"; sep = literal -> sep ] ]; *)
+ l1_magic_pattern: [
+ [ "list0"; p = l1_simple_pattern; sep = OPT sep -> Ast.List0 (p, sep)
+ | "list1"; p = l1_simple_pattern; sep = OPT sep -> Ast.List1 (p, sep)
+ | "opt"; p = l1_simple_pattern -> Ast.Opt p
+ ]
+ ];
+ l1_pattern_variable: [
+ [ "term"; id = IDENT -> Ast.TermVar id
+ | "number"; id = IDENT -> Ast.NumVar id
+ | "ident"; id = IDENT -> Ast.IdentVar id
+ ]
+ ];
+ l1_simple_pattern:
+ [ "layout" LEFTA
+ [ p1 = SELF; SYMBOL "\\sub"; p2 = SELF ->
+ return_term loc (Ast.Layout (Ast.Sub (p1, p2)))
+ | p1 = SELF; SYMBOL "\\sup"; p2 = SELF ->
+ return_term loc (Ast.Layout (Ast.Sup (p1, p2)))
+ | p1 = SELF; SYMBOL "\\below"; p2 = SELF ->
+ return_term loc (Ast.Layout (Ast.Below (p1, p2)))
+ | p1 = SELF; SYMBOL "\\above"; p2 = SELF ->
+ return_term loc (Ast.Layout (Ast.Above (p1, p2)))
+ | p1 = SELF; SYMBOL "\\over"; p2 = SELF ->
+ return_term loc (Ast.Layout (Ast.Over (p1, p2)))
+ | p1 = SELF; SYMBOL "\\atop"; p2 = SELF ->
+ return_term loc (Ast.Layout (Ast.Atop (p1, p2)))
+(* | "array"; p = SELF; csep = OPT field_sep; rsep = OPT row_sep ->
+ return_term loc (Array (p, csep, rsep)) *)
+ | SYMBOL "\\frac"; p1 = SELF; p2 = SELF ->
+ return_term loc (Ast.Layout (Ast.Frac (p1, p2)))
+ | SYMBOL "\\sqrt"; p = SELF -> return_term loc (Ast.Layout (Ast.Sqrt p))
+ | SYMBOL "\\root"; index = SELF; SYMBOL "\\of"; arg = SELF ->
+ return_term loc (Ast.Layout (Ast.Root (arg, index)))
+ | "hbox"; LPAREN; p = l1_pattern; RPAREN ->
+ return_term loc (Ast.Layout (Ast.Box ((Ast.H, false, false), p)))
+ | "vbox"; LPAREN; p = l1_pattern; RPAREN ->
+ return_term loc (Ast.Layout (Ast.Box ((Ast.V, false, false), p)))
+ | "hvbox"; LPAREN; p = l1_pattern; RPAREN ->
+ return_term loc (Ast.Layout (Ast.Box ((Ast.HV, false, false), p)))
+ | "hovbox"; LPAREN; p = l1_pattern; RPAREN ->
+ return_term loc (Ast.Layout (Ast.Box ((Ast.HOV, false, false), p)))
+ | "break" -> return_term loc (Ast.Layout Ast.Break)
+(* | SYMBOL "\\SPACE" -> return_term loc (Layout Space) *)
+ | LPAREN; p = l1_pattern; RPAREN ->
+ return_term loc (CicNotationUtil.group p)
+ ]
+ | "simple" NONA
+ [ i = IDENT -> return_term loc (Ast.Variable (Ast.TermVar i))
+ | m = l1_magic_pattern -> return_term loc (Ast.Magic m)
+ | v = l1_pattern_variable -> return_term loc (Ast.Variable v)
+ | l = literal -> return_term loc (Ast.Literal l)
+ ]
+ ];
+ END
+(* }}} *)
+
+(* {{{ Grammar for ast magics, notation level 2 *)
+EXTEND
+ GLOBAL: level2_meta;
+ l2_variable: [
+ [ "term"; id = IDENT -> Ast.TermVar id
+ | "number"; id = IDENT -> Ast.NumVar id
+ | "ident"; id = IDENT -> Ast.IdentVar id
+ | "fresh"; id = IDENT -> Ast.FreshVar id
+ | "anonymous" -> Ast.TermVar "_"
+ | id = IDENT -> Ast.TermVar id
+ ]
+ ];
+ l2_magic: [
+ [ "fold"; kind = [ "left" -> `Left | "right" -> `Right ];
+ base = level2_meta; "rec"; id = IDENT; recursive = level2_meta ->
+ Ast.Fold (kind, base, [id], recursive)
+ | "default"; some = level2_meta; none = level2_meta ->
+ Ast.Default (some, none)
+ | "if"; p_test = level2_meta;
+ "then"; p_true = level2_meta;
+ "else"; p_false = level2_meta ->
+ Ast.If (p_test, p_true, p_false)
+ | "fail" -> Ast.Fail
+ ]
+ ];
+ level2_meta: [
+ [ magic = l2_magic -> Ast.Magic magic
+ | var = l2_variable -> Ast.Variable var
+ | blob = UNPARSED_AST ->
+ !parse_level2_ast_ref (Ulexing.from_utf8_string blob)
+ ]
+ ];
+END
+(* }}} *)
+
+(* {{{ Grammar for ast patterns, notation level 2 *)
+EXTEND
+ GLOBAL: level2_ast term let_defs;
+ level2_ast: [ [ p = term -> p ] ];
+ sort: [
+ [ "Prop" -> `Prop
+ | "Set" -> `Set
+ | "Type" -> `Type (CicUniv.fresh ())
+ | "CProp" -> `CProp
+ ]
+ ];
+ explicit_subst: [
+ [ SYMBOL "\\subst"; (* to avoid catching frequent "a [1]" cases *)
+ SYMBOL "[";
+ substs = LIST1 [
+ i = IDENT; SYMBOL <:unicode<Assign>> (* â *); t = term -> (i, t)
+ ] SEP SYMBOL ";";
+ SYMBOL "]" ->
+ substs
+ ]
+ ];
+ meta_subst: [
+ [ s = SYMBOL "_" -> None
+ | p = term -> Some p ]
+ ];
+ meta_substs: [
+ [ SYMBOL "["; substs = LIST0 meta_subst; SYMBOL "]" -> substs ]
+ ];
+ possibly_typed_name: [
+ [ LPAREN; id = single_arg; SYMBOL ":"; typ = term; RPAREN ->
+ id, Some typ
+ | arg = single_arg -> arg, None
+ ]
+ ];
+ match_pattern: [
+ [ id = IDENT -> id, None, []
+ | LPAREN; id = IDENT; vars = LIST1 possibly_typed_name; RPAREN ->
+ id, None, vars
+ ]
+ ];
+ binder: [
+ [ SYMBOL <:unicode<Pi>> (* Î *) -> `Pi
+(* | SYMBOL <:unicode<exists>> |+ â +| -> `Exists *)
+ | SYMBOL <:unicode<forall>> (* â *) -> `Forall
+ | SYMBOL <:unicode<lambda>> (* λ *) -> `Lambda
+ ]
+ ];
+ arg: [
+ [ LPAREN; names = LIST1 IDENT SEP SYMBOL ",";
+ SYMBOL ":"; ty = term; RPAREN ->
+ List.map (fun n -> Ast.Ident (n, None)) names, Some ty
+ | name = IDENT -> [Ast.Ident (name, None)], None
+ | blob = UNPARSED_META ->
+ let meta = !parse_level2_meta_ref (Ulexing.from_utf8_string blob) in
+ match meta with
+ | Ast.Variable (Ast.FreshVar _) -> [meta], None
+ | Ast.Variable (Ast.TermVar "_") -> [Ast.Ident ("_", None)], None
+ | _ -> failwith "Invalid bound name."
+ ]
+ ];
+ single_arg: [
+ [ name = IDENT -> Ast.Ident (name, None)
+ | blob = UNPARSED_META ->
+ let meta = !parse_level2_meta_ref (Ulexing.from_utf8_string blob) in
+ match meta with
+ | Ast.Variable (Ast.FreshVar _)
+ | Ast.Variable (Ast.IdentVar _) -> meta
+ | Ast.Variable (Ast.TermVar "_") -> Ast.Ident ("_", None)
+ | _ -> failwith "Invalid index name."
+ ]
+ ];
+ induction_kind: [
+ [ "rec" -> `Inductive
+ | "corec" -> `CoInductive
+ ]
+ ];
+ let_defs: [
+ [ defs = LIST1 [
+ name = single_arg;
+ args = LIST1 arg;
+ index_name = OPT [ "on"; id = single_arg -> id ];
+ ty = OPT [ SYMBOL ":" ; p = term -> p ];
+ SYMBOL <:unicode<def>> (* â *); body = term ->
+ let body = fold_binder `Lambda args body in
+ let ty =
+ match ty with
+ | None -> None
+ | Some ty -> Some (fold_binder `Pi args ty)
+ in
+ let rec position_of name p = function
+ | [] -> None, p
+ | n :: _ when n = name -> Some p, p
+ | _ :: tl -> position_of name (p + 1) tl
+ in
+ let rec find_arg name n = function
+ | [] ->
+ Ast.fail loc (sprintf "Argument %s not found"
+ (CicNotationPp.pp_term name))
+ | (l,_) :: tl ->
+ (match position_of name 0 l with
+ | None, len -> find_arg name (n + len) tl
+ | Some where, len -> n + where)
+ in
+ let index =
+ match index_name with
+ | None -> 0
+ | Some index_name -> find_arg index_name 0 args
+ in
+ (name, ty), body, index
+ ] SEP "and" ->
+ defs
+ ]
+ ];
+ binder_vars: [
+ [ vars = [
+ l = LIST1 single_arg SEP SYMBOL "," -> l
+ | SYMBOL "_" -> [Ast.Ident ("_", None)] ];
+ typ = OPT [ SYMBOL ":"; t = term -> t ] -> (vars, typ)
+ | LPAREN;
+ vars = [
+ l = LIST1 single_arg SEP SYMBOL "," -> l
+ | SYMBOL "_" -> [Ast.Ident ("_", None)] ];
+ typ = OPT [ SYMBOL ":"; t = term -> t ];
+ RPAREN -> (vars, typ)
+ ]
+ ];
+ term: LEVEL "10N" [ (* let in *)
+ [ "let"; var = possibly_typed_name; SYMBOL <:unicode<def>> (* â *);
+ p1 = term; "in"; p2 = term ->
+ return_term loc (Ast.LetIn (var, p1, p2))
+ | "let"; k = induction_kind; defs = let_defs; "in";
+ body = term ->
+ return_term loc (Ast.LetRec (k, defs, body))
+ ]
+ ];
+ term: LEVEL "20R" (* binder *)
+ [
+ [ b = binder; (vars, typ) = binder_vars; SYMBOL "."; body = term ->
+ return_term loc (fold_cluster b vars typ body)
+ | SYMBOL <:unicode<exists>> (* â *);
+ (vars, typ) = binder_vars; SYMBOL "."; body = term ->
+ return_term loc (fold_exists vars typ body)
+ ]
+ ];
+ term: LEVEL "70L" (* apply *)
+ [
+ [ p1 = term; p2 = term ->
+ let rec aux = function
+ | Ast.Appl (hd :: tl)
+ | Ast.AttributedTerm (_, Ast.Appl (hd :: tl)) ->
+ aux hd @ tl
+ | term -> [term]
+ in
+ return_term loc (Ast.Appl (aux p1 @ [p2]))
+ ]
+ ];
+ term: LEVEL "90N" (* simple *)
+ [
+ [ id = IDENT -> return_term loc (Ast.Ident (id, None))
+ | id = IDENT; s = explicit_subst ->
+ return_term loc (Ast.Ident (id, Some s))
+ | s = CSYMBOL -> return_term loc (Ast.Symbol (s, 0))
+ | u = URI -> return_term loc (Ast.Uri (u, None))
+ | n = NUMBER -> return_term loc (Ast.Num (n, 0))
+ | IMPLICIT -> return_term loc (Ast.Implicit)
+ | PLACEHOLDER -> return_term loc Ast.UserInput
+ | m = META -> return_term loc (Ast.Meta (int_of_string m, []))
+ | m = META; s = meta_substs ->
+ return_term loc (Ast.Meta (int_of_string m, s))
+ | s = sort -> return_term loc (Ast.Sort s)
+ | "match"; t = term;
+ indty_ident = OPT [ "in"; id = IDENT -> id, None ];
+ outtyp = OPT [ "return"; ty = term -> ty ];
+ "with"; SYMBOL "[";
+ patterns = LIST0 [
+ lhs = match_pattern; SYMBOL <:unicode<Rightarrow>> (* â *);
+ rhs = term ->
+ lhs, rhs
+ ] SEP SYMBOL "|";
+ SYMBOL "]" ->
+ return_term loc (Ast.Case (t, indty_ident, outtyp, patterns))
+ | LPAREN; p1 = term; SYMBOL ":"; p2 = term; RPAREN ->
+ return_term loc (Ast.Cast (p1, p2))
+ | LPAREN; p = term; RPAREN -> p
+ | blob = UNPARSED_META ->
+ !parse_level2_meta_ref (Ulexing.from_utf8_string blob)
+ ]
+ ];
+END
+(* }}} *)
+
+(** {2 API implementation} *)
+
+let exc_located_wrapper f =
+ try
+ f ()
+ with
+ | Stdpp.Exc_located (floc, Stream.Error msg) ->
+ raise (HExtlib.Localized (floc, Parse_error msg))
+ | Stdpp.Exc_located (floc, exn) ->
+ raise (HExtlib.Localized (floc, (Parse_error (Printexc.to_string exn))))
+
+let parse_level1_pattern lexbuf =
+ exc_located_wrapper
+ (fun () -> Grammar.Entry.parse level1_pattern (Obj.magic lexbuf))
+
+let parse_level2_ast lexbuf =
+ exc_located_wrapper
+ (fun () -> Grammar.Entry.parse level2_ast (Obj.magic lexbuf))
+
+let parse_level2_meta lexbuf =
+ exc_located_wrapper
+ (fun () -> Grammar.Entry.parse level2_meta (Obj.magic lexbuf))
+
+let _ =
+ parse_level1_pattern_ref := parse_level1_pattern;
+ parse_level2_ast_ref := parse_level2_ast;
+ parse_level2_meta_ref := parse_level2_meta
+
+(** {2 Debugging} *)
+
+let print_l2_pattern () =
+ Grammar.print_entry Format.std_formatter (Grammar.Entry.obj term);
+ Format.pp_print_flush Format.std_formatter ();
+ flush stdout
+
+(* vim:set encoding=utf8 foldmethod=marker: *)
diff --git a/helm/ocaml/content_pres/cicNotationParser.mli b/helm/ocaml/content_pres/cicNotationParser.mli
new file mode 100644
index 000000000..e25968bbb
--- /dev/null
+++ b/helm/ocaml/content_pres/cicNotationParser.mli
@@ -0,0 +1,66 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+exception Parse_error of string
+exception Level_not_found of int
+
+(** {2 Parsing functions} *)
+
+ (** concrete syntax pattern: notation level 1 *)
+val parse_level1_pattern: Ulexing.lexbuf -> CicNotationPt.term
+
+ (** AST pattern: notation level 2 *)
+val parse_level2_ast: Ulexing.lexbuf -> CicNotationPt.term
+val parse_level2_meta: Ulexing.lexbuf -> CicNotationPt.term
+
+(** {2 Grammar extension} *)
+
+type rule_id
+
+val extend:
+ CicNotationPt.term -> (* level 1 pattern *)
+ precedence:int ->
+ associativity:Gramext.g_assoc ->
+ (CicNotationEnv.t -> CicNotationPt.location -> CicNotationPt.term) ->
+ rule_id
+
+val delete: rule_id -> unit
+
+(** {2 Grammar entries}
+ * needed by grafite parser *)
+
+val level2_ast_grammar: Grammar.g
+
+val term : CicNotationPt.term Grammar.Entry.e
+
+val let_defs :
+ (CicNotationPt.capture_variable * CicNotationPt.term * int) list
+ Grammar.Entry.e
+
+(** {2 Debugging} *)
+
+ (** print "level2_pattern" entry on stdout, flushing afterwards *)
+val print_l2_pattern: unit -> unit
+
diff --git a/helm/ocaml/content_pres/cicNotationPres.ml b/helm/ocaml/content_pres/cicNotationPres.ml
new file mode 100644
index 000000000..6412c3f0c
--- /dev/null
+++ b/helm/ocaml/content_pres/cicNotationPres.ml
@@ -0,0 +1,429 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+module Ast = CicNotationPt
+module Mpres = Mpresentation
+
+type mathml_markup = boxml_markup Mpres.mpres
+and boxml_markup = mathml_markup Box.box
+
+type markup = mathml_markup
+
+let atop_attributes = [None, "linethickness", "0pt"]
+
+let to_unicode = Utf8Macro.unicode_of_tex
+
+let rec make_attributes l1 = function
+ | [] -> []
+ | hd :: tl ->
+ (match hd with
+ | None -> make_attributes (List.tl l1) tl
+ | Some s ->
+ let p,n = List.hd l1 in
+ (p,n,s) :: make_attributes (List.tl l1) tl)
+
+let box_of_mpres =
+ function
+ | Mpresentation.Mobject (attrs, box) ->
+ assert (attrs = []);
+ box
+ | mpres -> Box.Object ([], mpres)
+
+let mpres_of_box =
+ function
+ | Box.Object (attrs, mpres) ->
+ assert (attrs = []);
+ mpres
+ | box -> Mpresentation.Mobject ([], box)
+
+let rec genuine_math =
+ function
+ | Mpresentation.Mobject ([], obj) -> not (genuine_box obj)
+ | _ -> true
+and genuine_box =
+ function
+ | Box.Object ([], mpres) -> not (genuine_math mpres)
+ | _ -> true
+
+let rec eligible_math =
+ function
+ | Mpresentation.Mobject ([], Box.Object ([], mpres)) -> eligible_math mpres
+ | Mpresentation.Mobject ([], _) -> false
+ | _ -> true
+
+let rec promote_to_math =
+ function
+ | Mpresentation.Mobject ([], Box.Object ([], mpres)) -> promote_to_math mpres
+ | math -> math
+
+let small_skip =
+ Mpresentation.Mspace (RenderingAttrs.small_skip_attributes `MathML)
+
+let rec add_mpres_attributes new_attr = function
+ | Mpresentation.Mobject (attr, box) ->
+ Mpresentation.Mobject (attr, add_box_attributes new_attr box)
+ | mpres ->
+ Mpresentation.set_attr (new_attr @ Mpresentation.get_attr mpres) mpres
+and add_box_attributes new_attr = function
+ | Box.Object (attr, mpres) ->
+ Box.Object (attr, add_mpres_attributes new_attr mpres)
+ | box -> Box.set_attr (new_attr @ Box.get_attr box) box
+
+let box_of mathonly spec attrs children =
+ match children with
+ | [t] -> add_mpres_attributes attrs t
+ | _ ->
+ let kind, spacing, indent = spec in
+ let dress children =
+ if spacing then
+ CicNotationUtil.dress small_skip children
+ else
+ children
+ in
+ if mathonly then Mpresentation.Mrow (attrs, dress children)
+ else
+ let attrs' =
+ (if spacing then RenderingAttrs.spacing_attributes `BoxML else [])
+ @ (if indent then RenderingAttrs.indent_attributes `BoxML else [])
+ @ attrs
+ in
+ match kind with
+ | Ast.H ->
+ if List.for_all eligible_math children then
+ Mpresentation.Mrow (attrs',
+ dress (List.map promote_to_math children))
+ else
+ mpres_of_box (Box.H (attrs',
+ List.map box_of_mpres children))
+(* | Ast.H when List.for_all genuine_math children ->
+ Mpresentation.Mrow (attrs', dress children) *)
+ | Ast.V ->
+ mpres_of_box (Box.V (attrs',
+ List.map box_of_mpres children))
+ | Ast.HV ->
+ mpres_of_box (Box.HV (attrs',
+ List.map box_of_mpres children))
+ | Ast.HOV ->
+ mpres_of_box (Box.HOV (attrs',
+ List.map box_of_mpres children))
+
+let open_paren = Mpresentation.Mo ([], "(")
+let closed_paren = Mpresentation.Mo ([], ")")
+let open_brace = Mpresentation.Mo ([], "{")
+let closed_brace = Mpresentation.Mo ([], "}")
+let hidden_substs = Mpresentation.Mtext ([], "{...}")
+let open_box_paren = Box.Text ([], "(")
+let closed_box_paren = Box.Text ([], ")")
+let semicolon = Mpresentation.Mo ([], ";")
+let toggle_action children =
+ Mpresentation.Maction ([None, "actiontype", "toggle"], children)
+
+type child_pos = [ `Left | `Right | `Inner ]
+
+let pp_assoc =
+ function
+ | Gramext.LeftA -> "LeftA"
+ | Gramext.RightA -> "RightA"
+ | Gramext.NonA -> "NonA"
+
+let is_atomic t =
+ let rec aux_mpres = function
+ | Mpres.Mi _
+ | Mpres.Mo _
+ | Mpres.Mn _
+ | Mpres.Ms _
+ | Mpres.Mtext _
+ | Mpres.Mspace _ -> true
+ | Mpres.Mobject (_, box) -> aux_box box
+ | Mpres.Maction (_, [mpres])
+ | Mpres.Mrow (_, [mpres]) -> aux_mpres mpres
+ | _ -> false
+ and aux_box = function
+ | Box.Space _
+ | Box.Ink _
+ | Box.Text _ -> true
+ | Box.Object (_, mpres) -> aux_mpres mpres
+ | Box.H (_, [box])
+ | Box.V (_, [box])
+ | Box.HV (_, [box])
+ | Box.HOV (_, [box])
+ | Box.Action (_, [box]) -> aux_box box
+ | _ -> false
+ in
+ aux_mpres t
+
+let add_parens child_prec child_assoc child_pos curr_prec t =
+ if is_atomic t then t
+ else if child_prec >= 0
+ && (child_prec < curr_prec
+ || (child_prec = curr_prec &&
+ child_assoc = Gramext.LeftA &&
+ child_pos = `Right)
+ || (child_prec = curr_prec &&
+ child_assoc = Gramext.RightA &&
+ child_pos = `Left))
+ then (* parens should be added *)
+(* (prerr_endline "adding parens";
+ prerr_endline (Printf.sprintf "child_prec = %d\nchild_assoc = %s\nchild_pos = %s\ncurr_prec= %d"
+ child_prec (pp_assoc child_assoc) (CicNotationPp.pp_pos
+ child_pos) curr_prec); *)
+ match t with
+ | Mpresentation.Mobject (_, box) ->
+ mpres_of_box (Box.H ([], [ open_box_paren; box; closed_box_paren ]))
+ | mpres -> Mpresentation.Mrow ([], [open_paren; t; closed_paren])
+ else
+ t
+
+let render ids_to_uris =
+ let module A = Ast in
+ let module P = Mpresentation in
+(* let use_unicode = true in *)
+ let lookup_uri id =
+ (try
+ let uri = Hashtbl.find ids_to_uris id in
+ Some (UriManager.string_of_uri uri)
+ with Not_found -> None)
+ in
+ let make_href xmlattrs xref =
+ let xref_uris =
+ List.fold_right
+ (fun xref uris ->
+ match lookup_uri xref with
+ | None -> uris
+ | Some uri -> uri :: uris)
+ !xref []
+ in
+ let xmlattrs_uris, xmlattrs =
+ let xref_attrs, other_attrs =
+ List.partition
+ (function Some "xlink", "href", _ -> true | _ -> false)
+ xmlattrs
+ in
+ List.map (fun (_, _, uri) -> uri) xref_attrs,
+ other_attrs
+ in
+ let uris =
+ match xmlattrs_uris @ xref_uris with
+ | [] -> None
+ | uris ->
+ Some (String.concat " "
+ (HExtlib.list_uniq (List.sort String.compare uris)))
+ in
+ let xrefs =
+ match !xref with [] -> None | xrefs -> Some (String.concat " " xrefs)
+ in
+ xref := [];
+ xmlattrs
+ @ make_attributes [Some "helm", "xref"; Some "xlink", "href"]
+ [xrefs; uris]
+ in
+ let make_xref xref =
+ let xrefs =
+ match !xref with [] -> None | xrefs -> Some (String.concat " " xrefs)
+ in
+ xref := [];
+ make_attributes [Some "helm","xref"] [xrefs]
+ in
+ (* when mathonly is true no boxes should be generated, only mrows *)
+ (* "xref" is *)
+ let rec aux xmlattrs mathonly xref pos prec t =
+ match t with
+ | A.AttributedTerm _ ->
+ aux_attributes xmlattrs mathonly xref pos prec t
+ | A.Num (literal, _) ->
+ let attrs =
+ (RenderingAttrs.number_attributes `MathML)
+ @ make_href xmlattrs xref
+ in
+ Mpres.Mn (attrs, literal)
+ | A.Symbol (literal, _) ->
+ let attrs =
+ (RenderingAttrs.symbol_attributes `MathML)
+ @ make_href xmlattrs xref
+ in
+ Mpres.Mo (attrs, to_unicode literal)
+ | A.Ident (literal, subst)
+ | A.Uri (literal, subst) ->
+ let attrs =
+ (RenderingAttrs.ident_attributes `MathML)
+ @ make_href xmlattrs xref
+ in
+ let name = Mpres.Mi (attrs, to_unicode literal) in
+ (match subst with
+ | Some []
+ | None -> name
+ | Some substs ->
+ let substs' =
+ box_of mathonly (A.H, false, false) []
+ (open_brace
+ :: (CicNotationUtil.dress semicolon
+ (List.map
+ (fun (name, t) ->
+ box_of mathonly (A.H, false, false) [] [
+ Mpres.Mi ([], name);
+ Mpres.Mo ([], to_unicode "\\def");
+ aux [] mathonly xref pos prec t ])
+ substs))
+ @ [ closed_brace ])
+ in
+ let substs_maction = toggle_action [ hidden_substs; substs' ] in
+ box_of mathonly (A.H, false, false) [] [ name; substs_maction ])
+ | A.Literal l -> aux_literal xmlattrs xref prec l
+ | A.UserInput -> Mpres.Mtext ([], "%")
+ | A.Layout l -> aux_layout mathonly xref pos prec l
+ | A.Magic _
+ | A.Variable _ -> assert false (* should have been instantiated *)
+ | t ->
+ prerr_endline ("unexpected ast: " ^ CicNotationPp.pp_term t);
+ assert false
+ and aux_attributes xmlattrs mathonly xref pos prec t =
+ let reset = ref false in
+ let new_level = ref None in
+ let new_xref = ref [] in
+ let new_xmlattrs = ref [] in
+ let new_pos = ref pos in
+(* let reinit = ref false in *)
+ let rec aux_attribute =
+ function
+ | A.AttributedTerm (attr, t) ->
+ (match attr with
+ | `Loc _
+ | `Raw _ -> ()
+ | `Level (-1, _) -> reset := true
+ | `Level (child_prec, child_assoc) ->
+ new_level := Some (child_prec, child_assoc)
+ | `IdRef xref -> new_xref := xref :: !new_xref
+ | `ChildPos pos -> new_pos := pos
+ | `XmlAttrs attrs -> new_xmlattrs := attrs @ !new_xmlattrs);
+ aux_attribute t
+ | t ->
+ (match !new_level with
+ | None -> aux !new_xmlattrs mathonly new_xref !new_pos prec t
+ | Some (child_prec, child_assoc) ->
+ let t' =
+ aux !new_xmlattrs mathonly new_xref !new_pos child_prec t
+ in
+ if !reset then t'
+ else add_parens child_prec child_assoc !new_pos prec t')
+ in
+ aux_attribute t
+ and aux_literal xmlattrs xref prec l =
+ let attrs = make_href xmlattrs xref in
+ (match l with
+ | `Symbol s -> Mpres.Mo (attrs, to_unicode s)
+ | `Keyword s -> Mpres.Mo (attrs, to_unicode s)
+ | `Number s -> Mpres.Mn (attrs, to_unicode s))
+ and aux_layout mathonly xref pos prec l =
+ let attrs = make_xref xref in
+ let invoke' t = aux [] true (ref []) pos prec t in
+ (* use the one below to reset precedence and associativity *)
+ let invoke_reinit t = aux [] mathonly xref `Inner ~-1 t in
+ match l with
+ | A.Sub (t1, t2) -> Mpres.Msub (attrs, invoke' t1, invoke_reinit t2)
+ | A.Sup (t1, t2) -> Mpres.Msup (attrs, invoke' t1, invoke_reinit t2)
+ | A.Below (t1, t2) -> Mpres.Munder (attrs, invoke' t1, invoke_reinit t2)
+ | A.Above (t1, t2) -> Mpres.Mover (attrs, invoke' t1, invoke_reinit t2)
+ | A.Frac (t1, t2)
+ | A.Over (t1, t2) ->
+ Mpres.Mfrac (attrs, invoke_reinit t1, invoke_reinit t2)
+ | A.Atop (t1, t2) ->
+ Mpres.Mfrac (atop_attributes @ attrs, invoke_reinit t1,
+ invoke_reinit t2)
+ | A.Sqrt t -> Mpres.Msqrt (attrs, invoke_reinit t)
+ | A.Root (t1, t2) ->
+ Mpres.Mroot (attrs, invoke_reinit t1, invoke_reinit t2)
+ | A.Box ((_, spacing, _) as kind, terms) ->
+ let children =
+ aux_children mathonly spacing xref pos prec
+ (CicNotationUtil.ungroup terms)
+ in
+ box_of mathonly kind attrs children
+ | A.Group terms ->
+ let children =
+ aux_children mathonly false xref pos prec
+ (CicNotationUtil.ungroup terms)
+ in
+ box_of mathonly (A.H, false, false) attrs children
+ | A.Break -> assert false (* TODO? *)
+ and aux_children mathonly spacing xref pos prec terms =
+ let find_clusters =
+ let rec aux_list first clusters acc =
+ function
+ [] when acc = [] -> List.rev clusters
+ | [] -> aux_list first (List.rev acc :: clusters) [] []
+ | (A.Layout A.Break) :: tl when acc = [] ->
+ aux_list first clusters [] tl
+ | (A.Layout A.Break) :: tl ->
+ aux_list first (List.rev acc :: clusters) [] tl
+ | [hd] ->
+(* let pos' =
+ if first then
+ pos
+ else
+ match pos with
+ `None -> `Right
+ | `Inner -> `Inner
+ | `Right -> `Right
+ | `Left -> `Inner
+ in *)
+ aux_list false clusters
+ (aux [] mathonly xref pos prec hd :: acc) []
+ | hd :: tl ->
+(* let pos' =
+ match pos, first with
+ `None, true -> `Left
+ | `None, false -> `Inner
+ | `Left, true -> `Left
+ | `Left, false -> `Inner
+ | `Right, _ -> `Inner
+ | `Inner, _ -> `Inner
+ in *)
+ aux_list false clusters
+ (aux [] mathonly xref pos prec hd :: acc) tl
+ in
+ aux_list true [] []
+ in
+ let boxify_pres =
+ function
+ [t] -> t
+ | tl -> box_of mathonly (A.H, spacing, false) [] tl
+ in
+ List.map boxify_pres (find_clusters terms)
+ in
+ aux [] false (ref []) `Inner ~-1
+
+let rec print_box (t: boxml_markup) =
+ Box.box2xml print_mpres t
+and print_mpres (t: mathml_markup) =
+ Mpresentation.print_mpres print_box t
+
+let print_xml = print_mpres
+
+(* let render_to_boxml id_to_uri t =
+ let xml_stream = print_box (box_of_mpres (render id_to_uri t)) in
+ Xml.add_xml_declaration xml_stream *)
+
diff --git a/helm/ocaml/content_pres/cicNotationPres.mli b/helm/ocaml/content_pres/cicNotationPres.mli
new file mode 100644
index 000000000..04411df2b
--- /dev/null
+++ b/helm/ocaml/content_pres/cicNotationPres.mli
@@ -0,0 +1,52 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+type mathml_markup = boxml_markup Mpresentation.mpres
+and boxml_markup = mathml_markup Box.box
+
+type markup = mathml_markup
+
+(** {2 Markup conversions} *)
+
+val mpres_of_box: boxml_markup -> mathml_markup
+val box_of_mpres: mathml_markup -> boxml_markup
+
+(** {2 Rendering} *)
+
+(** level 1 -> level 0
+ * @param ids_to_uris mapping id -> uri for hyperlinking *)
+val render: (Cic.id, UriManager.uri) Hashtbl.t -> CicNotationPt.term -> markup
+
+(** level 0 -> xml stream *)
+val print_xml: markup -> Xml.token Stream.t
+
+(* |+* level 1 -> xml stream
+ * @param ids_to_uris +|
+val render_to_boxml:
+ (Cic.id, string) Hashtbl.t -> CicNotationPt.term -> Xml.token Stream.t *)
+
+val print_box: boxml_markup -> Xml.token Stream.t
+val print_mpres: mathml_markup -> Xml.token Stream.t
+
diff --git a/helm/ocaml/content_pres/content2pres.ml b/helm/ocaml/content_pres/content2pres.ml
new file mode 100644
index 000000000..948eb7b9a
--- /dev/null
+++ b/helm/ocaml/content_pres/content2pres.ml
@@ -0,0 +1,817 @@
+(* Copyright (C) 2003-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(***************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Andrea Asperti <asperti@cs.unibo.it> *)
+(* 17/06/2003 *)
+(* *)
+(***************************************************************************)
+
+(* $Id$ *)
+
+module P = Mpresentation
+module B = Box
+module Con = Content
+
+let p_mtr a b = Mpresentation.Mtr(a,b)
+let p_mtd a b = Mpresentation.Mtd(a,b)
+let p_mtable a b = Mpresentation.Mtable(a,b)
+let p_mtext a b = Mpresentation.Mtext(a,b)
+let p_mi a b = Mpresentation.Mi(a,b)
+let p_mo a b = Mpresentation.Mo(a,b)
+let p_mrow a b = Mpresentation.Mrow(a,b)
+let p_mphantom a b = Mpresentation.Mphantom(a,b)
+
+let rec split n l =
+ if n = 0 then [],l
+ else let l1,l2 =
+ split (n-1) (List.tl l) in
+ (List.hd l)::l1,l2
+
+let get_xref = function
+ | `Declaration d
+ | `Hypothesis d -> d.Con.dec_id
+ | `Proof p -> p.Con.proof_id
+ | `Definition d -> d.Con.def_id
+ | `Joint jo -> jo.Con.joint_id
+
+let hv_attrs =
+ RenderingAttrs.spacing_attributes `BoxML
+ @ RenderingAttrs.indent_attributes `BoxML
+
+let make_row items concl =
+ B.b_hv hv_attrs (items @ [ concl ])
+(* match concl with
+ B.V _ -> |+ big! +|
+ B.b_v attrs [B.b_h [] items; B.b_indent concl]
+ | _ -> |+ small +|
+ B.b_h attrs (items@[B.b_space; concl]) *)
+
+let make_concl ?(attrs=[]) verb concl =
+ B.b_hv (hv_attrs @ attrs) [ B.b_kw verb; concl ]
+(* match concl with
+ B.V _ -> |+ big! +|
+ B.b_v attrs [ B.b_kw verb; B.b_indent concl]
+ | _ -> |+ small +|
+ B.b_h attrs [ B.b_kw verb; B.b_space; concl ] *)
+
+let make_args_for_apply term2pres args =
+ let make_arg_for_apply is_first arg row =
+ let res =
+ match arg with
+ Con.Aux n -> assert false
+ | Con.Premise prem ->
+ let name =
+ (match prem.Con.premise_binder with
+ None -> "previous"
+ | Some s -> s) in
+ (B.b_object (P.Mi ([], name)))::row
+ | Con.Lemma lemma ->
+ let lemma_attrs = [
+ Some "helm", "xref", lemma.Con.lemma_id;
+ Some "xlink", "href", lemma.Con.lemma_uri ]
+ in
+ (B.b_object (P.Mi(lemma_attrs,lemma.Con.lemma_name)))::row
+ | Con.Term t ->
+ if is_first then
+ (term2pres t)::row
+ else (B.b_object (P.Mi([],"_")))::row
+ | Con.ArgProof _
+ | Con.ArgMethod _ ->
+ (B.b_object (P.Mi([],"_")))::row
+ in
+ if is_first then res else B.skip::res
+ in
+ match args with
+ hd::tl ->
+ make_arg_for_apply true hd
+ (List.fold_right (make_arg_for_apply false) tl [])
+ | _ -> assert false
+
+let get_name = function
+ | Some s -> s
+ | None -> "_"
+
+let add_xref id = function
+ | B.Text (attrs, t) -> B.Text (((Some "helm", "xref", id) :: attrs), t)
+ | _ -> assert false (* TODO, add_xref is meaningful for all boxes *)
+
+let rec justification term2pres p =
+ if ((p.Con.proof_conclude.Con.conclude_method = "Exact") or
+ ((p.Con.proof_context = []) &
+ (p.Con.proof_apply_context = []) &
+ (p.Con.proof_conclude.Con.conclude_method = "Apply"))) then
+ let pres_args =
+ make_args_for_apply term2pres p.Con.proof_conclude.Con.conclude_args in
+ B.H([],
+ (B.b_kw "by")::B.b_space::
+ B.Text([],"(")::pres_args@[B.Text([],")")])
+ else proof2pres term2pres p
+
+and proof2pres term2pres p =
+ let rec proof2pres p =
+ let indent =
+ let is_decl e =
+ (match e with
+ `Declaration _
+ | `Hypothesis _ -> true
+ | _ -> false) in
+ ((List.filter is_decl p.Con.proof_context) != []) in
+ let omit_conclusion = (not indent) && (p.Con.proof_context != []) in
+ let concl =
+ (match p.Con.proof_conclude.Con.conclude_conclusion with
+ None -> None
+ | Some t -> Some (term2pres t)) in
+ let body =
+ let presconclude =
+ conclude2pres p.Con.proof_conclude indent omit_conclusion in
+ let presacontext =
+ acontext2pres p.Con.proof_apply_context presconclude indent in
+ context2pres p.Con.proof_context presacontext in
+ match p.Con.proof_name with
+ None -> body
+ | Some name ->
+ let action =
+ match concl with
+ None -> body
+ | Some ac ->
+ B.Action
+ ([None,"type","toggle"],
+ [(make_concl ~attrs:[Some "helm", "xref", p.Con.proof_id]
+ "proof of" ac); body])
+ in
+ B.V ([],
+ [B.Text ([],"(" ^ name ^ ")");
+ B.indent action])
+
+ and context2pres c continuation =
+ (* we generate a subtable for each context element, for selection
+ purposes
+ The table generated by the head-element does not have an xref;
+ the whole context-proof is already selectable *)
+ match c with
+ [] -> continuation
+ | hd::tl ->
+ let continuation' =
+ List.fold_right
+ (fun ce continuation ->
+ let xref = get_xref ce in
+ B.V([Some "helm", "xref", xref ],
+ [B.H([Some "helm", "xref", "ce_"^xref],
+ [ce2pres_in_proof_context_element ce]);
+ continuation])) tl continuation in
+ let hd_xref= get_xref hd in
+ B.V([],
+ [B.H([Some "helm", "xref", "ce_"^hd_xref],
+ [ce2pres_in_proof_context_element hd]);
+ continuation'])
+
+ and ce2pres_in_joint_context_element = function
+ | `Inductive _ -> assert false (* TODO *)
+ | (`Declaration _) as x -> ce2pres x
+ | (`Hypothesis _) as x -> ce2pres x
+ | (`Proof _) as x -> ce2pres x
+ | (`Definition _) as x -> ce2pres x
+
+ and ce2pres_in_proof_context_element = function
+ | `Joint ho ->
+ B.H ([],(List.map ce2pres_in_joint_context_element ho.Content.joint_defs))
+ | (`Declaration _) as x -> ce2pres x
+ | (`Hypothesis _) as x -> ce2pres x
+ | (`Proof _) as x -> ce2pres x
+ | (`Definition _) as x -> ce2pres x
+
+ and ce2pres =
+ function
+ `Declaration d ->
+ (match d.Con.dec_name with
+ Some s ->
+ let ty = term2pres d.Con.dec_type in
+ B.H ([],
+ [(B.b_kw "Assume");
+ B.b_space;
+ B.Object ([], P.Mi([],s));
+ B.Text([],":");
+ ty])
+ | None ->
+ prerr_endline "NO NAME!!"; assert false)
+ | `Hypothesis h ->
+ (match h.Con.dec_name with
+ Some s ->
+ let ty = term2pres h.Con.dec_type in
+ B.H ([],
+ [(B.b_kw "Suppose");
+ B.b_space;
+ B.Text([],"(");
+ B.Object ([], P.Mi ([],s));
+ B.Text([],")");
+ B.b_space;
+ ty])
+ | None ->
+ prerr_endline "NO NAME!!"; assert false)
+ | `Proof p ->
+ proof2pres p
+ | `Definition d ->
+ (match d.Con.def_name with
+ Some s ->
+ let term = term2pres d.Con.def_term in
+ B.H ([],
+ [ B.b_kw "Let"; B.b_space;
+ B.Object ([], P.Mi([],s));
+ B.Text([]," = ");
+ term])
+ | None ->
+ prerr_endline "NO NAME!!"; assert false)
+
+ and acontext2pres ac continuation indent =
+ List.fold_right
+ (fun p continuation ->
+ let hd =
+ if indent then
+ B.indent (proof2pres p)
+ else
+ proof2pres p in
+ B.V([Some "helm","xref",p.Con.proof_id],
+ [B.H([Some "helm","xref","ace_"^p.Con.proof_id],[hd]);
+ continuation])) ac continuation
+
+ and conclude2pres conclude indent omit_conclusion =
+ let tconclude_body =
+ match conclude.Con.conclude_conclusion with
+ Some t when
+ not omit_conclusion or
+ (* CSC: I ignore the omit_conclusion flag in this case. *)
+ (* CSC: Is this the correct behaviour? In the stylesheets *)
+ (* CSC: we simply generated nothing (i.e. the output type *)
+ (* CSC: of the function should become an option. *)
+ conclude.Con.conclude_method = "BU_Conversion" ->
+ let concl = (term2pres t) in
+ if conclude.Con.conclude_method = "BU_Conversion" then
+ make_concl "that is equivalent to" concl
+ else if conclude.Con.conclude_method = "FalseInd" then
+ (* false ind is in charge to add the conclusion *)
+ falseind conclude
+ else
+ let conclude_body = conclude_aux conclude in
+ let ann_concl =
+ if conclude.Con.conclude_method = "TD_Conversion" then
+ make_concl "that is equivalent to" concl
+ else make_concl "we conclude" concl in
+ B.V ([], [conclude_body; ann_concl])
+ | _ -> conclude_aux conclude in
+ if indent then
+ B.indent (B.H ([Some "helm", "xref", conclude.Con.conclude_id],
+ [tconclude_body]))
+ else
+ B.H ([Some "helm", "xref", conclude.Con.conclude_id],[tconclude_body])
+
+ and conclude_aux conclude =
+ if conclude.Con.conclude_method = "TD_Conversion" then
+ let expected =
+ (match conclude.Con.conclude_conclusion with
+ None -> B.Text([],"NO EXPECTED!!!")
+ | Some c -> term2pres c) in
+ let subproof =
+ (match conclude.Con.conclude_args with
+ [Con.ArgProof p] -> p
+ | _ -> assert false) in
+ let synth =
+ (match subproof.Con.proof_conclude.Con.conclude_conclusion with
+ None -> B.Text([],"NO SYNTH!!!")
+ | Some c -> (term2pres c)) in
+ B.V
+ ([],
+ [make_concl "we must prove" expected;
+ make_concl "or equivalently" synth;
+ proof2pres subproof])
+ else if conclude.Con.conclude_method = "BU_Conversion" then
+ assert false
+ else if conclude.Con.conclude_method = "Exact" then
+ let arg =
+ (match conclude.Con.conclude_args with
+ [Con.Term t] -> term2pres t
+ | [Con.Premise p] ->
+ (match p.Con.premise_binder with
+ | None -> assert false; (* unnamed hypothesis ??? *)
+ | Some s -> B.Text([],s))
+ | err -> assert false) in
+ (match conclude.Con.conclude_conclusion with
+ None ->
+ B.b_h [] [B.b_kw "Consider"; B.b_space; arg]
+ | Some c -> let conclusion = term2pres c in
+ make_row
+ [arg; B.b_space; B.b_kw "proves"]
+ conclusion
+ )
+ else if conclude.Con.conclude_method = "Intros+LetTac" then
+ (match conclude.Con.conclude_args with
+ [Con.ArgProof p] -> proof2pres p
+ | _ -> assert false)
+(* OLD CODE
+ let conclusion =
+ (match conclude.Con.conclude_conclusion with
+ None -> B.Text([],"NO Conclusion!!!")
+ | Some c -> term2pres c) in
+ (match conclude.Con.conclude_args with
+ [Con.ArgProof p] ->
+ B.V
+ ([None,"align","baseline 1"; None,"equalrows","false";
+ None,"columnalign","left"],
+ [B.H([],[B.Object([],proof2pres p)]);
+ B.H([],[B.Object([],
+ (make_concl "we proved 1" conclusion))])]);
+ | _ -> assert false)
+*)
+ else if (conclude.Con.conclude_method = "Case") then
+ case conclude
+ else if (conclude.Con.conclude_method = "ByInduction") then
+ byinduction conclude
+ else if (conclude.Con.conclude_method = "Exists") then
+ exists conclude
+ else if (conclude.Con.conclude_method = "AndInd") then
+ andind conclude
+ else if (conclude.Con.conclude_method = "FalseInd") then
+ falseind conclude
+ else if (conclude.Con.conclude_method = "Rewrite") then
+ let justif =
+ (match (List.nth conclude.Con.conclude_args 6) with
+ Con.ArgProof p -> justification term2pres p
+ | _ -> assert false) in
+ let term1 =
+ (match List.nth conclude.Con.conclude_args 2 with
+ Con.Term t -> term2pres t
+ | _ -> assert false) in
+ let term2 =
+ (match List.nth conclude.Con.conclude_args 5 with
+ Con.Term t -> term2pres t
+ | _ -> assert false) in
+ B.V ([],
+ [B.H ([],[
+ (B.b_kw "rewrite");
+ B.b_space; term1;
+ B.b_space; (B.b_kw "with");
+ B.b_space; term2;
+ B.indent justif])])
+ else if conclude.Con.conclude_method = "Apply" then
+ let pres_args =
+ make_args_for_apply term2pres conclude.Con.conclude_args in
+ B.H([],
+ (B.b_kw "by")::
+ B.b_space::
+ B.Text([],"(")::pres_args@[B.Text([],")")])
+ else
+ B.V ([], [
+ B.b_kw ("Apply method" ^ conclude.Con.conclude_method ^ " to");
+ (B.indent (B.V ([], args2pres conclude.Con.conclude_args)))])
+
+ and args2pres l = List.map arg2pres l
+
+ and arg2pres =
+ function
+ Con.Aux n -> B.b_kw ("aux " ^ n)
+ | Con.Premise prem -> B.b_kw "premise"
+ | Con.Lemma lemma -> B.b_kw "lemma"
+ | Con.Term t -> term2pres t
+ | Con.ArgProof p -> proof2pres p
+ | Con.ArgMethod s -> B.b_kw "method"
+
+ and case conclude =
+ let proof_conclusion =
+ (match conclude.Con.conclude_conclusion with
+ None -> B.b_kw "No conclusion???"
+ | Some t -> term2pres t) in
+ let arg,args_for_cases =
+ (match conclude.Con.conclude_args with
+ Con.Aux(_)::Con.Aux(_)::Con.Term(_)::arg::tl ->
+ arg,tl
+ | _ -> assert false) in
+ let case_on =
+ let case_arg =
+ (match arg with
+ Con.Aux n -> B.b_kw "an aux???"
+ | Con.Premise prem ->
+ (match prem.Con.premise_binder with
+ None -> B.b_kw "the previous result"
+ | Some n -> B.Object ([], P.Mi([],n)))
+ | Con.Lemma lemma -> B.Object ([], P.Mi([],lemma.Con.lemma_name))
+ | Con.Term t ->
+ term2pres t
+ | Con.ArgProof p -> B.b_kw "a proof???"
+ | Con.ArgMethod s -> B.b_kw "a method???")
+ in
+ (make_concl "we proceed by cases on" case_arg) in
+ let to_prove =
+ (make_concl "to prove" proof_conclusion) in
+ B.V ([], case_on::to_prove::(make_cases args_for_cases))
+
+ and byinduction conclude =
+ let proof_conclusion =
+ (match conclude.Con.conclude_conclusion with
+ None -> B.b_kw "No conclusion???"
+ | Some t -> term2pres t) in
+ let inductive_arg,args_for_cases =
+ (match conclude.Con.conclude_args with
+ Con.Aux(n)::_::tl ->
+ let l1,l2 = split (int_of_string n) tl in
+ let last_pos = (List.length l2)-1 in
+ List.nth l2 last_pos,l1
+ | _ -> assert false) in
+ let induction_on =
+ let arg =
+ (match inductive_arg with
+ Con.Aux n -> B.b_kw "an aux???"
+ | Con.Premise prem ->
+ (match prem.Con.premise_binder with
+ None -> B.b_kw "the previous result"
+ | Some n -> B.Object ([], P.Mi([],n)))
+ | Con.Lemma lemma -> B.Object ([], P.Mi([],lemma.Con.lemma_name))
+ | Con.Term t ->
+ term2pres t
+ | Con.ArgProof p -> B.b_kw "a proof???"
+ | Con.ArgMethod s -> B.b_kw "a method???") in
+ (make_concl "we proceed by induction on" arg) in
+ let to_prove =
+ (make_concl "to prove" proof_conclusion) in
+ B.V ([], induction_on::to_prove:: (make_cases args_for_cases))
+
+ and make_cases l = List.map make_case l
+
+ and make_case =
+ function
+ Con.ArgProof p ->
+ let name =
+ (match p.Con.proof_name with
+ None -> B.b_kw "no name for case!!"
+ | Some n -> B.Object ([], P.Mi([],n))) in
+ let indhyps,args =
+ List.partition
+ (function
+ `Hypothesis h -> h.Con.dec_inductive
+ | _ -> false) p.Con.proof_context in
+ let pattern_aux =
+ List.fold_right
+ (fun e p ->
+ let dec =
+ (match e with
+ `Declaration h
+ | `Hypothesis h ->
+ let name =
+ (match h.Con.dec_name with
+ None -> "NO NAME???"
+ | Some n ->n) in
+ [B.b_space;
+ B.Object ([], P.Mi ([],name));
+ B.Text([],":");
+ (term2pres h.Con.dec_type)]
+ | _ -> [B.Text ([],"???")]) in
+ dec@p) args [] in
+ let pattern =
+ B.H ([],
+ (B.b_kw "Case"::B.b_space::name::pattern_aux)@
+ [B.b_space;
+ B.Text([], Utf8Macro.unicode_of_tex "\\Rightarrow")]) in
+ let subconcl =
+ (match p.Con.proof_conclude.Con.conclude_conclusion with
+ None -> B.b_kw "No conclusion!!!"
+ | Some t -> term2pres t) in
+ let asubconcl = B.indent (make_concl "the thesis becomes" subconcl) in
+ let induction_hypothesis =
+ (match indhyps with
+ [] -> []
+ | _ ->
+ let text = B.indent (B.b_kw "by induction hypothesis we know") in
+ let make_hyp =
+ function
+ `Hypothesis h ->
+ let name =
+ (match h.Con.dec_name with
+ None -> "no name"
+ | Some s -> s) in
+ B.indent (B.H ([],
+ [B.Text([],"(");
+ B.Object ([], P.Mi ([],name));
+ B.Text([],")");
+ B.b_space;
+ term2pres h.Con.dec_type]))
+ | _ -> assert false in
+ let hyps = List.map make_hyp indhyps in
+ text::hyps) in
+ (* let acontext =
+ acontext2pres_old p.Con.proof_apply_context true in *)
+ let body = conclude2pres p.Con.proof_conclude true false in
+ let presacontext =
+ let acontext_id =
+ match p.Con.proof_apply_context with
+ [] -> p.Con.proof_conclude.Con.conclude_id
+ | {Con.proof_id = id}::_ -> id
+ in
+ B.Action([None,"type","toggle"],
+ [ B.indent (add_xref acontext_id (B.b_kw "Proof"));
+ acontext2pres p.Con.proof_apply_context body true]) in
+ B.V ([], pattern::asubconcl::induction_hypothesis@[presacontext])
+ | _ -> assert false
+
+ and falseind conclude =
+ let proof_conclusion =
+ (match conclude.Con.conclude_conclusion with
+ None -> B.b_kw "No conclusion???"
+ | Some t -> term2pres t) in
+ let case_arg =
+ (match conclude.Con.conclude_args with
+ [Con.Aux(n);_;case_arg] -> case_arg
+ | _ -> assert false;
+ (*
+ List.map (ContentPp.parg 0) conclude.Con.conclude_args;
+ assert false *)) in
+ let arg =
+ (match case_arg with
+ Con.Aux n -> assert false
+ | Con.Premise prem ->
+ (match prem.Con.premise_binder with
+ None -> [B.b_kw "Contradiction, hence"]
+ | Some n ->
+ [ B.Object ([],P.Mi([],n)); B.skip;
+ B.b_kw "is contradictory, hence"])
+ | Con.Lemma lemma ->
+ [ B.Object ([], P.Mi([],lemma.Con.lemma_name)); B.skip;
+ B.b_kw "is contradictory, hence" ]
+ | _ -> assert false) in
+ (* let body = proof2pres {proof with Con.proof_context = tl} in *)
+ make_row arg proof_conclusion
+
+ and andind conclude =
+ let proof,case_arg =
+ (match conclude.Con.conclude_args with
+ [Con.Aux(n);_;Con.ArgProof proof;case_arg] -> proof,case_arg
+ | _ -> assert false;
+ (*
+ List.map (ContentPp.parg 0) conclude.Con.conclude_args;
+ assert false *)) in
+ let arg =
+ (match case_arg with
+ Con.Aux n -> assert false
+ | Con.Premise prem ->
+ (match prem.Con.premise_binder with
+ None -> []
+ | Some n -> [(B.b_kw "by"); B.b_space; B.Object([], P.Mi([],n))])
+ | Con.Lemma lemma ->
+ [(B.b_kw "by");B.skip;
+ B.Object([], P.Mi([],lemma.Con.lemma_name))]
+ | _ -> assert false) in
+ match proof.Con.proof_context with
+ `Hypothesis hyp1::`Hypothesis hyp2::tl ->
+ let get_name hyp =
+ (match hyp.Con.dec_name with
+ None -> "_"
+ | Some s -> s) in
+ let preshyp1 =
+ B.H ([],
+ [B.Text([],"(");
+ B.Object ([], P.Mi([],get_name hyp1));
+ B.Text([],")");
+ B.skip;
+ term2pres hyp1.Con.dec_type]) in
+ let preshyp2 =
+ B.H ([],
+ [B.Text([],"(");
+ B.Object ([], P.Mi([],get_name hyp2));
+ B.Text([],")");
+ B.skip;
+ term2pres hyp2.Con.dec_type]) in
+ (* let body = proof2pres {proof with Con.proof_context = tl} in *)
+ let body = conclude2pres proof.Con.proof_conclude false true in
+ let presacontext =
+ acontext2pres proof.Con.proof_apply_context body false in
+ B.V
+ ([],
+ [B.H ([],arg@[B.skip; B.b_kw "we have"]);
+ preshyp1;
+ B.b_kw "and";
+ preshyp2;
+ presacontext]);
+ | _ -> assert false
+
+ and exists conclude =
+ let proof =
+ (match conclude.Con.conclude_args with
+ [Con.Aux(n);_;Con.ArgProof proof;_] -> proof
+ | _ -> assert false;
+ (*
+ List.map (ContentPp.parg 0) conclude.Con.conclude_args;
+ assert false *)) in
+ match proof.Con.proof_context with
+ `Declaration decl::`Hypothesis hyp::tl
+ | `Hypothesis decl::`Hypothesis hyp::tl ->
+ let get_name decl =
+ (match decl.Con.dec_name with
+ None -> "_"
+ | Some s -> s) in
+ let presdecl =
+ B.H ([],
+ [(B.b_kw "let");
+ B.skip;
+ B.Object ([], P.Mi([],get_name decl));
+ B.Text([],":"); term2pres decl.Con.dec_type]) in
+ let suchthat =
+ B.H ([],
+ [(B.b_kw "such that");
+ B.skip;
+ B.Text([],"(");
+ B.Object ([], P.Mi([],get_name hyp));
+ B.Text([],")");
+ B.skip;
+ term2pres hyp.Con.dec_type]) in
+ (* let body = proof2pres {proof with Con.proof_context = tl} in *)
+ let body = conclude2pres proof.Con.proof_conclude false true in
+ let presacontext =
+ acontext2pres proof.Con.proof_apply_context body false in
+ B.V
+ ([],
+ [presdecl;
+ suchthat;
+ presacontext]);
+ | _ -> assert false
+
+ in
+ proof2pres p
+
+exception ToDo
+
+let counter = ref 0
+
+let conjecture2pres term2pres (id, n, context, ty) =
+ (B.b_h [Some "helm", "xref", id]
+ (((List.map
+ (function
+ | None ->
+ B.b_h []
+ [ B.b_object (p_mi [] "_") ;
+ B.b_object (p_mo [] ":?") ;
+ B.b_object (p_mi [] "_")]
+ | Some (`Declaration d)
+ | Some (`Hypothesis d) ->
+ let { Content.dec_name =
+ dec_name ; Content.dec_type = ty } = d
+ in
+ B.b_h []
+ [ B.b_object
+ (p_mi []
+ (match dec_name with
+ None -> "_"
+ | Some n -> n));
+ B.b_text [] ":";
+ term2pres ty ]
+ | Some (`Definition d) ->
+ let
+ { Content.def_name = def_name ;
+ Content.def_term = bo } = d
+ in
+ B.b_h []
+ [ B.b_object (p_mi []
+ (match def_name with
+ None -> "_"
+ | Some n -> n)) ;
+ B.b_text [] (Utf8Macro.unicode_of_tex "\\Assign");
+ term2pres bo]
+ | Some (`Proof p) ->
+ let proof_name = p.Content.proof_name in
+ B.b_h []
+ [ B.b_object (p_mi []
+ (match proof_name with
+ None -> "_"
+ | Some n -> n)) ;
+ B.b_text [] (Utf8Macro.unicode_of_tex "\\Assign");
+ proof2pres term2pres p])
+ (List.rev context)) @
+ [ B.b_text [] (Utf8Macro.unicode_of_tex "\\vdash");
+ B.b_object (p_mi [] (string_of_int n)) ;
+ B.b_text [] ":" ;
+ term2pres ty ])))
+
+let metasenv2pres term2pres = function
+ | None -> []
+ | Some metasenv' ->
+ (* Conjectures are in their own table to make *)
+ (* diffing the DOM trees easier. *)
+ [B.b_v []
+ ((B.b_kw ("Conjectures:" ^
+ (let _ = incr counter; in (string_of_int !counter)))) ::
+ (List.map (conjecture2pres term2pres) metasenv'))]
+
+let params2pres params =
+ let param2pres uri =
+ B.b_text [Some "xlink", "href", UriManager.string_of_uri uri]
+ (UriManager.name_of_uri uri)
+ in
+ let rec spatiate = function
+ | [] -> []
+ | hd :: [] -> [hd]
+ | hd :: tl -> hd :: B.b_text [] ", " :: spatiate tl
+ in
+ match params with
+ | [] -> []
+ | p ->
+ let params = spatiate (List.map param2pres p) in
+ [B.b_space;
+ B.b_h [] (B.b_text [] "[" :: params @ [ B.b_text [] "]" ])]
+
+let recursion_kind2pres params kind =
+ let kind =
+ match kind with
+ | `Recursive _ -> "Recursive definition"
+ | `CoRecursive -> "CoRecursive definition"
+ | `Inductive _ -> "Inductive definition"
+ | `CoInductive _ -> "CoInductive definition"
+ in
+ B.b_h [] (B.b_kw kind :: params2pres params)
+
+let inductive2pres term2pres ind =
+ let constructor2pres decl =
+ B.b_h [] [
+ B.b_text [] ("| " ^ get_name decl.Content.dec_name ^ ":");
+ B.b_space;
+ term2pres decl.Content.dec_type
+ ]
+ in
+ B.b_v []
+ (B.b_h [] [
+ B.b_kw (ind.Content.inductive_name ^ " of arity");
+ B.smallskip;
+ term2pres ind.Content.inductive_type ]
+ :: List.map constructor2pres ind.Content.inductive_constructors)
+
+let joint_def2pres term2pres def =
+ match def with
+ | `Inductive ind -> inductive2pres term2pres ind
+ | _ -> assert false (* ZACK or raise ToDo? *)
+
+let content2pres term2pres (id,params,metasenv,obj) =
+ match obj with
+ | `Def (Content.Const, thesis, `Proof p) ->
+ let name = get_name p.Content.proof_name in
+ B.b_v
+ [Some "helm","xref","id"]
+ ([ B.b_h [] (B.b_kw ("Proof " ^ name) :: params2pres params);
+ B.b_kw "Thesis:";
+ B.indent (term2pres thesis) ] @
+ metasenv2pres term2pres metasenv @
+ [proof2pres term2pres p])
+ | `Def (_, ty, `Definition body) ->
+ let name = get_name body.Content.def_name in
+ B.b_v
+ [Some "helm","xref","id"]
+ ([B.b_h [] (B.b_kw ("Definition " ^ name) :: params2pres params);
+ B.b_kw "Type:";
+ B.indent (term2pres ty)] @
+ metasenv2pres term2pres metasenv @
+ [B.b_kw "Body:"; term2pres body.Content.def_term])
+ | `Decl (_, `Declaration decl)
+ | `Decl (_, `Hypothesis decl) ->
+ let name = get_name decl.Content.dec_name in
+ B.b_v
+ [Some "helm","xref","id"]
+ ([B.b_h [] (B.b_kw ("Axiom " ^ name) :: params2pres params);
+ B.b_kw "Type:";
+ B.indent (term2pres decl.Content.dec_type)] @
+ metasenv2pres term2pres metasenv)
+ | `Joint joint ->
+ B.b_v []
+ (recursion_kind2pres params joint.Content.joint_kind
+ :: List.map (joint_def2pres term2pres) joint.Content.joint_defs)
+ | _ -> raise ToDo
+
+let content2pres ~ids_to_inner_sorts =
+ content2pres
+ (fun annterm ->
+ let ast, ids_to_uris =
+ TermAcicContent.ast_of_acic ids_to_inner_sorts annterm
+ in
+ CicNotationPres.box_of_mpres
+ (CicNotationPres.render ids_to_uris
+ (TermContentPres.pp_ast ast)))
+
diff --git a/helm/ocaml/content_pres/content2pres.mli b/helm/ocaml/content_pres/content2pres.mli
new file mode 100644
index 000000000..793c31a4f
--- /dev/null
+++ b/helm/ocaml/content_pres/content2pres.mli
@@ -0,0 +1,39 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(**************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Andrea Asperti <asperti@cs.unibo.it> *)
+(* 27/6/2003 *)
+(* *)
+(**************************************************************************)
+
+val content2pres:
+ ids_to_inner_sorts:(Cic.id, Cic2acic.sort_kind) Hashtbl.t ->
+ Cic.annterm Content.cobj ->
+ CicNotationPres.boxml_markup
+
diff --git a/helm/ocaml/content_pres/content2presMatcher.ml b/helm/ocaml/content_pres/content2presMatcher.ml
new file mode 100644
index 000000000..7e080ea69
--- /dev/null
+++ b/helm/ocaml/content_pres/content2presMatcher.ml
@@ -0,0 +1,233 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+module Ast = CicNotationPt
+module Env = CicNotationEnv
+module Pp = CicNotationPp
+module Util = CicNotationUtil
+
+let get_tag term0 =
+ let subterms = ref [] in
+ let map_term t =
+ subterms := t :: !subterms ;
+ Ast.Implicit
+ in
+ let rec aux t = CicNotationUtil.visit_ast ~special_k map_term t
+ and special_k = function
+ | Ast.AttributedTerm (_, t) -> aux t
+ | _ -> assert false
+ in
+ let term_mask = aux term0 in
+ let tag = Hashtbl.hash term_mask in
+ tag, List.rev !subterms
+
+module Matcher21 =
+struct
+ module Pattern21 =
+ struct
+ type pattern_t = Ast.term
+ type term_t = Ast.term
+ let rec classify = function
+ | Ast.AttributedTerm (_, t) -> classify t
+ | Ast.Variable _ -> PatternMatcher.Variable
+ | Ast.Magic _
+ | Ast.Layout _
+ | Ast.Literal _ -> assert false
+ | _ -> PatternMatcher.Constructor
+ let tag_of_pattern = get_tag
+ let tag_of_term t = get_tag t
+ let string_of_term = CicNotationPp.pp_term
+ let string_of_pattern = CicNotationPp.pp_term
+ end
+
+ module M = PatternMatcher.Matcher (Pattern21)
+
+ let extract_magic term =
+ let magic_map = ref [] in
+ let add_magic m =
+ let name = Util.fresh_name () in
+ magic_map := (name, m) :: !magic_map;
+ Ast.Variable (Ast.TermVar name)
+ in
+ let rec aux = function
+ | Ast.AttributedTerm (_, t) -> assert false
+ | Ast.Literal _
+ | Ast.Layout _ -> assert false
+ | Ast.Variable v -> Ast.Variable v
+ | Ast.Magic m -> add_magic m
+ | t -> Util.visit_ast aux t
+ in
+ let term' = aux term in
+ term', !magic_map
+
+ let env_of_matched pl tl =
+ try
+ List.map2
+ (fun p t ->
+ match p, t with
+ Ast.Variable (Ast.TermVar name), _ ->
+ name, (Env.TermType, Env.TermValue t)
+ | Ast.Variable (Ast.NumVar name), (Ast.Num (s, _)) ->
+ name, (Env.NumType, Env.NumValue s)
+ | Ast.Variable (Ast.IdentVar name), (Ast.Ident (s, None)) ->
+ name, (Env.StringType, Env.StringValue s)
+ | _ -> assert false)
+ pl tl
+ with Invalid_argument _ -> assert false
+
+ let rec compiler rows =
+ let rows', magic_maps =
+ List.split
+ (List.map
+ (fun (p, pid) ->
+ let p', map = extract_magic p in
+ (p', pid), (pid, map))
+ rows)
+ in
+ let magichecker map =
+ List.fold_left
+ (fun f (name, m) ->
+ let m_checker = compile_magic m in
+ (fun env ctors ->
+ match m_checker (Env.lookup_term env name) env ctors with
+ | None -> None
+ | Some (env, ctors) -> f env ctors))
+ (fun env ctors -> Some (env, ctors))
+ map
+ in
+ let magichooser candidates =
+ List.fold_left
+ (fun f (pid, pl, checker) ->
+ (fun matched_terms constructors ->
+ let env = env_of_matched pl matched_terms in
+ match checker env constructors with
+ | None -> f matched_terms constructors
+ | Some (env, ctors') ->
+ let magic_map =
+ try List.assoc pid magic_maps with Not_found -> assert false
+ in
+ let env' = Env.remove_names env (List.map fst magic_map) in
+ Some (env', ctors', pid)))
+ (fun _ _ -> None)
+ (List.rev candidates)
+ in
+ let match_cb rows =
+ let candidates =
+ List.map
+ (fun (pl, pid) ->
+ let magic_map =
+ try List.assoc pid magic_maps with Not_found -> assert false
+ in
+ pid, pl, magichecker magic_map)
+ rows
+ in
+ magichooser candidates
+ in
+ M.compiler rows' match_cb (fun _ -> None)
+
+ and compile_magic = function
+ | Ast.Fold (kind, p_base, names, p_rec) ->
+ let p_rec_decls = Env.declarations_of_term p_rec in
+ (* LUCA: p_rec_decls should not contain "names" *)
+ let acc_name = try List.hd names with Failure _ -> assert false in
+ let compiled_base = compiler [p_base, 0]
+ and compiled_rec = compiler [p_rec, 0] in
+ (fun term env ctors ->
+ let aux_base term =
+ match compiled_base term with
+ | None -> None
+ | Some (env', ctors', _) -> Some (env', ctors', [])
+ in
+ let rec aux term =
+ match compiled_rec term with
+ | None -> aux_base term
+ | Some (env', ctors', _) ->
+ begin
+ let acc = Env.lookup_term env' acc_name in
+ let env'' = Env.remove_name env' acc_name in
+ match aux acc with
+ | None -> aux_base term
+ | Some (base_env, ctors', rec_envl) ->
+ let ctors'' = ctors' @ ctors in
+ Some (base_env, ctors'',env'' :: rec_envl)
+ end
+ in
+ match aux term with
+ | None -> None
+ | Some (base_env, ctors, rec_envl) ->
+ let env' =
+ base_env @ Env.coalesce_env p_rec_decls rec_envl @ env
+ (* @ env LUCA!!! *)
+ in
+ Some (env', ctors))
+
+ | Ast.Default (p_some, p_none) -> (* p_none can't bound names *)
+ let p_some_decls = Env.declarations_of_term p_some in
+ let p_none_decls = Env.declarations_of_term p_none in
+ let p_opt_decls =
+ List.filter
+ (fun decl -> not (List.mem decl p_none_decls))
+ p_some_decls
+ in
+ let none_env = List.map Env.opt_binding_of_name p_opt_decls in
+ let compiled = compiler [p_some, 0] in
+ (fun term env ctors ->
+ match compiled term with
+ | None -> Some (none_env, ctors) (* LUCA: @ env ??? *)
+ | Some (env', ctors', 0) ->
+ let env' =
+ List.map
+ (fun (name, (ty, v)) as binding ->
+ if List.exists (fun (name', _) -> name = name') p_opt_decls
+ then Env.opt_binding_some binding
+ else binding)
+ env'
+ in
+ Some (env' @ env, ctors' @ ctors)
+ | _ -> assert false)
+
+ | Ast.If (p_test, p_true, p_false) ->
+ let compiled_test = compiler [p_test, 0]
+ and compiled_true = compiler [p_true, 0]
+ and compiled_false = compiler [p_false, 0] in
+ (fun term env ctors ->
+ let branch =
+ match compiled_test term with
+ | None -> compiled_false
+ | Some _ -> compiled_true
+ in
+ match branch term with
+ | None -> None
+ | Some (env', ctors', _) -> Some (env' @ env, ctors' @ ctors))
+
+ | Ast.Fail -> (fun _ _ _ -> None)
+
+ | _ -> assert false
+end
+
diff --git a/helm/ocaml/content_pres/content2presMatcher.mli b/helm/ocaml/content_pres/content2presMatcher.mli
new file mode 100644
index 000000000..86b97b6d8
--- /dev/null
+++ b/helm/ocaml/content_pres/content2presMatcher.mli
@@ -0,0 +1,34 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+module Matcher21:
+sig
+ (** @param l2_patterns level 2 (AST) patterns *)
+ val compiler :
+ (CicNotationPt.term * int) list ->
+ (CicNotationPt.term ->
+ (CicNotationEnv.t * CicNotationPt.term list * int) option)
+end
+
diff --git a/helm/ocaml/content_pres/mpresentation.ml b/helm/ocaml/content_pres/mpresentation.ml
new file mode 100644
index 000000000..1aa5db129
--- /dev/null
+++ b/helm/ocaml/content_pres/mpresentation.ml
@@ -0,0 +1,258 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(**************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Andrea Asperti <asperti@cs.unibo.it> *)
+(* 16/62003 *)
+(* *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+type 'a mpres =
+ Mi of attr * string
+ | Mn of attr * string
+ | Mo of attr * string
+ | Mtext of attr * string
+ | Mspace of attr
+ | Ms of attr * string
+ | Mgliph of attr * string
+ | Mrow of attr * 'a mpres list
+ | Mfrac of attr * 'a mpres * 'a mpres
+ | Msqrt of attr * 'a mpres
+ | Mroot of attr * 'a mpres * 'a mpres
+ | Mstyle of attr * 'a mpres
+ | Merror of attr * 'a mpres
+ | Mpadded of attr * 'a mpres
+ | Mphantom of attr * 'a mpres
+ | Mfenced of attr * 'a mpres list
+ | Menclose of attr * 'a mpres
+ | Msub of attr * 'a mpres * 'a mpres
+ | Msup of attr * 'a mpres * 'a mpres
+ | Msubsup of attr * 'a mpres * 'a mpres *'a mpres
+ | Munder of attr * 'a mpres * 'a mpres
+ | Mover of attr * 'a mpres * 'a mpres
+ | Munderover of attr * 'a mpres * 'a mpres *'a mpres
+(* | Multiscripts of ??? NOT IMPLEMEMENTED *)
+ | Mtable of attr * 'a row list
+ | Maction of attr * 'a mpres list
+ | Mobject of attr * 'a
+and 'a row = Mtr of attr * 'a mtd list
+and 'a mtd = Mtd of attr * 'a mpres
+and attr = (string option * string * string) list
+;;
+
+let smallskip = Mspace([None,"width","0.5em"]);;
+let indentation = Mspace([None,"width","1em"]);;
+
+let indented elem =
+ Mrow([],[indentation;elem]);;
+
+let standard_tbl_attr =
+ [None,"align","baseline 1";None,"equalrows","false";None,"columnalign","left"]
+;;
+
+let two_rows_table attr a b =
+ Mtable(attr@standard_tbl_attr,
+ [Mtr([],[Mtd([],a)]);
+ Mtr([],[Mtd([],b)])]);;
+
+let two_rows_table_with_brackets attr a b op =
+ (* only the open bracket is added; the closed bracket must be in b *)
+ Mtable(attr@standard_tbl_attr,
+ [Mtr([],[Mtd([],Mrow([],[Mtext([],"(");a]))]);
+ Mtr([],[Mtd([],Mrow([],[indentation;op;b]))])]);;
+
+let two_rows_table_without_brackets attr a b op =
+ Mtable(attr@standard_tbl_attr,
+ [Mtr([],[Mtd([],a)]);
+ Mtr([],[Mtd([],Mrow([],[indentation;op;b]))])]);;
+
+let row_with_brackets attr a b op =
+ (* by analogy with two_rows_table_with_brackets we only add the
+ open brackets *)
+ Mrow(attr,[Mtext([],"(");a;op;b;Mtext([],")")])
+
+let row_without_brackets attr a b op =
+ Mrow(attr,[a;op;b])
+
+(* MathML prefix *)
+let prefix = "m";;
+
+let print_mpres obj_printer mpres =
+ let module X = Xml in
+ let rec aux =
+ function
+ Mi (attr,s) -> X.xml_nempty ~prefix "mi" attr (X.xml_cdata s)
+ | Mn (attr,s) -> X.xml_nempty ~prefix "mn" attr (X.xml_cdata s)
+ | Mo (attr,s) ->
+ let s =
+ let len = String.length s in
+ if len > 1 && s.[0] = '\\'
+ then String.sub s 1 (len - 1)
+ else s
+ in
+ X.xml_nempty ~prefix "mo" attr (X.xml_cdata s)
+ | Mtext (attr,s) -> X.xml_nempty ~prefix "mtext" attr (X.xml_cdata s)
+ | Mspace attr -> X.xml_empty ~prefix "mspace" attr
+ | Ms (attr,s) -> X.xml_nempty ~prefix "ms" attr (X.xml_cdata s)
+ | Mgliph (attr,s) -> X.xml_nempty ~prefix "mgliph" attr (X.xml_cdata s)
+ (* General Layout Schemata *)
+ | Mrow (attr,l) ->
+ X.xml_nempty ~prefix "mrow" attr
+ [< (List.fold_right (fun x i -> [< (aux x) ; i >]) l [<>])
+ >]
+ | Mfrac (attr,m1,m2) ->
+ X.xml_nempty ~prefix "mfrac" attr [< aux m1; aux m2 >]
+ | Msqrt (attr,m) ->
+ X.xml_nempty ~prefix "msqrt" attr [< aux m >]
+ | Mroot (attr,m1,m2) ->
+ X.xml_nempty ~prefix "mroot" attr [< aux m1; aux m2 >]
+ | Mstyle (attr,m) -> X.xml_nempty ~prefix "mstyle" attr [< aux m >]
+ | Merror (attr,m) -> X.xml_nempty ~prefix "merror" attr [< aux m >]
+ | Mpadded (attr,m) -> X.xml_nempty ~prefix "mpadded" attr [< aux m >]
+ | Mphantom (attr,m) -> X.xml_nempty ~prefix "mphantom" attr [< aux m >]
+ | Mfenced (attr,l) ->
+ X.xml_nempty ~prefix "mfenced" attr
+ [< (List.fold_right (fun x i -> [< (aux x) ; i >]) l [<>])
+ >]
+ | Menclose (attr,m) -> X.xml_nempty ~prefix "menclose" attr [< aux m >]
+ (* Script and Limit Schemata *)
+ | Msub (attr,m1,m2) ->
+ X.xml_nempty ~prefix "msub" attr [< aux m1; aux m2 >]
+ | Msup (attr,m1,m2) ->
+ X.xml_nempty ~prefix "msup" attr [< aux m1; aux m2 >]
+ | Msubsup (attr,m1,m2,m3) ->
+ X.xml_nempty ~prefix "msubsup" attr [< aux m1; aux m2; aux m3 >]
+ | Munder (attr,m1,m2) ->
+ X.xml_nempty ~prefix "munder" attr [< aux m1; aux m2 >]
+ | Mover (attr,m1,m2) ->
+ X.xml_nempty ~prefix "mover" attr [< aux m1; aux m2 >]
+ | Munderover (attr,m1,m2,m3) ->
+ X.xml_nempty ~prefix "munderover" attr [< aux m1; aux m2; aux m3 >]
+ (* | Multiscripts of ??? NOT IMPLEMEMENTED *)
+ (* Tables and Matrices *)
+ | Mtable (attr, rl) ->
+ X.xml_nempty ~prefix "mtable" attr
+ [< (List.fold_right (fun x i -> [< (aux_mrow x) ; i >]) rl [<>]) >]
+ (* Enlivening Expressions *)
+ | Maction (attr, l) ->
+ X.xml_nempty ~prefix "maction" attr
+ [< (List.fold_right (fun x i -> [< (aux x) ; i >]) l [<>]) >]
+ | Mobject (attr, obj) ->
+ let box_stream = obj_printer obj in
+ X.xml_nempty ~prefix "semantics" attr
+ [< X.xml_nempty ~prefix "annotation-xml" [None, "encoding", "BoxML"]
+ box_stream >]
+
+ and aux_mrow =
+ let module X = Xml in
+ function
+ Mtr (attr, l) ->
+ X.xml_nempty ~prefix "mtr" attr
+ [< (List.fold_right (fun x i -> [< (aux_mtd x) ; i >]) l [<>])
+ >]
+ and aux_mtd =
+ let module X = Xml in
+ function
+ Mtd (attr,m) -> X.xml_nempty ~prefix "mtd" attr
+ [< (aux m) ;
+ X.xml_nempty ~prefix "mphantom" []
+ (X.xml_nempty ~prefix "mtext" [] (X.xml_cdata "(")) >]
+ in
+ aux mpres
+;;
+
+let document_of_mpres pres =
+ [< Xml.xml_cdata "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n" ;
+ Xml.xml_cdata "\n";
+ Xml.xml_nempty ~prefix "math"
+ [Some "xmlns","m","http://www.w3.org/1998/Math/MathML" ;
+ Some "xmlns","helm","http://www.cs.unibo.it/helm" ;
+ Some "xmlns","xlink","http://www.w3.org/1999/xlink"
+ ] (Xml.xml_nempty ~prefix "mstyle" [None, "mathvariant", "normal"; None,
+ "rowspacing", "0.6ex"] (print_mpres (fun _ -> assert false) pres))
+ >]
+
+let get_attr = function
+ | Maction (attr, _)
+ | Menclose (attr, _)
+ | Merror (attr, _)
+ | Mfenced (attr, _)
+ | Mfrac (attr, _, _)
+ | Mgliph (attr, _)
+ | Mi (attr, _)
+ | Mn (attr, _)
+ | Mo (attr, _)
+ | Mobject (attr, _)
+ | Mover (attr, _, _)
+ | Mpadded (attr, _)
+ | Mphantom (attr, _)
+ | Mroot (attr, _, _)
+ | Mrow (attr, _)
+ | Ms (attr, _)
+ | Mspace attr
+ | Msqrt (attr, _)
+ | Mstyle (attr, _)
+ | Msub (attr, _, _)
+ | Msubsup (attr, _, _, _)
+ | Msup (attr, _, _)
+ | Mtable (attr, _)
+ | Mtext (attr, _)
+ | Munder (attr, _, _)
+ | Munderover (attr, _, _, _) ->
+ attr
+
+let set_attr attr = function
+ | Maction (_, x) -> Maction (attr, x)
+ | Menclose (_, x) -> Menclose (attr, x)
+ | Merror (_, x) -> Merror (attr, x)
+ | Mfenced (_, x) -> Mfenced (attr, x)
+ | Mfrac (_, x, y) -> Mfrac (attr, x, y)
+ | Mgliph (_, x) -> Mgliph (attr, x)
+ | Mi (_, x) -> Mi (attr, x)
+ | Mn (_, x) -> Mn (attr, x)
+ | Mo (_, x) -> Mo (attr, x)
+ | Mobject (_, x) -> Mobject (attr, x)
+ | Mover (_, x, y) -> Mover (attr, x, y)
+ | Mpadded (_, x) -> Mpadded (attr, x)
+ | Mphantom (_, x) -> Mphantom (attr, x)
+ | Mroot (_, x, y) -> Mroot (attr, x, y)
+ | Mrow (_, x) -> Mrow (attr, x)
+ | Ms (_, x) -> Ms (attr, x)
+ | Mspace _ -> Mspace attr
+ | Msqrt (_, x) -> Msqrt (attr, x)
+ | Mstyle (_, x) -> Mstyle (attr, x)
+ | Msub (_, x, y) -> Msub (attr, x, y)
+ | Msubsup (_, x, y, z) -> Msubsup (attr, x, y, z)
+ | Msup (_, x, y) -> Msup (attr, x, y)
+ | Mtable (_, x) -> Mtable (attr, x)
+ | Mtext (_, x) -> Mtext (attr, x)
+ | Munder (_, x, y) -> Munder (attr, x, y)
+ | Munderover (_, x, y, z) -> Munderover (attr, x, y, z)
+
diff --git a/helm/ocaml/content_pres/mpresentation.mli b/helm/ocaml/content_pres/mpresentation.mli
new file mode 100644
index 000000000..8252517a6
--- /dev/null
+++ b/helm/ocaml/content_pres/mpresentation.mli
@@ -0,0 +1,86 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+type 'a mpres =
+ (* token elements *)
+ Mi of attr * string
+ | Mn of attr * string
+ | Mo of attr * string
+ | Mtext of attr * string
+ | Mspace of attr
+ | Ms of attr * string
+ | Mgliph of attr * string
+ (* General Layout Schemata *)
+ | Mrow of attr * 'a mpres list
+ | Mfrac of attr * 'a mpres * 'a mpres
+ | Msqrt of attr * 'a mpres
+ | Mroot of attr * 'a mpres * 'a mpres
+ | Mstyle of attr * 'a mpres
+ | Merror of attr * 'a mpres
+ | Mpadded of attr * 'a mpres
+ | Mphantom of attr * 'a mpres
+ | Mfenced of attr * 'a mpres list
+ | Menclose of attr * 'a mpres
+ (* Script and Limit Schemata *)
+ | Msub of attr * 'a mpres * 'a mpres
+ | Msup of attr * 'a mpres * 'a mpres
+ | Msubsup of attr * 'a mpres * 'a mpres *'a mpres
+ | Munder of attr * 'a mpres * 'a mpres
+ | Mover of attr * 'a mpres * 'a mpres
+ | Munderover of attr * 'a mpres * 'a mpres *'a mpres
+ (* Tables and Matrices *)
+ | Mtable of attr * 'a row list
+ (* Enlivening Expressions *)
+ | Maction of attr * 'a mpres list
+ (* Embedding *)
+ | Mobject of attr * 'a
+
+and 'a row = Mtr of attr * 'a mtd list
+
+and 'a mtd = Mtd of attr * 'a mpres
+
+ (** XML attribute: namespace, name, value *)
+and attr = (string option * string * string) list
+
+;;
+
+val get_attr: 'a mpres -> attr
+val set_attr: attr -> 'a mpres -> 'a mpres
+
+val smallskip : 'a mpres
+val indented : 'a mpres -> 'a mpres
+val standard_tbl_attr : attr
+val two_rows_table : attr -> 'a mpres -> 'a mpres -> 'a mpres
+val two_rows_table_with_brackets :
+ attr -> 'a mpres -> 'a mpres -> 'a mpres -> 'a mpres
+val two_rows_table_without_brackets :
+ attr -> 'a mpres -> 'a mpres -> 'a mpres -> 'a mpres
+val row_with_brackets :
+ attr -> 'a mpres -> 'a mpres -> 'a mpres -> 'a mpres
+val row_without_brackets :
+ attr -> 'a mpres -> 'a mpres -> 'a mpres -> 'a mpres
+val print_mpres : ('a -> Xml.token Stream.t) -> 'a mpres -> Xml.token Stream.t
+val document_of_mpres : 'a mpres -> Xml.token Stream.t
+
diff --git a/helm/ocaml/content_pres/renderingAttrs.ml b/helm/ocaml/content_pres/renderingAttrs.ml
new file mode 100644
index 000000000..cc692abe9
--- /dev/null
+++ b/helm/ocaml/content_pres/renderingAttrs.ml
@@ -0,0 +1,50 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+type xml_attribute = string option * string * string
+type markup = [ `MathML | `BoxML ]
+
+let keyword_attributes = function
+ | `MathML -> [ None, "mathcolor", "blue" ]
+ | `BoxML -> [ None, "color", "blue" ]
+
+let builtin_symbol_attributes = function
+ | `MathML -> [ None, "mathcolor", "blue" ]
+ | `BoxML -> [ None, "color", "blue" ]
+
+let object_keyword_attributes = function
+ | `MathML -> [ None, "mathcolor", "red" ]
+ | `BoxML -> [ None, "color", "red" ]
+
+let symbol_attributes _ = []
+let ident_attributes _ = []
+let number_attributes _ = []
+
+let spacing_attributes _ = [ None, "spacing", "0.5em" ]
+let indent_attributes _ = [ None, "indent", "0.5em" ]
+let small_skip_attributes _ = [ None, "width", "0.5em" ]
+
diff --git a/helm/ocaml/content_pres/renderingAttrs.mli b/helm/ocaml/content_pres/renderingAttrs.mli
new file mode 100644
index 000000000..64323598b
--- /dev/null
+++ b/helm/ocaml/content_pres/renderingAttrs.mli
@@ -0,0 +1,57 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** XML attributes for MathML/BoxML rendering of terms and objects
+ * markup defaults to MathML in all functions below *)
+
+type xml_attribute = string option * string * string
+type markup = [ `MathML | `BoxML ]
+
+(** High-level attributes *)
+
+val keyword_attributes: (* let, match, in, ... *)
+ markup -> xml_attribute list
+
+val builtin_symbol_attributes: (* \\Pi, \\to, ... *)
+ markup -> xml_attribute list
+
+val symbol_attributes: (* +, *, ... *)
+ markup -> xml_attribute list
+
+val ident_attributes: (* nat, plus, ... *)
+ markup -> xml_attribute list
+
+val number_attributes: (* 1, 2, ... *)
+ markup -> xml_attribute list
+
+val object_keyword_attributes: (* Body, Definition, ... *)
+ markup -> xml_attribute list
+
+(** Low-level attributes *)
+
+val spacing_attributes: markup -> xml_attribute list
+val indent_attributes: markup -> xml_attribute list
+val small_skip_attributes: markup -> xml_attribute list
+
diff --git a/helm/ocaml/content_pres/sequent2pres.ml b/helm/ocaml/content_pres/sequent2pres.ml
new file mode 100644
index 000000000..88c804b7d
--- /dev/null
+++ b/helm/ocaml/content_pres/sequent2pres.ml
@@ -0,0 +1,106 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(***************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Andrea Asperti <asperti@cs.unibo.it> *)
+(* 19/11/2003 *)
+(* *)
+(***************************************************************************)
+
+(* $Id$ *)
+
+let p_mtr a b = Mpresentation.Mtr(a,b)
+let p_mtd a b = Mpresentation.Mtd(a,b)
+let p_mtable a b = Mpresentation.Mtable(a,b)
+let p_mtext a b = Mpresentation.Mtext(a,b)
+let p_mi a b = Mpresentation.Mi(a,b)
+let p_mo a b = Mpresentation.Mo(a,b)
+let p_mrow a b = Mpresentation.Mrow(a,b)
+let p_mphantom a b = Mpresentation.Mphantom(a,b)
+let b_ink a = Box.Ink a
+
+module K = Content
+module P = Mpresentation
+
+let sequent2pres term2pres (_,_,context,ty) =
+ let context2pres context =
+ let rec aux accum =
+ function
+ [] -> accum
+ | None::tl -> aux accum tl
+ | (Some (`Declaration d))::tl ->
+ let
+ { K.dec_name = dec_name ;
+ K.dec_id = dec_id ;
+ K.dec_type = ty } = d in
+ let r =
+ Box.b_h [Some "helm", "xref", dec_id]
+ [ Box.b_object (p_mi []
+ (match dec_name with
+ None -> "_"
+ | Some n -> n)) ;
+ Box.b_text [] ":" ;
+ term2pres ty] in
+ aux (r::accum) tl
+ | (Some (`Definition d))::tl ->
+ let
+ { K.def_name = def_name ;
+ K.def_id = def_id ;
+ K.def_term = bo } = d in
+ let r =
+ Box.b_h [Some "helm", "xref", def_id]
+ [ Box.b_object (p_mi []
+ (match def_name with
+ None -> "_"
+ | Some n -> n)) ;
+ Box.b_text [] (Utf8Macro.unicode_of_tex "\\def") ;
+ term2pres bo] in
+ aux (r::accum) tl
+ | _::_ -> assert false in
+ aux [] context in
+ let pres_context = (Box.b_v [] (context2pres context)) in
+ let pres_goal = term2pres ty in
+ (Box.b_h [] [
+ Box.b_space;
+ (Box.b_v []
+ [Box.b_space;
+ pres_context;
+ b_ink [None,"width","4cm"; None,"height","2px"]; (* sequent line *)
+ Box.b_space;
+ pres_goal])])
+
+let sequent2pres ~ids_to_inner_sorts =
+ sequent2pres
+ (fun annterm ->
+ let ast, ids_to_uris =
+ TermAcicContent.ast_of_acic ids_to_inner_sorts annterm
+ in
+ CicNotationPres.box_of_mpres
+ (CicNotationPres.render ids_to_uris
+ (TermContentPres.pp_ast ast)))
+
diff --git a/helm/ocaml/content_pres/sequent2pres.mli b/helm/ocaml/content_pres/sequent2pres.mli
new file mode 100644
index 000000000..615c8e35f
--- /dev/null
+++ b/helm/ocaml/content_pres/sequent2pres.mli
@@ -0,0 +1,39 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(***************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Andrea Asperti <asperti@cs.unibo.it> *)
+(* 19/11/2003 *)
+(* *)
+(***************************************************************************)
+
+val sequent2pres :
+ ids_to_inner_sorts:(Cic.id, Cic2acic.sort_kind) Hashtbl.t ->
+ Cic.annterm Content.conjecture ->
+ CicNotationPres.boxml_markup
+
diff --git a/helm/ocaml/content_pres/termContentPres.ml b/helm/ocaml/content_pres/termContentPres.ml
new file mode 100644
index 000000000..4c8bbc7d4
--- /dev/null
+++ b/helm/ocaml/content_pres/termContentPres.ml
@@ -0,0 +1,649 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+module Ast = CicNotationPt
+module Env = CicNotationEnv
+
+let debug = false
+let debug_print s = if debug then prerr_endline (Lazy.force s) else ()
+
+type pattern_id = int
+type pretty_printer_id = pattern_id
+
+let resolve_binder = function
+ | `Lambda -> "\\lambda"
+ | `Pi -> "\\Pi"
+ | `Forall -> "\\forall"
+ | `Exists -> "\\exists"
+
+let add_level_info prec assoc t = Ast.AttributedTerm (`Level (prec, assoc), t)
+let add_pos_info pos t = Ast.AttributedTerm (`ChildPos pos, t)
+let left_pos = add_pos_info `Left
+let right_pos = add_pos_info `Right
+let inner_pos = add_pos_info `Inner
+
+let rec top_pos t = add_level_info ~-1 Gramext.NonA (inner_pos t)
+(* function
+ | Ast.AttributedTerm (`Level _, t) ->
+ add_level_info ~-1 Gramext.NonA (inner_pos t)
+ | Ast.AttributedTerm (attr, t) -> Ast.AttributedTerm (attr, top_pos t)
+ | t -> add_level_info ~-1 Gramext.NonA (inner_pos t) *)
+
+let rec remove_level_info =
+ function
+ | Ast.AttributedTerm (`Level _, t) -> remove_level_info t
+ | Ast.AttributedTerm (a, t) -> Ast.AttributedTerm (a, remove_level_info t)
+ | t -> t
+
+let add_xml_attrs attrs t =
+ if attrs = [] then t else Ast.AttributedTerm (`XmlAttrs attrs, t)
+
+let add_keyword_attrs =
+ add_xml_attrs (RenderingAttrs.keyword_attributes `MathML)
+
+let box kind spacing indent content =
+ Ast.Layout (Ast.Box ((kind, spacing, indent), content))
+
+let hbox = box Ast.H
+let vbox = box Ast.V
+let hvbox = box Ast.HV
+let hovbox = box Ast.HOV
+let break = Ast.Layout Ast.Break
+let builtin_symbol s = Ast.Literal (`Symbol s)
+let keyword k = add_keyword_attrs (Ast.Literal (`Keyword k))
+
+let number s =
+ add_xml_attrs (RenderingAttrs.number_attributes `MathML)
+ (Ast.Literal (`Number s))
+
+let ident i =
+ add_xml_attrs (RenderingAttrs.ident_attributes `MathML) (Ast.Ident (i, None))
+
+let ident_w_href href i =
+ match href with
+ | None -> ident i
+ | Some href ->
+ let href = UriManager.string_of_uri href in
+ add_xml_attrs [Some "xlink", "href", href] (ident i)
+
+let binder_symbol s =
+ add_xml_attrs (RenderingAttrs.builtin_symbol_attributes `MathML)
+ (builtin_symbol s)
+
+let string_of_sort_kind = function
+ | `Prop -> "Prop"
+ | `Set -> "Set"
+ | `CProp -> "CProp"
+ | `Type _ -> "Type"
+
+let pp_ast0 t k =
+ let rec aux =
+ function
+ | Ast.Appl ts ->
+ let rec aux_args pos =
+ function
+ | [] -> []
+ | [ last ] ->
+ let last = k last in
+ if pos = `Left then [ left_pos last ] else [ right_pos last ]
+ | hd :: tl ->
+ (add_pos_info pos (k hd)) :: aux_args `Inner tl
+ in
+ add_level_info Ast.apply_prec Ast.apply_assoc
+ (hovbox true true (CicNotationUtil.dress break (aux_args `Left ts)))
+ | Ast.Binder (binder_kind, (id, ty), body) ->
+ add_level_info Ast.binder_prec Ast.binder_assoc
+ (hvbox false true
+ [ binder_symbol (resolve_binder binder_kind);
+ k id; builtin_symbol ":"; aux_ty ty; break;
+ builtin_symbol "."; right_pos (k body) ])
+ | Ast.Case (what, indty_opt, outty_opt, patterns) ->
+ let outty_box =
+ match outty_opt with
+ | None -> []
+ | Some outty ->
+ [ keyword "return"; break; remove_level_info (k outty)]
+ in
+ let indty_box =
+ match indty_opt with
+ | None -> []
+ | Some (indty, href) -> [ keyword "in"; break; ident_w_href href indty ]
+ in
+ let match_box =
+ hvbox false false [
+ hvbox false true [
+ hvbox false true [ keyword "match"; break; top_pos (k what) ];
+ break;
+ hvbox false true indty_box;
+ break;
+ hvbox false true outty_box
+ ];
+ break;
+ keyword "with"
+ ]
+ in
+ let mk_case_pattern (head, href, vars) =
+ hbox true false (ident_w_href href head :: List.map aux_var vars)
+ in
+ let patterns' =
+ List.map
+ (fun (lhs, rhs) ->
+ remove_level_info
+ (hvbox false true [
+ hbox false true [
+ mk_case_pattern lhs; builtin_symbol "\\Rightarrow" ];
+ break; top_pos (k rhs) ]))
+ patterns
+ in
+ let patterns'' =
+ let rec aux_patterns = function
+ | [] -> assert false
+ | [ last ] ->
+ [ break;
+ hbox false false [
+ builtin_symbol "|";
+ last; builtin_symbol "]" ] ]
+ | hd :: tl ->
+ [ break; hbox false false [ builtin_symbol "|"; hd ] ]
+ @ aux_patterns tl
+ in
+ match patterns' with
+ | [] ->
+ [ hbox false false [ builtin_symbol "["; builtin_symbol "]" ] ]
+ | [ one ] ->
+ [ hbox false false [
+ builtin_symbol "["; one; builtin_symbol "]" ] ]
+ | hd :: tl ->
+ hbox false false [ builtin_symbol "["; hd ]
+ :: aux_patterns tl
+ in
+ add_level_info Ast.simple_prec Ast.simple_assoc
+ (hvbox false false [
+ hvbox false false ([match_box]); break;
+ hbox false false [ hvbox false false patterns'' ] ])
+ | Ast.Cast (bo, ty) ->
+ add_level_info Ast.simple_prec Ast.simple_assoc
+ (hvbox false true [
+ builtin_symbol "("; top_pos (k bo); break; builtin_symbol ":";
+ top_pos (k ty); builtin_symbol ")"])
+ | Ast.LetIn (var, s, t) ->
+ add_level_info Ast.let_in_prec Ast.let_in_assoc
+ (hvbox false true [
+ hvbox false true [
+ keyword "let";
+ hvbox false true [
+ aux_var var; builtin_symbol "\\def"; break; top_pos (k s) ];
+ break; keyword "in" ];
+ break;
+ k t ])
+ | Ast.LetRec (rec_kind, funs, where) ->
+ let rec_op =
+ match rec_kind with `Inductive -> "rec" | `CoInductive -> "corec"
+ in
+ let mk_fun (var, body, _) = aux_var var, k body in
+ let mk_funs = List.map mk_fun in
+ let fst_fun, tl_funs =
+ match mk_funs funs with hd :: tl -> hd, tl | [] -> assert false
+ in
+ let fst_row =
+ let (name, body) = fst_fun in
+ hvbox false true [
+ keyword "let"; keyword rec_op; name; builtin_symbol "\\def"; break;
+ top_pos body ]
+ in
+ let tl_rows =
+ List.map
+ (fun (name, body) ->
+ [ break;
+ hvbox false true [
+ keyword "and"; name; builtin_symbol "\\def"; break; body ] ])
+ tl_funs
+ in
+ add_level_info Ast.let_in_prec Ast.let_in_assoc
+ ((hvbox false false
+ (fst_row :: List.flatten tl_rows
+ @ [ break; keyword "in"; break; k where ])))
+ | Ast.Implicit -> builtin_symbol "?"
+ | Ast.Meta (n, l) ->
+ let local_context l =
+ CicNotationUtil.dress (builtin_symbol ";")
+ (List.map (function None -> builtin_symbol "_" | Some t -> k t) l)
+ in
+ hbox false false
+ ([ builtin_symbol "?"; number (string_of_int n) ]
+ @ (if l <> [] then local_context l else []))
+ | Ast.Sort sort -> aux_sort sort
+ | Ast.Num _
+ | Ast.Symbol _
+ | Ast.Ident (_, None) | Ast.Ident (_, Some [])
+ | Ast.Uri (_, None) | Ast.Uri (_, Some [])
+ | Ast.Literal _
+ | Ast.UserInput as leaf -> leaf
+ | t -> CicNotationUtil.visit_ast ~special_k k t
+ and aux_sort sort_kind =
+ add_xml_attrs (RenderingAttrs.keyword_attributes `MathML)
+ (Ast.Ident (string_of_sort_kind sort_kind, None))
+ and aux_ty = function
+ | None -> builtin_symbol "?"
+ | Some ty -> k ty
+ and aux_var = function
+ | name, Some ty ->
+ hvbox false true [
+ builtin_symbol "("; name; builtin_symbol ":"; break; k ty;
+ builtin_symbol ")" ]
+ | name, None -> name
+ and special_k = function
+ | Ast.AttributedTerm (attrs, t) -> Ast.AttributedTerm (attrs, k t)
+ | t ->
+ prerr_endline ("unexpected special: " ^ CicNotationPp.pp_term t);
+ assert false
+ in
+ aux t
+
+ (* persistent state *)
+
+let level1_patterns21 = Hashtbl.create 211
+
+let compiled21 = ref None
+
+let pattern21_matrix = ref []
+
+let get_compiled21 () =
+ match !compiled21 with
+ | None -> assert false
+ | Some f -> Lazy.force f
+
+let set_compiled21 f = compiled21 := Some f
+
+let add_idrefs =
+ List.fold_right (fun idref t -> Ast.AttributedTerm (`IdRef idref, t))
+
+let instantiate21 idrefs env l1 =
+ let rec subst_singleton pos env =
+ function
+ Ast.AttributedTerm (attr, t) ->
+ Ast.AttributedTerm (attr, subst_singleton pos env t)
+ | t -> CicNotationUtil.group (subst pos env t)
+ and subst pos env = function
+ | Ast.AttributedTerm (attr, t) ->
+(* prerr_endline ("loosing attribute " ^ CicNotationPp.pp_attribute attr); *)
+ subst pos env t
+ | Ast.Variable var ->
+ let name, expected_ty = CicNotationEnv.declaration_of_var var in
+ let ty, value =
+ try
+ List.assoc name env
+ with Not_found ->
+ prerr_endline ("name " ^ name ^ " not found in environment");
+ assert false
+ in
+ assert (CicNotationEnv.well_typed ty value); (* INVARIANT *)
+ (* following assertion should be a conditional that makes this
+ * instantiation fail *)
+ assert (CicNotationEnv.well_typed expected_ty value);
+ [ add_pos_info pos (CicNotationEnv.term_of_value value) ]
+ | Ast.Magic m -> subst_magic pos env m
+ | Ast.Literal l as t ->
+ let t = add_idrefs idrefs t in
+ (match l with
+ | `Keyword k -> [ add_keyword_attrs t ]
+ | _ -> [ t ])
+ | Ast.Layout l -> [ Ast.Layout (subst_layout pos env l) ]
+ | t -> [ CicNotationUtil.visit_ast (subst_singleton pos env) t ]
+ and subst_magic pos env = function
+ | Ast.List0 (p, sep_opt)
+ | Ast.List1 (p, sep_opt) ->
+ let rec_decls = CicNotationEnv.declarations_of_term p in
+ let rec_values =
+ List.map (fun (n, _) -> CicNotationEnv.lookup_list env n) rec_decls
+ in
+ let values = CicNotationUtil.ncombine rec_values in
+ let sep =
+ match sep_opt with
+ | None -> []
+ | Some l -> [ Ast.Literal l ]
+ in
+ let rec instantiate_list acc = function
+ | [] -> List.rev acc
+ | value_set :: [] ->
+ let env = CicNotationEnv.combine rec_decls value_set in
+ instantiate_list (CicNotationUtil.group (subst pos env p) :: acc)
+ []
+ | value_set :: tl ->
+ let env = CicNotationEnv.combine rec_decls value_set in
+ let terms = subst pos env p in
+ instantiate_list (CicNotationUtil.group (terms @ sep) :: acc) tl
+ in
+ instantiate_list [] values
+ | Ast.Opt p ->
+ let opt_decls = CicNotationEnv.declarations_of_term p in
+ let env =
+ let rec build_env = function
+ | [] -> []
+ | (name, ty) :: tl ->
+ (* assumption: if one of the value is None then all are *)
+ (match CicNotationEnv.lookup_opt env name with
+ | None -> raise Exit
+ | Some v -> (name, (ty, v)) :: build_env tl)
+ in
+ try build_env opt_decls with Exit -> []
+ in
+ begin
+ match env with
+ | [] -> []
+ | _ -> subst pos env p
+ end
+ | _ -> assert false (* impossible *)
+ and subst_layout pos env = function
+ | Ast.Box (kind, tl) ->
+ let tl' = subst_children pos env tl in
+ Ast.Box (kind, List.concat tl')
+ | l -> CicNotationUtil.visit_layout (subst_singleton pos env) l
+ and subst_children pos env =
+ function
+ | [] -> []
+ | [ child ] ->
+ let pos' =
+ match pos with
+ | `Inner -> `Right
+ | `Left -> `Left
+(* | `None -> assert false *)
+ | `Right -> `Right
+ in
+ [ subst pos' env child ]
+ | hd :: tl ->
+ let pos' =
+ match pos with
+ | `Inner -> `Inner
+ | `Left -> `Inner
+(* | `None -> assert false *)
+ | `Right -> `Right
+ in
+ (subst pos env hd) :: subst_children pos' env tl
+ in
+ subst_singleton `Left env l1
+
+let rec pp_ast1 term =
+ let rec pp_value = function
+ | CicNotationEnv.NumValue _ as v -> v
+ | CicNotationEnv.StringValue _ as v -> v
+(* | CicNotationEnv.TermValue t when t == term -> CicNotationEnv.TermValue (pp_ast0 t pp_ast1) *)
+ | CicNotationEnv.TermValue t -> CicNotationEnv.TermValue (pp_ast1 t)
+ | CicNotationEnv.OptValue None as v -> v
+ | CicNotationEnv.OptValue (Some v) ->
+ CicNotationEnv.OptValue (Some (pp_value v))
+ | CicNotationEnv.ListValue vl ->
+ CicNotationEnv.ListValue (List.map pp_value vl)
+ in
+ let ast_env_of_env env =
+ List.map (fun (var, (ty, value)) -> (var, (ty, pp_value value))) env
+ in
+(* prerr_endline ("pattern matching from 2 to 1 on term " ^ CicNotationPp.pp_term term); *)
+ match term with
+ | Ast.AttributedTerm (attrs, term') ->
+ Ast.AttributedTerm (attrs, pp_ast1 term')
+ | _ ->
+ (match (get_compiled21 ()) term with
+ | None -> pp_ast0 term pp_ast1
+ | Some (env, ctors, pid) ->
+ let idrefs =
+ List.flatten (List.map CicNotationUtil.get_idrefs ctors)
+ in
+ let l1 =
+ try
+ Hashtbl.find level1_patterns21 pid
+ with Not_found -> assert false
+ in
+ instantiate21 idrefs (ast_env_of_env env) l1)
+
+let load_patterns21 t =
+ set_compiled21 (lazy (Content2presMatcher.Matcher21.compiler t))
+
+let pp_ast ast =
+ debug_print (lazy "pp_ast <-");
+ let ast' = pp_ast1 ast in
+ debug_print (lazy ("pp_ast -> " ^ CicNotationPp.pp_term ast'));
+ ast'
+
+exception Pretty_printer_not_found
+
+let fill_pos_info l1_pattern = l1_pattern
+(* let rec aux toplevel pos =
+ function
+ | Ast.Layout l ->
+ (match l
+
+ | Ast.Magic m ->
+ Ast.Box (
+ | Ast.Variable _ as t -> add_pos_info pos t
+ | t -> t
+ in
+ aux true l1_pattern *)
+
+let fresh_id =
+ let counter = ref ~-1 in
+ fun () ->
+ incr counter;
+ !counter
+
+let add_pretty_printer ~precedence ~associativity l2 l1 =
+ let id = fresh_id () in
+ let l1' = add_level_info precedence associativity (fill_pos_info l1) in
+ let l2' = CicNotationUtil.strip_attributes l2 in
+ Hashtbl.add level1_patterns21 id l1';
+ pattern21_matrix := (l2', id) :: !pattern21_matrix;
+ load_patterns21 !pattern21_matrix;
+ id
+
+let remove_pretty_printer id =
+ (try
+ Hashtbl.remove level1_patterns21 id;
+ with Not_found -> raise Pretty_printer_not_found);
+ pattern21_matrix := List.filter (fun (_, id') -> id <> id') !pattern21_matrix;
+ load_patterns21 !pattern21_matrix
+
+ (* presentation -> content *)
+
+let unopt_names names env =
+ let rec aux acc = function
+ | (name, (ty, v)) :: tl when List.mem name names ->
+ (match ty, v with
+ | Env.OptType ty, Env.OptValue (Some v) ->
+ aux ((name, (ty, v)) :: acc) tl
+ | _ -> assert false)
+ | hd :: tl -> aux (hd :: acc) tl
+ | [] -> acc
+ in
+ aux [] env
+
+let head_names names env =
+ let rec aux acc = function
+ | (name, (ty, v)) :: tl when List.mem name names ->
+ (match ty, v with
+ | Env.ListType ty, Env.ListValue (v :: _) ->
+ aux ((name, (ty, v)) :: acc) tl
+ | _ -> assert false)
+ | _ :: tl -> aux acc tl
+ (* base pattern may contain only meta names, thus we trash all others *)
+ | [] -> acc
+ in
+ aux [] env
+
+let tail_names names env =
+ let rec aux acc = function
+ | (name, (ty, v)) :: tl when List.mem name names ->
+ (match ty, v with
+ | Env.ListType ty, Env.ListValue (_ :: vtl) ->
+ aux ((name, (Env.ListType ty, Env.ListValue vtl)) :: acc) tl
+ | _ -> assert false)
+ | binding :: tl -> aux (binding :: acc) tl
+ | [] -> acc
+ in
+ aux [] env
+
+let instantiate_level2 env term =
+ let fresh_env = ref [] in
+ let lookup_fresh_name n =
+ try
+ List.assoc n !fresh_env
+ with Not_found ->
+ let new_name = CicNotationUtil.fresh_name () in
+ fresh_env := (n, new_name) :: !fresh_env;
+ new_name
+ in
+ let rec aux env term =
+(* prerr_endline ("ENV " ^ CicNotationPp.pp_env env); *)
+ match term with
+ | Ast.AttributedTerm (_, term) -> aux env term
+ | Ast.Appl terms -> Ast.Appl (List.map (aux env) terms)
+ | Ast.Binder (binder, var, body) ->
+ Ast.Binder (binder, aux_capture_var env var, aux env body)
+ | Ast.Case (term, indty, outty_opt, patterns) ->
+ Ast.Case (aux env term, indty, aux_opt env outty_opt,
+ List.map (aux_branch env) patterns)
+ | Ast.LetIn (var, t1, t2) ->
+ Ast.LetIn (aux_capture_var env var, aux env t1, aux env t2)
+ | Ast.LetRec (kind, definitions, body) ->
+ Ast.LetRec (kind, List.map (aux_definition env) definitions,
+ aux env body)
+ | Ast.Uri (name, None) -> Ast.Uri (name, None)
+ | Ast.Uri (name, Some substs) ->
+ Ast.Uri (name, Some (aux_substs env substs))
+ | Ast.Ident (name, Some substs) ->
+ Ast.Ident (name, Some (aux_substs env substs))
+ | Ast.Meta (index, substs) -> Ast.Meta (index, aux_meta_substs env substs)
+
+ | Ast.Implicit
+ | Ast.Ident _
+ | Ast.Num _
+ | Ast.Sort _
+ | Ast.Symbol _
+ | Ast.UserInput -> term
+
+ | Ast.Magic magic -> aux_magic env magic
+ | Ast.Variable var -> aux_variable env var
+
+ | _ -> assert false
+ and aux_opt env = function
+ | Some term -> Some (aux env term)
+ | None -> None
+ and aux_capture_var env (name, ty_opt) = (aux env name, aux_opt env ty_opt)
+ and aux_branch env (pattern, term) =
+ (aux_pattern env pattern, aux env term)
+ and aux_pattern env (head, hrefs, vars) =
+ (head, hrefs, List.map (aux_capture_var env) vars)
+ and aux_definition env (var, term, i) =
+ (aux_capture_var env var, aux env term, i)
+ and aux_substs env substs =
+ List.map (fun (name, term) -> (name, aux env term)) substs
+ and aux_meta_substs env meta_substs = List.map (aux_opt env) meta_substs
+ and aux_variable env = function
+ | Ast.NumVar name -> Ast.Num (Env.lookup_num env name, 0)
+ | Ast.IdentVar name -> Ast.Ident (Env.lookup_string env name, None)
+ | Ast.TermVar name -> Env.lookup_term env name
+ | Ast.FreshVar name -> Ast.Ident (lookup_fresh_name name, None)
+ | Ast.Ascription (term, name) -> assert false
+ and aux_magic env = function
+ | Ast.Default (some_pattern, none_pattern) ->
+ let some_pattern_names = CicNotationUtil.names_of_term some_pattern in
+ let none_pattern_names = CicNotationUtil.names_of_term none_pattern in
+ let opt_names =
+ List.filter
+ (fun name -> not (List.mem name none_pattern_names))
+ some_pattern_names
+ in
+ (match opt_names with
+ | [] -> assert false (* some pattern must contain at least 1 name *)
+ | (name :: _) as names ->
+ (match Env.lookup_value env name with
+ | Env.OptValue (Some _) ->
+ (* assumption: if "name" above is bound to Some _, then all
+ * names returned by "meta_names_of" are bound to Some _ as well
+ *)
+ aux (unopt_names names env) some_pattern
+ | Env.OptValue None -> aux env none_pattern
+ | _ ->
+ prerr_endline (sprintf
+ "lookup of %s in env %s did not return an optional value"
+ name (CicNotationPp.pp_env env));
+ assert false))
+ | Ast.Fold (`Left, base_pattern, names, rec_pattern) ->
+ let acc_name = List.hd names in (* names can't be empty, cfr. parser *)
+ let meta_names =
+ List.filter ((<>) acc_name)
+ (CicNotationUtil.names_of_term rec_pattern)
+ in
+ (match meta_names with
+ | [] -> assert false (* as above *)
+ | (name :: _) as names ->
+ let rec instantiate_fold_left acc env' =
+ match Env.lookup_value env' name with
+ | Env.ListValue (_ :: _) ->
+ instantiate_fold_left
+ (let acc_binding =
+ acc_name, (Env.TermType, Env.TermValue acc)
+ in
+ aux (acc_binding :: head_names names env') rec_pattern)
+ (tail_names names env')
+ | Env.ListValue [] -> acc
+ | _ -> assert false
+ in
+ instantiate_fold_left (aux env base_pattern) env)
+ | Ast.Fold (`Right, base_pattern, names, rec_pattern) ->
+ let acc_name = List.hd names in (* names can't be empty, cfr. parser *)
+ let meta_names =
+ List.filter ((<>) acc_name)
+ (CicNotationUtil.names_of_term rec_pattern)
+ in
+ (match meta_names with
+ | [] -> assert false (* as above *)
+ | (name :: _) as names ->
+ let rec instantiate_fold_right env' =
+ match Env.lookup_value env' name with
+ | Env.ListValue (_ :: _) ->
+ let acc = instantiate_fold_right (tail_names names env') in
+ let acc_binding =
+ acc_name, (Env.TermType, Env.TermValue acc)
+ in
+ aux (acc_binding :: head_names names env') rec_pattern
+ | Env.ListValue [] -> aux env base_pattern
+ | _ -> assert false
+ in
+ instantiate_fold_right env)
+ | Ast.If (_, p_true, p_false) as t ->
+ aux env (CicNotationUtil.find_branch (Ast.Magic t))
+ | Ast.Fail -> assert false
+ | _ -> assert false
+ in
+ aux env term
+
+ (* initialization *)
+
+let _ = load_patterns21 []
+
diff --git a/helm/ocaml/content_pres/termContentPres.mli b/helm/ocaml/content_pres/termContentPres.mli
new file mode 100644
index 000000000..5ff710036
--- /dev/null
+++ b/helm/ocaml/content_pres/termContentPres.mli
@@ -0,0 +1,52 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+ (** {2 Persistant state handling} *)
+
+type pretty_printer_id
+
+val add_pretty_printer:
+ precedence:int ->
+ associativity:Gramext.g_assoc ->
+ CicNotationPt.term -> (* level 2 pattern *)
+ CicNotationPt.term -> (* level 1 pattern *)
+ pretty_printer_id
+
+exception Pretty_printer_not_found
+
+ (** @raise Pretty_printer_not_found *)
+val remove_pretty_printer: pretty_printer_id -> unit
+
+ (** {2 content -> pres} *)
+
+val pp_ast: CicNotationPt.term -> CicNotationPt.term
+
+ (** {2 pres -> content} *)
+
+ (** fills a term pattern instantiating variable magics *)
+val instantiate_level2:
+ CicNotationEnv.t -> CicNotationPt.term ->
+ CicNotationPt.term
+
diff --git a/helm/ocaml/content_pres/test_lexer.ml b/helm/ocaml/content_pres/test_lexer.ml
new file mode 100644
index 000000000..b032d7f61
--- /dev/null
+++ b/helm/ocaml/content_pres/test_lexer.ml
@@ -0,0 +1,60 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let _ =
+ let level = ref "2@" in
+ let ic = ref stdin in
+ let arg_spec = [ "-level", Arg.Set_string level, "set the notation level" ] in
+ let usage = "test_lexer [ -level level ] [ file ]" in
+ let open_file fname =
+ if !ic <> stdin then close_in !ic;
+ ic := open_in fname
+ in
+ Arg.parse arg_spec open_file usage;
+ let lexer =
+ match !level with
+ "1" -> CicNotationLexer.level1_pattern_lexer
+ | "2@" -> CicNotationLexer.level2_ast_lexer
+ | "2$" -> CicNotationLexer.level2_meta_lexer
+ | l ->
+ prerr_endline (Printf.sprintf "Unsupported level %s" l);
+ exit 2
+ in
+ let token_stream =
+ fst (lexer.Token.tok_func (Obj.magic (Ulexing.from_utf8_channel !ic)))
+ in
+ Printf.printf "Lexing notation level %s\n" !level; flush stdout;
+ let rec dump () =
+ let (a,b) = Stream.next token_stream in
+ if a = "EOI" then raise Stream.Failure;
+ print_endline (Printf.sprintf "%s '%s'" a b);
+ dump ()
+ in
+ try
+ dump ()
+ with Stream.Failure -> ()
+
diff --git a/helm/ocaml/daemons.dot b/helm/ocaml/daemons.dot
new file mode 100644
index 000000000..93c122d8a
--- /dev/null
+++ b/helm/ocaml/daemons.dot
@@ -0,0 +1,19 @@
+ /* apps */
+ subgraph applications {
+ node [shape=plaintext,style=filled,fillcolor=slategray2];
+ DependencyAnalyzer [label="Dependency\nAnalyzer"];
+ Getter;
+ Matita;
+ ProofChecker [label="Proof\nChecker"];
+ Uwobo;
+ Whelp;
+ }
+ /* apps dep */
+ DependencyAnalyzer -> metadata;
+ Getter -> getter;
+ Matita -> grafite_engine;
+ Matita -> grafite_parser;
+ Matita -> hgdome;
+ ProofChecker -> cic_proof_checking;
+ Uwobo -> content_pres;
+ Whelp -> grafite_parser;
diff --git a/helm/ocaml/deps.patch b/helm/ocaml/deps.patch
new file mode 100644
index 000000000..d7f9cf8c9
--- /dev/null
+++ b/helm/ocaml/deps.patch
@@ -0,0 +1,11 @@
+--- .dep.dot 2005-12-19 12:07:15.000000000 +0100
++++ .dep.dot.new 2005-12-19 12:08:10.000000000 +0100
+@@ -14,7 +14,7 @@
+ "cic_unification" -> "library";
+ "library" -> "metadata";
+ "library" -> "cic_acic";
+-"metadata" -> "cic_proof_checking";
++"metadata" -> "cic";
+ "metadata" -> "hmysql";
+ "grafite" -> "content_pres";
+ "content_pres" -> "utf8_macros";
diff --git a/helm/ocaml/extlib/.depend b/helm/ocaml/extlib/.depend
new file mode 100644
index 000000000..b11273f7a
--- /dev/null
+++ b/helm/ocaml/extlib/.depend
@@ -0,0 +1,10 @@
+hExtlib.cmo: hExtlib.cmi
+hExtlib.cmx: hExtlib.cmi
+hMarshal.cmo: hExtlib.cmi hMarshal.cmi
+hMarshal.cmx: hExtlib.cmx hMarshal.cmi
+patternMatcher.cmo: patternMatcher.cmi
+patternMatcher.cmx: patternMatcher.cmi
+hLog.cmo: hLog.cmi
+hLog.cmx: hLog.cmi
+trie.cmo: trie.cmi
+trie.cmx: trie.cmi
diff --git a/helm/ocaml/extlib/Makefile b/helm/ocaml/extlib/Makefile
new file mode 100644
index 000000000..c67778af4
--- /dev/null
+++ b/helm/ocaml/extlib/Makefile
@@ -0,0 +1,16 @@
+PACKAGE = extlib
+PREDICATES =
+
+INTERFACE_FILES = \
+ hExtlib.mli \
+ hMarshal.mli \
+ patternMatcher.mli \
+ hLog.mli \
+ trie.mli \
+ $(NULL)
+IMPLEMENTATION_FILES = \
+ $(INTERFACE_FILES:%.mli=%.ml)
+EXTRA_OBJECTS_TO_INSTALL =
+EXTRA_OBJECTS_TO_CLEAN =
+
+include ../Makefile.common
diff --git a/helm/ocaml/extlib/hExtlib.ml b/helm/ocaml/extlib/hExtlib.ml
new file mode 100644
index 000000000..15a459cdc
--- /dev/null
+++ b/helm/ocaml/extlib/hExtlib.ml
@@ -0,0 +1,343 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+(** PROFILING *)
+
+(* we should use a key in te registry, but we can't see the registry.. *)
+let profiling_enabled = true
+
+let profiling_printings = ref (fun () -> true)
+let set_profiling_printings f = profiling_printings := f
+
+type profiler = { profile : 'a 'b. ('a -> 'b) -> 'a -> 'b }
+let profile ?(enable = true) =
+ if profiling_enabled && enable then
+ function s ->
+ let total = ref 0.0 in
+ let profile f x =
+ let before = Unix.gettimeofday () in
+ try
+ let res = f x in
+ let after = Unix.gettimeofday () in
+ total := !total +. (after -. before);
+ res
+ with
+ exc ->
+ let after = Unix.gettimeofday () in
+ total := !total +. (after -. before);
+ raise exc
+ in
+ at_exit
+ (fun () ->
+ if !profiling_printings () then
+ prerr_endline
+ ("!! TOTAL TIME SPENT IN " ^ s ^ ": " ^ string_of_float !total));
+ { profile = profile }
+ else
+ function _ -> { profile = fun f x -> f x }
+
+(** {2 Optional values} *)
+
+let map_option f = function None -> None | Some v -> Some (f v)
+let iter_option f = function None -> () | Some v -> f v
+let unopt = function None -> failwith "unopt: None" | Some v -> v
+
+(** {2 String processing} *)
+
+let split ?(sep = ' ') s =
+ let pieces = ref [] in
+ let rec aux idx =
+ match (try Some (String.index_from s idx sep) with Not_found -> None) with
+ | Some pos ->
+ pieces := String.sub s idx (pos - idx) :: !pieces;
+ aux (pos + 1)
+ | None -> pieces := String.sub s idx (String.length s - idx) :: !pieces
+ in
+ aux 0;
+ List.rev !pieces
+
+let trim_blanks s =
+ let rec find_left idx =
+ match s.[idx] with
+ | ' ' | '\t' | '\r' | '\n' -> find_left (idx + 1)
+ | _ -> idx
+ in
+ let rec find_right idx =
+ match s.[idx] with
+ | ' ' | '\t' | '\r' | '\n' -> find_right (idx - 1)
+ | _ -> idx
+ in
+ let s_len = String.length s in
+ let left, right = find_left 0, find_right (s_len - 1) in
+ String.sub s left (right - left + 1)
+
+(** {2 Char processing} *)
+
+let is_alpha c =
+ let code = Char.code c in
+ (code >= 65 && code <= 90) || (code >= 97 && code <= 122)
+
+let is_digit c =
+ let code = Char.code c in
+ code >= 48 && code <= 57
+
+let is_blank c =
+ let code = Char.code c in
+ code = 9 || code = 10 || code = 13 || code = 32
+
+let is_alphanum c = is_alpha c || is_digit c
+
+(** {2 List processing} *)
+
+let rec list_uniq ?(eq=(=)) = function
+ | [] -> []
+ | h::[] -> [h]
+ | h1::h2::tl when eq h1 h2 -> list_uniq ~eq (h2 :: tl)
+ | h1::tl (* when h1 <> h2 *) -> h1 :: list_uniq ~eq tl
+
+let rec filter_map f =
+ function
+ | [] -> []
+ | hd :: tl ->
+ (match f hd with
+ | None -> filter_map f tl
+ | Some v -> v :: filter_map f tl)
+
+let list_concat ?(sep = []) =
+ let rec aux acc =
+ function
+ | [] -> []
+ | [ last ] -> List.flatten (List.rev (last :: acc))
+ | hd :: tl -> aux ([sep; hd] @ acc) tl
+ in
+ aux []
+
+let rec list_findopt f l =
+ let rec aux = function
+ | [] -> None
+ | x::tl ->
+ (match f x with
+ | None -> aux tl
+ | Some _ as rc -> rc)
+ in
+ aux l
+
+(** {2 File predicates} *)
+
+let is_dir fname =
+ try
+ (Unix.stat fname).Unix.st_kind = Unix.S_DIR
+ with Unix.Unix_error _ -> false
+
+let is_regular fname =
+ try
+ (Unix.stat fname).Unix.st_kind = Unix.S_REG
+ with Unix.Unix_error _ -> false
+
+let mkdir path =
+ let components = split ~sep:'/' path in
+ let rec aux where = function
+ | [] -> ()
+ | piece::tl ->
+ let path = where ^ "/" ^ piece in
+ (try
+ Unix.mkdir path 0o755
+ with
+ | Unix.Unix_error (Unix.EEXIST,_,_) -> ()
+ | Unix.Unix_error (e,_,_) ->
+ raise
+ (Failure
+ ("Unix.mkdir " ^ path ^ " 0o755 :" ^ (Unix.error_message e))));
+ aux path tl
+ in
+ aux "" components
+
+(** {2 Filesystem} *)
+
+let input_file fname =
+ let size = (Unix.stat fname).Unix.st_size in
+ let buf = Buffer.create size in
+ let ic = open_in fname in
+ Buffer.add_channel buf ic size;
+ close_in ic;
+ Buffer.contents buf
+
+let input_all ic =
+ let size = 10240 in
+ let buf = Buffer.create size in
+ let s = String.create size in
+ (try
+ while true do
+ let bytes = input ic s 0 size in
+ if bytes = 0 then raise End_of_file
+ else Buffer.add_substring buf s 0 bytes
+ done
+ with End_of_file -> ());
+ Buffer.contents buf
+
+let output_file ~filename ~text =
+ let oc = open_out filename in
+ output_string oc text;
+ close_out oc
+
+let blank_split s =
+ let len = String.length s in
+ let buf = Buffer.create 0 in
+ let rec aux acc i =
+ if i >= len
+ then begin
+ if Buffer.length buf > 0
+ then List.rev (Buffer.contents buf :: acc)
+ else List.rev acc
+ end else begin
+ if is_blank s.[i] then
+ if Buffer.length buf > 0 then begin
+ let s = Buffer.contents buf in
+ Buffer.clear buf;
+ aux (s :: acc) (i + 1)
+ end else
+ aux acc (i + 1)
+ else begin
+ Buffer.add_char buf s.[i];
+ aux acc (i + 1)
+ end
+ end
+ in
+ aux [] 0
+
+ (* Rules: * "~name" -> home dir of "name"
+ * "~" -> value of $HOME if defined, home dir of the current user otherwise *)
+let tilde_expand s =
+ let get_home login = (Unix.getpwnam login).Unix.pw_dir in
+ let expand_one s =
+ let len = String.length s in
+ if len > 0 && s.[0] = '~' then begin
+ let login_len = ref 1 in
+ while !login_len < len && is_alphanum (s.[!login_len]) do
+ incr login_len
+ done;
+ let login = String.sub s 1 (!login_len - 1) in
+ try
+ let home =
+ if login = "" then
+ try Sys.getenv "HOME" with Not_found -> get_home (Unix.getlogin ())
+ else
+ get_home login
+ in
+ home ^ String.sub s !login_len (len - !login_len)
+ with Not_found | Invalid_argument _ -> s
+ end else
+ s
+ in
+ String.concat " " (List.map expand_one (blank_split s))
+
+let find ?(test = fun _ -> true) path =
+ let rec aux acc todo =
+ match todo with
+ | [] -> acc
+ | path :: tl ->
+ try
+ let handle = Unix.opendir path in
+ let dirs = ref [] in
+ let matching_files = ref [] in
+ (try
+ while true do
+ match Unix.readdir handle with
+ | "." | ".." -> ()
+ | entry ->
+ let qentry = path ^ "/" ^ entry in
+ (try
+ if is_dir qentry then
+ dirs := qentry :: !dirs
+ else if test qentry then
+ matching_files := qentry :: !matching_files;
+ with Unix.Unix_error _ -> ())
+ done
+ with End_of_file -> Unix.closedir handle);
+ aux (!matching_files @ acc) (!dirs @ tl)
+ with Unix.Unix_error _ -> aux acc tl
+ in
+ aux [] [path]
+
+let safe_remove fname = if Sys.file_exists fname then Sys.remove fname
+
+let is_dir_empty d =
+ let od = Unix.opendir d in
+ let rec aux () =
+ let name = Unix.readdir od in
+ if name <> "." && name <> ".." then false else aux () in
+ let res = try aux () with End_of_file -> true in
+ Unix.closedir od;
+ res
+
+let safe_rmdir d = try Unix.rmdir d with Unix.Unix_error _ -> ()
+
+let rec rmdir_descend d =
+ if is_dir_empty d then
+ begin
+ safe_rmdir d;
+ rmdir_descend (Filename.dirname d)
+ end
+
+
+(** {2 Exception handling} *)
+
+let finally at_end f arg =
+ let res =
+ try f arg
+ with exn -> at_end (); raise exn
+ in
+ at_end ();
+ res
+
+(** {2 Localized exceptions } *)
+
+exception Localized of Token.flocation * exn
+
+let loc_of_floc = function
+ | { Lexing.pos_cnum = loc_begin }, { Lexing.pos_cnum = loc_end } ->
+ (loc_begin, loc_end)
+
+let floc_of_loc (loc_begin, loc_end) =
+ let floc_begin =
+ { Lexing.pos_fname = ""; Lexing.pos_lnum = -1; Lexing.pos_bol = -1;
+ Lexing.pos_cnum = loc_begin }
+ in
+ let floc_end = { floc_begin with Lexing.pos_cnum = loc_end } in
+ (floc_begin, floc_end)
+
+let dummy_floc = floc_of_loc (-1, -1)
+
+let raise_localized_exception ~offset floc exn =
+ let (x, y) = loc_of_floc floc in
+ let x = offset + x in
+ let y = offset + y in
+ let flocb,floce = floc in
+ let floc =
+ { flocb with Lexing.pos_cnum = x }, { floce with Lexing.pos_cnum = y }
+ in
+ raise (Localized (floc, exn))
diff --git a/helm/ocaml/extlib/hExtlib.mli b/helm/ocaml/extlib/hExtlib.mli
new file mode 100644
index 000000000..aed9b2406
--- /dev/null
+++ b/helm/ocaml/extlib/hExtlib.mli
@@ -0,0 +1,95 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** {2 Optional values} *)
+
+val map_option: ('a -> 'b) -> 'a option -> 'b option
+val iter_option: ('a -> unit) -> 'a option -> unit
+val unopt: 'a option -> 'a (** @raise Failure *)
+
+(** {2 Filesystem} *)
+
+val is_dir: string -> bool (** @return true if file is a directory *)
+val is_regular: string -> bool (** @return true if file is a regular file *)
+val mkdir: string -> unit (** create dir and parents. @raise Failure *)
+val tilde_expand: string -> string (** bash-like (head) tilde expansion *)
+val safe_remove: string -> unit (** removes a file if it exists *)
+val safe_rmdir: string -> unit (** removes a dir if it exists and is empty *)
+val is_dir_empty: string -> bool (** checks if the dir is empty *)
+val rmdir_descend: string -> unit (** rmdir -p *)
+
+
+ (** find all _files_ matching test under a filesystem root *)
+val find: ?test:(string -> bool) -> string -> string list
+
+(** {2 File I/O} *)
+
+val input_file: string -> string (** read all the contents of file to string *)
+val input_all: in_channel -> string (** read all the contents of a channel *)
+val output_file: filename:string -> text:string -> unit (** other way round *)
+
+(** {2 Exception handling} *)
+
+val finally: (unit -> unit) -> ('a -> 'b) -> 'a -> 'b
+
+(** {2 Char processing} *)
+
+val is_alpha: char -> bool
+val is_blank: char -> bool
+val is_digit: char -> bool
+val is_alphanum: char -> bool (** is_alpha || is_digit *)
+
+(** {2 String processing} *)
+
+val split: ?sep:char -> string -> string list (** @param sep defaults to ' ' *)
+val trim_blanks: string -> string (** strip heading and trailing blanks *)
+
+(** {2 List processing} *)
+
+val list_uniq:
+ ?eq:('a->'a->bool) -> 'a list -> 'a list (** uniq unix filter on lists *)
+val filter_map: ('a -> 'b option) -> 'a list -> 'b list (** filter + map *)
+val list_concat: ?sep:'a list -> 'a list list -> 'a list (**String.concat-like*)
+val list_findopt: ('a -> 'b option) -> 'a list -> 'b option
+
+(** {2 Debugging & Profiling} *)
+
+type profiler = { profile : 'a 'b. ('a -> 'b) -> 'a -> 'b }
+
+ (** @return a profiling function; [s] is used for labelling the total time at
+ * the end of the execution *)
+val profile : ?enable:bool -> string -> profiler
+val set_profiling_printings : (unit -> bool) -> unit
+
+(** {2 Localized exceptions } *)
+
+exception Localized of Token.flocation * exn
+
+val loc_of_floc: Token.flocation -> int * int
+val floc_of_loc: int * int -> Token.flocation
+
+val dummy_floc: Lexing.position * Lexing.position
+
+val raise_localized_exception: offset:int -> Token.flocation -> exn -> 'a
diff --git a/helm/ocaml/extlib/hLog.ml b/helm/ocaml/extlib/hLog.ml
new file mode 100644
index 000000000..4ad2b5ba4
--- /dev/null
+++ b/helm/ocaml/extlib/hLog.ml
@@ -0,0 +1,64 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+type log_tag = [ `Debug | `Error | `Message | `Warning ]
+type log_callback = log_tag -> string -> unit
+
+(*
+colors=(black red green yellow blue magenta cyan gray white)
+ccodes=(30 31 32 33 34 35 36 37 39)
+*)
+
+let blue = "[0;34m"
+let yellow = "[0;33m"
+let green = "[0;32m"
+let red = "[0;31m"
+let black = "[0m"
+
+let default_callback tag s =
+ let prefix,ch =
+ match tag with
+ | `Message -> green ^ "Info: ", stdout
+ | `Warning -> yellow ^ "Warn: ", stderr
+ | `Error -> red ^ "Error: ", stderr
+ | `Debug -> blue ^ "Debug: ", stderr
+ in
+ output_string ch (prefix ^ black ^ s ^ "\n");
+ flush ch
+
+let callback = ref default_callback
+
+let set_log_callback f = callback := f
+let get_log_callback () = !callback
+
+let message s = !callback `Message s
+let warn s = !callback `Warning s
+let error s = !callback `Error s
+let debug s = !callback `Debug s
+
diff --git a/helm/ocaml/extlib/hLog.mli b/helm/ocaml/extlib/hLog.mli
new file mode 100644
index 000000000..6847ce32d
--- /dev/null
+++ b/helm/ocaml/extlib/hLog.mli
@@ -0,0 +1,36 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+type log_tag = [ `Debug | `Error | `Message | `Warning ]
+type log_callback = log_tag -> string -> unit
+
+val set_log_callback: log_callback -> unit
+val get_log_callback: unit -> log_callback
+
+val message : string -> unit
+val warn : string -> unit
+val error : string -> unit
+val debug : string -> unit
+
diff --git a/helm/ocaml/extlib/hMarshal.ml b/helm/ocaml/extlib/hMarshal.ml
new file mode 100644
index 000000000..c57886819
--- /dev/null
+++ b/helm/ocaml/extlib/hMarshal.ml
@@ -0,0 +1,72 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+exception Corrupt_file of string
+exception Format_mismatch of string
+exception Version_mismatch of string
+
+let ensure_path_exists fname = HExtlib.mkdir (Filename.dirname fname)
+let marshal_flags = []
+
+let save ~fmt ~version ~fname data =
+ ensure_path_exists fname;
+ let oc = open_out fname in
+ let marshalled = Marshal.to_string data marshal_flags in
+ output_binary_int oc (Hashtbl.hash fmt); (* field 1 *)
+ output_binary_int oc version; (* field 2 *)
+ output_string oc fmt; (* field 3 *)
+ output_string oc (string_of_int version); (* field 4 *)
+ output_binary_int oc (Hashtbl.hash marshalled); (* field 5 *)
+ output_string oc marshalled; (* field 6 *)
+ close_out oc
+
+let expect ic fname s =
+ let len = String.length s in
+ let buf = String.create len in
+ really_input ic buf 0 len;
+ if buf <> s then raise (Corrupt_file fname)
+
+let load ~fmt ~version ~fname =
+ let ic = open_in fname in
+ HExtlib.finally
+ (fun () -> close_in ic)
+ (fun () ->
+ try
+ let fmt' = input_binary_int ic in (* field 1 *)
+ if fmt' <> Hashtbl.hash fmt then raise (Format_mismatch fname);
+ let version' = input_binary_int ic in (* field 2 *)
+ if version' <> version then raise (Version_mismatch fname);
+ expect ic fname fmt; (* field 3 *)
+ expect ic fname (string_of_int version); (* field 4 *)
+ let checksum' = input_binary_int ic in (* field 5 *)
+ let marshalled' = HExtlib.input_all ic in (* field 6 *)
+ if checksum' <> Hashtbl.hash marshalled' then
+ raise (Corrupt_file fname);
+ Marshal.from_string marshalled' 0
+ with End_of_file -> raise (Corrupt_file fname))
+ ()
+
diff --git a/helm/ocaml/extlib/hMarshal.mli b/helm/ocaml/extlib/hMarshal.mli
new file mode 100644
index 000000000..90ce20def
--- /dev/null
+++ b/helm/ocaml/extlib/hMarshal.mli
@@ -0,0 +1,59 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** {2 Marshalling with version/consistency checks} *)
+
+(** {3 File formats}
+ *
+ * Files saved/loaded by this module share a common format:
+ *
+ * | n | Field name | Field type | Description |
+ * +---+-------------+------------+---------------------------------------+
+ * | 1 | format | integer | hash value of the 'fmt' parameter |
+ * | 2 | version | integer | 'version' parameter |
+ * | 3 | format dsc | string | extended 'fmt' parameter |
+ * | 4 | version dsc | string | extended 'version' parameter |
+ * | 5 | checksum | integer | hash value of the _field_ below |
+ * | 6 | data | raw | ocaml marshalling of 'data' parameter |
+ *
+ *)
+
+exception Corrupt_file of string (** checksum mismatch, or file too short *)
+exception Format_mismatch of string
+exception Version_mismatch of string
+
+ (** Marhsal some data according to the file format above.
+ * @param fmt format name
+ * @param version version number
+ * @param fname file name to which marshal data
+ * @param data data to be marshalled on disk *)
+val save: fmt:string -> version:int -> fname:string -> 'a -> unit
+
+ (** parameters as above
+ * @raise Corrupt_file
+ * @raise Format_mismatch
+ * @raise Version_mismatch *)
+val load: fmt:string -> version:int -> fname:string -> 'a
+
diff --git a/helm/ocaml/extlib/patternMatcher.ml b/helm/ocaml/extlib/patternMatcher.ml
new file mode 100644
index 000000000..c1b436a97
--- /dev/null
+++ b/helm/ocaml/extlib/patternMatcher.ml
@@ -0,0 +1,191 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+type pattern_kind = Variable | Constructor
+type tag_t = int
+
+type pattern_id = int
+
+module OrderedInt =
+struct
+ type t = int
+ let compare (x1:t) (x2:t) = Pervasives.compare x2 x1 (* reverse order *)
+end
+
+module IntSet = Set.Make (OrderedInt)
+
+let int_set_of_int_list l =
+ List.fold_left (fun acc i -> IntSet.add i acc) IntSet.empty l
+
+module type PATTERN =
+sig
+ type pattern_t
+ type term_t
+ val classify : pattern_t -> pattern_kind
+ val tag_of_pattern : pattern_t -> tag_t * pattern_t list
+ val tag_of_term : term_t -> tag_t * term_t list
+ val string_of_term: term_t -> string
+ val string_of_pattern: pattern_t -> string
+end
+
+module Matcher (P: PATTERN) =
+struct
+ type row_t = P.pattern_t list * P.pattern_t list * pattern_id
+ type t = row_t list
+
+ let compatible p1 p2 = P.classify p1 = P.classify p2
+
+ let matched = List.map (fun (matched, _, pid) -> matched, pid)
+
+ let partition t pidl =
+ let partitions = Hashtbl.create 11 in
+ let add pid row = Hashtbl.add partitions pid row in
+ (try
+ List.iter2 add pidl t
+ with Invalid_argument _ -> assert false);
+ let pidset = int_set_of_int_list pidl in
+ IntSet.fold
+ (fun pid acc ->
+ match Hashtbl.find_all partitions pid with
+ | [] -> acc
+ | patterns -> (pid, List.rev patterns) :: acc)
+ pidset []
+
+ let are_empty t =
+ match t with
+ | (_, [], _) :: _ -> true
+ (* if first row has an empty list of patterns, then others have as well *)
+ | _ -> false
+
+ (* return 2 lists of rows, first one containing homogeneous rows according
+ * to "compatible" below *)
+ let horizontal_split t =
+ let ap, first_row, t', first_row_class =
+ match t with
+ | [] -> assert false
+ | (_, [], _) :: _ ->
+ assert false (* are_empty should have been invoked in advance *)
+ | ((_, hd :: _ , _) as row) :: tl -> hd, row, tl, P.classify hd
+ in
+ let rec aux prev_t = function
+ | [] -> List.rev prev_t, []
+ | (_, [], _) :: _ -> assert false
+ | ((_, hd :: _, _) as row) :: tl when compatible ap hd ->
+ aux (row :: prev_t) tl
+ | t -> List.rev prev_t, t
+ in
+ let rows1, rows2 = aux [first_row] t' in
+ first_row_class, rows1, rows2
+
+ (* return 2 lists, first one representing first column, second one
+ * representing a new pattern matrix where matched patterns have been moved
+ * to decl *)
+ let vertical_split t =
+ List.map
+ (function
+ | decls, hd :: tl, pid -> hd :: decls, tl, pid
+ | _ -> assert false)
+ t
+
+ let variable_closure ksucc =
+ (fun matched_terms constructors terms ->
+(* prerr_endline "variable_closure"; *)
+ match terms with
+ | hd :: tl -> ksucc (hd :: matched_terms) constructors tl
+ | _ -> assert false)
+
+ let success_closure ksucc =
+ (fun matched_terms constructors terms ->
+(* prerr_endline "success_closure"; *)
+ ksucc matched_terms constructors)
+
+ let constructor_closure ksuccs =
+ (fun matched_terms constructors terms ->
+(* prerr_endline "constructor_closure"; *)
+ match terms with
+ | t :: tl ->
+ (try
+ let tag, subterms = P.tag_of_term t in
+ let constructors' =
+ if subterms = [] then t :: constructors else constructors
+ in
+ let k' = List.assoc tag ksuccs in
+ k' matched_terms constructors' (subterms @ tl)
+ with Not_found -> None)
+ | [] -> assert false)
+
+ let backtrack_closure ksucc kfail =
+ (fun matched_terms constructors terms ->
+(* prerr_endline "backtrack_closure"; *)
+ match ksucc matched_terms constructors terms with
+ | Some x -> Some x
+ | None -> kfail matched_terms constructors terms)
+
+ let compiler rows match_cb fail_k =
+ let rec aux t =
+ if t = [] then
+ (fun _ _ _ -> fail_k ())
+ else if are_empty t then
+ success_closure (match_cb (matched t))
+ else
+ match horizontal_split t with
+ | _, [], _ -> assert false
+ | Variable, t', [] -> variable_closure (aux (vertical_split t'))
+ | Constructor, t', [] ->
+ let tagl =
+ List.map
+ (function
+ | _, p :: _, _ -> fst (P.tag_of_pattern p)
+ | _ -> assert false)
+ t'
+ in
+ let clusters = partition t' tagl in
+ let ksuccs =
+ List.map
+ (fun (tag, cluster) ->
+ let cluster' =
+ List.map (* add args as patterns heads *)
+ (function
+ | matched_p, p :: tl, pid ->
+ let _, subpatterns = P.tag_of_pattern p in
+ matched_p, subpatterns @ tl, pid
+ | _ -> assert false)
+ cluster
+ in
+ tag, aux cluster')
+ clusters
+ in
+ constructor_closure ksuccs
+ | _, t', t'' -> backtrack_closure (aux t') (aux t'')
+ in
+ let t = List.map (fun (p, pid) -> [], [p], pid) rows in
+ let matcher = aux t in
+ (fun term -> matcher [] [] [term])
+end
+
diff --git a/helm/ocaml/extlib/patternMatcher.mli b/helm/ocaml/extlib/patternMatcher.mli
new file mode 100644
index 000000000..2201ddf7f
--- /dev/null
+++ b/helm/ocaml/extlib/patternMatcher.mli
@@ -0,0 +1,62 @@
+
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+type pattern_kind = Variable | Constructor
+type tag_t = int
+
+module type PATTERN =
+sig
+ type pattern_t
+ type term_t
+
+ val classify : pattern_t -> pattern_kind
+ val tag_of_pattern : pattern_t -> tag_t * pattern_t list
+ val tag_of_term : term_t -> tag_t * term_t list
+
+ (** {3 Debugging} *)
+ val string_of_term: term_t -> string
+ val string_of_pattern: pattern_t -> string
+end
+
+module Matcher (P: PATTERN) :
+sig
+ (** @param patterns pattern matrix (pairs <pattern, pattern_id>)
+ * @param success_cb callback invoked in case of matching.
+ * Its argument are the list of pattern who matches the input term, the list
+ * of terms bound in them, the list of terms which matched constructors.
+ * Its return value is Some _ if the matching is valid, None otherwise; the
+ * latter kind of return value will trigger backtracking in the pattern
+ * matching algorithm
+ * @param failure_cb callback invoked in case of matching failure
+ * @param term term on which pattern match on *)
+ val compiler:
+ (P.pattern_t * int) list ->
+ ((P.pattern_t list * int) list -> P.term_t list -> P.term_t list ->
+ 'a option) -> (* terms *) (* constructors *)
+ (unit -> 'a option) ->
+ (P.term_t -> 'a option)
+end
+
diff --git a/helm/ocaml/extlib/trie.ml b/helm/ocaml/extlib/trie.ml
new file mode 100644
index 000000000..f60b2d45c
--- /dev/null
+++ b/helm/ocaml/extlib/trie.ml
@@ -0,0 +1,153 @@
+(*
+ * Trie: maps over lists.
+ * Copyright (C) 2000 Jean-Christophe FILLIATRE
+ *
+ * This software is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Library General Public
+ * License version 2, as published by the Free Software Foundation.
+ *
+ * This software 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 Library General Public License version 2 for more details
+ * (enclosed in the file LGPL).
+ *)
+
+(* $Id$ *)
+
+(*s A trie is a tree-like structure to implement dictionaries over
+ keys which have list-like structures. The idea is that each node
+ branches on an element of the list and stores the value associated
+ to the path from the root, if any. Therefore, a trie can be
+ defined as soon as a map over the elements of the list is
+ given. *)
+
+
+module Make (M : Map.S) = struct
+
+(*s Then a trie is just a tree-like structure, where a possible
+ information is stored at the node (['a option]) and where the sons
+ are given by a map from type [key] to sub-tries, so of type
+ ['a t M.t]. The empty trie is just the empty map. *)
+
+ type key = M.key list
+
+ type 'a t = Node of 'a option * 'a t M.t
+
+ let empty = Node (None, M.empty)
+
+(*s To find a mapping in a trie is easy: when all the elements of the
+ key have been read, we just inspect the optional info at the
+ current node; otherwise, we descend in the appropriate sub-trie
+ using [M.find]. *)
+
+ let rec find l t = match (l,t) with
+ | [], Node (None,_) -> raise Not_found
+ | [], Node (Some v,_) -> v
+ | x::r, Node (_,m) -> find r (M.find x m)
+
+ let rec mem l t = match (l,t) with
+ | [], Node (None,_) -> false
+ | [], Node (Some _,_) -> true
+ | x::r, Node (_,m) -> try mem r (M.find x m) with Not_found -> false
+
+(*s Insertion is more subtle. When the final node is reached, we just
+ put the information ([Some v]). Otherwise, we have to insert the
+ binding in the appropriate sub-trie [t']. But it may not exists,
+ and in that case [t'] is bound to an empty trie. Then we get a new
+ sub-trie [t''] by a recursive insertion and we modify the
+ branching, so that it now points to [t''], with [M.add]. *)
+
+ let add l v t =
+ let rec ins = function
+ | [], Node (_,m) -> Node (Some v,m)
+ | x::r, Node (v,m) ->
+ let t' = try M.find x m with Not_found -> empty in
+ let t'' = ins (r,t') in
+ Node (v, M.add x t'' m)
+ in
+ ins (l,t)
+
+(*s When removing a binding, we take care of not leaving bindings to empty
+ sub-tries in the nodes. Therefore, we test wether the result [t'] of
+ the recursive call is the empty trie [empty]: if so, we just remove
+ the branching with [M.remove]; otherwise, we modify it with [M.add]. *)
+
+ let rec remove l t = match (l,t) with
+ | [], Node (_,m) -> Node (None,m)
+ | x::r, Node (v,m) ->
+ try
+ let t' = remove r (M.find x m) in
+ Node (v, if t' = empty then M.remove x m else M.add x t' m)
+ with Not_found ->
+ t
+
+(*s The iterators [map], [mapi], [iter] and [fold] are implemented in
+ a straigthforward way using the corresponding iterators [M.map],
+ [M.mapi], [M.iter] and [M.fold]. For the last three of them,
+ we have to remember the path from the root, as an extra argument
+ [revp]. Since elements are pushed in reverse order in [revp],
+ we have to reverse it with [List.rev] when the actual binding
+ has to be passed to function [f]. *)
+
+ let rec map f = function
+ | Node (None,m) -> Node (None, M.map (map f) m)
+ | Node (Some v,m) -> Node (Some (f v), M.map (map f) m)
+
+ let mapi f t =
+ let rec maprec revp = function
+ | Node (None,m) ->
+ Node (None, M.mapi (fun x -> maprec (x::revp)) m)
+ | Node (Some v,m) ->
+ Node (Some (f (List.rev revp) v), M.mapi (fun x -> maprec (x::revp)) m)
+ in
+ maprec [] t
+
+ let iter f t =
+ let rec traverse revp = function
+ | Node (None,m) ->
+ M.iter (fun x -> traverse (x::revp)) m
+ | Node (Some v,m) ->
+ f (List.rev revp) v; M.iter (fun x t -> traverse (x::revp) t) m
+ in
+ traverse [] t
+
+ let rec fold f t acc =
+ let rec traverse revp t acc = match t with
+ | Node (None,m) ->
+ M.fold (fun x -> traverse (x::revp)) m acc
+ | Node (Some v,m) ->
+ f (List.rev revp) v (M.fold (fun x -> traverse (x::revp)) m acc)
+ in
+ traverse [] t acc
+
+ let compare cmp a b =
+ let rec comp a b = match a,b with
+ | Node (Some _, _), Node (None, _) -> 1
+ | Node (None, _), Node (Some _, _) -> -1
+ | Node (None, m1), Node (None, m2) ->
+ M.compare comp m1 m2
+ | Node (Some a, m1), Node (Some b, m2) ->
+ let c = cmp a b in
+ if c <> 0 then c else M.compare comp m1 m2
+ in
+ comp a b
+
+ let equal eq a b =
+ let rec comp a b = match a,b with
+ | Node (None, m1), Node (None, m2) ->
+ M.equal comp m1 m2
+ | Node (Some a, m1), Node (Some b, m2) ->
+ eq a b && M.equal comp m1 m2
+ | _ ->
+ false
+ in
+ comp a b
+
+ (* The base case is rather stupid, but constructable *)
+ let is_empty = function
+ | Node (None, m1) -> M.is_empty m1
+ | _ -> false
+
+end
diff --git a/helm/ocaml/extlib/trie.mli b/helm/ocaml/extlib/trie.mli
new file mode 100644
index 000000000..b95157fd0
--- /dev/null
+++ b/helm/ocaml/extlib/trie.mli
@@ -0,0 +1,43 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+module Make :
+ functor (M : Map.S) ->
+ sig
+ type key = M.key list
+ type 'a t = Node of 'a option * 'a t M.t
+ val empty : 'a t
+ val find : M.key list -> 'a t -> 'a
+ val mem : M.key list -> 'a t -> bool
+ val add : M.key list -> 'a -> 'a t -> 'a t
+ val remove : M.key list -> 'a t -> 'a t
+ val map : ('a -> 'b) -> 'a t -> 'b t
+ val mapi : (M.key list -> 'a -> 'b) -> 'a t -> 'b t
+ val iter : (M.key list -> 'a -> 'b) -> 'a t -> unit
+ val fold : (M.key list -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+ val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
+ val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+ val is_empty : 'a t -> bool
+ end
diff --git a/helm/ocaml/getter/.depend b/helm/ocaml/getter/.depend
new file mode 100644
index 000000000..9f77a2458
--- /dev/null
+++ b/helm/ocaml/getter/.depend
@@ -0,0 +1,30 @@
+http_getter_common.cmi: http_getter_types.cmo
+http_getter.cmi: http_getter_types.cmo
+http_getter_wget.cmo: http_getter_types.cmo http_getter_wget.cmi
+http_getter_wget.cmx: http_getter_types.cmx http_getter_wget.cmi
+http_getter_logger.cmo: http_getter_logger.cmi
+http_getter_logger.cmx: http_getter_logger.cmi
+http_getter_misc.cmo: http_getter_logger.cmi http_getter_misc.cmi
+http_getter_misc.cmx: http_getter_logger.cmx http_getter_misc.cmi
+http_getter_const.cmo: http_getter_const.cmi
+http_getter_const.cmx: http_getter_const.cmi
+http_getter_env.cmo: http_getter_types.cmo http_getter_misc.cmi \
+ http_getter_logger.cmi http_getter_const.cmi http_getter_env.cmi
+http_getter_env.cmx: http_getter_types.cmx http_getter_misc.cmx \
+ http_getter_logger.cmx http_getter_const.cmx http_getter_env.cmi
+http_getter_storage.cmo: http_getter_wget.cmi http_getter_types.cmo \
+ http_getter_misc.cmi http_getter_env.cmi http_getter_storage.cmi
+http_getter_storage.cmx: http_getter_wget.cmx http_getter_types.cmx \
+ http_getter_misc.cmx http_getter_env.cmx http_getter_storage.cmi
+http_getter_common.cmo: http_getter_types.cmo http_getter_misc.cmi \
+ http_getter_logger.cmi http_getter_env.cmi http_getter_common.cmi
+http_getter_common.cmx: http_getter_types.cmx http_getter_misc.cmx \
+ http_getter_logger.cmx http_getter_env.cmx http_getter_common.cmi
+http_getter.cmo: http_getter_wget.cmi http_getter_types.cmo \
+ http_getter_storage.cmi http_getter_misc.cmi http_getter_logger.cmi \
+ http_getter_env.cmi http_getter_const.cmi http_getter_common.cmi \
+ http_getter.cmi
+http_getter.cmx: http_getter_wget.cmx http_getter_types.cmx \
+ http_getter_storage.cmx http_getter_misc.cmx http_getter_logger.cmx \
+ http_getter_env.cmx http_getter_const.cmx http_getter_common.cmx \
+ http_getter.cmi
diff --git a/helm/ocaml/getter/.ocamlinit b/helm/ocaml/getter/.ocamlinit
new file mode 100644
index 000000000..6512190cd
--- /dev/null
+++ b/helm/ocaml/getter/.ocamlinit
@@ -0,0 +1,3 @@
+#use "topfind";;
+#require "helm-getter";;
+Helm_registry.load_from "sample.conf.xml";;
diff --git a/helm/ocaml/getter/Makefile b/helm/ocaml/getter/Makefile
new file mode 100644
index 000000000..9ebca237a
--- /dev/null
+++ b/helm/ocaml/getter/Makefile
@@ -0,0 +1,20 @@
+
+PACKAGE = getter
+
+INTERFACE_FILES = \
+ http_getter_wget.mli \
+ http_getter_logger.mli \
+ http_getter_misc.mli \
+ http_getter_const.mli \
+ http_getter_env.mli \
+ http_getter_storage.mli \
+ http_getter_common.mli \
+ http_getter.mli \
+ $(NULL)
+
+IMPLEMENTATION_FILES = \
+ http_getter_types.ml \
+ $(INTERFACE_FILES:%.mli=%.ml)
+
+include ../Makefile.common
+
diff --git a/helm/ocaml/getter/http_getter.ml b/helm/ocaml/getter/http_getter.ml
new file mode 100644
index 000000000..61930a4aa
--- /dev/null
+++ b/helm/ocaml/getter/http_getter.ml
@@ -0,0 +1,363 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+open Http_getter_common
+open Http_getter_misc
+open Http_getter_types
+
+exception Not_implemented of string
+exception UnexpectedGetterOutput
+
+type resolve_result =
+ | Unknown
+ | Exception of exn
+ | Resolved of string
+
+type logger_callback = HelmLogger.html_tag -> unit
+
+let stdout_logger tag = print_string (HelmLogger.string_of_html_tag tag)
+
+let not_implemented s = raise (Not_implemented ("Http_getter." ^ s))
+
+let index_line_sep_RE = Pcre.regexp "[ \t]+"
+let index_sep_RE = Pcre.regexp "\r\n|\r|\n"
+let trailing_types_RE = Pcre.regexp "\\.types$"
+let heading_cic_RE = Pcre.regexp "^cic:"
+let heading_theory_RE = Pcre.regexp "^theory:"
+let heading_nuprl_RE = Pcre.regexp "^nuprl:"
+let types_RE = Pcre.regexp "\\.types$"
+let types_ann_RE = Pcre.regexp "\\.types\\.ann$"
+let body_RE = Pcre.regexp "\\.body$"
+let body_ann_RE = Pcre.regexp "\\.body\\.ann$"
+let proof_tree_RE = Pcre.regexp "\\.proof_tree$"
+let proof_tree_ann_RE = Pcre.regexp "\\.proof_tree\\.ann$"
+let theory_RE = Pcre.regexp "\\.theory$"
+let basepart_RE = Pcre.regexp
+ "^([^.]*\\.[^.]*)((\\.body)|(\\.proof_tree)|(\\.types))?(\\.ann)?$"
+let slash_RE = Pcre.regexp "/"
+let pipe_RE = Pcre.regexp "\\|"
+let til_slash_RE = Pcre.regexp "^.*/"
+let no_slashes_RE = Pcre.regexp "^[^/]*$"
+let fix_regexp_RE = Pcre.regexp ("^" ^ (Pcre.quote "(cic|theory)"))
+let showable_file_RE =
+ Pcre.regexp "(\\.con|\\.ind|\\.var|\\.body|\\.types|\\.proof_tree)$"
+
+let xml_suffix = ".xml"
+let theory_suffix = ".theory"
+
+ (* global maps, shared by all threads *)
+
+let ends_with_slash s =
+ try
+ s.[String.length s - 1] = '/'
+ with Invalid_argument _ -> false
+
+ (* should we use a remote getter or not *)
+let remote () =
+ try
+ Helm_registry.get "getter.mode" = "remote"
+ with Helm_registry.Key_not_found _ -> false
+
+let getter_url () = Helm_registry.get "getter.url"
+
+(* Remote interface: getter methods implemented using a remote getter *)
+
+ (* <TODO> *)
+let getxml_remote uri = not_implemented "getxml_remote"
+let getxslt_remote uri = not_implemented "getxslt_remote"
+let getdtd_remote uri = not_implemented "getdtd_remote"
+let clean_cache_remote () = not_implemented "clean_cache_remote"
+let list_servers_remote () = not_implemented "list_servers_remote"
+let add_server_remote ~logger ~position name =
+ not_implemented "add_server_remote"
+let remove_server_remote ~logger position =
+ not_implemented "remove_server_remote"
+let getalluris_remote () = not_implemented "getalluris_remote"
+let ls_remote lsuri = not_implemented "ls_remote"
+let exists_remote uri = not_implemented "exists_remote"
+ (* </TODO> *)
+
+let resolve_remote uri =
+ (* deliver resolve request to http_getter *)
+ let doc =
+ Http_getter_wget.get (sprintf "%sresolve?uri=%s" (getter_url ()) uri)
+ in
+ let res = ref Unknown in
+ let start_element tag attrs =
+ match tag with
+ | "url" ->
+ (try
+ res := Resolved (List.assoc "value" attrs)
+ with Not_found -> ())
+ | "unresolvable" -> res := Exception (Unresolvable_URI uri)
+ | "not_found" -> res := Exception (Key_not_found uri)
+ | _ -> ()
+ in
+ let callbacks = {
+ XmlPushParser.default_callbacks with
+ XmlPushParser.start_element = Some start_element
+ } in
+ let xml_parser = XmlPushParser.create_parser callbacks in
+ XmlPushParser.parse xml_parser (`String doc);
+ XmlPushParser.final xml_parser;
+ match !res with
+ | Unknown -> raise UnexpectedGetterOutput
+ | Exception e -> raise e
+ | Resolved url -> url
+
+let deref_index_theory uri =
+ if Http_getter_storage.exists (uri ^ xml_suffix) then uri
+ else if is_theory_uri uri && Filename.basename uri = "index.theory" then
+ strip_trailing_slash (Filename.dirname uri) ^ theory_suffix
+ else
+ uri
+
+(* API *)
+
+let help () = Http_getter_const.usage_string (Http_getter_env.env_to_string ())
+
+let exists uri =
+(* prerr_endline ("Http_getter.exists " ^ uri); *)
+ if remote () then
+ exists_remote uri
+ else
+ let uri = deref_index_theory uri in
+ Http_getter_storage.exists (uri ^ xml_suffix)
+
+let resolve uri =
+ if remote () then
+ resolve_remote uri
+ else
+ let uri = deref_index_theory uri in
+ try
+ Http_getter_storage.resolve (uri ^ xml_suffix)
+ with Http_getter_storage.Resource_not_found _ -> raise (Key_not_found uri)
+
+let getxml uri =
+ if remote () then getxml_remote uri
+ else begin
+ let uri' = deref_index_theory uri in
+ (try
+ Http_getter_storage.filename (uri' ^ xml_suffix)
+ with Http_getter_storage.Resource_not_found _ -> raise (Key_not_found uri))
+ end
+
+let getxslt uri =
+ if remote () then getxslt_remote uri
+ else Http_getter_storage.filename ~find:true ("xslt:/" ^ uri)
+
+let getdtd uri =
+ if remote () then
+ getdtd_remote uri
+ else begin
+ let fname = Lazy.force Http_getter_env.dtd_dir ^ "/" ^ uri in
+ if not (Sys.file_exists fname) then raise (Dtd_not_found uri);
+ fname
+ end
+
+let clean_cache () =
+ if remote () then
+ clean_cache_remote ()
+ else
+ Http_getter_storage.clean_cache ()
+
+let (++) (oldann, oldtypes, oldbody, oldtree)
+ (newann, newtypes, newbody, newtree) =
+ ((if newann > oldann then newann else oldann),
+ (if newtypes > oldtypes then newtypes else oldtypes),
+ (if newbody > oldbody then newbody else oldbody),
+ (if newtree > oldtree then newtree else oldtree))
+
+let store_obj tbl o =
+(* prerr_endline ("Http_getter.store_obj " ^ o); *)
+ if Pcre.pmatch ~rex:showable_file_RE o then begin
+ let basepart = Pcre.replace ~rex:basepart_RE ~templ:"$1" o in
+ let no_flags = false, No, No, No in
+ let oldflags =
+ try
+ Hashtbl.find tbl basepart
+ with Not_found -> (* no ann, no types, no body, no proof tree *)
+ no_flags
+ in
+ let newflags =
+ match o with
+ | s when Pcre.pmatch ~rex:types_RE s -> (false, Yes, No, No)
+ | s when Pcre.pmatch ~rex:types_ann_RE s -> (true, Ann, No, No)
+ | s when Pcre.pmatch ~rex:body_RE s -> (false, No, Yes, No)
+ | s when Pcre.pmatch ~rex:body_ann_RE s -> (true, No, Ann, No)
+ | s when Pcre.pmatch ~rex:proof_tree_RE s -> (false, No, No, Yes)
+ | s when Pcre.pmatch ~rex:proof_tree_ann_RE s -> (true, No, No, Ann)
+ | s -> no_flags
+ in
+ Hashtbl.replace tbl basepart (oldflags ++ newflags)
+ end
+
+let store_dir set_ref d =
+ set_ref := StringSet.add (List.hd (Pcre.split ~rex:slash_RE d)) !set_ref
+
+let collect_ls_items dirs_set objs_tbl =
+ let items = ref [] in
+ StringSet.iter (fun dir -> items := Ls_section dir :: !items) dirs_set;
+ Http_getter_misc.hashtbl_sorted_iter
+ (fun uri (annflag, typesflag, bodyflag, treeflag) ->
+ items :=
+ Ls_object {
+ uri = uri; ann = annflag;
+ types = typesflag; body = bodyflag; proof_tree = treeflag
+ } :: !items)
+ objs_tbl;
+ List.rev !items
+
+let contains_object = (<>) []
+
+ (** non regexp-aware version of ls *)
+let rec dumb_ls uri_prefix =
+(* prerr_endline ("Http_getter.dumb_ls " ^ uri_prefix); *)
+ if is_cic_obj_uri uri_prefix then begin
+ let dirs = ref StringSet.empty in
+ let objs = Hashtbl.create 17 in
+ List.iter
+ (fun fname ->
+ if ends_with_slash fname then
+ store_dir dirs fname
+ else
+ try
+ store_obj objs (strip_suffix ~suffix:xml_suffix fname)
+ with Invalid_argument _ -> ())
+ (Http_getter_storage.ls uri_prefix);
+ collect_ls_items !dirs objs
+ end else if is_theory_uri uri_prefix then begin
+ let items = ref [] in
+ let add_theory fname =
+ items :=
+ Ls_object {
+ uri = fname; ann = false; types = No; body = No; proof_tree = No }
+ :: !items
+ in
+ let cic_uri_prefix =
+ Pcre.replace_first ~rex:heading_theory_RE ~templ:"cic:" uri_prefix
+ in
+ List.iter
+ (fun fname ->
+ if ends_with_slash fname then
+ items := Ls_section (strip_trailing_slash fname) :: !items
+ else
+ try
+ let fname = strip_suffix ~suffix:xml_suffix fname in
+ let theory_name = strip_suffix ~suffix:theory_suffix fname in
+ let sub_theory = normalize_dir cic_uri_prefix ^ theory_name ^ "/" in
+ if is_empty_theory sub_theory then add_theory fname
+ with Invalid_argument _ -> ())
+ (Http_getter_storage.ls uri_prefix);
+ (try
+ if contains_object (dumb_ls cic_uri_prefix)
+ && exists (strip_trailing_slash uri_prefix ^ theory_suffix)
+ then
+ add_theory "index.theory";
+ with Unresolvable_URI _ -> ());
+ !items
+ end else
+ raise (Invalid_URI uri_prefix)
+
+and is_empty_theory uri_prefix =
+(* prerr_endline ("is_empty_theory " ^ uri_prefix); *)
+ not (contains_object (dumb_ls uri_prefix))
+
+ (* handle simple regular expressions of the form "...(..|..|..)..." on cic
+ * uris, not meant to be a real implementation of regexp. The only we use is
+ * "(cic|theory):/..." *)
+let explode_ls_regexp regexp =
+ try
+ let len = String.length regexp in
+ let lparen_idx = String.index regexp '(' in
+ let rparen_idx = String.index_from regexp lparen_idx ')' in
+ let choices_str = (* substring between parens, parens excluded *)
+ String.sub regexp (lparen_idx + 1) (rparen_idx - lparen_idx - 1)
+ in
+ let choices = Pcre.split ~rex:pipe_RE choices_str in
+ let prefix = String.sub regexp 0 lparen_idx in
+ let suffix = String.sub regexp (rparen_idx + 1) (len - (rparen_idx + 1)) in
+ List.map (fun choice -> prefix ^ choice ^ suffix) choices
+ with Not_found -> [regexp]
+
+let merge_results results =
+ let rec aux objects_acc dirs_acc = function
+ | [] -> dirs_acc @ objects_acc
+ | Ls_object _ as obj :: tl -> aux (obj :: objects_acc) dirs_acc tl
+ | Ls_section _ as dir :: tl ->
+ if List.mem dir dirs_acc then (* filters out dir duplicates *)
+ aux objects_acc dirs_acc tl
+ else
+ aux objects_acc (dir :: dirs_acc) tl
+ in
+ aux [] [] (List.concat results)
+
+let ls regexp =
+ if remote () then
+ ls_remote regexp
+ else
+ let prefixes = explode_ls_regexp regexp in
+ merge_results (List.map dumb_ls prefixes)
+
+let getalluris () =
+ let rec aux acc = function
+ | [] -> acc
+ | dir :: todo ->
+ let acc', todo' =
+ List.fold_left
+ (fun (acc, subdirs) result ->
+ match result with
+ | Ls_object obj -> (dir ^ obj.uri) :: acc, subdirs
+ | Ls_section sect -> acc, (dir ^ sect ^ "/") :: subdirs)
+ (acc, todo)
+ (dumb_ls dir)
+ in
+ aux acc' todo'
+ in
+ aux [] ["cic:/"] (* trailing slash required *)
+
+(* Shorthands from now on *)
+
+let getxml' uri = getxml (UriManager.string_of_uri uri)
+let resolve' uri = resolve (UriManager.string_of_uri uri)
+let exists' uri = exists (UriManager.string_of_uri uri)
+
+let tilde_expand_key k =
+ try
+ Helm_registry.set k (HExtlib.tilde_expand (Helm_registry.get k))
+ with Helm_registry.Key_not_found _ -> ()
+
+let init () =
+ List.iter tilde_expand_key ["getter.cache_dir"; "getter.dtd_dir"];
+ Http_getter_logger.set_log_level
+ (Helm_registry.get_opt_default Helm_registry.int ~default:1
+ "getter.log_level");
+ Http_getter_logger.set_log_file
+ (Helm_registry.get_opt Helm_registry.string "getter.log_file")
+
diff --git a/helm/ocaml/getter/http_getter.mli b/helm/ocaml/getter/http_getter.mli
new file mode 100644
index 000000000..4bbc447bd
--- /dev/null
+++ b/helm/ocaml/getter/http_getter.mli
@@ -0,0 +1,66 @@
+(*
+ * Copyright (C) 2003-2004:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+open Http_getter_types
+
+ (** {2 Loggers} *)
+
+type logger_callback = HelmLogger.html_tag -> unit
+
+val stdout_logger: logger_callback
+
+ (** {2 Getter Web Service interface as API *)
+
+val help: unit -> string
+
+ (** @raise Http_getter_types.Unresolvable_URI _
+ * @raise Http_getter_types.Key_not_found _ *)
+val resolve: string -> string (* uri -> url *)
+
+val exists: string -> bool
+
+val getxml : string -> string
+val getxslt : string -> string
+val getdtd : string -> string
+val clean_cache: unit -> unit
+val getalluris: unit -> string list
+
+ (** @param baseuri uri to be listed, simple form or regular expressions (a
+ * single choice among parens) are permitted *)
+val ls: string -> ls_item list
+
+ (** {2 UriManager shorthands} *)
+
+val getxml' : UriManager.uri -> string
+val resolve' : UriManager.uri -> string
+val exists' : UriManager.uri -> bool
+
+ (** {2 Misc} *)
+
+val init: unit -> unit
+
diff --git a/helm/ocaml/getter/http_getter_common.ml b/helm/ocaml/getter/http_getter_common.ml
new file mode 100644
index 000000000..a29a44de2
--- /dev/null
+++ b/helm/ocaml/getter/http_getter_common.ml
@@ -0,0 +1,168 @@
+(*
+ * Copyright (C) 2003-2004:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Http_getter_types;;
+open Printf;;
+
+let string_of_ls_flag = function No -> "NO" | Yes -> "YES" | Ann -> "ANN"
+let string_of_encoding = function
+ | `Normal -> "Normal"
+ | `Gzipped -> "GZipped"
+
+let is_cic_obj_uri uri = Pcre.pmatch ~pat:"^cic:" uri
+let is_theory_uri uri = Pcre.pmatch ~pat:"^theory:" uri
+let is_cic_uri uri = is_cic_obj_uri uri || is_theory_uri uri
+let is_nuprl_uri uri = Pcre.pmatch ~pat:"^nuprl:" uri
+let is_rdf_uri uri = Pcre.pmatch ~pat:"^helm:rdf(.*):(.*)//(.*)" uri
+let is_xsl_uri uri = Pcre.pmatch ~pat:"^\\w+\\.xsl" uri
+
+let rec uri_of_string = function
+ | uri when is_rdf_uri uri ->
+ (match Pcre.split ~pat:"//" uri with
+ | [ prefix; uri ] ->
+ let rest =
+ match uri_of_string uri with
+ | Cic_uri xmluri -> xmluri
+ | _ -> raise (Invalid_URI uri)
+ in
+ Rdf_uri (prefix, rest)
+ | _ -> raise (Invalid_URI uri))
+ | uri when is_cic_obj_uri uri -> Cic_uri (Cic (Pcre.replace ~pat:"^cic:" uri))
+ | uri when is_nuprl_uri uri -> Nuprl_uri (Pcre.replace ~pat:"^nuprl:" uri)
+ | uri when is_theory_uri uri ->
+ Cic_uri (Theory (Pcre.replace ~pat:"^theory:" uri))
+ | uri -> raise (Invalid_URI uri)
+
+let patch_xsl ?(via_http = true) () =
+ fun line ->
+ let mk_patch_fun tag line =
+ Pcre.replace
+ ~pat:(sprintf "%s\\s+href=\"" tag)
+ ~templ:(sprintf "%s href=\"%s/getxslt?uri="
+ tag (Lazy.force Http_getter_env.my_own_url))
+ line
+ in
+ let (patch_import, patch_include) =
+ (mk_patch_fun "xsl:import", mk_patch_fun "xsl:include")
+ in
+ patch_include (patch_import line)
+
+let patch_system kind ?(via_http = true) () =
+ let rex =
+ Pcre.regexp (sprintf "%s (.*) SYSTEM\\s+\"((%s)/)?" kind
+ (String.concat "|" (Lazy.force Http_getter_env.dtd_base_urls)))
+ in
+ let templ =
+ if via_http then
+ sprintf "%s $1 SYSTEM \"%s/getdtd?uri=" kind
+ (Lazy.force Http_getter_env.my_own_url)
+ else
+ sprintf "%s $1 SYSTEM \"file://%s/" kind
+ (Lazy.force Http_getter_env.dtd_dir)
+ in
+ fun line -> Pcre.replace ~rex ~templ line
+
+let patch_entity = patch_system "ENTITY"
+let patch_doctype = patch_system "DOCTYPE"
+
+let patch_xmlbase =
+ let rex = Pcre.regexp "^(\\s*<\\w[^ ]*)(\\s|>)" in
+ fun xmlbases baseurl baseuri s ->
+ let s' =
+ Pcre.replace ~rex
+ ~templ:(sprintf "$1 xml:base=\"%s\" helm:base=\"%s\"$2" baseurl baseuri)
+ s
+ in
+ if s <> s' then xmlbases := None;
+ s'
+
+let patch_dtd = patch_entity
+let patch_xml ?via_http ?xmlbases () =
+ let xmlbases = ref xmlbases in
+ fun line ->
+ match !xmlbases with
+ | None -> patch_doctype ?via_http () (patch_entity ?via_http () line)
+ | Some (xmlbaseuri, xmlbaseurl) ->
+ patch_xmlbase xmlbases xmlbaseurl xmlbaseuri
+ (patch_doctype ?via_http () (patch_entity ?via_http () line))
+
+let return_file
+ ~fname ?contype ?contenc ?patch_fun ?(gunzip = false) ?(via_http = true)
+ ~enc outchan
+=
+ if via_http then begin
+ let headers =
+ match (contype, contenc) with
+ | (Some t, Some e) -> ["Content-Encoding", e; "Content-Type", t]
+ | (Some t, None) -> ["Content-Type" , t]
+ | (None, Some e) -> ["Content-Encoding", e]
+ | (None, None) -> []
+ in
+ Http_daemon.send_basic_headers ~code:(`Code 200) outchan;
+ Http_daemon.send_headers headers outchan;
+ Http_daemon.send_CRLF outchan
+ end;
+ match gunzip, patch_fun with
+ | true, Some patch_fun ->
+ Http_getter_logger.log ~level:2
+ "Patch required, uncompress/compress cycle needed :-(";
+ (* gunzip needed, uncompress file, apply patch_fun to it, compress the
+ * result and sent it to client *)
+ let (tmp1, tmp2) =
+ (Http_getter_misc.tempfile (), Http_getter_misc.tempfile ())
+ in
+ (try
+ Http_getter_misc.gunzip ~keep:true ~output:tmp1 fname; (* gunzip tmp1 *)
+ let new_file = open_out tmp2 in
+ Http_getter_misc.iter_file (* tmp2 = patch(tmp1) *)
+ (fun line ->
+ output_string new_file (patch_fun line ^ "\n");
+ flush outchan)
+ tmp1;
+ close_out new_file;
+ Http_getter_misc.gzip ~output:tmp1 tmp2;(* tmp1 = gzip(tmp2); rm tmp2 *)
+ Http_getter_misc.iter_file (* send tmp1 to client as is*)
+ (fun line -> output_string outchan (line ^ "\n"); flush outchan)
+ tmp1;
+ Sys.remove tmp1 (* rm tmp1 *)
+ with e ->
+ Sys.remove tmp1;
+ raise e)
+ | false, Some patch_fun ->
+ (match enc with
+ | `Normal ->
+ Http_getter_misc.iter_file
+ (fun line -> output_string outchan (patch_fun (line ^ "\n")))
+ fname
+ | `Gzipped -> assert false)
+ (* dangerous case, if this happens it needs to be investigated *)
+ | _, None -> Http_getter_misc.iter_file_data (output_string outchan) fname
+;;
+
diff --git a/helm/ocaml/getter/http_getter_common.mli b/helm/ocaml/getter/http_getter_common.mli
new file mode 100644
index 000000000..d1bc66f76
--- /dev/null
+++ b/helm/ocaml/getter/http_getter_common.mli
@@ -0,0 +1,70 @@
+(*
+ * Copyright (C) 2003-2004:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+open Http_getter_types;;
+
+val string_of_ls_flag: ls_flag -> string
+val string_of_encoding: encoding -> string
+
+val is_cic_uri: string -> bool
+val is_cic_obj_uri: string -> bool
+val is_theory_uri: string -> bool
+val is_nuprl_uri: string -> bool
+val is_rdf_uri: string -> bool
+val is_xsl_uri: string -> bool
+
+val uri_of_string: string -> uri
+
+ (** @param xmlbases (xml base URI * xml base URL) *)
+val patch_xml :
+ ?via_http:bool -> ?xmlbases:(string * string) -> unit -> (string -> string)
+val patch_dtd : ?via_http:bool -> unit -> (string -> string)
+ (* TODO via_http not yet supported for patch_xsl *)
+val patch_xsl : ?via_http:bool -> unit -> (string -> string)
+
+ (**
+ @param fname name of the file to be sent
+ @param contype Content-Type header value
+ @param contenc Content-Enconding header value
+ @param patch_fun function used to patch file contents
+ @param gunzip is meaningful only if a patch function is provided. If gunzip
+ is true and patch_fun is given (i.e. is not None), then patch_fun is applied
+ to the uncompressed version of the file. The file is then compressed again and
+ send to client
+ @param via_http (default: true) if true http specific communications are used
+ (e.g. headers, crlf before body) and sent via outchan, otherwise they're not.
+ Set it to false when saving to a local file
+ @param outchan output channel over which sent file fname *)
+val return_file:
+ fname:string ->
+ ?contype:string -> ?contenc:string ->
+ ?patch_fun:(string -> string) -> ?gunzip:bool -> ?via_http:bool ->
+ enc:encoding ->
+ out_channel ->
+ unit
+
diff --git a/helm/ocaml/getter/http_getter_const.ml b/helm/ocaml/getter/http_getter_const.ml
new file mode 100644
index 000000000..8103efcfa
--- /dev/null
+++ b/helm/ocaml/getter/http_getter_const.ml
@@ -0,0 +1,102 @@
+(*
+ * Copyright (C) 2003-2004:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf;;
+
+let version = "0.4.0"
+let conffile = "http_getter.conf.xml"
+
+let xhtml_ns = "http://www.w3.org/1999/xhtml"
+let helm_ns = "http://www.cs.unibo.it/helm"
+
+ (* TODO provide a better usage string *)
+let usage_string configuration =
+ sprintf
+"<?xml version=\"1.0\"?>
+<html xmlns=\"%s\" xmlns:helm=\"%s\">
+ <head>
+ <title>HTTP Getter's help message</title>
+ </head>
+ <body>
+ <h1>HTTP Getter, version %s</h1>
+ <h2>Usage information</h2>
+ <p>
+ Usage: <kbd>http://hostname:getterport/</kbd><em>command</em>
+ </p>
+ <p>
+ Available commands:
+ </p>
+ <p>
+ <b><kbd><a href=\"/help\">help</a></kbd></b><br />
+ display this help message
+ </p>
+ <p>
+ <b><kbd>getxml?uri=URI[&format=(normal|gz)][&patch_dtd=(yes|no)]</kbd></b><br />
+ </p>
+ <p>
+ <b><kbd>resolve?uri=URI</kbd></b><br />
+ </p>
+ <p>
+ <b><kbd>getdtd?uri=URI[&patch_dtd=(yes|no)]</kbd></b><br />
+ </p>
+ <p>
+ <b><kbd>getxslt?uri=URI[&patch_dtd=(yes|no)]</kbd></b><br />
+ </p>
+ <p>
+ <b><kbd><a href=\"/update\">update</a></kbd></b><br />
+ </p>
+ <p>
+ <b><kbd><a href=\"clean_cache\">clean_cache</a></kbd></b><br />
+ </p>
+ <p>
+ <b><kbd>ls?baseuri=regexp&format=(txt|xml)</kbd></b><br />
+ </p>
+ <p>
+ <b><kbd>getalluris?format=(<a href=\"/getalluris?format=txt\">txt</a>|<a href=\"/getalluris?format=xml\">xml</a>)</kbd></b><br />
+ </p>
+ <p>
+ <b><kbd><a href=\"/getempty\">getempty</a></kbd></b><br />
+ </p>
+ <h2>Current configuration</h2>
+ <pre>%s</pre>
+ </body>
+</html>
+"
+ xhtml_ns helm_ns
+ version configuration
+
+let empty_xml =
+"<?xml version=\"1.0\"?>
+<!DOCTYPE empty [
+ <!ELEMENT empty EMPTY>
+]>
+<empty />
+"
+
diff --git a/helm/ocaml/getter/http_getter_const.mli b/helm/ocaml/getter/http_getter_const.mli
new file mode 100644
index 000000000..d532313f0
--- /dev/null
+++ b/helm/ocaml/getter/http_getter_const.mli
@@ -0,0 +1,39 @@
+(*
+ * Copyright (C) 2003-2004:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val version: string
+val conffile: string
+val empty_xml: string
+
+val helm_ns: string (** helm namespace *)
+val xhtml_ns: string (** xhtml namespace *)
+
+ (** @return an HTML usage string including configuration information passed as
+ input parameter *)
+val usage_string: string -> string
+
diff --git a/helm/ocaml/getter/http_getter_env.ml b/helm/ocaml/getter/http_getter_env.ml
new file mode 100644
index 000000000..7a3891b98
--- /dev/null
+++ b/helm/ocaml/getter/http_getter_env.ml
@@ -0,0 +1,114 @@
+(*
+ * Copyright (C) 2003-2004:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+open Http_getter_types
+open Http_getter_misc
+
+let version = Http_getter_const.version
+
+let prefix_RE = Pcre.regexp "^\\s*([^\\s]+)\\s+([^\\s]+)\\s*(.*)$"
+
+let cache_dir = lazy (normalize_dir (Helm_registry.get "getter.cache_dir"))
+let dtd_dir = lazy (normalize_dir (Helm_registry.get "getter.dtd_dir"))
+let dtd_base_urls = lazy (
+ let rex = Pcre.regexp "/*$" in
+ let raw_urls =
+ match
+ Helm_registry.get_list Helm_registry.string "getter.dtd_base_urls"
+ with
+ | [] -> ["http://helm.cs.unibo.it/dtd"; "http://mowgli.cs.unibo.it/dtd"]
+ | urls -> urls
+ in
+ List.map (Pcre.replace ~rex) raw_urls)
+let port = lazy (
+ Helm_registry.get_opt_default Helm_registry.int ~default:58081 "getter.port")
+
+let parse_prefix_attrs s =
+ List.fold_right
+ (fun s acc ->
+ match s with
+ | "ro" -> `Read_only :: acc
+ | "legacy" -> `Legacy :: acc
+ | s ->
+ Http_getter_logger.log ("ignoring unknown attribute: " ^ s);
+ acc)
+ (Pcre.split s) []
+
+let prefixes = lazy (
+ let prefixes = Helm_registry.get_list Helm_registry.string "getter.prefix" in
+ List.fold_left
+ (fun acc prefix ->
+ let subs = Pcre.extract ~rex:prefix_RE prefix in
+ try
+ (subs.(1), (subs.(2), parse_prefix_attrs subs.(3))) :: acc
+ with Invalid_argument _ ->
+ Http_getter_logger.log ("skipping invalid prefix: " ^ prefix);
+ acc)
+ [] prefixes)
+
+let host = lazy (Http_getter_misc.backtick "hostname -f")
+
+let my_own_url =
+ lazy
+ (let (host, port) = (Lazy.force host, Lazy.force port) in
+ sprintf "http://%s%s" (* without trailing '/' *)
+ host (if port = 80 then "" else (sprintf ":%d" port)))
+
+let env_to_string () =
+ let pp_attr = function `Read_only -> "ro" | `Legacy -> "legacy" in
+ let pp_prefix (uri_prefix, (url_prefix, attrs)) =
+ sprintf " %s -> %s [%s]" uri_prefix url_prefix
+ (String.concat "," (List.map pp_attr attrs)) in
+ let pp_prefixes prefixes =
+ match prefixes with
+ | [] -> ""
+ | l -> "\n" ^ String.concat "\n" (List.map pp_prefix l)
+ in
+ sprintf
+"HTTP Getter %s
+
+prefixes:%s
+dtd_dir:\t%s
+host:\t\t%s
+port:\t\t%d
+my_own_url:\t%s
+dtd_base_urls:\t%s
+log_file:\t%s
+log_level:\t%d
+"
+ version
+ (pp_prefixes (Lazy.force prefixes))
+ (Lazy.force dtd_dir) (Lazy.force host) (Lazy.force port)
+ (Lazy.force my_own_url) (String.concat " " (Lazy.force dtd_base_urls))
+ (match Http_getter_logger.get_log_file () with None -> "None" | Some f -> f)
+ (Http_getter_logger.get_log_level ())
+
diff --git a/helm/ocaml/getter/http_getter_env.mli b/helm/ocaml/getter/http_getter_env.mli
new file mode 100644
index 000000000..6a0f0f50a
--- /dev/null
+++ b/helm/ocaml/getter/http_getter_env.mli
@@ -0,0 +1,52 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+open Http_getter_types
+
+ (** {2 general information} *)
+
+val version : string (* getter version *)
+
+ (** {2 environment gathered data} *)
+ (** all *_dir values are returned with trailing "/" *)
+
+val cache_dir : string lazy_t (* cache root *)
+val dtd_dir : string lazy_t (* DTDs' root directory *)
+val port : int lazy_t (* port on which getter listens *)
+val dtd_base_urls : string list lazy_t (* base URLs for document patching *)
+val prefixes : (string * (string * prefix_attr list)) list lazy_t
+ (* prefix map uri -> url + attrs *)
+
+ (* {2 derived data} *)
+
+val host : string lazy_t (* host on which getter listens *)
+val my_own_url : string lazy_t (* URL at which contact getter *)
+
+ (* {2 misc} *)
+
+val env_to_string : unit -> string (* dump a textual representation of the
+ current http_getter settings on an output
+ channel *)
+
diff --git a/helm/ocaml/getter/http_getter_logger.ml b/helm/ocaml/getter/http_getter_logger.ml
new file mode 100644
index 000000000..1d774c102
--- /dev/null
+++ b/helm/ocaml/getter/http_getter_logger.ml
@@ -0,0 +1,63 @@
+(*
+ * Copyright (C) 2003-2004:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let log_level = ref 1
+let get_log_level () = !log_level
+let set_log_level l = log_level := l
+
+(* invariant: if logfile is set, then logchan is set too *)
+let logfile = ref None
+let logchan = ref None
+
+let set_log_file f =
+ (match !logchan with None -> () | Some oc -> close_out oc);
+ match f with
+ | Some f ->
+ logfile := Some f;
+ logchan := Some (open_out f)
+ | None ->
+ logfile := None;
+ logchan := None
+
+let get_log_file () = !logfile
+
+let close_log_file () = set_log_file None
+
+let log ?(level = 1) s =
+ if level <= !log_level then
+ let msg = "[HTTP-Getter] " ^ s in
+ match (!logfile, !logchan) with
+ | None, _ -> prerr_endline msg
+ | Some fname, Some oc ->
+ output_string oc msg;
+ output_string oc "\n";
+ flush oc
+ | Some _, None -> assert false
+
diff --git a/helm/ocaml/getter/http_getter_logger.mli b/helm/ocaml/getter/http_getter_logger.mli
new file mode 100644
index 000000000..d39fe739d
--- /dev/null
+++ b/helm/ocaml/getter/http_getter_logger.mli
@@ -0,0 +1,49 @@
+(*
+ * Copyright (C) 2003-2004:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** {2 Debugger and logger} *)
+
+ (** log level
+ * 0 -> logging disabled
+ * 1 -> standard logging
+ * >=2 -> verbose logging
+ * default is 1 *)
+val get_log_level: unit -> int
+val set_log_level: int -> unit
+
+ (** log a message through the logger with a given log level
+ * level defaults to 1, higher level denotes more verbose messages which are
+ * ignored with the default log_level *)
+val log: ?level: int -> string -> unit
+
+ (** if set to Some fname, fname will be used as a logfile, otherwise stderr
+ * will be used *)
+val get_log_file: unit -> string option
+val set_log_file: string option -> unit
+val close_log_file: unit -> unit
+
diff --git a/helm/ocaml/getter/http_getter_misc.ml b/helm/ocaml/getter/http_getter_misc.ml
new file mode 100644
index 000000000..45403effa
--- /dev/null
+++ b/helm/ocaml/getter/http_getter_misc.ml
@@ -0,0 +1,315 @@
+(*
+ * Copyright (C) 2003-2004:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+let file_scheme_prefix = "file://"
+
+let trailing_dot_gz_RE = Pcre.regexp "\\.gz$" (* for g{,un}zip *)
+let url_RE = Pcre.regexp "^([\\w.-]+)(:(\\d+))?(/.*)?$"
+let http_scheme_RE = Pcre.regexp ~flags:[`CASELESS] "^http://"
+let file_scheme_RE = Pcre.regexp ~flags:[`CASELESS] ("^" ^ file_scheme_prefix)
+let dir_sep_RE = Pcre.regexp "/"
+let heading_slash_RE = Pcre.regexp "^/"
+
+let local_url =
+ let rex = Pcre.regexp ("^(" ^ file_scheme_prefix ^ ")(.*)(.gz)$") in
+ fun s ->
+ try
+ Some ((Pcre.extract ~rex s).(2))
+ with Not_found -> None
+
+let bufsiz = 16384 (* for file system I/O *)
+let tcp_bufsiz = 4096 (* for TCP I/O *)
+
+let fold_file f init fname =
+ let ic = open_in fname in
+ let rec aux acc =
+ let line = try Some (input_line ic) with End_of_file -> None in
+ match line with
+ | None -> acc
+ | Some line -> aux (f line acc)
+ in
+ let res = try aux init with e -> close_in ic; raise e in
+ close_in ic;
+ res
+
+let iter_file f = fold_file (fun line _ -> f line) ()
+
+let iter_buf_size = 10240
+
+let iter_file_data f fname =
+ let ic = open_in fname in
+ let buf = String.create iter_buf_size in
+ try
+ while true do
+ let bytes = input ic buf 0 iter_buf_size in
+ if bytes = 0 then raise End_of_file;
+ f (String.sub buf 0 bytes)
+ done
+ with End_of_file -> close_in ic
+
+let hashtbl_sorted_fold f tbl init =
+ let sorted_keys =
+ List.sort compare (Hashtbl.fold (fun key _ keys -> key::keys) tbl [])
+ in
+ List.fold_left (fun acc k -> f k (Hashtbl.find tbl k) acc) init sorted_keys
+
+let hashtbl_sorted_iter f tbl =
+ let sorted_keys =
+ List.sort compare (Hashtbl.fold (fun key _ keys -> key::keys) tbl [])
+ in
+ List.iter (fun k -> f k (Hashtbl.find tbl k)) sorted_keys
+
+let cp src dst =
+ try
+ let ic = open_in src in
+ try
+ let oc = open_out dst in
+ let buf = String.create bufsiz in
+ (try
+ while true do
+ let bytes = input ic buf 0 bufsiz in
+ if bytes = 0 then raise End_of_file else output oc buf 0 bytes
+ done
+ with
+ End_of_file -> ()
+ );
+ close_in ic; close_out oc
+ with
+ Sys_error s ->
+ Http_getter_logger.log s;
+ close_in ic
+ | e ->
+ Http_getter_logger.log (Printexc.to_string e);
+ close_in ic;
+ raise e
+ with
+ Sys_error s ->
+ Http_getter_logger.log s
+ | e ->
+ Http_getter_logger.log (Printexc.to_string e);
+ raise e
+
+let wget ?output url =
+ Http_getter_logger.log
+ (sprintf "wgetting %s (output: %s)" url
+ (match output with None -> "default" | Some f -> f));
+ match url with
+ | url when Pcre.pmatch ~rex:file_scheme_RE url -> (* file:// *)
+ (let src_fname = Pcre.replace ~rex:file_scheme_RE url in
+ match output with
+ | Some dst_fname -> cp src_fname dst_fname
+ | None ->
+ let dst_fname = Filename.basename src_fname in
+ if src_fname <> dst_fname then
+ cp src_fname dst_fname
+ else (* src and dst are the same: do nothing *)
+ ())
+ | url when Pcre.pmatch ~rex:http_scheme_RE url -> (* http:// *)
+ (let oc =
+ open_out (match output with Some f -> f | None -> Filename.basename url)
+ in
+ Http_user_agent.get_iter (fun data -> output_string oc data) url;
+ close_out oc)
+ | scheme -> (* unsupported scheme *)
+ failwith ("Http_getter_misc.wget: unsupported scheme: " ^ scheme)
+
+let gzip ?(keep = false) ?output fname =
+ let output = match output with None -> fname ^ ".gz" | Some fname -> fname in
+ Http_getter_logger.log ~level:3
+ (sprintf "gzipping %s (keep: %b, output: %s)" fname keep output);
+ let (ic, oc) = (open_in fname, Gzip.open_out output) in
+ let buf = String.create bufsiz in
+ (try
+ while true do
+ let bytes = input ic buf 0 bufsiz in
+ if bytes = 0 then raise End_of_file else Gzip.output oc buf 0 bytes
+ done
+ with End_of_file -> ());
+ close_in ic; Gzip.close_out oc;
+ if not keep then Sys.remove fname
+;;
+
+let gunzip ?(keep = false) ?output fname =
+ (* assumption: given file name ends with ".gz" or output is set *)
+ let output =
+ match output with
+ | None ->
+ if (Pcre.pmatch ~rex:trailing_dot_gz_RE fname) then
+ Pcre.replace ~rex:trailing_dot_gz_RE fname
+ else
+ failwith
+ "Http_getter_misc.gunzip: unable to determine output file name"
+ | Some fname -> fname
+ in
+ Http_getter_logger.log ~level:3
+ (sprintf "gunzipping %s (keep: %b, output: %s)" fname keep output);
+ (* Open the zipped file manually since Gzip.open_in may
+ * leak the descriptor if it raises an exception *)
+ let zic = open_in fname in
+ begin
+ try
+ let ic = Gzip.open_in_chan zic in
+ let oc = open_out output in
+ let buf = String.create bufsiz in
+ (try
+ while true do
+ let bytes = Gzip.input ic buf 0 bufsiz in
+ if bytes = 0 then raise End_of_file else Pervasives.output oc buf 0 bytes
+ done
+ with End_of_file -> ());
+ close_out oc;
+ Gzip.close_in ic
+ with
+ e -> close_in zic ; raise e
+ end ;
+ if not keep then Sys.remove fname
+;;
+
+let tempfile () = Filename.temp_file "http_getter_" ""
+
+exception Mkdir_failure of string * string;; (* dirname, failure reason *)
+let dir_perm = 0o755
+
+let mkdir ?(parents = false) dirname =
+ let mkdirhier () =
+ let (pieces, hd) =
+ let split = Pcre.split ~rex:dir_sep_RE dirname in
+ if Pcre.pmatch ~rex:heading_slash_RE dirname then
+ (List.tl split, "/")
+ else
+ (split, "")
+ in
+ ignore
+ (List.fold_left
+ (fun pre dir ->
+ let next_dir =
+ sprintf "%s%s%s" pre (match pre with "/" | "" -> "" | _ -> "/") dir
+ in
+ (try
+ (match (Unix.stat next_dir).Unix.st_kind with
+ | Unix.S_DIR -> () (* dir component already exists, go on! *)
+ | _ -> (* dir component already exists but isn't a dir, abort! *)
+ raise
+ (Mkdir_failure (dirname,
+ sprintf "'%s' already exists but is not a dir" next_dir)))
+ with Unix.Unix_error (Unix.ENOENT, "stat", _) ->
+ (* dir component doesn't exists, create it and go on! *)
+ Unix.mkdir next_dir dir_perm);
+ next_dir)
+ hd pieces)
+ in
+ if parents then mkdirhier () else Unix.mkdir dirname dir_perm
+
+let string_of_proc_status = function
+ | Unix.WEXITED code -> sprintf "[Exited: %d]" code
+ | Unix.WSIGNALED sg -> sprintf "[Killed: %d]" sg
+ | Unix.WSTOPPED sg -> sprintf "[Stopped: %d]" sg
+
+let http_get url =
+ if Pcre.pmatch ~rex:file_scheme_RE url then begin
+ (* file:// URL. Read data from file system *)
+ let fname = Pcre.replace ~rex:file_scheme_RE url in
+ try
+ let size = (Unix.stat fname).Unix.st_size in
+ let buf = String.create size in
+ let ic = open_in fname in
+ really_input ic buf 0 size ;
+ close_in ic;
+ Some buf
+ with Unix.Unix_error (Unix.ENOENT, "stat", _) -> None
+ end else (* other URL, pass it to Http_user_agent *)
+ try
+ Some (Http_user_agent.get url)
+ with e ->
+ Http_getter_logger.log (sprintf
+ "Warning: Http_user_agent failed on url %s with exception: %s"
+ url (Printexc.to_string e));
+ None
+
+let is_blank_line =
+ let blank_line_RE = Pcre.regexp "(^#)|(^\\s*$)" in
+ fun line ->
+ Pcre.pmatch ~rex:blank_line_RE line
+
+let normalize_dir s = (* append "/" if missing *)
+ let len = String.length s in
+ try
+ if s.[len - 1] = '/' then s
+ else s ^ "/"
+ with Invalid_argument _ -> (* string is empty *) "/"
+
+let strip_trailing_slash s =
+ try
+ let len = String.length s in
+ if s.[len - 1] = '/' then String.sub s 0 (len - 1)
+ else s
+ with Invalid_argument _ -> s
+
+let strip_suffix ~suffix s =
+ try
+ let s_len = String.length s in
+ let suffix_len = String.length suffix in
+ let suffix_sub = String.sub s (s_len - suffix_len) suffix_len in
+ if suffix_sub <> suffix then raise (Invalid_argument "");
+ String.sub s 0 (s_len - suffix_len)
+ with Invalid_argument _ ->
+ raise (Invalid_argument "Http_getter_misc.strip_suffix")
+
+let rec list_uniq = function
+ | [] -> []
+ | h::[] -> [h]
+ | h1::h2::tl when h1 = h2 -> list_uniq (h2 :: tl)
+ | h1::tl (* when h1 <> h2 *) -> h1 :: list_uniq tl
+
+let extension s =
+ try
+ let idx = String.rindex s '.' in
+ String.sub s idx (String.length s - idx)
+ with Not_found -> ""
+
+let temp_file_of_uri uri =
+ let flat_string s s' c =
+ let cs = String.copy s in
+ for i = 0 to (String.length s) - 1 do
+ if String.contains s' s.[i] then cs.[i] <- c
+ done;
+ cs
+ in
+ let user = try Unix.getlogin () with _ -> "" in
+ Filename.open_temp_file (user ^ flat_string uri ".-=:;!?/&" '_') ""
+
+let backtick cmd =
+ let ic = Unix.open_process_in cmd in
+ let res = input_line ic in
+ ignore (Unix.close_process_in ic);
+ res
+
diff --git a/helm/ocaml/getter/http_getter_misc.mli b/helm/ocaml/getter/http_getter_misc.mli
new file mode 100644
index 000000000..e9b013ebd
--- /dev/null
+++ b/helm/ocaml/getter/http_getter_misc.mli
@@ -0,0 +1,102 @@
+(*
+ * Copyright (C) 2003-2004:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+ (** 'mkdir' failed, arguments are: name of the directory to be created and
+ failure reason *)
+exception Mkdir_failure of string * string
+
+ (** @return Some localpart for URI belonging to the "file://" scheme, None for
+ * other URIs
+ * removes trailing ".gz", if any
+ * e.g.: local_url "file:///etc/passwd.gz" = Some "/etc/passwd"
+ * local_url "http://...." = None *)
+val local_url: string -> string option
+
+ (** "fold_left" like function on file lines, trailing newline is not passed to
+ the given function *)
+val fold_file : (string -> 'a -> 'a) -> 'a -> string -> 'a
+
+ (* "iter" like function on file lines, trailing newline is not passed to the
+ given function *)
+val iter_file : (string -> unit) -> string -> unit
+
+ (* "iter" like function on file data chunks of fixed size *)
+val iter_file_data: (string -> unit) -> string -> unit
+
+ (** like Hashtbl.fold but keys are processed ordered *)
+val hashtbl_sorted_fold :
+ ('a -> 'b -> 'c -> 'c) -> ('a, 'b) Hashtbl.t -> 'c -> 'c
+ (** like Hashtbl.iter but keys are processed ordered *)
+val hashtbl_sorted_iter : ('a -> 'b -> unit) -> ('a, 'b) Hashtbl.t -> unit
+
+val list_uniq: 'a list -> 'a list (* uniq unix filter on lists *)
+
+ (** cp frontend *)
+val cp: string -> string -> unit
+ (** wget frontend, if output is given it is the destination file, otherwise
+ standard wget rules are used. Additionally this function support also the
+ "file://" scheme for file system addressing *)
+val wget: ?output: string -> string -> unit
+ (** gzip frontend. If keep = true original file will be kept, default is
+ false. output is the file on which gzipped data will be saved, default is
+ given file with an added ".gz" suffix *)
+val gzip: ?keep: bool -> ?output: string -> string -> unit
+ (** gunzip frontend. If keep = true original file will be kept, default is
+ false. output is the file on which gunzipped data will be saved, default is
+ given file name without trailing ".gz" *)
+val gunzip: ?keep: bool -> ?output: string -> string -> unit
+ (** tempfile frontend, return the name of created file. A special purpose
+ suffix is used (actually "_http_getter" *)
+val tempfile: unit -> string
+ (** mkdir frontend, if parents = true also parent directories will be created.
+ If the given directory already exists doesn't act.
+ parents defaults to false *)
+val mkdir: ?parents:bool -> string -> unit
+
+ (** pretty printer for Unix.process_status values *)
+val string_of_proc_status : Unix.process_status -> string
+
+ (** raw URL downloader, return Some the contents of downloaded resource or
+ None if an error occured while downloading. This function support also
+ "file://" scheme for filesystem resources *)
+val http_get: string -> string option
+
+ (** true on blanks-only and #-commented lines, false otherwise *)
+val is_blank_line: string -> bool
+
+val normalize_dir: string -> string (** add trailing "/" if missing *)
+val strip_trailing_slash: string -> string
+val strip_suffix: suffix:string -> string -> string
+
+val extension: string -> string (** @return string part after rightmost "." *)
+
+val temp_file_of_uri: string -> string * out_channel
+
+ (** execute a command and return first line of what it prints on stdout *)
+val backtick: string -> string
+
diff --git a/helm/ocaml/getter/http_getter_storage.ml b/helm/ocaml/getter/http_getter_storage.ml
new file mode 100644
index 000000000..fc6f415ac
--- /dev/null
+++ b/helm/ocaml/getter/http_getter_storage.ml
@@ -0,0 +1,275 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+open Http_getter_misc
+open Http_getter_types
+
+exception Not_found'
+exception Resource_not_found of string * string (** method, uri *)
+
+let index_fname = "INDEX"
+
+let trailing_slash_RE = Pcre.regexp "/$"
+let relative_RE_raw = "(^[^/]+(/[^/]+)*/?$)"
+let relative_RE = Pcre.regexp relative_RE_raw
+let file_scheme_RE_raw = "(^file://)"
+let extended_file_scheme_RE = Pcre.regexp "(^file:/+)"
+let file_scheme_RE = Pcre.regexp (relative_RE_raw ^ "|" ^ file_scheme_RE_raw)
+let http_scheme_RE = Pcre.regexp "^http://"
+let newline_RE = Pcre.regexp "\\n"
+let cic_scheme_sep_RE = Pcre.regexp ":/"
+let gz_suffix = ".gz"
+let gz_suffix_len = String.length gz_suffix
+
+let path_of_file_url url =
+ assert (Pcre.pmatch ~rex:file_scheme_RE url);
+ if Pcre.pmatch ~rex:relative_RE url then
+ url
+ else (* absolute path, add heading "/" if missing *)
+ "/" ^ (Pcre.replace ~rex:extended_file_scheme_RE url)
+
+ (** associative list regular expressions -> url prefixes
+ * sorted with longest prefixes first *)
+let prefix_map = lazy (
+ let map_w_length =
+ List.map
+ (fun (uri_prefix, (url_prefix, attrs)) ->
+ let uri_prefix = normalize_dir uri_prefix in
+ let url_prefix = normalize_dir url_prefix in
+ let regexp = Pcre.regexp ("^(" ^ Pcre.quote uri_prefix ^ ")") in
+ (regexp, String.length uri_prefix, uri_prefix, url_prefix, attrs))
+ (Lazy.force Http_getter_env.prefixes)
+ in
+ let decreasing_length (_, len1, _, _, _) (_, len2, _, _, _) =
+ compare len2 len1 in
+ List.map
+ (fun (regexp, len, uri_prefix, url_prefix, attrs) ->
+ (regexp, strip_trailing_slash uri_prefix, url_prefix, attrs))
+ (List.fast_sort decreasing_length map_w_length))
+
+let lookup uri =
+ let matches =
+ List.filter (fun (rex, _, _, _) -> Pcre.pmatch ~rex uri)
+ (Lazy.force prefix_map) in
+ if matches = [] then raise (Unresolvable_URI uri);
+ matches
+
+let resolve_prefix uri =
+ match lookup uri with
+ | (rex, _, url_prefix, _) :: _ ->
+ Pcre.replace_first ~rex ~templ:url_prefix uri
+ | [] -> assert false
+
+let resolve_prefixes uri =
+ let matches = lookup uri in
+ List.map
+ (fun (rex, _, url_prefix, _) ->
+ Pcre.replace_first ~rex ~templ:url_prefix uri)
+ matches
+
+let get_attrs uri =
+ match lookup uri with
+ | (_, _, _, attrs) :: _ -> attrs
+ | [] -> assert false
+
+let is_legacy uri = List.exists ((=) `Legacy) (get_attrs uri)
+
+let is_read_only uri =
+ is_legacy uri || List.exists ((=) `Read_only) (get_attrs uri)
+
+let exists_http _ url =
+ Http_getter_wget.exists (url ^ gz_suffix) || Http_getter_wget.exists url
+
+let exists_file _ fname =
+ Sys.file_exists (fname ^ gz_suffix) || Sys.file_exists fname
+
+let resolve_http _ url =
+ try
+ List.find Http_getter_wget.exists [ url ^ gz_suffix; url ]
+ with Not_found -> raise Not_found'
+
+let resolve_file _ fname =
+ try
+ List.find Sys.file_exists [ fname ^ gz_suffix; fname ]
+ with Not_found -> raise Not_found'
+
+let strip_gz_suffix fname =
+ if extension fname = gz_suffix then
+ String.sub fname 0 (String.length fname - gz_suffix_len)
+ else
+ fname
+
+let remove_duplicates l =
+ Http_getter_misc.list_uniq (List.fast_sort Pervasives.compare l)
+
+let ls_file_single _ path_prefix =
+ let is_dir fname = (Unix.stat fname).Unix.st_kind = Unix.S_DIR in
+ let is_useless dir = try dir.[0] = '.' with _ -> false in
+ let entries = ref [] in
+ try
+ let dir_handle = Unix.opendir path_prefix in
+ (try
+ while true do
+ let entry = Unix.readdir dir_handle in
+ if is_useless entry then
+ ()
+ else if is_dir (path_prefix ^ "/" ^ entry) then
+ entries := normalize_dir entry :: !entries
+ else
+ entries := strip_gz_suffix entry :: !entries
+ done
+ with End_of_file -> Unix.closedir dir_handle);
+ remove_duplicates !entries
+ with Unix.Unix_error (_, "opendir", _) -> []
+
+let ls_http_single _ url_prefix =
+ try
+ let index = Http_getter_wget.get (normalize_dir url_prefix ^ index_fname) in
+ Pcre.split ~rex:newline_RE index
+ with Http_client_error _ -> raise Not_found'
+
+let get_file _ path =
+ if Sys.file_exists (path ^ gz_suffix) then
+ path ^ gz_suffix
+ else if Sys.file_exists path then
+ path
+ else
+ raise Not_found'
+
+let get_http uri url =
+ let scheme, path =
+ match Pcre.split ~rex:cic_scheme_sep_RE uri with
+ | [scheme; path] -> scheme, path
+ | _ -> assert false
+ in
+ let cache_name =
+ sprintf "%s%s/%s" (Lazy.force Http_getter_env.cache_dir) scheme path
+ in
+ if Sys.file_exists (cache_name ^ gz_suffix) then
+ cache_name ^ gz_suffix
+ else if Sys.file_exists cache_name then
+ cache_name
+ else begin (* fill cache *)
+ Http_getter_misc.mkdir ~parents:true (Filename.dirname cache_name);
+ (try
+ Http_getter_wget.get_and_save (url ^ gz_suffix) (cache_name ^ gz_suffix);
+ cache_name ^ gz_suffix
+ with Http_client_error _ ->
+ (try
+ Http_getter_wget.get_and_save url cache_name;
+ cache_name
+ with Http_client_error _ ->
+ raise Not_found'))
+ end
+
+let remove_file _ path =
+ if Sys.file_exists (path ^ gz_suffix) then Sys.remove (path ^ gz_suffix);
+ if Sys.file_exists path then Sys.remove path
+
+let remove_http _ _ =
+ prerr_endline "Http_getter_storage.remove: not implemented for HTTP scheme";
+ assert false
+
+type 'a storage_method = {
+ name: string;
+ file: string -> string -> 'a; (* unresolved uri, resolved uri *)
+ http: string -> string -> 'a; (* unresolved uri, resolved uri *)
+}
+
+let normalize_root uri = (* add trailing slash to roots *)
+ try
+ if uri.[String.length uri - 1] = ':' then uri ^ "/"
+ else uri
+ with Invalid_argument _ -> uri
+
+let invoke_method storage_method uri url =
+ try
+ if Pcre.pmatch ~rex:file_scheme_RE url then
+ storage_method.file uri (path_of_file_url url)
+ else if Pcre.pmatch ~rex:http_scheme_RE url then
+ storage_method.http uri url
+ else
+ raise (Unsupported_scheme url)
+ with Not_found' -> raise (Resource_not_found (storage_method.name, uri))
+
+let dispatch_single storage_method uri =
+ assert (extension uri <> gz_suffix);
+ let uri = normalize_root uri in
+ let url = resolve_prefix uri in
+ invoke_method storage_method uri url
+
+let dispatch_multi storage_method uri =
+ let urls = resolve_prefixes uri in
+ let rec aux = function
+ | [] -> raise (Resource_not_found (storage_method.name, uri))
+ | url :: tl ->
+ (try
+ invoke_method storage_method uri url
+ with Resource_not_found _ -> aux tl)
+ in
+ aux urls
+
+let exists =
+ dispatch_single { name = "exists"; file = exists_file; http = exists_http }
+
+let resolve =
+ dispatch_single { name = "resolve"; file = resolve_file; http = resolve_http }
+
+let ls_single =
+ dispatch_single { name = "ls"; file = ls_file_single; http = ls_http_single }
+
+let remove =
+ dispatch_single { name = "remove"; file = remove_file; http = remove_http }
+
+let filename ?(find = false) =
+ if find then
+ dispatch_multi { name = "filename"; file = get_file; http = get_http }
+ else
+ dispatch_single { name = "filename"; file = get_file; http = get_http }
+
+ (* ls_single performs ls only below a single prefix, but prefixes which have
+ * common prefix (sorry) with a given one may need to be considered as well
+ * for example: when doing "ls cic:/" we would like to see the "cic:/matita"
+ * directory *)
+let ls uri_prefix =
+(* prerr_endline ("Http_getter_storage.ls " ^ uri_prefix); *)
+ let direct_results = ls_single uri_prefix in
+ List.fold_left
+ (fun results (_, uri_prefix', _, _) ->
+ if Filename.dirname uri_prefix' = strip_trailing_slash uri_prefix then
+ (Filename.basename uri_prefix' ^ "/") :: results
+ else
+ results)
+ direct_results
+ (Lazy.force prefix_map)
+
+let clean_cache () =
+ ignore (Sys.command
+ (sprintf "rm -rf %s/" (Lazy.force Http_getter_env.cache_dir)))
+
diff --git a/helm/ocaml/getter/http_getter_storage.mli b/helm/ocaml/getter/http_getter_storage.mli
new file mode 100644
index 000000000..24fc329c9
--- /dev/null
+++ b/helm/ocaml/getter/http_getter_storage.mli
@@ -0,0 +1,71 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** Transparent handling of local/remote getter resources.
+ * Configuration of this module are prefix mappings (see
+ * Http_getter_env.prefixes). All functions of this module take as input an URI,
+ * resolve it using mappings and act on the resulting resource which can be
+ * local (file:/// scheme or relative path) or remote via HTTP (http:// scheme).
+ *
+ * Each resource could be either compressed (trailing ".gz") or non-compressed.
+ * All functions of this module will first loook for the compressed resource
+ * (i.e. the asked one ^ ".gz"), falling back to the non-compressed one.
+ *
+ * All filenames returned by functions of this module exists on the filesystem
+ * after function's return.
+ *
+ * Almost all functions may raise Resource_not_found, the following invariant
+ * holds: that exception is raised iff exists return false on a given resource
+ * *)
+
+exception Resource_not_found of string * string (** method, uri *)
+
+ (** @return a list of string where dir are returned with a trailing "/" *)
+val ls: string -> string list
+
+
+ (** @return the filename of the resource corresponding to a given uri. Handle
+ * download and caching for remote resources.
+ * @param find if set to true all matching prefixes will be searched for the
+ * asked resource, if not only the best matching prefix will be used. Note
+ * that the search is performed only if the asked resource is not found in
+ * cache (i.e. to perform the find again you need to clean the cache).
+ * Defaults to false *)
+val filename: ?find:bool -> string -> string
+
+ (** only works for local resources
+ * if both compressed and non-compressed versions of a resource exist, both of
+ * them are removed *)
+val remove: string -> unit
+
+val exists: string -> bool
+val resolve: string -> string
+
+(* val get_attrs: string -> Http_getter_types.prefix_attr list *)
+val is_read_only: string -> bool
+val is_legacy: string -> bool
+
+val clean_cache: unit -> unit
+
diff --git a/helm/ocaml/getter/http_getter_types.ml b/helm/ocaml/getter/http_getter_types.ml
new file mode 100644
index 000000000..fb0c30e83
--- /dev/null
+++ b/helm/ocaml/getter/http_getter_types.ml
@@ -0,0 +1,72 @@
+(*
+ * Copyright (C) 2003-2004:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+exception Bad_request of string
+exception Unresolvable_URI of string
+exception Invalid_URI of string
+exception Invalid_URL of string
+exception Invalid_RDF_class of string
+exception Internal_error of string
+exception Cache_failure of string
+exception Dtd_not_found of string (* dtd's url *)
+exception Key_already_in of string;;
+exception Key_not_found of string;;
+exception Http_client_error of string * string (* url, error message *)
+exception Unsupported_scheme of string (** unsupported url scheme *)
+
+type encoding = [ `Normal | `Gzipped ]
+type answer_format = [ `Text | `Xml ]
+type ls_flag = No | Yes | Ann
+type ls_object =
+ {
+ uri: string;
+ ann: bool;
+ types: ls_flag;
+ body: ls_flag;
+ proof_tree: ls_flag;
+ }
+type ls_item =
+ | Ls_section of string
+ | Ls_object of ls_object
+
+type xml_uri =
+ | Cic of string
+ | Theory of string
+type rdf_uri = string * xml_uri
+type nuprl_uri = string
+type uri =
+ | Cic_uri of xml_uri
+ | Nuprl_uri of nuprl_uri
+ | Rdf_uri of rdf_uri
+
+module StringSet = Set.Make (String)
+
+type prefix_attr = [ `Read_only | `Legacy ]
+
diff --git a/helm/ocaml/getter/http_getter_wget.ml b/helm/ocaml/getter/http_getter_wget.ml
new file mode 100644
index 000000000..2052e7bd5
--- /dev/null
+++ b/helm/ocaml/getter/http_getter_wget.ml
@@ -0,0 +1,70 @@
+(* Copyright (C) 2000-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+open Http_getter_types
+
+let send cmd =
+ try
+ ignore (Http_user_agent.get cmd)
+ with exn -> raise (Http_client_error (cmd, Printexc.to_string exn))
+
+let get url =
+ try
+ Http_user_agent.get url
+ with exn -> raise (Http_client_error (Printexc.to_string exn, url))
+
+let get_and_save url dest_filename =
+ let out_channel = open_out dest_filename in
+ (try
+ Http_user_agent.get_iter (output_string out_channel) url;
+ with exn ->
+ close_out out_channel;
+ Sys.remove dest_filename;
+ raise (Http_client_error (Printexc.to_string exn, url)));
+ close_out out_channel
+
+let get_and_save_to_tmp url =
+ let flat_string s s' c =
+ let cs = String.copy s in
+ for i = 0 to (String.length s) - 1 do
+ if String.contains s' s.[i] then cs.[i] <- c
+ done;
+ cs
+ in
+ let user = try Unix.getlogin () with _ -> "" in
+ let tmp_file =
+ Filename.temp_file (user ^ flat_string url ".-=:;!?/&" '_') ""
+ in
+ get_and_save url tmp_file;
+ tmp_file
+
+let exists url =
+ try
+ ignore (Http_user_agent.head url);
+ true
+ with Http_user_agent.Http_error _ -> false
+
diff --git a/helm/ocaml/getter/http_getter_wget.mli b/helm/ocaml/getter/http_getter_wget.mli
new file mode 100644
index 000000000..5d28df185
--- /dev/null
+++ b/helm/ocaml/getter/http_getter_wget.mli
@@ -0,0 +1,35 @@
+(* Copyright (C) 2000-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+ (** try to guess if an HTTP resource exists using HEAD request
+ * @return true if HEAD response code = 200 *)
+val exists: string -> bool
+
+val get: string -> string
+val get_and_save: string -> string -> unit
+val get_and_save_to_tmp: string -> string
+
+val send: string -> unit
+
diff --git a/helm/ocaml/getter/mkindexes.pl b/helm/ocaml/getter/mkindexes.pl
new file mode 100755
index 000000000..3107846aa
--- /dev/null
+++ b/helm/ocaml/getter/mkindexes.pl
@@ -0,0 +1,40 @@
+#!/usr/bin/perl -w
+# To be invoked in a directory where a tree of XML files of the HELM library is
+# rooted. This script will then creates INDEX files in all directories of the
+# tree.
+use strict;
+my $index_fname = "INDEX";
+sub getcwd() {
+ my $pwd = `pwd`;
+ chomp $pwd;
+ return $pwd;
+}
+sub add_trailing_slash($) {
+ my ($dir) = @_;
+ return $dir if ($dir =~ /\/$/);
+ return "$dir/";
+}
+sub indexable($) {
+ my ($fname) = @_;
+ return 1 if ($fname =~ /\.(ind|types|body|var|theory).xml/);
+ return 0;
+}
+my @todo = (getcwd());
+while (my $dir = shift @todo) {
+ print "$dir\n";
+ chdir $dir or die "Can't chdir to $dir\n";
+ open LS, 'ls | sed \'s/\\.gz//\' | sort | uniq |';
+ open INDEX, "> $index_fname"
+ or die "Can't open $index_fname in " . getcwd() . "\n";
+ while (my $entry = <LS>) {
+ chomp $entry;
+ if (-d $entry) {
+ print INDEX add_trailing_slash($entry) . "\n";
+ push @todo, getcwd() . "/$entry";
+ } else {
+ print INDEX "$entry\n" if indexable($entry);
+ }
+ }
+ close INDEX;
+ close LS;
+}
diff --git a/helm/ocaml/getter/sample.conf.xml b/helm/ocaml/getter/sample.conf.xml
new file mode 100644
index 000000000..54cdc2557
--- /dev/null
+++ b/helm/ocaml/getter/sample.conf.xml
@@ -0,0 +1,50 @@
+<helm_registry>
+ <section name="getter">
+ <key name="cache_dir">/tmp/helm/cache</key>
+ <key name="dtd_dir">/projects/helm/xml/dtd</key>
+ <key name="port">58081</key>
+ <key name="log_level">180</key>
+ <key name="log_file">http_getter.log</key>
+ <key name="prefix">
+ theory:/ file:///projects/helm/library/theories/
+ </key>
+ <key name="prefix">
+ xslt:/ file:///projects/helm/xml/stylesheets_ccorn/
+ </key>
+ <key name="prefix">
+ xslt:/ file:///projects/helm/xml/stylesheets_hanane/
+ </key>
+ <key name="prefix">
+ xslt:/ file:///projects/helm/xml/on-line/xslt/
+ </key>
+ <key name="prefix">
+ xslt:/ file:///projects/helm/nuprl/NuPRL/nuprl_stylesheets/
+ </key>
+ <key name="prefix">
+ nuprl:/ http://www.cs.uwyo.edu/~nuprl/helm-library/
+ </key>
+ <key name="prefix">
+ xslt:/ file:///projects/helm/xml/stylesheets/
+ </key>
+ <key name="prefix">
+ xslt:/ file:///projects/helm/xml/stylesheets/generated/
+ </key>
+ <key name="prefix">
+ theory:/residual_theory_in_lambda_calculus/
+ http://helm.cs.unibo.it/~sacerdot/huet_lambda_calculus_mowgli/residual_theory_in_lambda_calculus/
+ </key>
+ <key name="prefix">
+ theory:/IDA/
+ http://mowgli.cs.unibo.it/~sacerdot/ida/IDA/
+ </key>
+ <key name="prefix">
+ cic:/ file:///projects/helm/library/coq_contribs/
+ legacy
+ </key>
+ <key name="prefix">
+ cic:/matita/
+ file:///projects/helm/library/matita/
+ ro
+ </key>
+ </section>
+</helm_registry>
diff --git a/helm/ocaml/getter/test.ml b/helm/ocaml/getter/test.ml
new file mode 100644
index 000000000..6fa236fd0
--- /dev/null
+++ b/helm/ocaml/getter/test.ml
@@ -0,0 +1,12 @@
+(* $Id$ *)
+
+let _ = Helm_registry.load_from "foo.conf.xml"
+let fname = Http_getter.getxml ~format:`Normal ~patch_dtd:true Sys.argv.(1) in
+let ic = open_in fname in
+(try
+ while true do
+ let line = input_line ic in
+ print_endline line
+ done
+with End_of_file -> ())
+
diff --git a/helm/ocaml/grafite/.depend b/helm/ocaml/grafite/.depend
new file mode 100644
index 000000000..dc225e221
--- /dev/null
+++ b/helm/ocaml/grafite/.depend
@@ -0,0 +1,6 @@
+grafiteAstPp.cmi: grafiteAst.cmo
+grafiteMarshal.cmi: grafiteAst.cmo
+grafiteAstPp.cmo: grafiteAst.cmo grafiteAstPp.cmi
+grafiteAstPp.cmx: grafiteAst.cmx grafiteAstPp.cmi
+grafiteMarshal.cmo: grafiteAstPp.cmi grafiteAst.cmo grafiteMarshal.cmi
+grafiteMarshal.cmx: grafiteAstPp.cmx grafiteAst.cmx grafiteMarshal.cmi
diff --git a/helm/ocaml/grafite/Makefile b/helm/ocaml/grafite/Makefile
new file mode 100644
index 000000000..182cd4561
--- /dev/null
+++ b/helm/ocaml/grafite/Makefile
@@ -0,0 +1,13 @@
+PACKAGE = grafite
+PREDICATES =
+
+INTERFACE_FILES = \
+ grafiteAstPp.mli \
+ grafiteMarshal.mli \
+ $(NULL)
+IMPLEMENTATION_FILES = \
+ grafiteAst.ml \
+ $(INTERFACE_FILES:%.mli=%.ml)
+
+
+include ../Makefile.common
diff --git a/helm/ocaml/grafite/grafiteAst.ml b/helm/ocaml/grafite/grafiteAst.ml
new file mode 100644
index 000000000..c9567155d
--- /dev/null
+++ b/helm/ocaml/grafite/grafiteAst.ml
@@ -0,0 +1,167 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+type direction = [ `LeftToRight | `RightToLeft ]
+
+type loc = Token.flocation
+
+type ('term, 'lazy_term, 'ident) pattern =
+ 'lazy_term option * ('ident * 'term) list * 'term option
+
+type ('term, 'ident) type_spec =
+ | Ident of 'ident
+ | Type of UriManager.uri * int
+
+type 'lazy_term reduction =
+ [ `Normalize
+ | `Reduce
+ | `Simpl
+ | `Unfold of 'lazy_term option
+ | `Whd ]
+
+type ('term, 'lazy_term, 'reduction, 'ident) tactic =
+ | Absurd of loc * 'term
+ | Apply of loc * 'term
+ | Assumption of loc
+ | Auto of loc * int option * int option * string option * string option
+ (* depth, width, paramodulation, full *) (* ALB *)
+ | Change of loc * ('term, 'lazy_term, 'ident) pattern * 'lazy_term
+ | Clear of loc * 'ident
+ | ClearBody of loc * 'ident
+ | Compare of loc * 'term
+ | Constructor of loc * int
+ | Contradiction of loc
+ | Cut of loc * 'ident option * 'term
+ | DecideEquality of loc
+ | Decompose of loc * ('term, 'ident) type_spec list * 'ident * 'ident list
+ | Discriminate of loc * 'term
+ | Elim of loc * 'term * 'term option * int option * 'ident list
+ | ElimType of loc * 'term * 'term option * int option * 'ident list
+ | Exact of loc * 'term
+ | Exists of loc
+ | Fail of loc
+ | Fold of loc * 'reduction * 'lazy_term * ('term, 'lazy_term, 'ident) pattern
+ | Fourier of loc
+ | FwdSimpl of loc * string * 'ident list
+ | Generalize of loc * ('term, 'lazy_term, 'ident) pattern * 'ident option
+ | Goal of loc * int (* change current goal, argument is goal number 1-based *)
+ | IdTac of loc
+ | Injection of loc * 'term
+ | Intros of loc * int option * 'ident list
+ | Inversion of loc * 'term
+ | LApply of loc * int option * 'term list * 'term * 'ident option
+ | Left of loc
+ | LetIn of loc * 'term * 'ident
+ | Reduce of loc * 'reduction * ('term, 'lazy_term, 'ident) pattern
+ | Reflexivity of loc
+ | Replace of loc * ('term, 'lazy_term, 'ident) pattern * 'lazy_term
+ | Rewrite of loc * direction * 'term *
+ ('term, 'lazy_term, 'ident) pattern
+ | Right of loc
+ | Ring of loc
+ | Split of loc
+ | Symmetry of loc
+ | Transitivity of loc * 'term
+
+type search_kind = [ `Locate | `Hint | `Match | `Elim ]
+
+type print_kind = [ `Env | `Coer ]
+
+type 'term macro =
+ (* Whelp's stuff *)
+ | WHint of loc * 'term
+ | WMatch of loc * 'term
+ | WInstance of loc * 'term
+ | WLocate of loc * string
+ | WElim of loc * 'term
+ (* real macros *)
+(* | Abort of loc *)
+ | Print of loc * string
+ | Check of loc * 'term
+ | Hint of loc
+ | Quit of loc
+(* | Redo of loc * int option
+ | Undo of loc * int option *)
+(* | Print of loc * print_kind *)
+ | Search_pat of loc * search_kind * string (* searches with string pattern *)
+ | Search_term of loc * search_kind * 'term (* searches with term pattern *)
+
+(** To be increased each time the command type below changes, used for "safe"
+ * marshalling *)
+let magic = 5
+
+type 'obj command =
+ | Default of loc * string * UriManager.uri list
+ | Include of loc * string
+ | Set of loc * string * string
+ | Drop of loc
+ | Qed of loc
+ | Coercion of loc * UriManager.uri * bool (* add composites *)
+ | Obj of loc * 'obj
+
+type ('term, 'lazy_term, 'reduction, 'ident) tactical =
+ | Tactic of loc * ('term, 'lazy_term, 'reduction, 'ident) tactic
+ | Do of loc * int * ('term, 'lazy_term, 'reduction, 'ident) tactical
+ | Repeat of loc * ('term, 'lazy_term, 'reduction, 'ident) tactical
+ | Seq of loc * ('term, 'lazy_term, 'reduction, 'ident) tactical list
+ (* sequential composition *)
+ | Then of loc * ('term, 'lazy_term, 'reduction, 'ident) tactical *
+ ('term, 'lazy_term, 'reduction, 'ident) tactical list
+ | First of loc * ('term, 'lazy_term, 'reduction, 'ident) tactical list
+ (* try a sequence of loc * tactical until one succeeds, fail otherwise *)
+ | Try of loc * ('term, 'lazy_term, 'reduction, 'ident) tactical
+ (* try a tactical and mask failures *)
+ | Solve of loc * ('term, 'lazy_term, 'reduction, 'ident) tactical list
+
+ | Dot of loc
+ | Semicolon of loc
+ | Branch of loc
+ | Shift of loc
+ | Pos of loc * int
+ | Merge of loc
+ | Focus of loc * int list
+ | Unfocus of loc
+ | Skip of loc
+
+let is_punctuation =
+ function
+ | Dot _ | Semicolon _ | Branch _ | Shift _ | Merge _ | Pos _ -> true
+ | _ -> false
+
+type ('term, 'lazy_term, 'reduction, 'obj, 'ident) code =
+ | Command of loc * 'obj command
+ | Macro of loc * 'term macro
+ | Tactical of loc * ('term, 'lazy_term, 'reduction, 'ident) tactical
+ * ('term, 'lazy_term, 'reduction, 'ident) tactical option(* punctuation *)
+
+type ('term, 'lazy_term, 'reduction, 'obj, 'ident) comment =
+ | Note of loc * string
+ | Code of loc * ('term, 'lazy_term, 'reduction, 'obj, 'ident) code
+
+type ('term, 'lazy_term, 'reduction, 'obj, 'ident) statement =
+ | Executable of loc * ('term, 'lazy_term, 'reduction, 'obj, 'ident) code
+ | Comment of loc * ('term, 'lazy_term, 'reduction, 'obj, 'ident) comment
diff --git a/helm/ocaml/grafite/grafiteAstPp.ml b/helm/ocaml/grafite/grafiteAstPp.ml
new file mode 100644
index 000000000..6abfa4dd6
--- /dev/null
+++ b/helm/ocaml/grafite/grafiteAstPp.ml
@@ -0,0 +1,253 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+open GrafiteAst
+
+let tactical_terminator = ""
+let tactic_terminator = tactical_terminator
+let command_terminator = tactical_terminator
+
+let pp_idents idents = "[" ^ String.concat "; " idents ^ "]"
+
+let pp_reduction_kind ~term_pp = function
+ | `Normalize -> "normalize"
+ | `Reduce -> "reduce"
+ | `Simpl -> "simplify"
+ | `Unfold (Some t) -> "unfold " ^ term_pp t
+ | `Unfold None -> "unfold"
+ | `Whd -> "whd"
+
+let pp_tactic_pattern ~term_pp ~lazy_term_pp (what, hyp, goal) =
+ let what_text =
+ match what with
+ | None -> ""
+ | Some t -> sprintf "in match (%s) " (lazy_term_pp t) in
+ let hyp_text =
+ String.concat " "
+ (List.map (fun (name, p) -> sprintf "%s:(%s)" name (term_pp p)) hyp) in
+ let goal_text =
+ match goal with
+ | None -> ""
+ | Some t -> sprintf "\\vdash (%s)" (term_pp t) in
+ sprintf "%sin %s%s" what_text hyp_text goal_text
+
+let pp_intros_specs = function
+ | None, [] -> ""
+ | Some num, [] -> Printf.sprintf " names %i" num
+ | None, idents -> Printf.sprintf " names %s" (pp_idents idents)
+ | Some num, idents -> Printf.sprintf " names %i %s" num (pp_idents idents)
+
+let terms_pp ~term_pp terms = String.concat ", " (List.map term_pp terms)
+
+let rec pp_tactic ~term_pp ~lazy_term_pp =
+ let pp_reduction_kind = pp_reduction_kind ~term_pp in
+ let pp_tactic_pattern = pp_tactic_pattern ~lazy_term_pp ~term_pp in
+ function
+ | Absurd (_, term) -> "absurd" ^ term_pp term
+ | Apply (_, term) -> "apply " ^ term_pp term
+ | Auto _ -> "auto"
+ | Assumption _ -> "assumption"
+ | Change (_, where, with_what) ->
+ sprintf "change %s with %s" (pp_tactic_pattern where) (lazy_term_pp with_what)
+ | Clear (_,id) -> sprintf "clear %s" id
+ | ClearBody (_,id) -> sprintf "clearbody %s" id
+ | Compare (_,term) -> "compare " ^ term_pp term
+ | Constructor (_,n) -> "constructor " ^ string_of_int n
+ | Contradiction _ -> "contradiction"
+ | Cut (_, ident, term) ->
+ "cut " ^ term_pp term ^
+ (match ident with None -> "" | Some id -> " as " ^ id)
+ | DecideEquality _ -> "decide equality"
+ | Decompose (_, [], what, names) ->
+ sprintf "decompose %s%s" what (pp_intros_specs (None, names))
+ | Decompose (_, types, what, names) ->
+ let to_ident = function
+ | Ident id -> id
+ | Type _ -> assert false
+ in
+ let types = List.rev_map to_ident types in
+ sprintf "decompose %s %s%s" (pp_idents types) what (pp_intros_specs (None, names))
+ | Discriminate (_, term) -> "discriminate " ^ term_pp term
+ | Elim (_, term, using, num, idents) ->
+ sprintf "elim " ^ term_pp term ^
+ (match using with None -> "" | Some term -> " using " ^ term_pp term)
+ ^ pp_intros_specs (num, idents)
+ | ElimType (_, term, using, num, idents) ->
+ sprintf "elim type " ^ term_pp term ^
+ (match using with None -> "" | Some term -> " using " ^ term_pp term)
+ ^ pp_intros_specs (num, idents)
+ | Exact (_, term) -> "exact " ^ term_pp term
+ | Exists _ -> "exists"
+ | Fold (_, kind, term, pattern) ->
+ sprintf "fold %s %s %s" (pp_reduction_kind kind)
+ (lazy_term_pp term) (pp_tactic_pattern pattern)
+ | FwdSimpl (_, hyp, idents) ->
+ sprintf "fwd %s%s" hyp
+ (match idents with [] -> "" | idents -> " " ^ pp_idents idents)
+ | Generalize (_, pattern, ident) ->
+ sprintf "generalize %s%s" (pp_tactic_pattern pattern)
+ (match ident with None -> "" | Some id -> " as " ^ id)
+ | Goal (_, n) -> "goal " ^ string_of_int n
+ | Fail _ -> "fail"
+ | Fourier _ -> "fourier"
+ | IdTac _ -> "id"
+ | Injection (_, term) -> "injection " ^ term_pp term
+ | Intros (_, None, []) -> "intro"
+ | Inversion (_, term) -> "inversion " ^ term_pp term
+ | Intros (_, num, idents) ->
+ sprintf "intros%s%s"
+ (match num with None -> "" | Some num -> " " ^ string_of_int num)
+ (match idents with [] -> "" | idents -> " " ^ pp_idents idents)
+ | LApply (_, level_opt, terms, term, ident_opt) ->
+ sprintf "lapply %s%s%s%s"
+ (match level_opt with None -> "" | Some i -> " depth = " ^ string_of_int i ^ " ")
+ (term_pp term)
+ (match terms with [] -> "" | _ -> " to " ^ terms_pp ~term_pp terms)
+ (match ident_opt with None -> "" | Some ident -> " using " ^ ident)
+ | Left _ -> "left"
+ | LetIn (_, term, ident) -> sprintf "let %s in %s" (term_pp term) ident
+ | Reduce (_, kind, pat) ->
+ sprintf "%s %s" (pp_reduction_kind kind) (pp_tactic_pattern pat)
+ | Reflexivity _ -> "reflexivity"
+ | Replace (_, pattern, t) ->
+ sprintf "replace %s with %s" (pp_tactic_pattern pattern) (lazy_term_pp t)
+ | Rewrite (_, pos, t, pattern) ->
+ sprintf "rewrite %s %s %s"
+ (if pos = `LeftToRight then ">" else "<")
+ (term_pp t)
+ (pp_tactic_pattern pattern)
+ | Right _ -> "right"
+ | Ring _ -> "ring"
+ | Split _ -> "split"
+ | Symmetry _ -> "symmetry"
+ | Transitivity (_, term) -> "transitivity " ^ term_pp term
+
+let pp_search_kind = function
+ | `Locate -> "locate"
+ | `Hint -> "hint"
+ | `Match -> "match"
+ | `Elim -> "elim"
+ | `Instance -> "instance"
+
+let pp_macro ~term_pp = function
+ (* Whelp *)
+ | WInstance (_, term) -> "whelp instance " ^ term_pp term
+ | WHint (_, t) -> "whelp hint " ^ term_pp t
+ | WLocate (_, s) -> "whelp locate " ^ s
+ | WElim (_, t) -> "whelp elim " ^ term_pp t
+ | WMatch (_, term) -> "whelp match " ^ term_pp term
+ (* real macros *)
+ | Check (_, term) -> sprintf "Check %s" (term_pp term)
+ | Hint _ -> "hint"
+ | Search_pat (_, kind, pat) ->
+ sprintf "search %s \"%s\"" (pp_search_kind kind) pat
+ | Search_term (_, kind, term) ->
+ sprintf "search %s %s" (pp_search_kind kind) (term_pp term)
+ | Print (_, name) -> sprintf "Print \"%s\"" name
+ | Quit _ -> "Quit"
+
+let pp_associativity = function
+ | Gramext.LeftA -> "left associative"
+ | Gramext.RightA -> "right associative"
+ | Gramext.NonA -> "non associative"
+
+let pp_precedence i = sprintf "with precedence %d" i
+
+let pp_dir_opt = function
+ | None -> ""
+ | Some `LeftToRight -> "> "
+ | Some `RightToLeft -> "< "
+
+let pp_default what uris =
+ sprintf "default \"%s\" %s" what
+ (String.concat " " (List.map UriManager.string_of_uri uris))
+
+let pp_coercion uri do_composites =
+ sprintf "coercion %s (* %s *)" (UriManager.string_of_uri uri)
+ (if do_composites then "compounds" else "no compounds")
+
+let pp_command ~obj_pp = function
+ | Include (_,path) -> "include " ^ path
+ | Qed _ -> "qed"
+ | Drop _ -> "drop"
+ | Set (_, name, value) -> sprintf "set \"%s\" \"%s\"" name value
+ | Coercion (_, uri, do_composites) -> pp_coercion uri do_composites
+ | Obj (_,obj) -> obj_pp obj
+ | Default (_,what,uris) ->
+ pp_default what uris
+
+let rec pp_tactical ~term_pp ~lazy_term_pp =
+ let pp_tactic = pp_tactic ~lazy_term_pp ~term_pp in
+ let pp_tacticals = pp_tacticals ~lazy_term_pp ~term_pp in
+ function
+ | Tactic (_, tac) -> pp_tactic tac
+ | Do (_, count, tac) ->
+ sprintf "do %d %s" count (pp_tactical ~term_pp ~lazy_term_pp tac)
+ | Repeat (_, tac) -> "repeat " ^ pp_tactical ~term_pp ~lazy_term_pp tac
+ | Seq (_, tacs) -> pp_tacticals ~sep:"; " tacs
+ | Then (_, tac, tacs) ->
+ sprintf "%s; [%s]" (pp_tactical ~term_pp ~lazy_term_pp tac)
+ (pp_tacticals ~sep:" | " tacs)
+ | First (_, tacs) -> sprintf "tries [%s]" (pp_tacticals ~sep:" | " tacs)
+ | Try (_, tac) -> "try " ^ pp_tactical ~term_pp ~lazy_term_pp tac
+ | Solve (_, tac) -> sprintf "solve [%s]" (pp_tacticals ~sep:" | " tac)
+
+ | Dot _ -> "."
+ | Semicolon _ -> ";"
+ | Branch _ -> "["
+ | Shift _ -> "|"
+ | Pos (_, i) -> sprintf "%d:" i
+ | Merge _ -> "]"
+ | Focus (_, goals) ->
+ sprintf "focus %s" (String.concat " " (List.map string_of_int goals))
+ | Unfocus _ -> "unfocus"
+ | Skip _ -> "skip"
+
+and pp_tacticals ~term_pp ~lazy_term_pp ~sep tacs =
+ String.concat sep (List.map (pp_tactical~lazy_term_pp ~term_pp) tacs)
+
+let pp_executable ~term_pp ~lazy_term_pp ~obj_pp =
+ function
+ | Macro (_, macro) -> pp_macro ~term_pp macro
+ | Tactical (_, tac, Some punct) ->
+ pp_tactical ~lazy_term_pp ~term_pp tac
+ ^ pp_tactical ~lazy_term_pp ~term_pp punct
+ | Tactical (_, tac, None) -> pp_tactical ~lazy_term_pp ~term_pp tac
+ | Command (_, cmd) -> pp_command ~obj_pp cmd
+
+let pp_comment ~term_pp ~lazy_term_pp ~obj_pp =
+ function
+ | Note (_,str) -> sprintf "(* %s *)" str
+ | Code (_,code) ->
+ sprintf "(** %s. **)" (pp_executable ~term_pp ~lazy_term_pp ~obj_pp code)
+
+let pp_statement ~term_pp ~lazy_term_pp ~obj_pp =
+ function
+ | Executable (_, ex) -> pp_executable ~lazy_term_pp ~term_pp ~obj_pp ex
+ | Comment (_, c) -> pp_comment ~term_pp ~lazy_term_pp ~obj_pp c
diff --git a/helm/ocaml/grafite/grafiteAstPp.mli b/helm/ocaml/grafite/grafiteAstPp.mli
new file mode 100644
index 000000000..f9b3b37cc
--- /dev/null
+++ b/helm/ocaml/grafite/grafiteAstPp.mli
@@ -0,0 +1,76 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val pp_tactic:
+ term_pp:('term -> string) ->
+ lazy_term_pp:('lazy_term -> string) ->
+ ('term, 'lazy_term, 'term GrafiteAst.reduction, string)
+ GrafiteAst.tactic ->
+ string
+
+val pp_tactic_pattern:
+ term_pp:('term -> string) ->
+ lazy_term_pp:('lazy_term -> string) ->
+ ('term, 'lazy_term, string) GrafiteAst.pattern ->
+ string
+
+val pp_reduction_kind:
+ term_pp:('a -> string) ->
+ 'a GrafiteAst.reduction ->
+ string
+
+val pp_command: obj_pp:('obj -> string) -> 'obj GrafiteAst.command -> string
+val pp_macro: term_pp:('term -> string) -> 'term GrafiteAst.macro -> string
+val pp_comment:
+ term_pp:('term -> string) ->
+ lazy_term_pp:('lazy_term -> string) ->
+ obj_pp:('obj -> string) ->
+ ('term, 'lazy_term, 'term GrafiteAst.reduction, 'obj, string)
+ GrafiteAst.comment ->
+ string
+
+val pp_executable:
+ term_pp:('term -> string) ->
+ lazy_term_pp:('lazy_term -> string) ->
+ obj_pp:('obj -> string) ->
+ ('term, 'lazy_term, 'term GrafiteAst.reduction, 'obj, string)
+ GrafiteAst.code ->
+ string
+
+val pp_statement:
+ term_pp:('term -> string) ->
+ lazy_term_pp:('lazy_term -> string) ->
+ obj_pp:('obj -> string) ->
+ ('term, 'lazy_term, 'term GrafiteAst.reduction, 'obj, string)
+ GrafiteAst.statement ->
+ string
+
+val pp_tactical:
+ term_pp:('term -> string) ->
+ lazy_term_pp:('lazy_term -> string) ->
+ ('term, 'lazy_term, 'term GrafiteAst.reduction, string)
+ GrafiteAst.tactical ->
+ string
+
diff --git a/helm/ocaml/grafite/grafiteMarshal.ml b/helm/ocaml/grafite/grafiteMarshal.ml
new file mode 100644
index 000000000..e786d5001
--- /dev/null
+++ b/helm/ocaml/grafite/grafiteMarshal.ml
@@ -0,0 +1,60 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+type ast_command = Cic.obj GrafiteAst.command
+type moo = ast_command list
+
+let format_name = "grafite"
+
+let save_moo_to_file ~fname moo =
+ HMarshal.save ~fmt:format_name ~version:GrafiteAst.magic ~fname moo
+
+let load_moo_from_file ~fname =
+ let raw = HMarshal.load ~fmt:format_name ~version:GrafiteAst.magic ~fname in
+ (raw: moo)
+
+let rehash_cmd_uris =
+ let rehash_uri uri =
+ UriManager.uri_of_string (UriManager.string_of_uri uri) in
+ function
+ | GrafiteAst.Default (loc, name, uris) ->
+ let uris = List.map rehash_uri uris in
+ GrafiteAst.Default (loc, name, uris)
+ | GrafiteAst.Coercion (loc, uri, close) ->
+ GrafiteAst.Coercion (loc, rehash_uri uri, close)
+ | cmd ->
+ prerr_endline "Found a command not expected in a .moo:";
+ let obj_pp _ = assert false in
+ prerr_endline (GrafiteAstPp.pp_command ~obj_pp cmd);
+ assert false
+
+let save_moo ~fname moo = save_moo_to_file ~fname (List.rev moo)
+
+let load_moo ~fname =
+ let moo = load_moo_from_file ~fname in
+ List.map rehash_cmd_uris moo
+
diff --git a/helm/ocaml/grafite/grafiteMarshal.mli b/helm/ocaml/grafite/grafiteMarshal.mli
new file mode 100644
index 000000000..e60ad39d8
--- /dev/null
+++ b/helm/ocaml/grafite/grafiteMarshal.mli
@@ -0,0 +1,33 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+type ast_command = Cic.obj GrafiteAst.command
+type moo = ast_command list
+
+val save_moo: fname:string -> moo -> unit
+
+ (** @raise Corrupt_moo *)
+val load_moo: fname:string -> moo
+
diff --git a/helm/ocaml/grafite_engine/.depend b/helm/ocaml/grafite_engine/.depend
new file mode 100644
index 000000000..d0e9a3a86
--- /dev/null
+++ b/helm/ocaml/grafite_engine/.depend
@@ -0,0 +1,12 @@
+grafiteSync.cmi: grafiteTypes.cmi
+grafiteEngine.cmi: grafiteTypes.cmi
+grafiteTypes.cmo: grafiteTypes.cmi
+grafiteTypes.cmx: grafiteTypes.cmi
+grafiteSync.cmo: grafiteTypes.cmi grafiteSync.cmi
+grafiteSync.cmx: grafiteTypes.cmx grafiteSync.cmi
+grafiteMisc.cmo: grafiteMisc.cmi
+grafiteMisc.cmx: grafiteMisc.cmi
+grafiteEngine.cmo: grafiteTypes.cmi grafiteSync.cmi grafiteMisc.cmi \
+ grafiteEngine.cmi
+grafiteEngine.cmx: grafiteTypes.cmx grafiteSync.cmx grafiteMisc.cmx \
+ grafiteEngine.cmi
diff --git a/helm/ocaml/grafite_engine/Makefile b/helm/ocaml/grafite_engine/Makefile
new file mode 100644
index 000000000..e72acd29c
--- /dev/null
+++ b/helm/ocaml/grafite_engine/Makefile
@@ -0,0 +1,12 @@
+PACKAGE = grafite_engine
+PREDICATES =
+
+INTERFACE_FILES = \
+ grafiteTypes.mli \
+ grafiteSync.mli \
+ grafiteMisc.mli \
+ grafiteEngine.mli \
+ $(NULL)
+IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml)
+
+include ../Makefile.common
diff --git a/helm/ocaml/grafite_engine/grafiteEngine.ml b/helm/ocaml/grafite_engine/grafiteEngine.ml
new file mode 100644
index 000000000..c0a453c93
--- /dev/null
+++ b/helm/ocaml/grafite_engine/grafiteEngine.ml
@@ -0,0 +1,714 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+exception Drop
+exception IncludedFileNotCompiled of string (* file name *)
+exception Macro of
+ GrafiteAst.loc *
+ (Cic.context -> GrafiteTypes.status * Cic.term GrafiteAst.macro)
+exception ReadOnlyUri of string
+
+type options = {
+ do_heavy_checks: bool ;
+ clean_baseuri: bool
+}
+
+(** create a ProofEngineTypes.mk_fresh_name_type function which uses given
+ * names as long as they are available, then it fallbacks to name generation
+ * using FreshNamesGenerator module *)
+let namer_of names =
+ let len = List.length names in
+ let count = ref 0 in
+ fun metasenv context name ~typ ->
+ if !count < len then begin
+ let name = Cic.Name (List.nth names !count) in
+ incr count;
+ name
+ end else
+ FreshNamesGenerator.mk_fresh_name ~subst:[] metasenv context name ~typ
+
+let tactic_of_ast ast =
+ let module PET = ProofEngineTypes in
+ match ast with
+ | GrafiteAst.Absurd (_, term) -> Tactics.absurd term
+ | GrafiteAst.Apply (_, term) -> Tactics.apply term
+ | GrafiteAst.Assumption _ -> Tactics.assumption
+ | GrafiteAst.Auto (_,depth,width,paramodulation,full) ->
+ AutoTactic.auto_tac ?depth ?width ?paramodulation ?full
+ ~dbd:(LibraryDb.instance ()) ()
+ | GrafiteAst.Change (_, pattern, with_what) ->
+ Tactics.change ~pattern with_what
+ | GrafiteAst.Clear (_,id) -> Tactics.clear id
+ | GrafiteAst.ClearBody (_,id) -> Tactics.clearbody id
+ | GrafiteAst.Contradiction _ -> Tactics.contradiction
+ | GrafiteAst.Compare (_, term) -> Tactics.compare term
+ | GrafiteAst.Constructor (_, n) -> Tactics.constructor n
+ | GrafiteAst.Cut (_, ident, term) ->
+ let names = match ident with None -> [] | Some id -> [id] in
+ Tactics.cut ~mk_fresh_name_callback:(namer_of names) term
+ | GrafiteAst.DecideEquality _ -> Tactics.decide_equality
+ | GrafiteAst.Decompose (_, types, what, names) ->
+ let to_type = function
+ | GrafiteAst.Type (uri, typeno) -> uri, typeno
+ | GrafiteAst.Ident _ -> assert false
+ in
+ let user_types = List.rev_map to_type types in
+ let dbd = LibraryDb.instance () in
+ let mk_fresh_name_callback = namer_of names in
+ Tactics.decompose ~mk_fresh_name_callback ~dbd ~user_types what
+ | GrafiteAst.Discriminate (_,term) -> Tactics.discriminate term
+ | GrafiteAst.Elim (_, what, using, depth, names) ->
+ Tactics.elim_intros ?using ?depth ~mk_fresh_name_callback:(namer_of names)
+ what
+ | GrafiteAst.ElimType (_, what, using, depth, names) ->
+ Tactics.elim_type ?using ?depth ~mk_fresh_name_callback:(namer_of names)
+ what
+ | GrafiteAst.Exact (_, term) -> Tactics.exact term
+ | GrafiteAst.Exists _ -> Tactics.exists
+ | GrafiteAst.Fail _ -> Tactics.fail
+ | GrafiteAst.Fold (_, reduction_kind, term, pattern) ->
+ let reduction =
+ match reduction_kind with
+ | `Normalize ->
+ PET.const_lazy_reduction
+ (CicReduction.normalize ~delta:false ~subst:[])
+ | `Reduce -> PET.const_lazy_reduction ProofEngineReduction.reduce
+ | `Simpl -> PET.const_lazy_reduction ProofEngineReduction.simpl
+ | `Unfold None ->
+ PET.const_lazy_reduction (ProofEngineReduction.unfold ?what:None)
+ | `Unfold (Some lazy_term) ->
+ (fun context metasenv ugraph ->
+ let what, metasenv, ugraph = lazy_term context metasenv ugraph in
+ ProofEngineReduction.unfold ~what, metasenv, ugraph)
+ | `Whd ->
+ PET.const_lazy_reduction (CicReduction.whd ~delta:false ~subst:[])
+ in
+ Tactics.fold ~reduction ~term ~pattern
+ | GrafiteAst.Fourier _ -> Tactics.fourier
+ | GrafiteAst.FwdSimpl (_, hyp, names) ->
+ Tactics.fwd_simpl ~mk_fresh_name_callback:(namer_of names)
+ ~dbd:(LibraryDb.instance ()) hyp
+ | GrafiteAst.Generalize (_,pattern,ident) ->
+ let names = match ident with None -> [] | Some id -> [id] in
+ Tactics.generalize ~mk_fresh_name_callback:(namer_of names) pattern
+ | GrafiteAst.Goal (_, n) -> Tactics.set_goal n
+ | GrafiteAst.IdTac _ -> Tactics.id
+ | GrafiteAst.Injection (_,term) -> Tactics.injection term
+ | GrafiteAst.Intros (_, None, names) ->
+ PrimitiveTactics.intros_tac ~mk_fresh_name_callback:(namer_of names) ()
+ | GrafiteAst.Intros (_, Some num, names) ->
+ PrimitiveTactics.intros_tac ~howmany:num
+ ~mk_fresh_name_callback:(namer_of names) ()
+ | GrafiteAst.Inversion (_, term) ->
+ Tactics.inversion term
+ | GrafiteAst.LApply (_, how_many, to_what, what, ident) ->
+ let names = match ident with None -> [] | Some id -> [id] in
+ Tactics.lapply ~mk_fresh_name_callback:(namer_of names) ?how_many
+ ~to_what what
+ | GrafiteAst.Left _ -> Tactics.left
+ | GrafiteAst.LetIn (loc,term,name) ->
+ Tactics.letin term ~mk_fresh_name_callback:(namer_of [name])
+ | GrafiteAst.Reduce (_, reduction_kind, pattern) ->
+ (match reduction_kind with
+ | `Normalize -> Tactics.normalize ~pattern
+ | `Reduce -> Tactics.reduce ~pattern
+ | `Simpl -> Tactics.simpl ~pattern
+ | `Unfold what -> Tactics.unfold ~pattern what
+ | `Whd -> Tactics.whd ~pattern)
+ | GrafiteAst.Reflexivity _ -> Tactics.reflexivity
+ | GrafiteAst.Replace (_, pattern, with_what) ->
+ Tactics.replace ~pattern ~with_what
+ | GrafiteAst.Rewrite (_, direction, t, pattern) ->
+ EqualityTactics.rewrite_tac ~direction ~pattern t
+ | GrafiteAst.Right _ -> Tactics.right
+ | GrafiteAst.Ring _ -> Tactics.ring
+ | GrafiteAst.Split _ -> Tactics.split
+ | GrafiteAst.Symmetry _ -> Tactics.symmetry
+ | GrafiteAst.Transitivity (_, term) -> Tactics.transitivity term
+
+(* maybe we only need special cases for apply and goal *)
+let classify_tactic tactic =
+ match tactic with
+ (* tactics that can't close the goal (return a goal we want to "select") *)
+ | GrafiteAst.Rewrite _
+ | GrafiteAst.Split _
+ | GrafiteAst.Replace _
+ | GrafiteAst.Reduce _
+ | GrafiteAst.Injection _
+ | GrafiteAst.IdTac _
+ | GrafiteAst.Generalize _
+ | GrafiteAst.Elim _
+ | GrafiteAst.Cut _
+ | GrafiteAst.Decompose _ -> true, true
+ (* tactics we don't want to reorder goals. I think only Goal needs this. *)
+ | GrafiteAst.Goal _ -> false, true
+ (* tactics like apply *)
+ | _ -> true, false
+
+let reorder_metasenv start refine tactic goals current_goal always_opens_a_goal=
+ let module PEH = ProofEngineHelpers in
+(* let print_m name metasenv =
+ prerr_endline (">>>>> " ^ name);
+ prerr_endline (CicMetaSubst.ppmetasenv [] metasenv)
+ in *)
+ (* phase one calculates:
+ * new_goals_from_refine: goals added by refine
+ * head_goal: the first goal opened by ythe tactic
+ * other_goals: other goals opened by the tactic
+ *)
+ let new_goals_from_refine = PEH.compare_metasenvs start refine in
+ let new_goals_from_tactic = PEH.compare_metasenvs refine tactic in
+ let head_goal, other_goals, goals =
+ match goals with
+ | [] -> None,[],goals
+ | hd::tl ->
+ (* assert (List.mem hd new_goals_from_tactic);
+ * invalidato dalla goal_tac
+ * *)
+ Some hd, List.filter ((<>) hd) new_goals_from_tactic, List.filter ((<>)
+ hd) goals
+ in
+ let produced_goals =
+ match head_goal with
+ | None -> new_goals_from_refine @ other_goals
+ | Some x -> x :: new_goals_from_refine @ other_goals
+ in
+ (* extract the metas generated by refine and tactic *)
+ let metas_for_tactic_head =
+ match head_goal with
+ | None -> []
+ | Some head_goal -> List.filter (fun (n,_,_) -> n = head_goal) tactic in
+ let metas_for_tactic_goals =
+ List.map
+ (fun x -> List.find (fun (metano,_,_) -> metano = x) tactic)
+ goals
+ in
+ let metas_for_refine_goals =
+ List.filter (fun (n,_,_) -> List.mem n new_goals_from_refine) tactic in
+ let produced_metas, goals =
+ let produced_metas =
+ if always_opens_a_goal then
+ metas_for_tactic_head @ metas_for_refine_goals @
+ metas_for_tactic_goals
+ else begin
+(* print_m "metas_for_refine_goals" metas_for_refine_goals;
+ print_m "metas_for_tactic_head" metas_for_tactic_head;
+ print_m "metas_for_tactic_goals" metas_for_tactic_goals; *)
+ metas_for_refine_goals @ metas_for_tactic_head @
+ metas_for_tactic_goals
+ end
+ in
+ let goals = List.map (fun (metano, _, _) -> metano) produced_metas in
+ produced_metas, goals
+ in
+ (* residual metas, preserving the original order *)
+ let before, after =
+ let rec split e =
+ function
+ | [] -> [],[]
+ | (metano, _, _) :: tl when metano = e ->
+ [], List.map (fun (x,_,_) -> x) tl
+ | (metano, _, _) :: tl -> let b, a = split e tl in metano :: b, a
+ in
+ let find n metasenv =
+ try
+ Some (List.find (fun (metano, _, _) -> metano = n) metasenv)
+ with Not_found -> None
+ in
+ let extract l =
+ List.fold_right
+ (fun n acc ->
+ match find n tactic with
+ | Some x -> x::acc
+ | None -> acc
+ ) l [] in
+ let before_l, after_l = split current_goal start in
+ let before_l =
+ List.filter (fun x -> not (List.mem x produced_goals)) before_l in
+ let after_l =
+ List.filter (fun x -> not (List.mem x produced_goals)) after_l in
+ let before = extract before_l in
+ let after = extract after_l in
+ before, after
+ in
+(* |+ DEBUG CODE +|
+ print_m "BEGIN" start;
+ prerr_endline ("goal was: " ^ string_of_int current_goal);
+ prerr_endline ("and metas from refine are:");
+ List.iter
+ (fun t -> prerr_string (" " ^ string_of_int t))
+ new_goals_from_refine;
+ prerr_endline "";
+ print_m "before" before;
+ print_m "metas_for_tactic_head" metas_for_tactic_head;
+ print_m "metas_for_refine_goals" metas_for_refine_goals;
+ print_m "metas_for_tactic_goals" metas_for_tactic_goals;
+ print_m "produced_metas" produced_metas;
+ print_m "after" after;
+|+ FINE DEBUG CODE +| *)
+ before @ produced_metas @ after, goals
+
+let apply_tactic ~disambiguate_tactic tactic (status, goal) =
+(* prerr_endline "apply_tactic"; *)
+(* prerr_endline (Continuationals.Stack.pp (GrafiteTypes.get_stack status)); *)
+ let starting_metasenv = GrafiteTypes.get_proof_metasenv status in
+ let before = List.map (fun g, _, _ -> g) starting_metasenv in
+(* prerr_endline "disambiguate"; *)
+ let status, tactic = disambiguate_tactic status goal tactic in
+ let metasenv_after_refinement = GrafiteTypes.get_proof_metasenv status in
+ let proof = GrafiteTypes.get_current_proof status in
+ let proof_status = proof, goal in
+ let needs_reordering, always_opens_a_goal = classify_tactic tactic in
+ let tactic = tactic_of_ast tactic in
+ (* apply tactic will change the lexicon_status ... *)
+(* prerr_endline "apply_tactic bassa"; *)
+ let (proof, opened) = ProofEngineTypes.apply_tactic tactic proof_status in
+ let after = ProofEngineTypes.goals_of_proof proof in
+ let opened_goals, closed_goals = Tacticals.goals_diff ~before ~after ~opened in
+(* prerr_endline("before: " ^ String.concat ", " (List.map string_of_int before));
+prerr_endline("after: " ^ String.concat ", " (List.map string_of_int after));
+prerr_endline("opened: " ^ String.concat ", " (List.map string_of_int opened)); *)
+(* prerr_endline("opened_goals: " ^ String.concat ", " (List.map string_of_int opened_goals));
+prerr_endline("closed_goals: " ^ String.concat ", " (List.map string_of_int closed_goals)); *)
+ let proof, opened_goals =
+ if needs_reordering then begin
+ let uri, metasenv_after_tactic, t, ty = proof in
+(* prerr_endline ("goal prima del riordino: " ^ String.concat " " (List.map string_of_int (ProofEngineTypes.goals_of_proof proof))); *)
+ let reordered_metasenv, opened_goals =
+ reorder_metasenv
+ starting_metasenv
+ metasenv_after_refinement metasenv_after_tactic
+ opened goal always_opens_a_goal
+ in
+ let proof' = uri, reordered_metasenv, t, ty in
+(* prerr_endline ("goal dopo il riordino: " ^ String.concat " " (List.map string_of_int (ProofEngineTypes.goals_of_proof proof'))); *)
+ proof', opened_goals
+ end
+ else
+ proof, opened_goals
+ in
+ let incomplete_proof =
+ match status.GrafiteTypes.proof_status with
+ | GrafiteTypes.Incomplete_proof p -> p
+ | _ -> assert false
+ in
+ { status with GrafiteTypes.proof_status =
+ GrafiteTypes.Incomplete_proof
+ { incomplete_proof with GrafiteTypes.proof = proof } },
+ opened_goals, closed_goals
+
+type eval_ast =
+ {ea_go:
+ 'term 'lazy_term 'reduction 'obj 'ident.
+ disambiguate_tactic:
+ (GrafiteTypes.status ->
+ ProofEngineTypes.goal ->
+ ('term, 'lazy_term, 'reduction, 'ident) GrafiteAst.tactic ->
+ GrafiteTypes.status *
+ (Cic.term, Cic.lazy_term, Cic.lazy_term GrafiteAst.reduction, string) GrafiteAst.tactic) ->
+
+ disambiguate_command:
+ (GrafiteTypes.status ->
+ 'obj GrafiteAst.command ->
+ GrafiteTypes.status * Cic.obj GrafiteAst.command) ->
+
+ disambiguate_macro:
+ (GrafiteTypes.status ->
+ 'term GrafiteAst.macro ->
+ Cic.context -> GrafiteTypes.status * Cic.term GrafiteAst.macro) ->
+
+ ?do_heavy_checks:bool ->
+ ?clean_baseuri:bool ->
+ GrafiteTypes.status ->
+ ('term, 'lazy_term, 'reduction, 'obj, 'ident) GrafiteAst.statement ->
+ GrafiteTypes.status * UriManager.uri list
+ }
+
+type 'a eval_command =
+ {ec_go: 'term 'obj.
+ disambiguate_command:
+ (GrafiteTypes.status ->
+ 'obj GrafiteAst.command ->
+ GrafiteTypes.status * Cic.obj GrafiteAst.command) ->
+ options -> GrafiteTypes.status -> 'obj GrafiteAst.command ->
+ GrafiteTypes.status * UriManager.uri list
+ }
+
+type 'a eval_executable =
+ {ee_go: 'term 'lazy_term 'reduction 'obj 'ident.
+ disambiguate_tactic:
+ (GrafiteTypes.status ->
+ ProofEngineTypes.goal ->
+ ('term, 'lazy_term, 'reduction, 'ident) GrafiteAst.tactic ->
+ GrafiteTypes.status *
+ (Cic.term, Cic.lazy_term, Cic.lazy_term GrafiteAst.reduction, string) GrafiteAst.tactic) ->
+
+ disambiguate_command:
+ (GrafiteTypes.status ->
+ 'obj GrafiteAst.command ->
+ GrafiteTypes.status * Cic.obj GrafiteAst.command) ->
+
+ disambiguate_macro:
+ (GrafiteTypes.status ->
+ 'term GrafiteAst.macro ->
+ Cic.context -> GrafiteTypes.status * Cic.term GrafiteAst.macro) ->
+
+ options ->
+ GrafiteTypes.status ->
+ ('term, 'lazy_term, 'reduction, 'obj, 'ident) GrafiteAst.code ->
+ GrafiteTypes.status * UriManager.uri list
+ }
+
+type 'a eval_from_moo =
+ { efm_go: GrafiteTypes.status -> string -> GrafiteTypes.status }
+
+let coercion_moo_statement_of uri =
+ GrafiteAst.Coercion (HExtlib.dummy_floc, uri, false)
+
+let eval_coercion status ~add_composites uri =
+ let basedir = Helm_registry.get "matita.basedir" in
+ let status,compounds =
+ GrafiteSync.add_coercion ~basedir ~add_composites status uri in
+ let moo_content = coercion_moo_statement_of uri in
+ let status = GrafiteTypes.add_moo_content [moo_content] status in
+ {status with GrafiteTypes.proof_status = GrafiteTypes.No_proof},
+ compounds
+
+let eval_tactical ~disambiguate_tactic status tac =
+ let apply_tactic = apply_tactic ~disambiguate_tactic in
+ let module MatitaStatus =
+ struct
+ type input_status = GrafiteTypes.status * ProofEngineTypes.goal
+
+ type output_status =
+ GrafiteTypes.status * ProofEngineTypes.goal list * ProofEngineTypes.goal list
+
+ type tactic = input_status -> output_status
+
+ let id_tactic = apply_tactic (GrafiteAst.IdTac HExtlib.dummy_floc)
+ let mk_tactic tac = tac
+ let apply_tactic tac = tac
+ let goals (_, opened, closed) = opened, closed
+ let set_goals (opened, closed) (status, _, _) = (status, opened, closed)
+ let get_stack (status, _) = GrafiteTypes.get_stack status
+
+ let set_stack stack (status, opened, closed) =
+ GrafiteTypes.set_stack stack status, opened, closed
+
+ let inject (status, _) = (status, [], [])
+ let focus goal (status, _, _) = (status, goal)
+ end
+ in
+ let module MatitaTacticals = Tacticals.Make (MatitaStatus) in
+ let rec tactical_of_ast l tac =
+ match tac with
+ | GrafiteAst.Tactic (loc, tactic) ->
+ MatitaTacticals.tactic (MatitaStatus.mk_tactic (apply_tactic tactic))
+ | GrafiteAst.Seq (loc, tacticals) -> (* tac1; tac2; ... *)
+ assert (l > 0);
+ MatitaTacticals.seq ~tactics:(List.map (tactical_of_ast (l+1)) tacticals)
+ | GrafiteAst.Do (loc, n, tactical) ->
+ MatitaTacticals.do_tactic ~n ~tactic:(tactical_of_ast (l+1) tactical)
+ | GrafiteAst.Repeat (loc, tactical) ->
+ MatitaTacticals.repeat_tactic ~tactic:(tactical_of_ast (l+1) tactical)
+ | GrafiteAst.Then (loc, tactical, tacticals) -> (* tac; [ tac1 | ... ] *)
+ assert (l > 0);
+ MatitaTacticals.thens ~start:(tactical_of_ast (l+1) tactical)
+ ~continuations:(List.map (tactical_of_ast (l+1)) tacticals)
+ | GrafiteAst.First (loc, tacticals) ->
+ MatitaTacticals.first
+ ~tactics:(List.map (fun t -> "", tactical_of_ast (l+1) t) tacticals)
+ | GrafiteAst.Try (loc, tactical) ->
+ MatitaTacticals.try_tactic ~tactic:(tactical_of_ast (l+1) tactical)
+ | GrafiteAst.Solve (loc, tacticals) ->
+ MatitaTacticals.solve_tactics
+ ~tactics:(List.map (fun t -> "", tactical_of_ast (l+1) t) tacticals)
+
+ | GrafiteAst.Skip loc -> MatitaTacticals.skip
+ | GrafiteAst.Dot loc -> MatitaTacticals.dot
+ | GrafiteAst.Semicolon loc -> MatitaTacticals.semicolon
+ | GrafiteAst.Branch loc -> MatitaTacticals.branch
+ | GrafiteAst.Shift loc -> MatitaTacticals.shift
+ | GrafiteAst.Pos (loc, i) -> MatitaTacticals.pos i
+ | GrafiteAst.Merge loc -> MatitaTacticals.merge
+ | GrafiteAst.Focus (loc, goals) -> MatitaTacticals.focus goals
+ | GrafiteAst.Unfocus loc -> MatitaTacticals.unfocus
+ in
+ let status, _, _ = tactical_of_ast 0 tac (status, ~-1) in
+ let status = (* is proof completed? *)
+ match status.GrafiteTypes.proof_status with
+ | GrafiteTypes.Incomplete_proof
+ { GrafiteTypes.stack = stack; proof = proof }
+ when Continuationals.Stack.is_empty stack ->
+ { status with GrafiteTypes.proof_status = GrafiteTypes.Proof proof }
+ | _ -> status
+ in
+ status
+
+let eval_comment status c = status
+
+(* since the record syntax allows to declare coercions, we have to put this
+ * information inside the moo *)
+let add_coercions_of_record_to_moo obj lemmas status =
+ let attributes = CicUtil.attributes_of_obj obj in
+ let is_record = function `Class (`Record att) -> Some att | _-> None in
+ match HExtlib.list_findopt is_record attributes with
+ | None -> status,[]
+ | Some fields ->
+ let is_a_coercion uri =
+ try
+ let obj,_ =
+ CicEnvironment.get_cooked_obj CicUniv.empty_ugraph uri in
+ let attrs = CicUtil.attributes_of_obj obj in
+ List.mem (`Class `Projection) attrs
+ with Not_found -> assert false
+ in
+ (* looking at the fields we can know the 'wanted' coercions, but not the
+ * actually generated ones. So, only the intersection between the wanted
+ * and the actual should be in the moo as coercion, while everithing in
+ * lemmas should go as aliases *)
+ let wanted_coercions =
+ HExtlib.filter_map
+ (function
+ | (name,true) ->
+ Some
+ (UriManager.uri_of_string
+ (GrafiteTypes.qualify status name ^ ".con"))
+ | _ -> None)
+ fields
+ in
+ prerr_endline "wanted coercions:";
+ List.iter
+ (fun u -> prerr_endline (UriManager.string_of_uri u))
+ wanted_coercions;
+ let coercions, moo_content =
+ List.split
+ (HExtlib.filter_map
+ (fun uri ->
+ let is_a_wanted_coercion =
+ List.exists (UriManager.eq uri) wanted_coercions in
+ if is_a_coercion uri && is_a_wanted_coercion then
+ Some (uri, coercion_moo_statement_of uri)
+ else
+ None)
+ lemmas)
+ in
+ List.iter
+ (fun u -> prerr_endline (UriManager.string_of_uri u))
+ coercions;
+ let status = GrafiteTypes.add_moo_content moo_content status in
+ let basedir = Helm_registry.get "matita.basedir" in
+ List.fold_left
+ (fun (status,lemmas) uri ->
+ let status,new_lemmas =
+ GrafiteSync.add_coercion ~basedir ~add_composites:true status uri
+ in
+ status,new_lemmas@lemmas
+ ) (status,[]) coercions
+
+let add_obj uri obj status =
+ let basedir = Helm_registry.get "matita.basedir" in
+ let status,lemmas = GrafiteSync.add_obj ~basedir uri obj status in
+ status, lemmas
+
+let rec eval_command = {ec_go = fun ~disambiguate_command opts status cmd ->
+ let status,cmd = disambiguate_command status cmd in
+ let basedir = Helm_registry.get "matita.basedir" in
+ let status,uris =
+ match cmd with
+ | GrafiteAst.Default (loc, what, uris) as cmd ->
+ LibraryObjects.set_default what uris;
+ GrafiteTypes.add_moo_content [cmd] status,[]
+ | GrafiteAst.Include (loc, baseuri) ->
+ let moopath = LibraryMisc.obj_file_of_baseuri ~basedir ~baseuri in
+ if not (Sys.file_exists moopath) then
+ raise (IncludedFileNotCompiled moopath);
+ let status = eval_from_moo.efm_go status moopath in
+ status,[]
+ | GrafiteAst.Set (loc, name, value) ->
+ if name = "baseuri" then begin
+ let value =
+ let v = Http_getter_misc.strip_trailing_slash value in
+ try
+ ignore (String.index v ' ');
+ GrafiteTypes.command_error "baseuri can't contain spaces"
+ with Not_found -> v
+ in
+ if Http_getter_storage.is_read_only value then begin
+ HLog.error (sprintf "uri %s belongs to a read-only repository" value);
+ raise (ReadOnlyUri value)
+ end;
+ if not (GrafiteMisc.is_empty value) && opts.clean_baseuri then begin
+ HLog.message ("baseuri " ^ value ^ " is not empty");
+ HLog.message ("cleaning baseuri " ^ value);
+ LibraryClean.clean_baseuris ~basedir [value];
+ end;
+ end;
+ GrafiteTypes.set_option status name value,[]
+ | GrafiteAst.Drop loc -> raise Drop
+ | GrafiteAst.Qed loc ->
+ let uri, metasenv, bo, ty =
+ match status.GrafiteTypes.proof_status with
+ | GrafiteTypes.Proof (Some uri, metasenv, body, ty) ->
+ uri, metasenv, body, ty
+ | GrafiteTypes.Proof (None, metasenv, body, ty) ->
+ raise (GrafiteTypes.Command_error
+ ("Someone allows to start a theorem without giving the "^
+ "name/uri. This should be fixed!"))
+ | _->
+ raise
+ (GrafiteTypes.Command_error "You can't Qed an incomplete theorem")
+ in
+ if metasenv <> [] then
+ raise
+ (GrafiteTypes.Command_error
+ "Proof not completed! metasenv is not empty!");
+ let name = UriManager.name_of_uri uri in
+ let obj = Cic.Constant (name,Some bo,ty,[],[]) in
+ let status, lemmas = add_obj uri obj status in
+ {status with GrafiteTypes.proof_status = GrafiteTypes.No_proof},
+ uri::lemmas
+ | GrafiteAst.Coercion (loc, uri, add_composites) ->
+ eval_coercion status ~add_composites uri
+ | GrafiteAst.Obj (loc,obj) ->
+ let ext,name =
+ match obj with
+ Cic.Constant (name,_,_,_,_)
+ | Cic.CurrentProof (name,_,_,_,_,_) -> ".con",name
+ | Cic.InductiveDefinition (types,_,_,_) ->
+ ".ind",
+ (match types with (name,_,_,_)::_ -> name | _ -> assert false)
+ | _ -> assert false in
+ let uri =
+ UriManager.uri_of_string (GrafiteTypes.qualify status name ^ ext)
+ in
+ let metasenv = GrafiteTypes.get_proof_metasenv status in
+ match obj with
+ | Cic.CurrentProof (_,metasenv',bo,ty,_,_) ->
+ let name = UriManager.name_of_uri uri in
+ if not(CicPp.check name ty) then
+ HLog.error ("Bad name: " ^ name);
+ if opts.do_heavy_checks then
+ begin
+ let dbd = LibraryDb.instance () in
+ let similar = Whelp.match_term ~dbd ty in
+ let similar_len = List.length similar in
+ if similar_len> 30 then
+ (HLog.message
+ ("Duplicate check will compare your theorem with " ^
+ string_of_int similar_len ^
+ " theorems, this may take a while."));
+ let convertible =
+ List.filter (
+ fun u ->
+ let t = CicUtil.term_of_uri u in
+ let ty',g =
+ CicTypeChecker.type_of_aux'
+ metasenv' [] t CicUniv.empty_ugraph
+ in
+ fst(CicReduction.are_convertible [] ty' ty g))
+ similar
+ in
+ (match convertible with
+ | [] -> ()
+ | x::_ ->
+ HLog.warn
+ ("Theorem already proved: " ^ UriManager.string_of_uri x ^
+ "\nPlease use a variant."));
+ end;
+ assert (metasenv = metasenv');
+ let initial_proof = (Some uri, metasenv, bo, ty) in
+ let initial_stack = Continuationals.Stack.of_metasenv metasenv in
+ { status with GrafiteTypes.proof_status =
+ GrafiteTypes.Incomplete_proof
+ { GrafiteTypes.proof = initial_proof; stack = initial_stack } },
+ []
+ | _ ->
+ if metasenv <> [] then
+ raise (GrafiteTypes.Command_error (
+ "metasenv not empty while giving a definition with body: " ^
+ CicMetaSubst.ppmetasenv [] metasenv));
+ let status, lemmas = add_obj uri obj status in
+ let status,new_lemmas =
+ add_coercions_of_record_to_moo obj lemmas status
+ in
+ {status with GrafiteTypes.proof_status = GrafiteTypes.No_proof},
+ uri::new_lemmas@lemmas
+ in
+ match status.GrafiteTypes.proof_status with
+ GrafiteTypes.Intermediate _ ->
+ {status with GrafiteTypes.proof_status = GrafiteTypes.No_proof},uris
+ | _ -> status,uris
+
+} and eval_executable = {ee_go = fun ~disambiguate_tactic ~disambiguate_command ~disambiguate_macro opts status ex ->
+ match ex with
+ | GrafiteAst.Tactical (_, tac, None) ->
+ eval_tactical ~disambiguate_tactic status tac,[]
+ | GrafiteAst.Tactical (_, tac, Some punct) ->
+ let status = eval_tactical ~disambiguate_tactic status tac in
+ eval_tactical ~disambiguate_tactic status punct,[]
+ | GrafiteAst.Command (_, cmd) ->
+ eval_command.ec_go ~disambiguate_command opts status cmd
+ | GrafiteAst.Macro (loc, macro) ->
+ raise (Macro (loc,disambiguate_macro status macro))
+
+} and eval_from_moo = {efm_go = fun status fname ->
+ let ast_of_cmd cmd =
+ GrafiteAst.Executable (HExtlib.dummy_floc,
+ GrafiteAst.Command (HExtlib.dummy_floc,
+ cmd))
+ in
+ let moo = GrafiteMarshal.load_moo fname in
+ List.fold_left
+ (fun status ast ->
+ let ast = ast_of_cmd ast in
+ let status,lemmas =
+ eval_ast.ea_go
+ ~disambiguate_tactic:(fun status _ tactic -> status,tactic)
+ ~disambiguate_command:(fun status cmd -> status,cmd)
+ ~disambiguate_macro:(fun _ _ -> assert false)
+ status ast
+ in
+ assert (lemmas=[]);
+ status)
+ status moo
+} and eval_ast = {ea_go = fun ~disambiguate_tactic ~disambiguate_command ~disambiguate_macro ?(do_heavy_checks=false) ?(clean_baseuri=true) status st
+->
+ let opts = {
+ do_heavy_checks = do_heavy_checks ;
+ clean_baseuri = clean_baseuri }
+ in
+ match st with
+ | GrafiteAst.Executable (_,ex) ->
+ eval_executable.ee_go ~disambiguate_tactic ~disambiguate_command
+ ~disambiguate_macro opts status ex
+ | GrafiteAst.Comment (_,c) -> eval_comment status c,[]
+}
+
+let eval_ast = eval_ast.ea_go
diff --git a/helm/ocaml/grafite_engine/grafiteEngine.mli b/helm/ocaml/grafite_engine/grafiteEngine.mli
new file mode 100644
index 000000000..ee5f3a157
--- /dev/null
+++ b/helm/ocaml/grafite_engine/grafiteEngine.mli
@@ -0,0 +1,55 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+exception Drop
+exception IncludedFileNotCompiled of string
+exception Macro of
+ GrafiteAst.loc *
+ (Cic.context -> GrafiteTypes.status * Cic.term GrafiteAst.macro)
+
+val eval_ast :
+ disambiguate_tactic:
+ (GrafiteTypes.status ->
+ ProofEngineTypes.goal ->
+ ('term, 'lazy_term, 'reduction, 'ident) GrafiteAst.tactic ->
+ GrafiteTypes.status *
+ (Cic.term, Cic.lazy_term, Cic.lazy_term GrafiteAst.reduction, string) GrafiteAst.tactic) ->
+
+ disambiguate_command:
+ (GrafiteTypes.status ->
+ 'obj GrafiteAst.command ->
+ GrafiteTypes.status * Cic.obj GrafiteAst.command) ->
+
+ disambiguate_macro:
+ (GrafiteTypes.status ->
+ 'term GrafiteAst.macro ->
+ Cic.context -> GrafiteTypes.status * Cic.term GrafiteAst.macro) ->
+
+ ?do_heavy_checks:bool ->
+ ?clean_baseuri:bool ->
+ GrafiteTypes.status ->
+ ('term, 'lazy_term, 'reduction, 'obj, 'ident) GrafiteAst.statement ->
+ (* the new status and generated objects, if any *)
+ GrafiteTypes.status * UriManager.uri list
diff --git a/helm/ocaml/grafite_engine/grafiteMisc.ml b/helm/ocaml/grafite_engine/grafiteMisc.ml
new file mode 100644
index 000000000..5b86293db
--- /dev/null
+++ b/helm/ocaml/grafite_engine/grafiteMisc.ml
@@ -0,0 +1,33 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let is_empty buri =
+ List.for_all
+ (function
+ Http_getter_types.Ls_section _ -> true
+ | Http_getter_types.Ls_object _ -> false)
+ (Http_getter.ls (Http_getter_misc.strip_trailing_slash buri ^ "/"))
diff --git a/helm/ocaml/grafite_engine/grafiteMisc.mli b/helm/ocaml/grafite_engine/grafiteMisc.mli
new file mode 100644
index 000000000..833bb6360
--- /dev/null
+++ b/helm/ocaml/grafite_engine/grafiteMisc.mli
@@ -0,0 +1,27 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+ (** check whether no objects are defined below a given baseuri *)
+val is_empty: string -> bool
diff --git a/helm/ocaml/grafite_engine/grafiteSync.ml b/helm/ocaml/grafite_engine/grafiteSync.ml
new file mode 100644
index 000000000..37a3132e7
--- /dev/null
+++ b/helm/ocaml/grafite_engine/grafiteSync.ml
@@ -0,0 +1,74 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+let add_obj ~basedir uri obj status =
+ let lemmas = LibrarySync.add_obj uri obj basedir in
+ {status with GrafiteTypes.objects = uri::status.GrafiteTypes.objects},
+ lemmas
+
+let add_coercion ~basedir ~add_composites status uri =
+ let compounds = LibrarySync.add_coercion ~add_composites ~basedir uri in
+ {status with GrafiteTypes.coercions = uri :: status.GrafiteTypes.coercions},
+ compounds
+
+module OrderedUri =
+struct
+ type t = UriManager.uri * string
+ let compare (u1, _) (u2, _) = UriManager.compare u1 u2
+end
+
+module UriSet = Set.Make (OrderedUri)
+
+ (** @return l2 \ l1 *)
+let uri_list_diff l2 l1 =
+ let module S = UriManager.UriSet in
+ let s1 = List.fold_left (fun set uri -> S.add uri set) S.empty l1 in
+ let s2 = List.fold_left (fun set uri -> S.add uri set) S.empty l2 in
+ let diff = S.diff s2 s1 in
+ S.fold (fun uri uris -> uri :: uris) diff []
+
+let time_travel ~present ~past =
+ let objs_to_remove =
+ uri_list_diff present.GrafiteTypes.objects past.GrafiteTypes.objects in
+ let coercions_to_remove =
+ uri_list_diff present.GrafiteTypes.coercions past.GrafiteTypes.coercions
+ in
+ List.iter (fun uri -> LibrarySync.remove_coercion uri) coercions_to_remove;
+ List.iter LibrarySync.remove_obj objs_to_remove
+
+let init () =
+ LibrarySync.remove_all_coercions ();
+ LibraryObjects.reset_defaults ();
+ {
+ GrafiteTypes.moo_content_rev = [];
+ proof_status = GrafiteTypes.No_proof;
+ options = GrafiteTypes.no_options;
+ objects = [];
+ coercions = [];
+ }
diff --git a/helm/ocaml/grafite_engine/grafiteSync.mli b/helm/ocaml/grafite_engine/grafiteSync.mli
new file mode 100644
index 000000000..ce3c04250
--- /dev/null
+++ b/helm/ocaml/grafite_engine/grafiteSync.mli
@@ -0,0 +1,38 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val add_obj:
+ basedir:string -> UriManager.uri -> Cic.obj -> GrafiteTypes.status ->
+ GrafiteTypes.status * UriManager.uri list
+
+val add_coercion:
+ basedir:string -> add_composites:bool -> GrafiteTypes.status ->
+ UriManager.uri -> GrafiteTypes.status * UriManager.uri list
+
+val time_travel:
+ present:GrafiteTypes.status -> past:GrafiteTypes.status -> unit
+
+ (* also resets the imperative part of the status *)
+val init: unit -> GrafiteTypes.status
diff --git a/helm/ocaml/grafite_engine/grafiteTypes.ml b/helm/ocaml/grafite_engine/grafiteTypes.ml
new file mode 100644
index 000000000..0c02e1b6c
--- /dev/null
+++ b/helm/ocaml/grafite_engine/grafiteTypes.ml
@@ -0,0 +1,195 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+exception Option_error of string * string
+exception Statement_error of string
+exception Command_error of string
+
+let command_error msg = raise (Command_error msg)
+
+type incomplete_proof = {
+ proof: ProofEngineTypes.proof;
+ stack: Continuationals.Stack.t;
+}
+
+type proof_status =
+ | No_proof
+ | Incomplete_proof of incomplete_proof
+ | Proof of ProofEngineTypes.proof
+ | Intermediate of Cic.metasenv
+ (* Status in which the proof could be while it is being processed by the
+ * engine. No status entering/exiting the engine could be in it. *)
+
+module StringMap = Map.Make (String)
+type option_value =
+ | String of string
+ | Int of int
+type options = option_value StringMap.t
+let no_options = StringMap.empty
+
+type status = {
+ moo_content_rev: GrafiteMarshal.moo;
+ proof_status: proof_status;
+ options: options;
+ objects: UriManager.uri list;
+ coercions: UriManager.uri list;
+}
+
+let get_current_proof status =
+ match status.proof_status with
+ | Incomplete_proof { proof = p } -> p
+ | _ -> raise (Statement_error "no ongoing proof")
+
+let get_proof_metasenv status =
+ match status.proof_status with
+ | No_proof -> []
+ | Proof (_, metasenv, _, _)
+ | Incomplete_proof { proof = (_, metasenv, _, _) }
+ | Intermediate metasenv ->
+ metasenv
+
+let get_stack status =
+ match status.proof_status with
+ | Incomplete_proof p -> p.stack
+ | Proof _ -> Continuationals.Stack.empty
+ | _ -> assert false
+
+let set_stack stack status =
+ match status.proof_status with
+ | Incomplete_proof p ->
+ { status with proof_status = Incomplete_proof { p with stack = stack } }
+ | Proof _ ->
+ assert (Continuationals.Stack.is_empty stack);
+ status
+ | _ -> assert false
+
+let set_metasenv metasenv status =
+ let proof_status =
+ match status.proof_status with
+ | No_proof -> Intermediate metasenv
+ | Incomplete_proof ({ proof = (uri, _, proof, ty) } as incomplete_proof) ->
+ Incomplete_proof
+ { incomplete_proof with proof = (uri, metasenv, proof, ty) }
+ | Intermediate _ -> Intermediate metasenv
+ | Proof (_, metasenv', _, _) ->
+ assert (metasenv = metasenv');
+ status.proof_status
+ in
+ { status with proof_status = proof_status }
+
+let get_proof_context status goal =
+ match status.proof_status with
+ | Incomplete_proof { proof = (_, metasenv, _, _) } ->
+ let (_, context, _) = CicUtil.lookup_meta goal metasenv in
+ context
+ | _ -> []
+
+let get_proof_conclusion status goal =
+ match status.proof_status with
+ | Incomplete_proof { proof = (_, metasenv, _, _) } ->
+ let (_, _, conclusion) = CicUtil.lookup_meta goal metasenv in
+ conclusion
+ | _ -> raise (Statement_error "no ongoing proof")
+
+let add_moo_content cmds status =
+ let content = status.moo_content_rev in
+ let content' =
+ List.fold_right
+ (fun cmd acc ->
+(* prerr_endline ("adding to moo command: " ^ GrafiteAstPp.pp_command cmd); *)
+ match cmd with
+ | GrafiteAst.Default _ ->
+ if List.mem cmd content then acc
+ else cmd :: acc
+ | _ -> cmd :: acc)
+ cmds content
+ in
+(* prerr_endline ("new moo content: " ^ String.concat " " (List.map
+ GrafiteAstPp.pp_command content')); *)
+ { status with moo_content_rev = content' }
+
+let get_option status name =
+ try
+ StringMap.find name status.options
+ with Not_found -> raise (Option_error (name, "not found"))
+
+let set_option status name value =
+ let mangle_dir s =
+ let s = Str.global_replace (Str.regexp "//+") "/" s in
+ let s = Str.global_replace (Str.regexp "/$") "" s in
+ s
+ in
+ let types = [ "baseuri", (`String, mangle_dir); ] in
+ let ty_and_mangler =
+ try
+ List.assoc name types
+ with Not_found ->
+ command_error (Printf.sprintf "Unknown option \"%s\"" name)
+ in
+ let value =
+ match ty_and_mangler with
+ | `String, f -> String (f value)
+ | `Int, f ->
+ (try
+ Int (int_of_string (f value))
+ with Failure _ ->
+ command_error (Printf.sprintf "Not an integer value \"%s\"" value))
+ in
+ if StringMap.mem name status.options && name = "baseuri" then
+ command_error "Redefinition of 'baseuri' is forbidden."
+ else
+ { status with options = StringMap.add name value status.options }
+
+
+let get_string_option status name =
+ match get_option status name with
+ | String s -> s
+ | _ -> raise (Option_error (name, "not a string value"))
+
+let qualify status name = get_string_option status "baseuri" ^ "/" ^ name
+
+let dump_status status =
+ HLog.message "status.aliases:\n";
+ HLog.message "status.proof_status:";
+ HLog.message
+ (match status.proof_status with
+ | No_proof -> "no proof\n"
+ | Incomplete_proof _ -> "incomplete proof\n"
+ | Proof _ -> "proof\n"
+ | Intermediate _ -> "Intermediate\n");
+ HLog.message "status.options\n";
+ StringMap.iter (fun k v ->
+ let v =
+ match v with
+ | String s -> s
+ | Int i -> string_of_int i
+ in
+ HLog.message (k ^ "::=" ^ v)) status.options;
+ HLog.message "status.coercions\n";
+ HLog.message "status.objects:\n";
+ List.iter
+ (fun u -> HLog.message (UriManager.string_of_uri u)) status.objects
diff --git a/helm/ocaml/grafite_engine/grafiteTypes.mli b/helm/ocaml/grafite_engine/grafiteTypes.mli
new file mode 100644
index 000000000..a8b86c276
--- /dev/null
+++ b/helm/ocaml/grafite_engine/grafiteTypes.mli
@@ -0,0 +1,77 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+exception Option_error of string * string
+exception Statement_error of string
+exception Command_error of string
+
+val command_error: string -> 'a (** @raise Command_error *)
+
+type incomplete_proof = {
+ proof: ProofEngineTypes.proof;
+ stack: Continuationals.Stack.t;
+}
+
+type proof_status =
+ No_proof
+ | Incomplete_proof of incomplete_proof
+ | Proof of ProofEngineTypes.proof
+ | Intermediate of Cic.metasenv
+
+type option_value =
+ | String of string
+ | Int of int
+type options
+val no_options: options
+
+type status = {
+ moo_content_rev: GrafiteMarshal.moo;
+ proof_status: proof_status; (** logical status *)
+ options: options;
+ objects: UriManager.uri list; (** in-scope objects *)
+ coercions: UriManager.uri list; (** defined coercions *)
+}
+
+val dump_status : status -> unit
+
+ (** list is not reversed, head command will be the first emitted *)
+val add_moo_content: GrafiteMarshal.ast_command list -> status -> status
+
+val get_option : status -> string -> option_value
+val get_string_option : status -> string -> string
+val set_option : status -> string -> string -> status
+
+val qualify: status -> string -> string
+
+val get_current_proof: status -> ProofEngineTypes.proof
+val get_proof_metasenv: status -> Cic.metasenv
+val get_stack: status -> Continuationals.Stack.t
+val get_proof_context : status -> int -> Cic.context
+val get_proof_conclusion : status -> int -> Cic.term
+
+val set_stack: Continuationals.Stack.t -> status -> status
+val set_metasenv: Cic.metasenv -> status -> status
diff --git a/helm/ocaml/grafite_parser/.depend b/helm/ocaml/grafite_parser/.depend
new file mode 100644
index 000000000..360429635
--- /dev/null
+++ b/helm/ocaml/grafite_parser/.depend
@@ -0,0 +1,10 @@
+dependenciesParser.cmo: dependenciesParser.cmi
+dependenciesParser.cmx: dependenciesParser.cmi
+grafiteParser.cmo: dependenciesParser.cmi grafiteParser.cmi
+grafiteParser.cmx: dependenciesParser.cmx grafiteParser.cmi
+cicNotation2.cmo: grafiteParser.cmi cicNotation2.cmi
+cicNotation2.cmx: grafiteParser.cmx cicNotation2.cmi
+grafiteDisambiguator.cmo: grafiteDisambiguator.cmi
+grafiteDisambiguator.cmx: grafiteDisambiguator.cmi
+grafiteDisambiguate.cmo: grafiteDisambiguator.cmi grafiteDisambiguate.cmi
+grafiteDisambiguate.cmx: grafiteDisambiguator.cmx grafiteDisambiguate.cmi
diff --git a/helm/ocaml/grafite_parser/Makefile b/helm/ocaml/grafite_parser/Makefile
new file mode 100644
index 000000000..4b04b597e
--- /dev/null
+++ b/helm/ocaml/grafite_parser/Makefile
@@ -0,0 +1,42 @@
+PACKAGE = grafite_parser
+PREDICATES =
+
+INTERFACE_FILES = \
+ dependenciesParser.mli \
+ grafiteParser.mli \
+ cicNotation2.mli \
+ grafiteDisambiguator.mli \
+ grafiteDisambiguate.mli \
+ $(NULL)
+IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml)
+
+all: test_parser print_grammar test_dep
+clean: clean_tests
+
+# <cross> cross compatibility among ocaml 3.09 and ocaml 3.08, to be removed as
+# soon as we have ocaml 3.09 everywhere and "loc" occurrences are replaced by
+# "_loc" occurrences
+UTF8DIR = $(shell $(OCAMLFIND) query helm-utf8_macros)
+ULEXDIR = $(shell $(OCAMLFIND) query ulex)
+MY_SYNTAXOPTIONS = -pp "camlp4o -I $(UTF8DIR) -I $(ULEXDIR) pa_extend.cmo pa_ulex.cma pa_unicode_macro.cma -loc loc"
+grafiteParser.cmo: SYNTAXOPTIONS = $(MY_SYNTAXOPTIONS)
+grafiteParser.cmx: SYNTAXOPTIONS = $(MY_SYNTAXOPTIONS)
+depend: SYNTAXOPTIONS = $(MY_SYNTAXOPTIONS)
+# </cross>
+#
+grafiteParser.cmo: OCAMLC = $(OCAMLC_P4)
+grafiteParser.cmx: OCAMLOPT = $(OCAMLOPT_P4)
+
+clean_tests:
+ rm -f test_parser{,.opt} test_dep{,.opt} print_grammar{,.opt}
+
+LOCAL_LINKOPTS = -package helm-$(PACKAGE) -linkpkg
+test: test_parser print_grammar test_dep
+test_parser: test_parser.ml $(PACKAGE).cma
+ $(OCAMLC) $(LOCAL_LINKOPTS) -o $@ $<
+print_grammar: print_grammar.ml $(PACKAGE).cma
+ $(OCAMLC) $(LOCAL_LINKOPTS) -o $@ $<
+test_dep: test_dep.ml $(PACKAGE).cma
+ $(OCAMLC) $(LOCAL_LINKOPTS) -o $@ $<
+
+include ../Makefile.common
diff --git a/helm/ocaml/grafite_parser/cicNotation2.ml b/helm/ocaml/grafite_parser/cicNotation2.ml
new file mode 100644
index 000000000..015d426e7
--- /dev/null
+++ b/helm/ocaml/grafite_parser/cicNotation2.ml
@@ -0,0 +1,49 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let load_notation ~include_paths fname =
+ let ic = open_in fname in
+ let lexbuf = Ulexing.from_utf8_channel ic in
+ let status = ref LexiconSync.init in
+ try
+ while true do
+ status := fst (GrafiteParser.parse_statement ~include_paths lexbuf !status)
+ done;
+ assert false
+ with End_of_file -> close_in ic; !status
+
+let parse_environment ~include_paths str =
+ let lexbuf = Ulexing.from_utf8_string str in
+ let status = ref LexiconSync.init in
+ try
+ while true do
+ status := fst (GrafiteParser.parse_statement ~include_paths lexbuf !status)
+ done;
+ assert false
+ with End_of_file ->
+ !status.LexiconEngine.aliases,
+ !status.LexiconEngine.multi_aliases
diff --git a/helm/ocaml/grafite_parser/cicNotation2.mli b/helm/ocaml/grafite_parser/cicNotation2.mli
new file mode 100644
index 000000000..00f184b3b
--- /dev/null
+++ b/helm/ocaml/grafite_parser/cicNotation2.mli
@@ -0,0 +1,35 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** Note: notation is also loaded, but it cannot be undone since the
+ notation_ids part of the status is thrown away;
+ so far this function is useful only in Whelp *)
+val parse_environment:
+ include_paths:string list ->
+ string ->
+ DisambiguateTypes.environment * DisambiguateTypes.multiple_environment
+
+(** @param fname file from which load notation *)
+val load_notation: include_paths:string list -> string -> LexiconEngine.status
diff --git a/helm/ocaml/grafite_parser/dependenciesParser.ml b/helm/ocaml/grafite_parser/dependenciesParser.ml
new file mode 100644
index 000000000..fc49de600
--- /dev/null
+++ b/helm/ocaml/grafite_parser/dependenciesParser.ml
@@ -0,0 +1,92 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+exception UnableToInclude of string
+
+ (* statements meaningful for matitadep *)
+type dependency =
+ | IncludeDep of string
+ | BaseuriDep of string
+ | UriDep of UriManager.uri
+
+let pp_dependency = function
+ | IncludeDep str -> "include \"" ^ str ^ "\""
+ | BaseuriDep str -> "set \"baseuri\" \"" ^ str ^ "\""
+ | UriDep uri -> "uri \"" ^ UriManager.string_of_uri uri ^ "\""
+
+let parse_dependencies lexbuf =
+ let tok_stream,_ =
+ CicNotationLexer.level2_ast_lexer.Token.tok_func (Obj.magic lexbuf)
+ in
+ let rec parse acc =
+ (parser
+ | [< '("URI", u) >] ->
+ parse (UriDep (UriManager.uri_of_string u) :: acc)
+ | [< '("IDENT", "include"); '("QSTRING", fname) >] ->
+ parse (IncludeDep fname :: acc)
+ | [< '("IDENT", "set"); '("QSTRING", "baseuri"); '("QSTRING", baseuri) >] ->
+ parse (BaseuriDep baseuri :: acc)
+ | [< '("EOI", _) >] -> acc
+ | [< 'tok >] -> parse acc
+ | [< >] -> acc) tok_stream
+ in
+ List.rev (parse [])
+
+let make_absolute paths path =
+ let rec aux = function
+ | [] -> ignore (Unix.stat path); path
+ | p :: tl ->
+ let path = p ^ "/" ^ path in
+ try
+ ignore (Unix.stat path); path
+ with Unix.Unix_error _ -> aux tl
+ in
+ try
+ aux paths
+ with Unix.Unix_error _ -> raise (UnableToInclude path)
+;;
+
+let baseuri_of_script ~include_paths file =
+ let file = make_absolute include_paths file in
+ let ic = open_in file in
+ let istream = Ulexing.from_utf8_channel ic in
+ let rec find_baseuri =
+ function
+ [] -> failwith ("No baseuri defined in " ^ file)
+ | BaseuriDep s::_ -> s
+ | _::tl -> find_baseuri tl in
+ let buri = find_baseuri (parse_dependencies istream) in
+ let uri = Http_getter_misc.strip_trailing_slash buri in
+ if String.length uri < 5 || String.sub uri 0 5 <> "cic:/" then
+ HLog.error (file ^ " sets an incorrect baseuri: " ^ buri);
+ (try
+ ignore(Http_getter.resolve uri)
+ with
+ | Http_getter_types.Unresolvable_URI _ ->
+ HLog.error (file ^ " sets an unresolvable baseuri: " ^ buri)
+ | Http_getter_types.Key_not_found _ -> ());
+ uri
diff --git a/helm/ocaml/grafite_parser/dependenciesParser.mli b/helm/ocaml/grafite_parser/dependenciesParser.mli
new file mode 100644
index 000000000..882d45fb8
--- /dev/null
+++ b/helm/ocaml/grafite_parser/dependenciesParser.mli
@@ -0,0 +1,39 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+exception UnableToInclude of string
+
+ (* statements meaningful for matitadep *)
+type dependency =
+ | IncludeDep of string
+ | BaseuriDep of string
+ | UriDep of UriManager.uri
+
+val pp_dependency: dependency -> string
+
+ (** @raise End_of_file *)
+val parse_dependencies: Ulexing.lexbuf -> dependency list
+
+val baseuri_of_script : include_paths:string list -> string -> string
diff --git a/helm/ocaml/grafite_parser/grafiteDisambiguate.ml b/helm/ocaml/grafite_parser/grafiteDisambiguate.ml
new file mode 100644
index 000000000..3d6f893ee
--- /dev/null
+++ b/helm/ocaml/grafite_parser/grafiteDisambiguate.ml
@@ -0,0 +1,288 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+exception BaseUriNotSetYet
+
+let singleton = function
+ | [x], _ -> x
+ | _ -> assert false
+
+ (** @param term not meaningful when context is given *)
+let disambiguate_term lexicon_status_ref context metasenv term =
+ let lexicon_status = !lexicon_status_ref in
+ let (diff, metasenv, cic, _) =
+ singleton
+ (GrafiteDisambiguator.disambiguate_term ~dbd:(LibraryDb.instance ())
+ ~aliases:lexicon_status.LexiconEngine.aliases
+ ~universe:(Some lexicon_status.LexiconEngine.multi_aliases)
+ ~context ~metasenv term)
+ in
+ let lexicon_status = LexiconEngine.set_proof_aliases lexicon_status diff in
+ lexicon_status_ref := lexicon_status;
+ metasenv,cic
+
+ (** disambiguate_lazy_term (circa): term -> (unit -> status) * lazy_term
+ * rationale: lazy_term will be invoked in different context to obtain a term,
+ * each invocation will disambiguate the term and can add aliases. Once all
+ * disambiguations have been performed, the first returned function can be
+ * used to obtain the resulting aliases *)
+let disambiguate_lazy_term lexicon_status_ref term =
+ (fun context metasenv ugraph ->
+ let lexicon_status = !lexicon_status_ref in
+ let (diff, metasenv, cic, ugraph) =
+ singleton
+ (GrafiteDisambiguator.disambiguate_term ~dbd:(LibraryDb.instance ())
+ ~initial_ugraph:ugraph ~aliases:lexicon_status.LexiconEngine.aliases
+ ~universe:(Some lexicon_status.LexiconEngine.multi_aliases)
+ ~context ~metasenv
+ term) in
+ let lexicon_status = LexiconEngine.set_proof_aliases lexicon_status diff in
+ lexicon_status_ref := lexicon_status;
+ cic, metasenv, ugraph)
+
+let disambiguate_pattern lexicon_status_ref (wanted, hyp_paths, goal_path) =
+ let interp path = Disambiguate.interpretate_path [] path in
+ let goal_path = HExtlib.map_option interp goal_path in
+ let hyp_paths = List.map (fun (name, path) -> name, interp path) hyp_paths in
+ let wanted =
+ match wanted with
+ None -> None
+ | Some wanted ->
+ let wanted = disambiguate_lazy_term lexicon_status_ref wanted in
+ Some wanted
+ in
+ (wanted, hyp_paths, goal_path)
+
+let disambiguate_reduction_kind lexicon_status_ref = function
+ | `Unfold (Some t) ->
+ let t = disambiguate_lazy_term lexicon_status_ref t in
+ `Unfold (Some t)
+ | `Normalize
+ | `Reduce
+ | `Simpl
+ | `Unfold None
+ | `Whd as kind -> kind
+
+let disambiguate_tactic lexicon_status_ref context metasenv tactic =
+ let disambiguate_term = disambiguate_term lexicon_status_ref in
+ let disambiguate_pattern = disambiguate_pattern lexicon_status_ref in
+ let disambiguate_reduction_kind = disambiguate_reduction_kind lexicon_status_ref in
+ let disambiguate_lazy_term = disambiguate_lazy_term lexicon_status_ref in
+ match tactic with
+ | GrafiteAst.Absurd (loc, term) ->
+ let metasenv,cic = disambiguate_term context metasenv term in
+ metasenv,GrafiteAst.Absurd (loc, cic)
+ | GrafiteAst.Apply (loc, term) ->
+ let metasenv,cic = disambiguate_term context metasenv term in
+ metasenv,GrafiteAst.Apply (loc, cic)
+ | GrafiteAst.Assumption loc ->
+ metasenv,GrafiteAst.Assumption loc
+ | GrafiteAst.Auto (loc,depth,width,paramodulation,full) ->
+ metasenv,GrafiteAst.Auto (loc,depth,width,paramodulation,full)
+ | GrafiteAst.Change (loc, pattern, with_what) ->
+ let with_what = disambiguate_lazy_term with_what in
+ let pattern = disambiguate_pattern pattern in
+ metasenv,GrafiteAst.Change (loc, pattern, with_what)
+ | GrafiteAst.Clear (loc,id) ->
+ metasenv,GrafiteAst.Clear (loc,id)
+ | GrafiteAst.ClearBody (loc,id) ->
+ metasenv,GrafiteAst.ClearBody (loc,id)
+ | GrafiteAst.Compare (loc,term) ->
+ let metasenv,term = disambiguate_term context metasenv term in
+ metasenv,GrafiteAst.Compare (loc,term)
+ | GrafiteAst.Constructor (loc,n) ->
+ metasenv,GrafiteAst.Constructor (loc,n)
+ | GrafiteAst.Contradiction loc ->
+ metasenv,GrafiteAst.Contradiction loc
+ | GrafiteAst.Cut (loc, ident, term) ->
+ let metasenv,cic = disambiguate_term context metasenv term in
+ metasenv,GrafiteAst.Cut (loc, ident, cic)
+ | GrafiteAst.DecideEquality loc ->
+ metasenv,GrafiteAst.DecideEquality loc
+ | GrafiteAst.Decompose (loc, types, what, names) ->
+ let disambiguate (metasenv,types) = function
+ | GrafiteAst.Type _ -> assert false
+ | GrafiteAst.Ident id ->
+ (match
+ disambiguate_term context metasenv
+ (CicNotationPt.Ident(id, None))
+ with
+ | metasenv,Cic.MutInd (uri, tyno, _) ->
+ metasenv,(GrafiteAst.Type (uri, tyno) :: types)
+ | _ ->
+ raise (GrafiteDisambiguator.DisambiguationError
+ (0,[[None,lazy "Decompose works only on inductive types"]])))
+ in
+ let metasenv,types =
+ List.fold_left disambiguate (metasenv,[]) types
+ in
+ metasenv,GrafiteAst.Decompose (loc, types, what, names)
+ | GrafiteAst.Discriminate (loc,term) ->
+ let metasenv,term = disambiguate_term context metasenv term in
+ metasenv,GrafiteAst.Discriminate(loc,term)
+ | GrafiteAst.Exact (loc, term) ->
+ let metasenv,cic = disambiguate_term context metasenv term in
+ metasenv,GrafiteAst.Exact (loc, cic)
+ | GrafiteAst.Elim (loc, what, Some using, depth, idents) ->
+ let metasenv,what = disambiguate_term context metasenv what in
+ let metasenv,using = disambiguate_term context metasenv using in
+ metasenv,GrafiteAst.Elim (loc, what, Some using, depth, idents)
+ | GrafiteAst.Elim (loc, what, None, depth, idents) ->
+ let metasenv,what = disambiguate_term context metasenv what in
+ metasenv,GrafiteAst.Elim (loc, what, None, depth, idents)
+ | GrafiteAst.ElimType (loc, what, Some using, depth, idents) ->
+ let metasenv,what = disambiguate_term context metasenv what in
+ let metasenv,using = disambiguate_term context metasenv using in
+ metasenv,GrafiteAst.ElimType (loc, what, Some using, depth, idents)
+ | GrafiteAst.ElimType (loc, what, None, depth, idents) ->
+ let metasenv,what = disambiguate_term context metasenv what in
+ metasenv,GrafiteAst.ElimType (loc, what, None, depth, idents)
+ | GrafiteAst.Exists loc ->
+ metasenv,GrafiteAst.Exists loc
+ | GrafiteAst.Fail loc ->
+ metasenv,GrafiteAst.Fail loc
+ | GrafiteAst.Fold (loc,red_kind, term, pattern) ->
+ let pattern = disambiguate_pattern pattern in
+ let term = disambiguate_lazy_term term in
+ let red_kind = disambiguate_reduction_kind red_kind in
+ metasenv,GrafiteAst.Fold (loc, red_kind, term, pattern)
+ | GrafiteAst.FwdSimpl (loc, hyp, names) ->
+ metasenv,GrafiteAst.FwdSimpl (loc, hyp, names)
+ | GrafiteAst.Fourier loc ->
+ metasenv,GrafiteAst.Fourier loc
+ | GrafiteAst.Generalize (loc,pattern,ident) ->
+ let pattern = disambiguate_pattern pattern in
+ metasenv,GrafiteAst.Generalize (loc,pattern,ident)
+ | GrafiteAst.Goal (loc, g) ->
+ metasenv,GrafiteAst.Goal (loc, g)
+ | GrafiteAst.IdTac loc ->
+ metasenv,GrafiteAst.IdTac loc
+ | GrafiteAst.Injection (loc, term) ->
+ let metasenv,term = disambiguate_term context metasenv term in
+ metasenv,GrafiteAst.Injection (loc,term)
+ | GrafiteAst.Intros (loc, num, names) ->
+ metasenv,GrafiteAst.Intros (loc, num, names)
+ | GrafiteAst.Inversion (loc, term) ->
+ let metasenv,term = disambiguate_term context metasenv term in
+ metasenv,GrafiteAst.Inversion (loc, term)
+ | GrafiteAst.LApply (loc, depth, to_what, what, ident) ->
+ let f term to_what =
+ let metasenv,term = disambiguate_term context metasenv term in
+ term :: to_what
+ in
+ let to_what = List.fold_right f to_what [] in
+ let metasenv,what = disambiguate_term context metasenv what in
+ metasenv,GrafiteAst.LApply (loc, depth, to_what, what, ident)
+ | GrafiteAst.Left loc ->
+ metasenv,GrafiteAst.Left loc
+ | GrafiteAst.LetIn (loc, term, name) ->
+ let metasenv,term = disambiguate_term context metasenv term in
+ metasenv,GrafiteAst.LetIn (loc,term,name)
+ | GrafiteAst.Reduce (loc, red_kind, pattern) ->
+ let pattern = disambiguate_pattern pattern in
+ let red_kind = disambiguate_reduction_kind red_kind in
+ metasenv,GrafiteAst.Reduce(loc, red_kind, pattern)
+ | GrafiteAst.Reflexivity loc ->
+ metasenv,GrafiteAst.Reflexivity loc
+ | GrafiteAst.Replace (loc, pattern, with_what) ->
+ let pattern = disambiguate_pattern pattern in
+ let with_what = disambiguate_lazy_term with_what in
+ metasenv,GrafiteAst.Replace (loc, pattern, with_what)
+ | GrafiteAst.Rewrite (loc, dir, t, pattern) ->
+ let metasenv,term = disambiguate_term context metasenv t in
+ let pattern = disambiguate_pattern pattern in
+ metasenv,GrafiteAst.Rewrite (loc, dir, term, pattern)
+ | GrafiteAst.Right loc ->
+ metasenv,GrafiteAst.Right loc
+ | GrafiteAst.Ring loc ->
+ metasenv,GrafiteAst.Ring loc
+ | GrafiteAst.Split loc ->
+ metasenv,GrafiteAst.Split loc
+ | GrafiteAst.Symmetry loc ->
+ metasenv,GrafiteAst.Symmetry loc
+ | GrafiteAst.Transitivity (loc, term) ->
+ let metasenv,cic = disambiguate_term context metasenv term in
+ metasenv,GrafiteAst.Transitivity (loc, cic)
+
+let disambiguate_obj lexicon_status ~baseuri metasenv obj =
+ let uri =
+ match obj with
+ | CicNotationPt.Inductive (_,(name,_,_,_)::_)
+ | CicNotationPt.Record (_,name,_,_) ->
+ (match baseuri with
+ | Some baseuri ->
+ Some (UriManager.uri_of_string (baseuri ^ "/" ^ name ^ ".ind"))
+ | None -> raise BaseUriNotSetYet)
+ | CicNotationPt.Inductive _ -> assert false
+ | CicNotationPt.Theorem _ -> None in
+ let (diff, metasenv, cic, _) =
+ singleton
+ (GrafiteDisambiguator.disambiguate_obj ~dbd:(LibraryDb.instance ())
+ ~aliases:lexicon_status.LexiconEngine.aliases
+ ~universe:(Some lexicon_status.LexiconEngine.multi_aliases) ~uri obj) in
+ let lexicon_status = LexiconEngine.set_proof_aliases lexicon_status diff in
+ lexicon_status, metasenv, cic
+
+let disambiguate_command lexicon_status ~baseuri metasenv =
+ function
+ | GrafiteAst.Coercion _
+ | GrafiteAst.Default _
+ | GrafiteAst.Drop _
+ | GrafiteAst.Include _
+ | GrafiteAst.Qed _
+ | GrafiteAst.Set _ as cmd ->
+ lexicon_status,metasenv,cmd
+ | GrafiteAst.Obj (loc,obj) ->
+ let lexicon_status,metasenv,obj =
+ disambiguate_obj lexicon_status ~baseuri metasenv obj in
+ lexicon_status, metasenv, GrafiteAst.Obj (loc,obj)
+
+let disambiguate_macro lexicon_status_ref metasenv context macro =
+ let disambiguate_term = disambiguate_term lexicon_status_ref in
+ match macro with
+ | GrafiteAst.WMatch (loc,term) ->
+ let metasenv,term = disambiguate_term context metasenv term in
+ metasenv,GrafiteAst.WMatch (loc,term)
+ | GrafiteAst.WInstance (loc,term) ->
+ let metasenv,term = disambiguate_term context metasenv term in
+ metasenv,GrafiteAst.WInstance (loc,term)
+ | GrafiteAst.WElim (loc,term) ->
+ let metasenv,term = disambiguate_term context metasenv term in
+ metasenv,GrafiteAst.WElim (loc,term)
+ | GrafiteAst.WHint (loc,term) ->
+ let metasenv,term = disambiguate_term context metasenv term in
+ metasenv,GrafiteAst.WHint (loc,term)
+ | GrafiteAst.Check (loc,term) ->
+ let metasenv,term = disambiguate_term context metasenv term in
+ metasenv,GrafiteAst.Check (loc,term)
+ | GrafiteAst.Hint _
+ | GrafiteAst.WLocate _ as macro ->
+ metasenv,macro
+ | GrafiteAst.Quit _
+ | GrafiteAst.Print _
+ | GrafiteAst.Search_pat _
+ | GrafiteAst.Search_term _ -> assert false
diff --git a/helm/ocaml/grafite_parser/grafiteDisambiguate.mli b/helm/ocaml/grafite_parser/grafiteDisambiguate.mli
new file mode 100644
index 000000000..b04aa3cde
--- /dev/null
+++ b/helm/ocaml/grafite_parser/grafiteDisambiguate.mli
@@ -0,0 +1,48 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+exception BaseUriNotSetYet
+
+val disambiguate_tactic:
+ LexiconEngine.status ref ->
+ Cic.context ->
+ Cic.metasenv ->
+ (CicNotationPt.term, CicNotationPt.term, CicNotationPt.term GrafiteAst.reduction, string) GrafiteAst.tactic ->
+ Cic.metasenv *
+ (Cic.term, Cic.lazy_term, Cic.lazy_term GrafiteAst.reduction, string) GrafiteAst.tactic
+
+val disambiguate_command:
+ LexiconEngine.status ->
+ baseuri:string option ->
+ Cic.metasenv ->
+ CicNotationPt.obj GrafiteAst.command ->
+ LexiconEngine.status * Cic.metasenv * Cic.obj GrafiteAst.command
+
+val disambiguate_macro:
+ LexiconEngine.status ref ->
+ Cic.metasenv ->
+ Cic.context ->
+ CicNotationPt.term GrafiteAst.macro ->
+ Cic.metasenv * Cic.term GrafiteAst.macro
diff --git a/helm/ocaml/grafite_parser/grafiteDisambiguator.ml b/helm/ocaml/grafite_parser/grafiteDisambiguator.ml
new file mode 100644
index 000000000..d05351cd2
--- /dev/null
+++ b/helm/ocaml/grafite_parser/grafiteDisambiguator.ml
@@ -0,0 +1,178 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+exception Ambiguous_input
+(* the integer is an offset to be added to each location *)
+exception DisambiguationError of
+ int * (Token.flocation option * string Lazy.t) list list
+ (** parameters are: option name, error message *)
+exception Unbound_identifier of string
+
+type choose_uris_callback =
+ id:string -> UriManager.uri list -> UriManager.uri list
+
+type choose_interp_callback = (string * string) list list -> int list
+
+let mono_uris_callback ~id =
+ if Helm_registry.get_bool "matita.auto_disambiguation" then
+ function l -> l
+ else
+ raise Ambiguous_input
+
+let mono_interp_callback _ = raise Ambiguous_input
+
+let _choose_uris_callback = ref mono_uris_callback
+let _choose_interp_callback = ref mono_interp_callback
+let set_choose_uris_callback f = _choose_uris_callback := f
+let set_choose_interp_callback f = _choose_interp_callback := f
+
+module Callbacks =
+ struct
+ let interactive_user_uri_choice ~selection_mode ?ok
+ ?(enable_button_for_non_vars = true) ~title ~msg ~id uris =
+ !_choose_uris_callback ~id uris
+
+ let interactive_interpretation_choice interp =
+ !_choose_interp_callback interp
+
+ let input_or_locate_uri ~(title:string) ?id =
+ (* Zack: I try to avoid using this callback. I therefore assume that
+ * the presence of an identifier that can't be resolved via "locate"
+ * query is a syntax error *)
+ let msg = match id with Some id -> id | _ -> "_" in
+ raise (Unbound_identifier msg)
+ end
+
+module Disambiguator = Disambiguate.Make (Callbacks)
+
+(* implement module's API *)
+
+let disambiguate_thing ~aliases ~universe
+ ~(f:?fresh_instances:bool ->
+ aliases:DisambiguateTypes.environment ->
+ universe:DisambiguateTypes.multiple_environment option ->
+ 'a -> 'b)
+ ~(drop_aliases: 'b -> 'b)
+ ~(drop_aliases_and_clear_diff: 'b -> 'b)
+ (thing: 'a)
+=
+ assert (universe <> None);
+ let library = false, DisambiguateTypes.Environment.empty, None in
+ let multi_aliases = false, DisambiguateTypes.Environment.empty, universe in
+ let mono_aliases = true, aliases, Some DisambiguateTypes.Environment.empty in
+ let passes = (* <fresh_instances?, aliases, coercions?> *)
+ [ (false, mono_aliases, false);
+ (false, multi_aliases, false);
+ (true, mono_aliases, false);
+ (true, multi_aliases, false);
+ (true, mono_aliases, true);
+ (true, multi_aliases, true);
+ (true, library, true);
+ ]
+ in
+ let try_pass (fresh_instances, (_, aliases, universe), insert_coercions) =
+ CicRefine.insert_coercions := insert_coercions;
+ f ~fresh_instances ~aliases ~universe thing
+ in
+ let set_aliases (instances,(use_mono_aliases,_,_),_) (_, user_asked as res) =
+ if use_mono_aliases && not instances then
+ drop_aliases res
+ else if user_asked then
+ drop_aliases res (* one shot aliases *)
+ else
+ drop_aliases_and_clear_diff res
+ in
+ let rec aux errors =
+ function
+ | [ pass ] ->
+ (try
+ set_aliases pass (try_pass pass)
+ with Disambiguate.NoWellTypedInterpretation (offset,newerrors) ->
+ raise (DisambiguationError (offset, errors @ [newerrors])))
+ | hd :: tl ->
+ (try
+ set_aliases hd (try_pass hd)
+ with Disambiguate.NoWellTypedInterpretation (_offset,newerrors) ->
+ aux (errors @ [newerrors]) tl)
+ | [] -> assert false
+ in
+ let saved_insert_coercions = !CicRefine.insert_coercions in
+ try
+ let res = aux [] passes in
+ CicRefine.insert_coercions := saved_insert_coercions;
+ res
+ with exn ->
+ CicRefine.insert_coercions := saved_insert_coercions;
+ raise exn
+
+type disambiguator_thing =
+ { do_it :
+ 'a 'b.
+ aliases:DisambiguateTypes.environment ->
+ universe:DisambiguateTypes.multiple_environment option ->
+ f:(?fresh_instances:bool ->
+ aliases:DisambiguateTypes.environment ->
+ universe:DisambiguateTypes.multiple_environment option ->
+ 'a -> 'b * bool) ->
+ drop_aliases:('b * bool -> 'b * bool) ->
+ drop_aliases_and_clear_diff:('b * bool -> 'b * bool) -> 'a -> 'b * bool
+ }
+
+let disambiguate_thing =
+ let profiler = HExtlib.profile "disambiguate_thing" in
+ { do_it =
+ fun ~aliases ~universe ~f ~drop_aliases ~drop_aliases_and_clear_diff thing
+ -> profiler.HExtlib.profile
+ (disambiguate_thing ~aliases ~universe ~f ~drop_aliases
+ ~drop_aliases_and_clear_diff) thing
+ }
+
+let drop_aliases (choices, user_asked) =
+ (List.map (fun (d, a, b, c) -> d, a, b, c) choices),
+ user_asked
+
+let drop_aliases_and_clear_diff (choices, user_asked) =
+ (List.map (fun (_, a, b, c) -> [], a, b, c) choices),
+ user_asked
+
+let disambiguate_term ?fresh_instances ~dbd ~context ~metasenv ?initial_ugraph
+ ~aliases ~universe term
+ =
+ assert (fresh_instances = None);
+ let f =
+ Disambiguator.disambiguate_term ~dbd ~context ~metasenv ?initial_ugraph
+ in
+ disambiguate_thing.do_it ~aliases ~universe ~f ~drop_aliases
+ ~drop_aliases_and_clear_diff term
+
+let disambiguate_obj ?fresh_instances ~dbd ~aliases ~universe ~uri obj =
+ assert (fresh_instances = None);
+ let f = Disambiguator.disambiguate_obj ~dbd ~uri in
+ disambiguate_thing.do_it ~aliases ~universe ~f ~drop_aliases
+ ~drop_aliases_and_clear_diff obj
diff --git a/helm/ocaml/grafite_parser/grafiteDisambiguator.mli b/helm/ocaml/grafite_parser/grafiteDisambiguator.mli
new file mode 100644
index 000000000..b7c85f6af
--- /dev/null
+++ b/helm/ocaml/grafite_parser/grafiteDisambiguator.mli
@@ -0,0 +1,51 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** raised when ambiguous input is found but not expected (e.g. in the batch
+ * compiler) *)
+exception Ambiguous_input
+(* the integer is an offset to be added to each location *)
+exception DisambiguationError of
+ int * (Token.flocation option * string Lazy.t) list list
+
+type choose_uris_callback = id:string -> UriManager.uri list -> UriManager.uri list
+type choose_interp_callback = (string * string) list list -> int list
+
+val set_choose_uris_callback: choose_uris_callback -> unit
+val set_choose_interp_callback: choose_interp_callback -> unit
+
+(** @raise Ambiguous_input if called, default value for internal
+ * choose_uris_callback if not set otherwise with set_choose_uris_callback
+ * above *)
+val mono_uris_callback: choose_uris_callback
+
+(** @raise Ambiguous_input if called, default value for internal
+ * choose_interp_callback if not set otherwise with set_choose_interp_callback
+ * above *)
+val mono_interp_callback: choose_interp_callback
+
+(** for GUI callbacks see MatitaGui.interactive_{interp,user_uri}_choice *)
+
+include Disambiguate.Disambiguator
diff --git a/helm/ocaml/grafite_parser/grafiteParser.ml b/helm/ocaml/grafite_parser/grafiteParser.ml
new file mode 100644
index 000000000..90d1898ea
--- /dev/null
+++ b/helm/ocaml/grafite_parser/grafiteParser.ml
@@ -0,0 +1,565 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+module Ast = CicNotationPt
+
+type 'a localized_option =
+ LSome of 'a
+ | LNone of Token.flocation
+
+type statement =
+ include_paths:string list ->
+ LexiconEngine.status ->
+ LexiconEngine.status *
+ (CicNotationPt.term, CicNotationPt.term,
+ CicNotationPt.term GrafiteAst.reduction, CicNotationPt.obj, string)
+ GrafiteAst.statement localized_option
+
+let grammar = CicNotationParser.level2_ast_grammar
+
+let term = CicNotationParser.term
+let statement = Grammar.Entry.create grammar "statement"
+
+let add_raw_attribute ~text t = Ast.AttributedTerm (`Raw text, t)
+
+let default_precedence = 50
+let default_associativity = Gramext.NonA
+
+EXTEND
+ GLOBAL: term statement;
+ arg: [
+ [ LPAREN; names = LIST1 IDENT SEP SYMBOL ",";
+ SYMBOL ":"; ty = term; RPAREN -> names,ty
+ | name = IDENT -> [name],Ast.Implicit
+ ]
+ ];
+ constructor: [ [ name = IDENT; SYMBOL ":"; typ = term -> (name, typ) ] ];
+ tactic_term: [ [ t = term LEVEL "90N" -> t ] ];
+ ident_list0: [ [ LPAREN; idents = LIST0 IDENT; RPAREN -> idents ] ];
+ tactic_term_list1: [
+ [ tactic_terms = LIST1 tactic_term SEP SYMBOL "," -> tactic_terms ]
+ ];
+ reduction_kind: [
+ [ IDENT "normalize" -> `Normalize
+ | IDENT "reduce" -> `Reduce
+ | IDENT "simplify" -> `Simpl
+ | IDENT "unfold"; t = OPT term -> `Unfold t
+ | IDENT "whd" -> `Whd ]
+ ];
+ sequent_pattern_spec: [
+ [ hyp_paths =
+ LIST0
+ [ id = IDENT ;
+ path = OPT [SYMBOL ":" ; path = tactic_term -> path ] ->
+ (id,match path with Some p -> p | None -> Ast.UserInput) ];
+ goal_path = OPT [ SYMBOL <:unicode<vdash>>; term = tactic_term -> term ] ->
+ let goal_path =
+ match goal_path, hyp_paths with
+ None, [] -> Some Ast.UserInput
+ | None, _::_ -> None
+ | Some goal_path, _ -> Some goal_path
+ in
+ hyp_paths,goal_path
+ ]
+ ];
+ pattern_spec: [
+ [ res = OPT [
+ "in";
+ wanted_and_sps =
+ [ "match" ; wanted = tactic_term ;
+ sps = OPT [ "in"; sps = sequent_pattern_spec -> sps ] ->
+ Some wanted,sps
+ | sps = sequent_pattern_spec ->
+ None,Some sps
+ ] ->
+ let wanted,hyp_paths,goal_path =
+ match wanted_and_sps with
+ wanted,None -> wanted, [], Some Ast.UserInput
+ | wanted,Some (hyp_paths,goal_path) -> wanted,hyp_paths,goal_path
+ in
+ wanted, hyp_paths, goal_path ] ->
+ match res with
+ None -> None,[],Some Ast.UserInput
+ | Some ps -> ps]
+ ];
+ direction: [
+ [ SYMBOL ">" -> `LeftToRight
+ | SYMBOL "<" -> `RightToLeft ]
+ ];
+ int: [ [ num = NUMBER -> int_of_string num ] ];
+ intros_spec: [
+ [ num = OPT [ num = int -> num ]; idents = OPT ident_list0 ->
+ let idents = match idents with None -> [] | Some idents -> idents in
+ num, idents
+ ]
+ ];
+ using: [ [ using = OPT [ IDENT "using"; t = tactic_term -> t ] -> using ] ];
+ tactic: [
+ [ IDENT "absurd"; t = tactic_term ->
+ GrafiteAst.Absurd (loc, t)
+ | IDENT "apply"; t = tactic_term ->
+ GrafiteAst.Apply (loc, t)
+ | IDENT "assumption" ->
+ GrafiteAst.Assumption loc
+ | IDENT "auto";
+ depth = OPT [ IDENT "depth"; SYMBOL "="; i = int -> i ];
+ width = OPT [ IDENT "width"; SYMBOL "="; i = int -> i ];
+ paramodulation = OPT [ IDENT "paramodulation" ];
+ full = OPT [ IDENT "full" ] -> (* ALB *)
+ GrafiteAst.Auto (loc,depth,width,paramodulation,full)
+ | IDENT "clear"; id = IDENT ->
+ GrafiteAst.Clear (loc,id)
+ | IDENT "clearbody"; id = IDENT ->
+ GrafiteAst.ClearBody (loc,id)
+ | IDENT "change"; what = pattern_spec; "with"; t = tactic_term ->
+ GrafiteAst.Change (loc, what, t)
+ | IDENT "compare"; t = tactic_term ->
+ GrafiteAst.Compare (loc,t)
+ | IDENT "constructor"; n = int ->
+ GrafiteAst.Constructor (loc, n)
+ | IDENT "contradiction" ->
+ GrafiteAst.Contradiction loc
+ | IDENT "cut"; t = tactic_term; ident = OPT [ "as"; id = IDENT -> id] ->
+ GrafiteAst.Cut (loc, ident, t)
+ | IDENT "decide"; IDENT "equality" ->
+ GrafiteAst.DecideEquality loc
+ | IDENT "decompose"; types = OPT ident_list0; what = IDENT;
+ (num, idents) = intros_spec ->
+ let types = match types with None -> [] | Some types -> types in
+ let to_spec id = GrafiteAst.Ident id in
+ GrafiteAst.Decompose (loc, List.rev_map to_spec types, what, idents)
+ | IDENT "discriminate"; t = tactic_term ->
+ GrafiteAst.Discriminate (loc, t)
+ | IDENT "elim"; what = tactic_term; using = using;
+ (num, idents) = intros_spec ->
+ GrafiteAst.Elim (loc, what, using, num, idents)
+ | IDENT "elimType"; what = tactic_term; using = using;
+ (num, idents) = intros_spec ->
+ GrafiteAst.ElimType (loc, what, using, num, idents)
+ | IDENT "exact"; t = tactic_term ->
+ GrafiteAst.Exact (loc, t)
+ | IDENT "exists" ->
+ GrafiteAst.Exists loc
+ | IDENT "fail" -> GrafiteAst.Fail loc
+ | IDENT "fold"; kind = reduction_kind; t = tactic_term; p = pattern_spec ->
+ let (pt,_,_) = p in
+ if pt <> None then
+ raise (HExtlib.Localized (loc, CicNotationParser.Parse_error
+ ("the pattern cannot specify the term to replace, only its"
+ ^ " paths in the hypotheses and in the conclusion")))
+ else
+ GrafiteAst.Fold (loc, kind, t, p)
+ | IDENT "fourier" ->
+ GrafiteAst.Fourier loc
+ | IDENT "fwd"; hyp = IDENT; idents = OPT ident_list0 ->
+ let idents = match idents with None -> [] | Some idents -> idents in
+ GrafiteAst.FwdSimpl (loc, hyp, idents)
+ | IDENT "generalize"; p=pattern_spec; id = OPT ["as" ; id = IDENT -> id] ->
+ GrafiteAst.Generalize (loc,p,id)
+ | IDENT "goal"; n = int ->
+ GrafiteAst.Goal (loc, n)
+ | IDENT "id" -> GrafiteAst.IdTac loc
+ | IDENT "injection"; t = tactic_term ->
+ GrafiteAst.Injection (loc, t)
+ | IDENT "intro"; ident = OPT IDENT ->
+ let idents = match ident with None -> [] | Some id -> [id] in
+ GrafiteAst.Intros (loc, Some 1, idents)
+ | IDENT "intros"; (num, idents) = intros_spec ->
+ GrafiteAst.Intros (loc, num, idents)
+ | IDENT "inversion"; t = tactic_term ->
+ GrafiteAst.Inversion (loc, t)
+ | IDENT "lapply";
+ depth = OPT [ IDENT "depth"; SYMBOL "="; i = int -> i ];
+ what = tactic_term;
+ to_what = OPT [ "to" ; t = tactic_term_list1 -> t ];
+ ident = OPT [ IDENT "using" ; ident = IDENT -> ident ] ->
+ let to_what = match to_what with None -> [] | Some to_what -> to_what in
+ GrafiteAst.LApply (loc, depth, to_what, what, ident)
+ | IDENT "left" -> GrafiteAst.Left loc
+ | IDENT "letin"; where = IDENT ; SYMBOL <:unicode<def>> ; t = tactic_term ->
+ GrafiteAst.LetIn (loc, t, where)
+ | kind = reduction_kind; p = pattern_spec ->
+ GrafiteAst.Reduce (loc, kind, p)
+ | IDENT "reflexivity" ->
+ GrafiteAst.Reflexivity loc
+ | IDENT "replace"; p = pattern_spec; "with"; t = tactic_term ->
+ GrafiteAst.Replace (loc, p, t)
+ | IDENT "rewrite" ; d = direction; t = tactic_term ; p = pattern_spec ->
+ let (pt,_,_) = p in
+ if pt <> None then
+ raise
+ (HExtlib.Localized (loc,
+ (CicNotationParser.Parse_error
+ "the pattern cannot specify the term to rewrite, only its paths in the hypotheses and in the conclusion")))
+ else
+ GrafiteAst.Rewrite (loc, d, t, p)
+ | IDENT "right" ->
+ GrafiteAst.Right loc
+ | IDENT "ring" ->
+ GrafiteAst.Ring loc
+ | IDENT "split" ->
+ GrafiteAst.Split loc
+ | IDENT "symmetry" ->
+ GrafiteAst.Symmetry loc
+ | IDENT "transitivity"; t = tactic_term ->
+ GrafiteAst.Transitivity (loc, t)
+ ]
+ ];
+ atomic_tactical:
+ [ "sequence" LEFTA
+ [ t1 = SELF; SYMBOL ";"; t2 = SELF ->
+ let ts =
+ match t1 with
+ | GrafiteAst.Seq (_, l) -> l @ [ t2 ]
+ | _ -> [ t1; t2 ]
+ in
+ GrafiteAst.Seq (loc, ts)
+ ]
+ | "then" NONA
+ [ tac = SELF; SYMBOL ";";
+ SYMBOL "["; tacs = LIST0 SELF SEP SYMBOL "|"; SYMBOL "]"->
+ (GrafiteAst.Then (loc, tac, tacs))
+ ]
+ | "loops" RIGHTA
+ [ IDENT "do"; count = int; tac = SELF; IDENT "end" ->
+ GrafiteAst.Do (loc, count, tac)
+ | IDENT "repeat"; tac = SELF; IDENT "end" -> GrafiteAst.Repeat (loc, tac)
+ ]
+ | "simple" NONA
+ [ IDENT "first";
+ SYMBOL "["; tacs = LIST0 SELF SEP SYMBOL "|"; SYMBOL "]"->
+ GrafiteAst.First (loc, tacs)
+ | IDENT "try"; tac = SELF -> GrafiteAst.Try (loc, tac)
+ | IDENT "solve";
+ SYMBOL "["; tacs = LIST0 SELF SEP SYMBOL "|"; SYMBOL "]"->
+ GrafiteAst.Solve (loc, tacs)
+ | LPAREN; tac = SELF; RPAREN -> tac
+ | tac = tactic -> GrafiteAst.Tactic (loc, tac)
+ ]
+ ];
+ punctuation_tactical:
+ [
+ [ SYMBOL "[" -> GrafiteAst.Branch loc
+ | SYMBOL "|" -> GrafiteAst.Shift loc
+ | i = int; SYMBOL ":" -> GrafiteAst.Pos (loc, i)
+ | SYMBOL "]" -> GrafiteAst.Merge loc
+ | SYMBOL ";" -> GrafiteAst.Semicolon loc
+ | SYMBOL "." -> GrafiteAst.Dot loc
+ ]
+ ];
+ tactical:
+ [ "simple" NONA
+ [ IDENT "focus"; goals = LIST1 int -> GrafiteAst.Focus (loc, goals)
+ | IDENT "unfocus" -> GrafiteAst.Unfocus loc
+ | IDENT "skip" -> GrafiteAst.Skip loc
+ | tac = atomic_tactical LEVEL "loops" -> tac
+ ]
+ ];
+ theorem_flavour: [
+ [ [ IDENT "definition" ] -> `Definition
+ | [ IDENT "fact" ] -> `Fact
+ | [ IDENT "lemma" ] -> `Lemma
+ | [ IDENT "remark" ] -> `Remark
+ | [ IDENT "theorem" ] -> `Theorem
+ ]
+ ];
+ inductive_spec: [ [
+ fst_name = IDENT; params = LIST0 [ arg=arg -> arg ];
+ SYMBOL ":"; fst_typ = term; SYMBOL <:unicode<def>>; OPT SYMBOL "|";
+ fst_constructors = LIST0 constructor SEP SYMBOL "|";
+ tl = OPT [ "with";
+ types = LIST1 [
+ name = IDENT; SYMBOL ":"; typ = term; SYMBOL <:unicode<def>>;
+ OPT SYMBOL "|"; constructors = LIST0 constructor SEP SYMBOL "|" ->
+ (name, true, typ, constructors) ] SEP "with" -> types
+ ] ->
+ let params =
+ List.fold_right
+ (fun (names, typ) acc ->
+ (List.map (fun name -> (name, typ)) names) @ acc)
+ params []
+ in
+ let fst_ind_type = (fst_name, true, fst_typ, fst_constructors) in
+ let tl_ind_types = match tl with None -> [] | Some types -> types in
+ let ind_types = fst_ind_type :: tl_ind_types in
+ (params, ind_types)
+ ] ];
+
+ record_spec: [ [
+ name = IDENT; params = LIST0 [ arg = arg -> arg ] ;
+ SYMBOL ":"; typ = term; SYMBOL <:unicode<def>>; SYMBOL "{" ;
+ fields = LIST0 [
+ name = IDENT ;
+ coercion = [ SYMBOL ":" -> false | SYMBOL ":"; SYMBOL ">" -> true ] ;
+ ty = term -> (name,ty,coercion)
+ ] SEP SYMBOL ";"; SYMBOL "}" ->
+ let params =
+ List.fold_right
+ (fun (names, typ) acc ->
+ (List.map (fun name -> (name, typ)) names) @ acc)
+ params []
+ in
+ (params,name,typ,fields)
+ ] ];
+
+ macro: [
+ [ [ IDENT "quit" ] -> GrafiteAst.Quit loc
+(* | [ IDENT "abort" ] -> GrafiteAst.Abort loc *)
+(* | [ IDENT "undo" ]; steps = OPT NUMBER ->
+ GrafiteAst.Undo (loc, int_opt steps)
+ | [ IDENT "redo" ]; steps = OPT NUMBER ->
+ GrafiteAst.Redo (loc, int_opt steps) *)
+ | [ IDENT "check" ]; t = term ->
+ GrafiteAst.Check (loc, t)
+ | [ IDENT "hint" ] -> GrafiteAst.Hint loc
+ | [ IDENT "whelp"; "match" ] ; t = term ->
+ GrafiteAst.WMatch (loc,t)
+ | [ IDENT "whelp"; IDENT "instance" ] ; t = term ->
+ GrafiteAst.WInstance (loc,t)
+ | [ IDENT "whelp"; IDENT "locate" ] ; id = IDENT ->
+ GrafiteAst.WLocate (loc,id)
+ | [ IDENT "whelp"; IDENT "elim" ] ; t = term ->
+ GrafiteAst.WElim (loc, t)
+ | [ IDENT "whelp"; IDENT "hint" ] ; t = term ->
+ GrafiteAst.WHint (loc,t)
+ | [ IDENT "print" ]; name = QSTRING -> GrafiteAst.Print (loc, name)
+ ]
+ ];
+ alias_spec: [
+ [ IDENT "id"; id = QSTRING; SYMBOL "="; uri = QSTRING ->
+ let alpha = "[a-zA-Z]" in
+ let num = "[0-9]+" in
+ let ident_cont = "\\("^alpha^"\\|"^num^"\\|_\\|\\\\\\)" in
+ let ident = "\\("^alpha^ident_cont^"*\\|_"^ident_cont^"+\\)" in
+ let rex = Str.regexp ("^"^ident^"$") in
+ if Str.string_match rex id 0 then
+ if (try ignore (UriManager.uri_of_string uri); true
+ with UriManager.IllFormedUri _ -> false)
+ then
+ LexiconAst.Ident_alias (id, uri)
+ else
+ raise
+ (HExtlib.Localized (loc, CicNotationParser.Parse_error (sprintf "Not a valid uri: %s" uri)))
+ else
+ raise (HExtlib.Localized (loc, CicNotationParser.Parse_error (
+ sprintf "Not a valid identifier: %s" id)))
+ | IDENT "symbol"; symbol = QSTRING;
+ instance = OPT [ LPAREN; IDENT "instance"; n = int; RPAREN -> n ];
+ SYMBOL "="; dsc = QSTRING ->
+ let instance =
+ match instance with Some i -> i | None -> 0
+ in
+ LexiconAst.Symbol_alias (symbol, instance, dsc)
+ | IDENT "num";
+ instance = OPT [ LPAREN; IDENT "instance"; n = int; RPAREN -> n ];
+ SYMBOL "="; dsc = QSTRING ->
+ let instance =
+ match instance with Some i -> i | None -> 0
+ in
+ LexiconAst.Number_alias (instance, dsc)
+ ]
+ ];
+ argument: [
+ [ l = LIST0 [ SYMBOL <:unicode<eta>> (* η *); SYMBOL "." -> () ];
+ id = IDENT ->
+ Ast.IdentArg (List.length l, id)
+ ]
+ ];
+ associativity: [
+ [ IDENT "left"; IDENT "associative" -> Gramext.LeftA
+ | IDENT "right"; IDENT "associative" -> Gramext.RightA
+ | IDENT "non"; IDENT "associative" -> Gramext.NonA
+ ]
+ ];
+ precedence: [
+ [ "with"; IDENT "precedence"; n = NUMBER -> int_of_string n ]
+ ];
+ notation: [
+ [ dir = OPT direction; s = QSTRING;
+ assoc = OPT associativity; prec = OPT precedence;
+ IDENT "for";
+ p2 =
+ [ blob = UNPARSED_AST ->
+ add_raw_attribute ~text:(sprintf "@{%s}" blob)
+ (CicNotationParser.parse_level2_ast
+ (Ulexing.from_utf8_string blob))
+ | blob = UNPARSED_META ->
+ add_raw_attribute ~text:(sprintf "${%s}" blob)
+ (CicNotationParser.parse_level2_meta
+ (Ulexing.from_utf8_string blob))
+ ] ->
+ let assoc =
+ match assoc with
+ | None -> default_associativity
+ | Some assoc -> assoc
+ in
+ let prec =
+ match prec with
+ | None -> default_precedence
+ | Some prec -> prec
+ in
+ let p1 =
+ add_raw_attribute ~text:s
+ (CicNotationParser.parse_level1_pattern
+ (Ulexing.from_utf8_string s))
+ in
+ (dir, p1, assoc, prec, p2)
+ ]
+ ];
+ level3_term: [
+ [ u = URI -> Ast.UriPattern (UriManager.uri_of_string u)
+ | id = IDENT -> Ast.VarPattern id
+ | SYMBOL "_" -> Ast.ImplicitPattern
+ | LPAREN; terms = LIST1 SELF; RPAREN ->
+ (match terms with
+ | [] -> assert false
+ | [term] -> term
+ | terms -> Ast.ApplPattern terms)
+ ]
+ ];
+ interpretation: [
+ [ s = CSYMBOL; args = LIST0 argument; SYMBOL "="; t = level3_term ->
+ (s, args, t)
+ ]
+ ];
+
+ include_command: [ [
+ IDENT "include" ; path = QSTRING -> loc,path
+ ]];
+
+ grafite_command: [ [
+ IDENT "set"; n = QSTRING; v = QSTRING ->
+ GrafiteAst.Set (loc, n, v)
+ | IDENT "drop" -> GrafiteAst.Drop loc
+ | IDENT "qed" -> GrafiteAst.Qed loc
+ | IDENT "variant" ; name = IDENT; SYMBOL ":";
+ typ = term; SYMBOL <:unicode<def>> ; newname = IDENT ->
+ GrafiteAst.Obj (loc,
+ Ast.Theorem
+ (`Variant,name,typ,Some (Ast.Ident (newname, None))))
+ | flavour = theorem_flavour; name = IDENT; SYMBOL ":"; typ = term;
+ body = OPT [ SYMBOL <:unicode<def>> (* â *); body = term -> body ] ->
+ GrafiteAst.Obj (loc, Ast.Theorem (flavour, name, typ, body))
+ | flavour = theorem_flavour; name = IDENT; SYMBOL <:unicode<def>> (* â *);
+ body = term ->
+ GrafiteAst.Obj (loc,
+ Ast.Theorem (flavour, name, Ast.Implicit, Some body))
+ | "let"; ind_kind = [ "corec" -> `CoInductive | "rec"-> `Inductive ];
+ defs = CicNotationParser.let_defs ->
+ let name,ty =
+ match defs with
+ | ((Ast.Ident (name, None), Some ty),_,_) :: _ -> name,ty
+ | ((Ast.Ident (name, None), None),_,_) :: _ ->
+ name, Ast.Implicit
+ | _ -> assert false
+ in
+ let body = Ast.Ident (name,None) in
+ GrafiteAst.Obj (loc, Ast.Theorem(`Definition, name, ty,
+ Some (Ast.LetRec (ind_kind, defs, body))))
+ | IDENT "inductive"; spec = inductive_spec ->
+ let (params, ind_types) = spec in
+ GrafiteAst.Obj (loc, Ast.Inductive (params, ind_types))
+ | IDENT "coinductive"; spec = inductive_spec ->
+ let (params, ind_types) = spec in
+ let ind_types = (* set inductive flags to false (coinductive) *)
+ List.map (fun (name, _, term, ctors) -> (name, false, term, ctors))
+ ind_types
+ in
+ GrafiteAst.Obj (loc, Ast.Inductive (params, ind_types))
+ | IDENT "coercion" ; suri = URI ->
+ GrafiteAst.Coercion (loc, UriManager.uri_of_string suri, true)
+ | IDENT "record" ; (params,name,ty,fields) = record_spec ->
+ GrafiteAst.Obj (loc, Ast.Record (params,name,ty,fields))
+ | IDENT "default" ; what = QSTRING ; uris = LIST1 URI ->
+ let uris = List.map UriManager.uri_of_string uris in
+ GrafiteAst.Default (loc,what,uris)
+ ]];
+ lexicon_command: [ [
+ IDENT "alias" ; spec = alias_spec ->
+ LexiconAst.Alias (loc, spec)
+ | IDENT "notation"; (dir, l1, assoc, prec, l2) = notation ->
+ LexiconAst.Notation (loc, dir, l1, assoc, prec, l2)
+ | IDENT "interpretation"; id = QSTRING;
+ (symbol, args, l3) = interpretation ->
+ LexiconAst.Interpretation (loc, id, (symbol, args), l3)
+ ]];
+ executable: [
+ [ cmd = grafite_command; SYMBOL "." -> GrafiteAst.Command (loc, cmd)
+ | tac = tactical; punct = punctuation_tactical ->
+ GrafiteAst.Tactical (loc, tac, Some punct)
+ | punct = punctuation_tactical -> GrafiteAst.Tactical (loc, punct, None)
+ | mac = macro; SYMBOL "." -> GrafiteAst.Macro (loc, mac)
+ ]
+ ];
+ comment: [
+ [ BEGINCOMMENT ; ex = executable ; ENDCOMMENT ->
+ GrafiteAst.Code (loc, ex)
+ | str = NOTE ->
+ GrafiteAst.Note (loc, str)
+ ]
+ ];
+ statement: [
+ [ ex = executable ->
+ fun ~include_paths status -> status,LSome(GrafiteAst.Executable (loc,ex))
+ | com = comment ->
+ fun ~include_paths status -> status,LSome (GrafiteAst.Comment (loc, com))
+ | (iloc,fname) = include_command ; SYMBOL "." ->
+ fun ~include_paths status ->
+ let path = DependenciesParser.baseuri_of_script ~include_paths fname in
+ let status =
+ LexiconEngine.eval_command status (LexiconAst.Include (iloc,path))
+ in
+ status,
+ LSome
+ (GrafiteAst.Executable
+ (loc,GrafiteAst.Command
+ (loc,GrafiteAst.Include (iloc,path))))
+ | scom = lexicon_command ; SYMBOL "." ->
+ fun ~include_paths status ->
+ let status = LexiconEngine.eval_command status scom in
+ status,LNone loc
+ | EOI -> raise End_of_file
+ ]
+ ];
+END
+
+let exc_located_wrapper f =
+ try
+ f ()
+ with
+ | Stdpp.Exc_located (_, End_of_file) -> raise End_of_file
+ | Stdpp.Exc_located (floc, Stream.Error msg) ->
+ raise (HExtlib.Localized (floc,CicNotationParser.Parse_error msg))
+ | Stdpp.Exc_located (floc, exn) ->
+ raise
+ (HExtlib.Localized (floc,CicNotationParser.Parse_error (Printexc.to_string exn)))
+
+let parse_statement lexbuf =
+ exc_located_wrapper
+ (fun () -> (Grammar.Entry.parse statement (Obj.magic lexbuf)))
diff --git a/helm/ocaml/grafite_parser/grafiteParser.mli b/helm/ocaml/grafite_parser/grafiteParser.mli
new file mode 100644
index 000000000..6a1980011
--- /dev/null
+++ b/helm/ocaml/grafite_parser/grafiteParser.mli
@@ -0,0 +1,41 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+type 'a localized_option =
+ LSome of 'a
+ | LNone of Token.flocation
+
+type statement =
+ include_paths:string list ->
+ LexiconEngine.status ->
+ LexiconEngine.status *
+ (CicNotationPt.term, CicNotationPt.term,
+ CicNotationPt.term GrafiteAst.reduction, CicNotationPt.obj, string)
+ GrafiteAst.statement localized_option
+
+val parse_statement: Ulexing.lexbuf -> statement (** @raise End_of_file *)
+
+val statement: statement Grammar.Entry.e
+
diff --git a/helm/ocaml/grafite_parser/print_grammar.ml b/helm/ocaml/grafite_parser/print_grammar.ml
new file mode 100644
index 000000000..6a05865de
--- /dev/null
+++ b/helm/ocaml/grafite_parser/print_grammar.ml
@@ -0,0 +1,287 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Gramext
+
+let tex_of_unicode s =
+ let contractions = ("\\Longrightarrow","=>") :: [] in
+ if String.length s <= 1 then s
+ else (* probably an extended unicode symbol *)
+ let s = Utf8Macro.tex_of_unicode s in
+ try List.assoc s contractions with Not_found -> s
+
+let needs_brackets t =
+ let rec count_brothers = function
+ | Node {brother = brother} -> 1 + count_brothers brother
+ | _ -> 0
+ in
+ count_brothers t > 1
+
+let visit_description desc fmt self =
+ let skip s = List.mem s [ ] in
+ let inline s = List.mem s [ "int" ] in
+
+ let rec visit_entry e todo is_son nesting =
+ let { ename = ename; edesc = desc } = e in
+ if inline ename then
+ visit_desc desc todo is_son nesting
+ else
+ begin
+ Format.fprintf fmt "%s " ename;
+ if skip ename then
+ todo
+ else
+ todo @ [e]
+ end
+
+ and visit_desc d todo is_son nesting =
+ match d with
+ | Dlevels [] -> todo
+ | Dlevels [lev] -> visit_level lev todo is_son nesting
+ | Dlevels (lev::levels) ->
+ let todo = visit_level lev todo is_son nesting in
+ List.fold_left
+ (fun acc l ->
+ Format.fprintf fmt "@ | ";
+ visit_level l acc is_son nesting)
+ todo levels;
+ | _ -> todo
+
+ and visit_level l todo is_son nesting =
+ let { lsuffix = suff ; lprefix = pref } = l in
+ let todo = visit_tree suff todo is_son nesting in
+ visit_tree pref todo is_son nesting
+
+ and visit_tree t todo is_son nesting =
+ match t with
+ | Node node -> visit_node node todo is_son nesting
+ | _ -> todo
+
+ and visit_node n todo is_son nesting =
+ let is_tree_printable t =
+ match t with
+ | Node _ -> true
+ | _ -> false
+ in
+ let { node = symbol; son = son ; brother = brother } = n in
+ let todo = visit_symbol symbol todo is_son nesting in
+ let todo =
+ if is_tree_printable son then
+ begin
+ let need_b = needs_brackets son in
+ if not is_son then
+ Format.fprintf fmt "@[<hov2>";
+ if need_b then
+ Format.fprintf fmt "( ";
+ let todo = visit_tree son todo true nesting in
+ if need_b then
+ Format.fprintf fmt ")";
+ if not is_son then
+ Format.fprintf fmt "@]";
+ todo
+ end
+ else
+ todo
+ in
+ if is_tree_printable brother then
+ begin
+ Format.fprintf fmt "@ | ";
+ visit_tree brother todo is_son nesting
+ end
+ else
+ todo
+
+ and visit_symbol s todo is_son nesting =
+ match s with
+ | Smeta (name, sl, _) ->
+ Format.fprintf fmt "%s " name;
+ List.fold_left (
+ fun acc s ->
+ let todo = visit_symbol s acc is_son nesting in
+ if is_son then
+ Format.fprintf fmt "@ ";
+ todo)
+ todo sl
+ | Snterm entry -> visit_entry entry todo is_son nesting
+ | Snterml (entry,_) -> visit_entry entry todo is_son nesting
+ | Slist0 symbol ->
+ Format.fprintf fmt "{@[<hov2> ";
+ let todo = visit_symbol symbol todo is_son (nesting+1) in
+ Format.fprintf fmt "@]} @ ";
+ todo
+ | Slist0sep (symbol,sep) ->
+ Format.fprintf fmt "[@[<hov2> ";
+ let todo = visit_symbol symbol todo is_son (nesting + 1) in
+ Format.fprintf fmt "{@[<hov2> ";
+ let todo = visit_symbol sep todo is_son (nesting + 2) in
+ Format.fprintf fmt " ";
+ let todo = visit_symbol symbol todo is_son (nesting + 2) in
+ Format.fprintf fmt "@]} @]] @ ";
+ todo
+ | Slist1 symbol ->
+ Format.fprintf fmt "{@[<hov2> ";
+ let todo = visit_symbol symbol todo is_son (nesting + 1) in
+ Format.fprintf fmt "@]}+ @ ";
+ todo
+ | Slist1sep (symbol,sep) ->
+ let todo = visit_symbol symbol todo is_son nesting in
+ Format.fprintf fmt "{@[<hov2> ";
+ let todo = visit_symbol sep todo is_son (nesting + 1) in
+ let todo = visit_symbol symbol todo is_son (nesting + 1) in
+ Format.fprintf fmt "@]} @ ";
+ todo
+ | Sopt symbol ->
+ Format.fprintf fmt "[@[<hov2> ";
+ let todo = visit_symbol symbol todo is_son (nesting + 1) in
+ Format.fprintf fmt "@]] @ ";
+ todo
+ | Sself -> Format.fprintf fmt "%s " self; todo
+ | Snext -> Format.fprintf fmt "next "; todo
+ | Stoken pattern ->
+ let constructor, keyword = pattern in
+ if keyword = "" then
+ Format.fprintf fmt "`%s' " constructor
+ else
+ Format.fprintf fmt "\"%s\" " (tex_of_unicode keyword);
+ todo
+ | Stree tree ->
+ if needs_brackets tree then
+ begin
+ Format.fprintf fmt "@[<hov2>( ";
+ let todo = visit_tree tree todo is_son (nesting + 1) in
+ Format.fprintf fmt ")@] @ ";
+ todo
+ end
+ else
+ visit_tree tree todo is_son (nesting + 1)
+ in
+ visit_desc desc [] false 0
+;;
+
+let rec clean_dummy_desc = function
+ | Dlevels l -> Dlevels (clean_levels l)
+ | x -> x
+
+and clean_levels = function
+ | [] -> []
+ | l :: tl -> clean_level l @ clean_levels tl
+
+and clean_level = function
+ | x ->
+ let pref = clean_tree x.lprefix in
+ let suff = clean_tree x.lsuffix in
+ match pref,suff with
+ | DeadEnd, DeadEnd -> []
+ | _ -> [{x with lprefix = pref; lsuffix = suff}]
+
+and clean_tree = function
+ | Node n -> clean_node n
+ | x -> x
+
+and clean_node = function
+ | {node=node;son=son;brother=brother} ->
+ let bn = is_symbol_dummy node in
+ let bs = is_tree_dummy son in
+ let bb = is_tree_dummy brother in
+ let son = if bs then DeadEnd else son in
+ let brother = if bb then DeadEnd else brother in
+ if bb && bs && bn then
+ DeadEnd
+ else
+ if bn then
+ Node {node=Sself;son=son;brother=brother}
+ else
+ Node {node=node;son=son;brother=brother}
+
+and is_level_dummy = function
+ | {lsuffix=lsuffix;lprefix=lprefix} ->
+ is_tree_dummy lsuffix && is_tree_dummy lprefix
+
+and is_desc_dummy = function
+ | Dlevels l -> List.for_all is_level_dummy l
+ | Dparser _ -> true
+
+and is_entry_dummy = function
+ | {edesc=edesc} -> is_desc_dummy edesc
+
+and is_symbol_dummy = function
+ | Stoken ("DUMMY", _) -> true
+ | Stoken _ -> false
+ | Smeta (_, lt, _) -> List.for_all is_symbol_dummy lt
+ | Snterm e | Snterml (e, _) -> is_entry_dummy e
+ | Slist1 x | Slist0 x -> is_symbol_dummy x
+ | Slist1sep (x,y) | Slist0sep (x,y) -> is_symbol_dummy x && is_symbol_dummy y
+ | Sopt x -> is_symbol_dummy x
+ | Sself | Snext -> false
+ | Stree t -> is_tree_dummy t
+
+and is_tree_dummy = function
+ | Node {node=node} -> is_symbol_dummy node
+ | _ -> true
+;;
+
+
+let rec visit_entries todo pped =
+ let fmt = Format.std_formatter in
+ match todo with
+ | [] -> ()
+ | hd :: tl ->
+ let todo =
+ if not (List.memq hd pped) then
+ begin
+ let { ename = ename; edesc = desc } = hd in
+ Format.fprintf fmt "@[<hv2>%s ::=@ " ename;
+ let desc = clean_dummy_desc desc in
+ let todo = visit_description desc fmt ename @ todo in
+ Format.fprintf fmt "@]";
+ Format.pp_print_newline fmt ();
+ Format.pp_print_newline fmt ();
+ todo
+ end
+ else
+ todo
+ in
+ let clean_todo todo =
+ let name_of_entry e = e.ename in
+ let pped = hd :: pped in
+ let todo = tl @ todo in
+ let todo = List.filter (fun e -> not(List.memq e pped)) todo in
+ HExtlib.list_uniq
+ ~eq:(fun e1 e2 -> (name_of_entry e1) = (name_of_entry e2))
+ (List.sort
+ (fun e1 e2 ->
+ Pervasives.compare (name_of_entry e1) (name_of_entry e2))
+ todo),
+ pped
+ in
+ let todo,pped = clean_todo todo in
+ visit_entries todo pped
+;;
+
+let _ =
+ let g_entry = Grammar.Entry.obj GrafiteParser.statement in
+ visit_entries [g_entry] []
diff --git a/helm/ocaml/grafite_parser/test_dep.ml b/helm/ocaml/grafite_parser/test_dep.ml
new file mode 100644
index 000000000..2d0f7813f
--- /dev/null
+++ b/helm/ocaml/grafite_parser/test_dep.ml
@@ -0,0 +1,40 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let _ =
+ let ic = ref stdin in
+ let usage = "test_coarse_parser [ file ]" in
+ let open_file fname =
+ if !ic <> stdin then close_in !ic;
+ ic := open_in fname
+ in
+ Arg.parse [] open_file usage;
+ let deps =
+ DependenciesParser.parse_dependencies (Ulexing.from_utf8_channel !ic)
+ in
+ List.iter (fun dep -> print_endline (DependenciesParser.pp_dependency dep)) deps
+
diff --git a/helm/ocaml/grafite_parser/test_parser.ml b/helm/ocaml/grafite_parser/test_parser.ml
new file mode 100644
index 000000000..2deef1bd5
--- /dev/null
+++ b/helm/ocaml/grafite_parser/test_parser.ml
@@ -0,0 +1,133 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+let _ = Helm_registry.load_from "test_parser.conf.xml"
+
+let xml_stream_of_markup =
+ let rec print_box (t: CicNotationPres.boxml_markup) =
+ Box.box2xml print_mpres t
+ and print_mpres (t: CicNotationPres.mathml_markup) =
+ Mpresentation.print_mpres print_box t
+ in
+ print_mpres
+
+let dump_xml t id_to_uri fname =
+ prerr_endline (sprintf "dumping MathML to %s ..." fname);
+ flush stdout;
+ let oc = open_out fname in
+ let markup = CicNotationPres.render id_to_uri t in
+ let xml_stream = CicNotationPres.print_xml markup in
+ Xml.pp_to_outchan xml_stream oc;
+ close_out oc
+
+let extract_loc =
+ function
+ | GrafiteAst.Executable (loc, _)
+ | GrafiteAst.Comment (loc, _) -> loc
+
+let pp_associativity = function
+ | Gramext.LeftA -> "left"
+ | Gramext.RightA -> "right"
+ | Gramext.NonA -> "non"
+
+let pp_precedence = string_of_int
+
+(* let last_rule_id = ref None *)
+
+let process_stream istream =
+ let char_count = ref 0 in
+ let module P = CicNotationPt in
+ let module G = GrafiteAst in
+ let status =
+ ref
+ (CicNotation2.load_notation
+ ~include_paths:[] (Helm_registry.get "notation.core_file"))
+ in
+ try
+ while true do
+ try
+ match
+ GrafiteParser.parse_statement ~include_paths:[] istream !status
+ with
+ newstatus, GrafiteParser.LNone _ -> status := newstatus
+ | newstatus, GrafiteParser.LSome statement ->
+ status := newstatus;
+ let floc = extract_loc statement in
+ let (_, y) = HExtlib.loc_of_floc floc in
+ char_count := y + !char_count;
+ match statement with
+ (* | G.Executable (_, G.Macro (_, G.Check (_,
+ P.AttributedTerm (_, P.Ident _)))) ->
+ prerr_endline "mega hack";
+ (match !last_rule_id with
+ | None -> ()
+ | Some id ->
+ prerr_endline "removing last notation rule ...";
+ CicNotationParser.delete id) *)
+ | G.Executable (_, G.Macro (_, G.Check (_, t))) ->
+ prerr_endline (sprintf "ast: %s" (CicNotationPp.pp_term t));
+ let t' = TermContentPres.pp_ast t in
+ prerr_endline (sprintf "rendered ast: %s"
+ (CicNotationPp.pp_term t'));
+ let tbl = Hashtbl.create 0 in
+ dump_xml t' tbl "out.xml"
+ | statement ->
+ prerr_endline
+ ("Unsupported statement: " ^
+ GrafiteAstPp.pp_statement
+ ~term_pp:CicNotationPp.pp_term
+ ~lazy_term_pp:(fun _ -> "_lazy_term_here_")
+ ~obj_pp:(fun _ -> "_obj_here_")
+ statement)
+ with
+ | End_of_file -> raise End_of_file
+ | HExtlib.Localized (floc,CicNotationParser.Parse_error msg) ->
+ let (x, y) = HExtlib.loc_of_floc floc in
+(* let before = String.sub line 0 x in
+ let error = String.sub line x (y - x) in
+ let after = String.sub line y (String.length line - y) in
+ eprintf "%s[01;31m%s[00m%s\n" before error after;
+ prerr_endline (sprintf "at character %d-%d: %s" x y msg) *)
+ prerr_endline (sprintf "Parse error at character %d-%d: %s"
+ (!char_count + x) (!char_count + y) msg)
+ | exn ->
+ prerr_endline
+ (sprintf "Uncaught exception: %s" (Printexc.to_string exn))
+ done
+ with End_of_file -> ()
+
+let _ =
+ let arg_spec = [ ] in
+ let usage = "" in
+ Arg.parse arg_spec (fun _ -> raise (Arg.Bad usage)) usage;
+ print_endline "Loading builtin notation ...";
+ print_endline "done.";
+ flush stdout;
+ process_stream (Ulexing.from_utf8_channel stdin)
+
diff --git a/helm/ocaml/hbugs/.depend b/helm/ocaml/hbugs/.depend
new file mode 100644
index 000000000..d6a85b905
--- /dev/null
+++ b/helm/ocaml/hbugs/.depend
@@ -0,0 +1,20 @@
+hbugs_common.cmi: hbugs_types.cmi
+hbugs_id_generator.cmi: hbugs_types.cmi
+hbugs_messages.cmi: hbugs_types.cmi
+hbugs_client.cmi: hbugs_types.cmi
+hbugs_misc.cmo: hbugs_misc.cmi
+hbugs_misc.cmx: hbugs_misc.cmi
+hbugs_common.cmo: hbugs_types.cmi hbugs_common.cmi
+hbugs_common.cmx: hbugs_types.cmi hbugs_common.cmi
+hbugs_id_generator.cmo: hbugs_id_generator.cmi
+hbugs_id_generator.cmx: hbugs_id_generator.cmi
+hbugs_messages.cmo: hbugs_types.cmi hbugs_misc.cmi hbugs_messages.cmi
+hbugs_messages.cmx: hbugs_types.cmi hbugs_misc.cmx hbugs_messages.cmi
+hbugs_client_gui.cmo: hbugs_client_gui.cmi
+hbugs_client_gui.cmx: hbugs_client_gui.cmi
+hbugs_client.cmo: hbugs_types.cmi hbugs_misc.cmi hbugs_messages.cmi \
+ hbugs_id_generator.cmi hbugs_common.cmi hbugs_client_gui.cmi \
+ hbugs_client.cmi
+hbugs_client.cmx: hbugs_types.cmi hbugs_misc.cmx hbugs_messages.cmx \
+ hbugs_id_generator.cmx hbugs_common.cmx hbugs_client_gui.cmx \
+ hbugs_client.cmi
diff --git a/helm/ocaml/hbugs/Makefile b/helm/ocaml/hbugs/Makefile
new file mode 100644
index 000000000..c38ac3e92
--- /dev/null
+++ b/helm/ocaml/hbugs/Makefile
@@ -0,0 +1,97 @@
+
+# Targets description:
+# all (default) -> builds hbugs bytecode library hbugs.cma
+# opt -> builds hbugs native library hbugs.cmxa
+# daemons -> builds hbugs broker and tutors executables
+#
+# start -> starts up broker and tutors
+# stop -> stop broker and tutors
+#
+# broker -> builds broker executable
+# tutors -> builds tutors executables
+# client -> builds hbugs client
+
+PACKAGE = hbugs
+
+IMPLEMENTATION_FILES = \
+ hbugs_misc.ml \
+ hbugs_common.ml \
+ hbugs_id_generator.ml \
+ hbugs_messages.ml \
+ hbugs_client_gui.ml \
+ hbugs_client.ml
+INTERFACE_FILES = \
+ hbugs_types.mli \
+ $(patsubst %.ml, %.mli, $(IMPLEMENTATION_FILES))
+
+include ../Makefile.common
+include .tutors.ml
+include .generated_tutors.ml
+
+.tutors.ml:
+ echo -n "TUTORS_ML = " > $@
+ scripts/ls_tutors.ml | xargs >> $@
+.generated_tutors.ml:
+ echo -n "GENERATED_TUTORS_ML = " > $@
+ scripts/ls_tutors.ml -auto | xargs >> $@
+
+TUTORS = $(patsubst %.ml, %, $(TUTORS_ML))
+TUTORS_OPT = $(patsubst %, %.opt, $(TUTORS))
+GENERATED_TUTORS = $(patsubst %.ml, %, $(GENERATED_TUTORS_ML))
+
+hbugs_client_gui.ml hbugs_client_gui.mli: hbugs_client_gui.glade
+ lablgladecc2 $< > hbugs_client_gui.ml
+ $(OCAMLC) -i hbugs_client_gui.ml > hbugs_client_gui.mli
+
+clean: clean_mains
+.PHONY: clean_mains
+clean_mains:
+ rm -f $(TUTORS) $(TUTORS_OPT) broker{,.opt} client{,.opt}
+distclean: clean
+ rm -f $(GENERATED_TUTORS_ML) hbugs_client_gui.ml{,i}
+ rm -f .tutors.ml .generated_tutors.ml
+
+MAINS_DEPS = \
+ hbugs_misc.cmo \
+ hbugs_messages.cmo \
+ hbugs_id_generator.cmo
+TUTOR_DEPS = $(MAINS_DEPS) \
+ hbugs_tutors.cmo
+BROKER_DEPS = $(MAINS_DEPS) \
+ hbugs_broker_registry.cmo
+CLIENT_DEPS = $(MAINS_DEPS) \
+ hbugs_client_gui.cmo \
+ hbugs_common.cmo \
+ hbugs_client.cmo
+TUTOR_DEPS_OPT = $(patsubst %.cmo, %.cmx, $(TUTOR_DEPS))
+BROKER_DEPS_OPT = $(patsubst %.cmo, %.cmx, $(BROKER_DEPS))
+CLIENT_DEPS_OPT = $(patsubst %.cmo, %.cmx, $(CLIENT_DEPS))
+$(GENERATED_TUTORS_ML): scripts/build_tutors.ml data/tutors_index.xml data/hbugs_tutor.TPL.ml
+ scripts/build_tutors.ml
+hbugs_tutors.cmo: hbugs_tutors.cmi
+hbugs_broker_registry.cmo: hbugs_broker_registry.cmi
+.PHONY: daemons
+daemons: tutors broker
+.PHONY: tutors
+tutors: all $(TUTORS)
+%_tutor: $(TUTOR_DEPS) %_tutor.ml
+ $(OCAMLC) -linkpkg -o $@ $^
+%_tutor.opt: $(TUTOR_DEPS_OPT) %_tutor.ml
+ $(OCAMLOPT) -linkpkg -o $@ $^
+broker: $(BROKER_DEPS) broker.ml
+ $(OCAMLC) -linkpkg -o $@ $^
+broker.opt: $(BROKER_DEPS_OPT) broker.ml
+ $(OCAMLOPT) -linkpkg -o $@ $^
+client: $(CLIENT_DEPS) client.ml
+ $(OCAMLC) -linkpkg -o $@ $^
+client.opt: $(CLIENT_DEPS_OPT) client.ml
+ $(OCAMLOPT) -linkpkg -o $@ $^
+
+.PHONY: start stop
+start:
+ scripts/brokerctl.sh start
+ scripts/sabba.sh start
+stop:
+ scripts/brokerctl.sh stop
+ scripts/sabba.sh stop
+
diff --git a/helm/ocaml/hbugs/broker.ml b/helm/ocaml/hbugs/broker.ml
new file mode 100644
index 000000000..691f9d11a
--- /dev/null
+++ b/helm/ocaml/hbugs/broker.ml
@@ -0,0 +1,293 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Hbugs_types;;
+open Printf;;
+
+let debug = true ;;
+let debug_print s = if debug then prerr_endline (Lazy.force s) ;;
+
+let daemon_name = "H-Bugs Broker" ;;
+let default_port = 49081 ;;
+let port_env_var = "HELM_HBUGS_BROKER_PORT" ;;
+let port =
+ try
+ int_of_string (Sys.getenv port_env_var)
+ with
+ | Not_found -> default_port
+ | Failure "int_of_string" ->
+ prerr_endline "Warning: invalid port, reverting to default";
+ default_port
+;;
+let usage_string = "HBugs Broker: usage string not yet written :-(";;
+
+exception Unexpected_msg of message;;
+
+let return_xml_msg body outchan =
+ Http_daemon.respond ~headers:["Content-Type", "text/xml"] ~body outchan
+;;
+let parse_musing_id = function
+ | Musing_started (_, musing_id) ->
+ prerr_endline ("#### Started musing ID: " ^ musing_id);
+ musing_id
+ | Musing_aborted (_, musing_id) -> musing_id
+ | msg ->
+ prerr_endline (sprintf "Assertion failed, received msg: %s"
+ (Hbugs_messages.string_of_msg msg));
+ assert false
+;;
+
+let do_critical =
+ let mutex = Mutex.create () in
+ fun action ->
+ try
+(* debug_print (lazy "Acquiring lock ..."); *)
+ Mutex.lock mutex;
+(* debug_print (lazy "Lock Acquired!"); *)
+ let res = Lazy.force action in
+(* debug_print (lazy "Releaseing lock ..."); *)
+ Mutex.unlock mutex;
+(* debug_print (lazy "Lock released!"); *)
+ res
+ with e -> Mutex.unlock mutex; raise e
+;;
+
+ (* registries *)
+let clients = new Hbugs_broker_registry.clients in
+let tutors = new Hbugs_broker_registry.tutors in
+let musings = new Hbugs_broker_registry.musings in
+let registries =
+ [ (clients :> Hbugs_broker_registry.registry);
+ (tutors :> Hbugs_broker_registry.registry);
+ (musings :> Hbugs_broker_registry.registry) ]
+in
+
+let my_own_id = Hbugs_id_generator.new_broker_id () in
+
+ (* debugging: dump broker internal status, used by '/dump' method *)
+let dump_registries () =
+ assert debug;
+ String.concat "\n" (List.map (fun o -> o#dump) registries)
+in
+
+let handle_msg outchan msg =
+ (* messages from clients *)
+ (match msg with
+
+ | Help ->
+ Hbugs_messages.respond_msg (Usage usage_string) outchan
+ | Register_client (client_id, client_url) -> do_critical (lazy (
+ try
+ clients#register client_id client_url;
+ Hbugs_messages.respond_msg (Client_registered my_own_id) outchan
+ with Hbugs_broker_registry.Client_already_in id ->
+ Hbugs_messages.respond_exc "already_registered" id outchan
+ ))
+ | Unregister_client client_id -> do_critical (lazy (
+ if clients#isAuthenticated client_id then begin
+ clients#unregister client_id;
+ Hbugs_messages.respond_msg (Client_unregistered my_own_id) outchan
+ end else
+ Hbugs_messages.respond_exc "forbidden" client_id outchan
+ ))
+ | List_tutors client_id -> do_critical (lazy (
+ if clients#isAuthenticated client_id then begin
+ Hbugs_messages.respond_msg
+ (Tutor_list (my_own_id, tutors#index))
+ outchan
+ end else
+ Hbugs_messages.respond_exc "forbidden" client_id outchan
+ ))
+ | Subscribe (client_id, tutor_ids) -> do_critical (lazy (
+ if clients#isAuthenticated client_id then begin
+ if List.length tutor_ids <> 0 then begin (* at least one tutor id *)
+ if List.for_all tutors#exists tutor_ids then begin
+ clients#subscribe client_id tutor_ids;
+ Hbugs_messages.respond_msg
+ (Subscribed (my_own_id, tutor_ids)) outchan
+ end else (* required subscription to at least one unexistent tutor *)
+ let missing_tutors =
+ List.filter (fun id -> not (tutors#exists id)) tutor_ids
+ in
+ Hbugs_messages.respond_exc
+ "tutor_not_found" (String.concat " " missing_tutors) outchan
+ end else (* no tutor id specified *)
+ Hbugs_messages.respond_exc "no_tutor_specified" "" outchan
+ end else
+ Hbugs_messages.respond_exc "forbidden" client_id outchan
+ ))
+ | State_change (client_id, new_state) -> do_critical (lazy (
+ if clients#isAuthenticated client_id then begin
+ let active_musings = musings#getByClientId client_id in
+ prerr_endline (sprintf "ACTIVE MUSINGS: %s" (String.concat ", " active_musings));
+ if List.length active_musings = 0 then
+ prerr_endline ("No active musings for client " ^ client_id);
+ prerr_endline "CSC: State change!!!" ;
+ let stop_answers =
+ List.map (* collect Abort_musing message's responses *)
+ (fun id -> (* musing id *)
+ let tutor = snd (musings#getByMusingId id) in
+ Hbugs_messages.submit_req
+ ~url:(tutors#getUrl tutor) (Abort_musing (my_own_id, id)))
+ active_musings
+ in
+ let stopped_musing_ids = List.map parse_musing_id stop_answers in
+ List.iter musings#unregister active_musings;
+ (match new_state with
+ | Some new_state -> (* need to start new musings *)
+ let subscriptions = clients#getSubscription client_id in
+ if List.length subscriptions = 0 then
+ prerr_endline ("No subscriptions for client " ^ client_id);
+ let started_musing_ids =
+ List.map (* register new musings and collect their ids *)
+ (fun tutor_id ->
+ let res =
+ Hbugs_messages.submit_req
+ ~url:(tutors#getUrl tutor_id)
+ (Start_musing (my_own_id, new_state))
+ in
+ let musing_id = parse_musing_id res in
+ musings#register musing_id client_id tutor_id;
+ musing_id)
+ subscriptions
+ in
+ Hbugs_messages.respond_msg
+ (State_accepted (my_own_id, stopped_musing_ids, started_musing_ids))
+ outchan
+ | None -> (* no need to start new musings *)
+ Hbugs_messages.respond_msg
+ (State_accepted (my_own_id, stopped_musing_ids, []))
+ outchan)
+ end else
+ Hbugs_messages.respond_exc "forbidden" client_id outchan
+ ))
+
+ (* messages from tutors *)
+
+ | Register_tutor (tutor_id, tutor_url, hint_type, dsc) -> do_critical (lazy (
+ try
+ tutors#register tutor_id tutor_url hint_type dsc;
+ Hbugs_messages.respond_msg (Tutor_registered my_own_id) outchan
+ with Hbugs_broker_registry.Tutor_already_in id ->
+ Hbugs_messages.respond_exc "already_registered" id outchan
+ ))
+ | Unregister_tutor tutor_id -> do_critical (lazy (
+ if tutors#isAuthenticated tutor_id then begin
+ tutors#unregister tutor_id;
+ Hbugs_messages.respond_msg (Tutor_unregistered my_own_id) outchan
+ end else
+ Hbugs_messages.respond_exc "forbidden" tutor_id outchan
+ ))
+
+ | Musing_completed (tutor_id, musing_id, result) -> do_critical (lazy (
+ if not (tutors#isAuthenticated tutor_id) then begin (* unauthorized *)
+ Hbugs_messages.respond_exc "forbidden" tutor_id outchan;
+ end else if not (musings#isActive musing_id) then begin (* too late *)
+ Hbugs_messages.respond_msg (Too_late (my_own_id, musing_id)) outchan;
+ end else begin (* all is ok: autorhized and on time *)
+ (match result with
+ | Sorry -> ()
+ | Eureka hint ->
+ let client_url =
+ clients#getUrl (fst (musings#getByMusingId musing_id))
+ in
+ let res =
+ Hbugs_messages.submit_req ~url:client_url (Hint (my_own_id, hint))
+ in
+ (match res with
+ | Wow _ -> () (* ok: client is happy with our hint *)
+ | unexpected_msg ->
+ prerr_endline
+ (sprintf
+ "Warning: unexpected msg from client: %s\nExpected was: Wow"
+ (Hbugs_messages.string_of_msg msg))));
+ Hbugs_messages.respond_msg (Thanks (my_own_id, musing_id)) outchan;
+ musings#unregister musing_id
+ end
+ ))
+
+ | msg -> (* unexpected message *)
+ debug_print (lazy "Unknown message!");
+ Hbugs_messages.respond_exc
+ "unexpected_msg" (Hbugs_messages.string_of_msg msg) outchan)
+in
+(* (* DEBUGGING wrapper around 'handle_msg' *)
+let handle_msg outchan =
+ if debug then
+ (fun msg -> (* filter handle_msg through a function which dumps input
+ messages *)
+ debug_print (lazy (Hbugs_messages.string_of_msg msg));
+ handle_msg outchan msg)
+ else
+ handle_msg outchan
+in
+*)
+
+ (* thread action *)
+let callback (req: Http_types.request) outchan =
+ try
+ debug_print (lazy ("Connection from " ^ req#clientAddr));
+ debug_print (lazy ("Received request: " ^ req#path));
+ (match req#path with
+ (* TODO write help message *)
+ | "/help" -> return_xml_msg "<help> not yet written </help>" outchan
+ | "/act" ->
+ let msg = Hbugs_messages.msg_of_string req#body in
+ handle_msg outchan msg
+ | "/dump" ->
+ if debug then
+ Http_daemon.respond ~body:(dump_registries ()) outchan
+ else
+ Http_daemon.respond_error ~code:400 outchan
+ | _ -> Http_daemon.respond_error ~code:400 outchan);
+ debug_print (lazy "Done!\n")
+ with
+ | Http_types.Param_not_found attr_name ->
+ Hbugs_messages.respond_exc "missing_parameter" attr_name outchan
+ | exc ->
+ Hbugs_messages.respond_exc
+ "uncaught_exception" (Printexc.to_string exc) outchan
+in
+
+ (* thread who cleans up ancient client/tutor/musing registrations *)
+let ragman () =
+ let delay = 3600.0 in (* 1 hour delay *)
+ while true do
+ Thread.delay delay;
+ List.iter (fun o -> o#purge) registries
+ done
+in
+
+ (* start daemon *)
+printf "Listening on port %d ...\n" port;
+flush stdout;
+ignore (Thread.create ragman ());
+Http_daemon.start' ~port ~mode:`Thread callback
+
diff --git a/helm/ocaml/hbugs/client.ml b/helm/ocaml/hbugs/client.ml
new file mode 100644
index 000000000..93114b305
--- /dev/null
+++ b/helm/ocaml/hbugs/client.ml
@@ -0,0 +1,46 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Hbugs_common;;
+open Printf;;
+
+let client =
+ new Hbugs_client.hbugsClient
+ ~use_hint_callback:
+ (fun hint ->
+ prerr_endline (sprintf "Using hint: %s" (string_of_hint hint)))
+ ~describe_hint_callback:
+ (fun hint ->
+ prerr_endline (sprintf "Describing hint: %s" (string_of_hint hint)))
+ ()
+in
+client#show ();
+GtkThread.main ()
+
diff --git a/helm/ocaml/hbugs/data/hbugs_tutor.TPL.ml b/helm/ocaml/hbugs/data/hbugs_tutor.TPL.ml
new file mode 100644
index 000000000..947e351c7
--- /dev/null
+++ b/helm/ocaml/hbugs/data/hbugs_tutor.TPL.ml
@@ -0,0 +1,42 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+module TutorDescription =
+ struct
+ let addr = "@ADDR@"
+ let port = @PORT@
+ let tactic = @TACTIC@
+ let hint = @HINT@
+ let hint_type = "@HINT_TYPE@"
+ let description = "@DESCRIPTION@"
+ let environment_file = "@ENVIRONMENT_FILE@"
+ end
+;;
+module Tutor = Hbugs_tutors.BuildTutor (TutorDescription) ;;
+Tutor.start () ;;
+
diff --git a/helm/ocaml/hbugs/data/tutors_index.xml b/helm/ocaml/hbugs/data/tutors_index.xml
new file mode 100644
index 000000000..bd4baad45
--- /dev/null
+++ b/helm/ocaml/hbugs/data/tutors_index.xml
@@ -0,0 +1,140 @@
+<!--
+ Data used to fill template "hbugs_tutor.TPL.ml"
+
+ @ADDR@ tutor ip address
+ @PORT@ tutor tcp port
+ @TACTIC@ tactic to use (OCaml function, must have type
+ ProofEngineTypes.tactic)
+ @HINT@ hint to be sent to client (content of Hbugs_types.Eureka
+ type constructor, must have type Hbugs_types.hint, see
+ hbugs_types.ml)
+ @HINT_TYPE@ hint type (3rd argument of Hbugs_types.Register_tutor type
+ constructor, must have type Hbugs_types.hint_type)
+ @DESCRIPTION@ human readable tutor description
+ @ENVIRONMENT_FILE@ file from which restore proof checking environment on boot
+
+ "source" attribute corresponding OCaml source file
+
+ INVARIANT: XML element name below are lowercase version of @TAGS@ used in
+ template
+
+ TODO: hint type isn't yet well formalized
+-->
+
+<tutors>
+
+ <!-- DEBUGGING -->
+<!--
+ <tutor source="wait_tutor.ml">
+ <addr>127.0.0.1</addr>
+ <port>50111</port>
+ <tactic>Wait.wait_tac</tactic>
+ <hint>Hbugs_types.Use_ring_Luke</hint>
+ <hint_type>Use Ring Luke</hint_type>
+ <description>WAIT FOREVER tutor</description>
+ <environment_file>wait.environment</environment_file>
+ </tutor>
+-->
+
+ <tutor source="ring_tutor.ml">
+ <addr>127.0.0.1</addr>
+ <port>50001</port>
+ <tactic>Ring.ring_tac</tactic>
+ <hint>Hbugs_types.Use_ring_Luke</hint>
+ <hint_type>Use Ring Luke</hint_type>
+ <description>Ring tutor</description>
+ <environment_file>ring.environment</environment_file>
+ </tutor>
+ <tutor source="fourier_tutor.ml">
+ <addr>127.0.0.1</addr>
+ <port>50002</port>
+ <tactic>FourierR.fourier_tac</tactic>
+ <hint>Hbugs_types.Use_fourier_Luke</hint>
+ <hint_type>Use Fourier Luke</hint_type>
+ <description>Fourier tutor</description>
+ <environment_file>fourier.environment</environment_file>
+ </tutor>
+ <tutor source="reflexivity_tutor.ml">
+ <addr>127.0.0.1</addr>
+ <port>50003</port>
+ <tactic>EqualityTactics.reflexivity_tac</tactic>
+ <hint>Hbugs_types.Use_reflexivity_Luke</hint>
+ <hint_type>Use Reflexivity Luke</hint_type>
+ <description>Reflexivity tutor</description>
+ <environment_file>reflexivity.environment</environment_file>
+ </tutor>
+ <tutor source="symmetry_tutor.ml">
+ <addr>127.0.0.1</addr>
+ <port>50004</port>
+ <tactic>EqualityTactics.symmetry_tac</tactic>
+ <hint>Hbugs_types.Use_symmetry_Luke</hint>
+ <hint_type>Use Symmetry Luke</hint_type>
+ <description>Symmetry tutor</description>
+ <environment_file>symmetry.environment</environment_file>
+ </tutor>
+ <tutor source="assumption_tutor.ml">
+ <addr>127.0.0.1</addr>
+ <port>50005</port>
+ <tactic>VariousTactics.assumption_tac</tactic>
+ <hint>Hbugs_types.Use_assumption_Luke</hint>
+ <hint_type>Use Assumption Luke</hint_type>
+ <description>Assumption tutor</description>
+ <environment_file>assumption.environment</environment_file>
+ </tutor>
+ <tutor source="contradiction_tutor.ml">
+ <addr>127.0.0.1</addr>
+ <port>50006</port>
+ <tactic>NegationTactics.contradiction_tac</tactic>
+ <hint>Hbugs_types.Use_contradiction_Luke</hint>
+ <hint_type>Use Contradiction Luke</hint_type>
+ <description>Contradiction tutor</description>
+ <environment_file>contradiction.environment</environment_file>
+ </tutor>
+ <tutor source="exists_tutor.ml">
+ <addr>127.0.0.1</addr>
+ <port>50007</port>
+ <tactic>IntroductionTactics.exists_tac</tactic>
+ <hint>Hbugs_types.Use_exists_Luke</hint>
+ <hint_type>Use Exists Luke</hint_type>
+ <description>Exists tutor</description>
+ <environment_file>exists.environment</environment_file>
+ </tutor>
+ <tutor source="split_tutor.ml">
+ <addr>127.0.0.1</addr>
+ <port>50008</port>
+ <tactic>IntroductionTactics.split_tac</tactic>
+ <hint>Hbugs_types.Use_split_Luke</hint>
+ <hint_type>Use Split Luke</hint_type>
+ <description>Split tutor</description>
+ <environment_file>split.environment</environment_file>
+ </tutor>
+ <tutor source="left_tutor.ml">
+ <addr>127.0.0.1</addr>
+ <port>50009</port>
+ <tactic>IntroductionTactics.left_tac</tactic>
+ <hint>Hbugs_types.Use_left_Luke</hint>
+ <hint_type>Use Left Luke</hint_type>
+ <description>Left tutor</description>
+ <environment_file>left.environment</environment_file>
+ </tutor>
+ <tutor source="right_tutor.ml">
+ <addr>127.0.0.1</addr>
+ <port>50010</port>
+ <tactic>IntroductionTactics.right_tac</tactic>
+ <hint>Hbugs_types.Use_right_Luke</hint>
+ <hint_type>Use Right Luke</hint_type>
+ <description>Right tutor</description>
+ <environment_file>right.environment</environment_file>
+ </tutor>
+ <tutor source="search_pattern_apply_tutor.ml">
+ <no_auto /> <!-- this imply that settings below are not significant -->
+ <addr>127.0.0.1</addr>
+ <port>50011</port>
+ <tactic>PrimitiveTactics.apply_tac</tactic>
+ <hint>Hbugs_types.Use_apply_Luke</hint>
+ <hint_type>Use Apply Luke (with argument)</hint_type>
+ <description>Search pattern apply tutor</description>
+ <environment_file>search_pattern_apply.environment</environment_file>
+ </tutor>
+</tutors>
+
diff --git a/helm/ocaml/hbugs/doc/hbugs.dia b/helm/ocaml/hbugs/doc/hbugs.dia
new file mode 100644
index 0000000000000000000000000000000000000000..b1c4e64e294dfa83da49661e287419060021d95e
GIT binary patch
literal 1927
zcmV;22YC1&iwFP!000001MOX1Z`(E$eb28j+?NV)W${~Tn-pDvVGk(=Y$^6=$TnkZ
zktKtYljdc=ee_3SOP0;pCNH2u0b0Ncb1z999i4k9(Vss5m?fP@sq#2Wue-?eyB(R1
zvT>YFuDjpwet#cyKi^z^8pqKG{cob8Sx5gxnlC?Hcc(=$|IqJ0Jw18Ja~>6$@{)Mr
z<+A@@lq6AKH|lq9t~#CF0OP2Lmd7?nqoPppa8bxk8qMT&cNmQxCMsK`<L<iErrjt@
zGSzvElI!lf`_)gkzX{VX#W@mt9?hkyhMmo`Jl0K$=lNcf196uB@3h&p%5|f3a`WyB
zeYft?=D;>qT}KZlDQ1zH#OZz>C8K0L5!eeb#xL`5dWxa@6p8y3%6*DBAIvjVs3<P>
z(+smLkx{zNRH%hKKTkf25(=4PLqX?9zmJO|GxYyHO7gc1V14-Y>N)jFoTzww{6Z|X
zI1uG29v9QW4@c9rj{fW@`eU5O!$j8gK28g3;h!%If9ZK%#ABHo&UCrWfk@L$v%YEI
z)pl<k!TM0;CbdeDM9)%f!vD6tJ#{v7yt(LiW+5B?D@Vm<c;CO>cHVbx<9n$uZQ0%4
zZS}o29$$C=^vlyz9gq&D$!BkV=Gp6cBt2Xm?*4f^6nZ$UMpnA-Q94QF3wLtXLtZG@
zN8%CI6WsGLJ1^lVOVfc&$E(i2c}R7?7W}*(s3M#15BTMJ_PsL)riNK@I4n9Z=vYNh
zgZpf>*qf;%x15s`j8v8%Pf)ohoOHtH$spBt&gqlP_a>;0h)xQgXA5`1S3Q@J!=7Ih
ze0^|DHfOUBx|DrT;FNxl*zykwzzC>3s@mVT6x32sOF<SW2wyCKkW&gG{*DAfa2g01
zL=b8zsHLEmg5FF)-(;RglR5?>mzQ9n(-JJCTm(HWe*%G)GRPN8M)E!CW9qyV3kpIA
z`R8?^kU#cL`-_SCmz>0TA=O}%#4;^v9o3U^X&h8@$#gN>Fy8qCFsWnThzuJ5rWRB@
zLT(|9$qKTs5M~7T5QczoWpH&EN7z1wzpkJ=P#Y-Aag$MuAb6Nv&clcR5V3}BnTaV3
z6YmbL9_G|OjBho12gRbuRNiO+6952n8$8Sac$ijrm_zX}Gw?9C58%5cb_a=uaij6e
z0Prg;l;YH_8yKRH^~f5&x*FH;6+N~@FX!$Ha%$jT=1>W*D7di*#?%N58vqV05HNQP
zV9JR`>??o+pY;R?fXid6ca&Vw?@yqDF*8EL282Tk>%kBr7*|9v1`@&8B!aO65&U-%
z6>>0|>Uoe&RuLFN1tSZOG#~*{$MH%X7Xa09!c@lv4j{Z3<|Ey@(fBpO!U}$EEQ+HL
zpo|O3WgPaQ%DC`&8Has`_-(e224M#yY~!g82B3p6Eem11G9m=P(;dv9gfVxbB2+P$
zEpq*-$uby2coB%$crHKyxDl9_?Fbw|fVeWcdXziR5#Ltu9pp<aH@lj{AY#JC+8hQD
z6SyKK2$Yz>1~EZ=SM^*p8p(OlY(arR1cil_IYI#{Izq}79bqsP9Wgn>gtex`AqW!)
zXBgR7n<Eh3FsYcsL;z`GVseLx1AF+(F#8EKF*QTO3W#ki(2)RQg-(<;F$sY*@$TsA
zQ64(e#L*JVP1eNJ3=S(Wwy{h{eF!cN%Unzm5Et)`u6`*Rwf@Axm1Z9T#G#FcB`^RN
zYtWXsm=Yi^rlxnOC~5tPBQVAQFvh+LE~f7N2};WT1Z6<}1f|FQ3Cdc3;&5?CA&NVU
zY;ZAzS4=BjF@^GqsmUv*?!4mV?hA?3K<@mKXG%T)+GN+5Lb%4*#tI$^0TeO{$_knJ
zPzpITC}ifqH@=%j=|kRV_(J%_*uooi3<LPZ43+(2MqvD6W>UtCw0`j+Nx?vLv5j>*
zMj@UhCKU!|Kn%>NiGf+`Q5-7n7>F)r7IZP=0J@m5$}1fLNEb71Vq(#H6h~kTvFw3u
ztlhD|y+^@B*`r_~kVnCS;~oVITaV(1pnzEPz&6(II0N8fPRm@(IS?0fX5eDZAv_AX
zQ1T&av`N7sp3uZr-nJ6}5}EU|MCJjIMCQUEk$KRX6gBV#@z_Ee@C8s6yrL>Nl&atc
zRlyyoia+9JZ}-D(XbCN?(s8858ozhTxvJT+%Emi(4x#IN!q-q;?)QTOCO$F`hdk&Z
z59!Yq@8Z?nq$_O>ZM42ZR;gVDhLgK&ek&hka$qz6BO7ub+I~Gti@J=<<C`X5vxSPK
z+P&yb&oh<rWLlePcZ<K^vLt0_8R2zKiq$th)Fs*dDhPk|b6KJ&i6`ky)}Ng%YrJ(h
zwHuDR<pL}3E4q|nx`3dVZrK2Z9%F(xhYp4+dyuN-g7dhb46l|9oRWc!?R1@P1sHmQ
z;9yGz1bdhZ+#E7Eyc18$1!i4<S}w4|1;$-%FJFXT*PB9Ls@U<abfE~?G7&;}UFgz4
zC&nJd0dj3T){nC0HYU7q)e@h-{r9ob_n+*k!IiH^{Piq~lV1;Ce_nmh&dpWni+FCX
N{s%x=tH-2n0000Gj9>r&
literal 0
HcmV?d00001
diff --git a/helm/ocaml/hbugs/hbugs_broker_registry.ml b/helm/ocaml/hbugs/hbugs_broker_registry.ml
new file mode 100644
index 000000000..4670b5eca
--- /dev/null
+++ b/helm/ocaml/hbugs/hbugs_broker_registry.ml
@@ -0,0 +1,317 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Hbugs_misc;;
+open Hbugs_types;;
+open Printf;;
+
+exception Client_already_in of client_id;;
+exception Client_not_found of client_id;;
+exception Musing_already_in of musing_id;;
+exception Musing_not_found of musing_id;;
+exception Tutor_already_in of tutor_id;;
+exception Tutor_not_found of tutor_id;;
+
+class type registry =
+ object
+ method dump: string
+ method purge: unit
+ end
+
+let expire_time = 1800. (* 30 minutes *)
+
+class clients =
+ object (self)
+
+ inherit ThreadSafe.threadSafe
+(*
+ (* <DEBUGGING> *)
+ method private doCritical: 'a. 'a lazy_t -> 'a = fun act -> Lazy.force act
+ method private doWriter: 'a. 'a lazy_t -> 'a = fun act -> Lazy.force act
+ method private doReader: 'a. 'a lazy_t -> 'a = fun act -> Lazy.force act
+ (* </DEBUGGING> *)
+*)
+
+ val timetable: (client_id, float) Hashtbl.t = Hashtbl.create 17
+ val urls: (client_id, string) Hashtbl.t = Hashtbl.create 17
+ val subscriptions: (client_id, tutor_id list) Hashtbl.t = Hashtbl.create 17
+
+ (** INVARIANT: each client registered has an entry in 'urls' hash table
+ _and_ in 'subscriptions hash table even if it hasn't yet invoked
+ 'subscribe' method *)
+
+ method register id url = self#doWriter (lazy (
+ if Hashtbl.mem urls id then
+ raise (Client_already_in id)
+ else begin
+ Hashtbl.add urls id url;
+ Hashtbl.add subscriptions id [];
+ Hashtbl.add timetable id (Unix.time ())
+ end
+ ))
+ method private remove id =
+ Hashtbl.remove urls id;
+ Hashtbl.remove subscriptions id;
+ Hashtbl.remove timetable id
+ method unregister id = self#doWriter (lazy (
+ if Hashtbl.mem urls id then
+ self#remove id
+ else
+ raise (Client_not_found id)
+ ))
+ method isAuthenticated id = self#doReader (lazy (
+ Hashtbl.mem urls id
+ ))
+ method subscribe client_id tutor_ids = self#doWriter (lazy (
+ if Hashtbl.mem urls client_id then
+ Hashtbl.replace subscriptions client_id tutor_ids
+ else
+ raise (Client_not_found client_id)
+ ))
+ method getUrl id = self#doReader (lazy (
+ if Hashtbl.mem urls id then
+ Hashtbl.find urls id
+ else
+ raise (Client_not_found id)
+ ))
+ method getSubscription id = self#doReader (lazy (
+ if Hashtbl.mem urls id then
+ Hashtbl.find subscriptions id
+ else
+ raise (Client_not_found id)
+ ))
+
+ method dump = self#doReader (lazy (
+ "<clients>\n" ^
+ (Hashtbl.fold
+ (fun id url dump ->
+ (dump ^
+ (sprintf "<client id=\"%s\" url=\"%s\">\n" id url) ^
+ "<subscriptions>\n" ^
+ (String.concat "\n" (* id's subscriptions *)
+ (List.map
+ (fun tutor_id -> sprintf "<tutor id=\"%s\" />\n" tutor_id)
+ (Hashtbl.find subscriptions id))) ^
+ "</subscriptions>\n</client>\n"))
+ urls "") ^
+ "</clients>"
+ ))
+ method purge = self#doWriter (lazy (
+ let now = Unix.time () in
+ Hashtbl.iter
+ (fun id birthday ->
+ if now -. birthday > expire_time then
+ self#remove id)
+ timetable
+ ))
+
+ end
+
+class tutors =
+ object (self)
+
+ inherit ThreadSafe.threadSafe
+(*
+ (* <DEBUGGING> *)
+ method private doCritical: 'a. 'a lazy_t -> 'a = fun act -> Lazy.force act
+ method private doWriter: 'a. 'a lazy_t -> 'a = fun act -> Lazy.force act
+ method private doReader: 'a. 'a lazy_t -> 'a = fun act -> Lazy.force act
+ (* </DEBUGGING> *)
+*)
+
+ val timetable: (tutor_id, float) Hashtbl.t = Hashtbl.create 17
+ val tbl: (tutor_id, string * hint_type * string) Hashtbl.t =
+ Hashtbl.create 17
+
+ method register id url hint_type dsc = self#doWriter (lazy (
+ if Hashtbl.mem tbl id then
+ raise (Tutor_already_in id)
+ else begin
+ Hashtbl.add tbl id (url, hint_type, dsc);
+ Hashtbl.add timetable id (Unix.time ())
+ end
+ ))
+ method private remove id =
+ Hashtbl.remove tbl id;
+ Hashtbl.remove timetable id
+ method unregister id = self#doWriter (lazy (
+ if Hashtbl.mem tbl id then
+ self#remove id
+ else
+ raise (Tutor_not_found id)
+ ))
+ method isAuthenticated id = self#doReader (lazy (
+ Hashtbl.mem tbl id
+ ))
+ method exists id = self#doReader (lazy (
+ Hashtbl.mem tbl id
+ ))
+ method getTutor id = self#doReader (lazy (
+ if Hashtbl.mem tbl id then
+ Hashtbl.find tbl id
+ else
+ raise (Tutor_not_found id)
+ ))
+ method getUrl id =
+ let (url, _, _) = self#getTutor id in
+ url
+ method getHintType id =
+ let (_, hint_type, _) = self#getTutor id in
+ hint_type
+ method getDescription id =
+ let (_, _, dsc) = self#getTutor id in
+ dsc
+ method index = self#doReader (lazy (
+ Hashtbl.fold
+ (fun id (url, hint_type, dsc) idx -> (id, dsc) :: idx) tbl []
+ ))
+
+ method dump = self#doReader (lazy (
+ "<tutors>\n" ^
+ (Hashtbl.fold
+ (fun id (url, hint_type, dsc) dump ->
+ dump ^
+ (sprintf
+"<tutor id=\"%s\" url=\"%s\">\n<hint_type>%s</hint_type>\n<description>%s</description>\n</tutor>"
+ id url hint_type dsc))
+ tbl "") ^
+ "</tutors>"
+ ))
+ method purge = self#doWriter (lazy (
+ let now = Unix.time () in
+ Hashtbl.iter
+ (fun id birthday ->
+ if now -. birthday > expire_time then
+ self#remove id)
+ timetable
+ ))
+
+ end
+
+class musings =
+ object (self)
+
+ inherit ThreadSafe.threadSafe
+(*
+ (* <DEBUGGING> *)
+ method private doCritical: 'a. 'a lazy_t -> 'a = fun act -> Lazy.force act
+ method private doWriter: 'a. 'a lazy_t -> 'a = fun act -> Lazy.force act
+ method private doReader: 'a. 'a lazy_t -> 'a = fun act -> Lazy.force act
+ (* </DEBUGGING> *)
+*)
+
+ val timetable: (musing_id, float) Hashtbl.t = Hashtbl.create 17
+ val musings: (musing_id, client_id * tutor_id) Hashtbl.t = Hashtbl.create 17
+ val clients: (client_id, musing_id list) Hashtbl.t = Hashtbl.create 17
+ val tutors: (tutor_id, musing_id list) Hashtbl.t = Hashtbl.create 17
+
+ (** INVARIANT: each registered musing <musing_id, client_id, tutor_id> has
+ an entry in 'musings' table, an entry in 'clients' (i.e. one of the
+ musings for client_id is musing_id) table, an entry in 'tutors' table
+ (i.e. one of the musings for tutor_id is musing_id) and an entry in
+ 'timetable' table *)
+
+
+ method register musing_id client_id tutor_id = self#doWriter (lazy (
+ if Hashtbl.mem musings musing_id then
+ raise (Musing_already_in musing_id)
+ else begin
+ Hashtbl.add musings musing_id (client_id, tutor_id);
+ (* now add this musing as the first one of musings list for client and
+ tutor *)
+ Hashtbl.replace clients client_id
+ (musing_id ::
+ (try Hashtbl.find clients client_id with Not_found -> []));
+ Hashtbl.replace tutors tutor_id
+ (musing_id ::
+ (try Hashtbl.find tutors tutor_id with Not_found -> []));
+ Hashtbl.add timetable musing_id (Unix.time ())
+ end
+ ))
+ method private remove id =
+ (* ASSUMPTION: this method is invoked under a 'writer' lock *)
+ let (client_id, tutor_id) = self#getByMusingId' id in
+ Hashtbl.remove musings id;
+ (* now remove this musing from the list of musings for client and tutor
+ *)
+ Hashtbl.replace clients client_id
+ (List.filter ((<>) id)
+ (try Hashtbl.find clients client_id with Not_found -> []));
+ Hashtbl.replace tutors tutor_id
+ (List.filter ((<>) id)
+ (try Hashtbl.find tutors tutor_id with Not_found -> []));
+ Hashtbl.remove timetable id
+ method unregister id = self#doWriter (lazy (
+ if Hashtbl.mem musings id then
+ self#remove id
+ ))
+ method private getByMusingId' id =
+ (* ASSUMPTION: this method is invoked under a 'reader' lock *)
+ try
+ Hashtbl.find musings id
+ with Not_found -> raise (Musing_not_found id)
+ method getByMusingId id = self#doReader (lazy (
+ self#getByMusingId' id
+ ))
+ method getByClientId id = self#doReader (lazy (
+ try
+ Hashtbl.find clients id
+ with Not_found -> []
+ ))
+ method getByTutorId id = self#doReader (lazy (
+ try
+ Hashtbl.find tutors id
+ with Not_found -> []
+ ))
+ method isActive id = self#doReader (lazy (
+ Hashtbl.mem musings id
+ ))
+
+ method dump = self#doReader (lazy (
+ "<musings>\n" ^
+ (Hashtbl.fold
+ (fun mid (cid, tid) dump ->
+ dump ^
+ (sprintf "<musing id=\"%s\" client=\"%s\" tutor=\"%s\" />\n"
+ mid cid tid))
+ musings "") ^
+ "</musings>"
+ ))
+ method purge = self#doWriter (lazy (
+ let now = Unix.time () in
+ Hashtbl.iter
+ (fun id birthday ->
+ if now -. birthday > expire_time then
+ self#remove id)
+ timetable
+ ))
+
+ end
+
diff --git a/helm/ocaml/hbugs/hbugs_broker_registry.mli b/helm/ocaml/hbugs/hbugs_broker_registry.mli
new file mode 100644
index 000000000..ece9e07cf
--- /dev/null
+++ b/helm/ocaml/hbugs/hbugs_broker_registry.mli
@@ -0,0 +1,87 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+open Hbugs_types;;
+
+exception Client_already_in of client_id
+exception Client_not_found of client_id
+exception Musing_already_in of musing_id
+exception Musing_not_found of musing_id
+exception Tutor_already_in of tutor_id
+exception Tutor_not_found of tutor_id
+
+class type registry =
+ object
+ method dump: string
+ method purge: unit
+ end
+
+class clients:
+ object
+ (** 'register client_id client_url' *)
+ method register: client_id -> string -> unit
+ method unregister: client_id -> unit
+ method isAuthenticated: client_id -> bool
+ (** subcribe a client to a set of tutor removing previous subcriptions *)
+ method subscribe: client_id -> tutor_id list -> unit
+ method getUrl: client_id -> string
+ method getSubscription: client_id -> tutor_id list
+
+ method dump: string
+ method purge: unit
+ end
+
+class tutors:
+ object
+ method register: tutor_id -> string -> hint_type -> string -> unit
+ method unregister: tutor_id -> unit
+ method isAuthenticated: tutor_id -> bool
+ method exists: tutor_id -> bool
+ method getTutor: tutor_id -> string * hint_type * string
+ method getUrl: tutor_id -> string
+ method getHintType: tutor_id -> hint_type
+ method getDescription: tutor_id -> string
+ method index: tutor_dsc list
+
+ method dump: string
+ method purge: unit
+ end
+
+class musings:
+ object
+ method register: musing_id -> client_id -> tutor_id -> unit
+ method unregister: musing_id -> unit
+ method getByMusingId: musing_id -> client_id * tutor_id
+ method getByClientId: client_id -> musing_id list
+ method getByTutorId: tutor_id -> musing_id list
+ method isActive: musing_id -> bool
+
+ method dump: string
+ method purge: unit
+ end
+
diff --git a/helm/ocaml/hbugs/hbugs_client.ml b/helm/ocaml/hbugs/hbugs_client.ml
new file mode 100644
index 000000000..c7b5fae75
--- /dev/null
+++ b/helm/ocaml/hbugs/hbugs_client.ml
@@ -0,0 +1,526 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Hbugs_common;;
+open Hbugs_types;;
+open Printf;;
+
+exception Invalid_URL of string;;
+
+let do_nothing _ = ();;
+
+module SmartHbugs_client_gui =
+ struct
+ class ['a] oneColumnCList gtree_view ~column_type ~column_title
+ =
+ let obj =
+ ((Gobject.unsafe_cast gtree_view#as_widget) : Gtk.tree_view Gtk.obj) in
+ let columns = new GTree.column_list in
+ let col = columns#add column_type in
+ let vcol = GTree.view_column ~title:column_title ()
+ ~renderer:(GTree.cell_renderer_text[], ["text",col]) in
+ let store = GTree.list_store columns in
+ object(self)
+ inherit GTree.view obj
+ method clear = store#clear
+ method append (v : 'a) =
+ let row = store#append () in
+ store#set ~row ~column:col v;
+ method column = col
+ initializer
+ self#set_model (Some (store :> GTree.model)) ;
+ ignore (self#append_column vcol)
+ end
+
+ class ['a,'b] twoColumnsCList gtree_view ~column1_type ~column2_type
+ ~column1_title ~column2_title
+ =
+ let obj =
+ ((Gobject.unsafe_cast gtree_view#as_widget) : Gtk.tree_view Gtk.obj) in
+ let columns = new GTree.column_list in
+ let col1 = columns#add column1_type in
+ let vcol1 = GTree.view_column ~title:column1_title ()
+ ~renderer:(GTree.cell_renderer_text[], ["text",col1]) in
+ let col2 = columns#add column2_type in
+ let vcol2 = GTree.view_column ~title:column2_title ()
+ ~renderer:(GTree.cell_renderer_text[], ["text",col2]) in
+ let store = GTree.list_store columns in
+ object(self)
+ inherit GTree.view obj
+ method clear = store#clear
+ method append (v1 : 'a) (v2 : 'b) =
+ let row = store#append () in
+ store#set ~row ~column:col1 v1;
+ store#set ~row ~column:col2 v2
+ method column1 = col1
+ method column2 = col2
+ initializer
+ self#set_model (Some (store :> GTree.model)) ;
+ ignore (self#append_column vcol1) ;
+ ignore (self#append_column vcol2) ;
+ end
+
+ class subscribeWindow () =
+ object(self)
+ inherit Hbugs_client_gui.subscribeWindow ()
+ val mutable tutorsSmartCList = None
+ method tutorsSmartCList =
+ match tutorsSmartCList with
+ None -> assert false
+ | Some w -> w
+ initializer
+ tutorsSmartCList <-
+ Some
+ (new twoColumnsCList self#tutorsCList
+ ~column1_type:Gobject.Data.string ~column2_type:Gobject.Data.string
+ ~column1_title:"Id" ~column2_title:"Description")
+ end
+
+ class hbugsMainWindow () =
+ object(self)
+ inherit Hbugs_client_gui.hbugsMainWindow ()
+ val mutable subscriptionSmartCList = None
+ val mutable hintsSmartCList = None
+ method subscriptionSmartCList =
+ match subscriptionSmartCList with
+ None -> assert false
+ | Some w -> w
+ method hintsSmartCList =
+ match hintsSmartCList with
+ None -> assert false
+ | Some w -> w
+ initializer
+ subscriptionSmartCList <-
+ Some
+ (new oneColumnCList self#subscriptionCList
+ ~column_type:Gobject.Data.string ~column_title:"Description")
+ initializer
+ hintsSmartCList <-
+ Some
+ (new oneColumnCList self#hintsCList
+ ~column_type:Gobject.Data.string ~column_title:"Description")
+ end
+
+ end
+;;
+
+class hbugsClient
+ ?(use_hint_callback: hint -> unit = do_nothing)
+ ?(describe_hint_callback: hint -> unit = do_nothing)
+ ?(destroy_callback: unit -> unit = do_nothing)
+ ()
+ =
+
+ let http_url_RE = Pcre.regexp "^(http://)?(.*):(\\d+)" in
+ let port_of_http_url url =
+ try
+ let subs = Pcre.extract ~rex:http_url_RE url in
+ int_of_string subs.(3)
+ with e -> raise (Invalid_URL url)
+ in
+
+ object (self)
+
+ val mainWindow = new SmartHbugs_client_gui.hbugsMainWindow ()
+ val subscribeWindow = new SmartHbugs_client_gui.subscribeWindow ()
+ val messageDialog = new Hbugs_client_gui.messageDialog ()
+ val myOwnId = Hbugs_id_generator.new_client_id ()
+ val mutable use_hint_callback = use_hint_callback
+ val mutable myOwnUrl = "localhost:49082"
+ val mutable brokerUrl = "localhost:49081"
+ val mutable brokerId: broker_id option = None
+ (* all available tutors, saved last time a List_tutors message was sent to
+ broker *)
+ val mutable availableTutors: tutor_dsc list = []
+ val mutable statusContext = None
+ val mutable subscribeWindowStatusContext = None
+ val mutable debug = false (* enable/disable debugging buttons *)
+ val mutable hints = [] (* actually available hints *)
+
+ initializer
+ self#initGui;
+ self#startLocalHttpDaemon ();
+ self#testLocalHttpDaemon ();
+ self#testBroker ();
+ self#registerToBroker ();
+ self#reconfigDebuggingButtons
+
+ method show = mainWindow#hbugsMainWindow#show
+ method hide = mainWindow#hbugsMainWindow#misc#hide
+
+ method setUseHintCallback callback =
+ use_hint_callback <- callback
+
+ method private debugButtons =
+ List.map
+ (fun (b: GButton.button) -> new GObj.misc_ops b#as_widget)
+ [ mainWindow#startLocalHttpDaemonButton;
+ mainWindow#testLocalHttpDaemonButton; mainWindow#testBrokerButton ]
+
+ method private initGui =
+
+ (* GUI: main window *)
+
+ (* ignore delete events so that hbugs window is closable only using
+ menu; on destroy (e.g. while quitting gTopLevel) self#quit is invoked
+ *)
+
+ ignore (mainWindow#hbugsMainWindow#event#connect#delete (fun _ -> true));
+ ignore (mainWindow#hbugsMainWindow#event#connect#destroy
+ (fun _ -> self#quit (); false));
+
+ (* GUI main window's menu *)
+ mainWindow#toggleDebuggingMenuItem#set_active debug;
+ ignore (mainWindow#toggleDebuggingMenuItem#connect#toggled
+ self#toggleDebug);
+
+ (* GUI: local HTTP daemon settings *)
+ ignore (mainWindow#clientUrlEntry#connect#changed
+ (fun _ -> myOwnUrl <- mainWindow#clientUrlEntry#text));
+ mainWindow#clientUrlEntry#set_text myOwnUrl;
+ ignore (mainWindow#startLocalHttpDaemonButton#connect#clicked
+ self#startLocalHttpDaemon);
+ ignore (mainWindow#testLocalHttpDaemonButton#connect#clicked
+ self#testLocalHttpDaemon);
+
+ (* GUI: broker choice *)
+ ignore (mainWindow#brokerUrlEntry#connect#changed
+ (fun _ -> brokerUrl <- mainWindow#brokerUrlEntry#text));
+ mainWindow#brokerUrlEntry#set_text brokerUrl;
+ ignore (mainWindow#testBrokerButton#connect#clicked self#testBroker);
+ mainWindow#clientIdLabel#set_text myOwnId;
+
+ (* GUI: client registration *)
+ ignore (mainWindow#registerClientButton#connect#clicked
+ self#registerToBroker);
+
+ (* GUI: subscriptions *)
+ ignore (mainWindow#showSubscriptionWindowButton#connect#clicked
+ (fun () ->
+ self#listTutors ();
+ subscribeWindow#subscribeWindow#show ()));
+
+ let get_selected_row_index () =
+ match mainWindow#hintsCList#selection#get_selected_rows with
+ [path] ->
+ (match GTree.Path.get_indices path with
+ [|n|] -> n
+ | _ -> assert false)
+ | _ -> assert false
+ in
+ (* GUI: hints list *)
+ ignore (
+ let event_ops = new GObj.event_ops mainWindow#hintsCList#as_widget in
+ event_ops#connect#button_press
+ (fun event ->
+ if GdkEvent.get_type event = `TWO_BUTTON_PRESS then
+ use_hint_callback (self#hint (get_selected_row_index ())) ;
+ false));
+
+ ignore (mainWindow#hintsCList#selection#connect#changed
+ (fun () ->
+ describe_hint_callback (self#hint (get_selected_row_index ())))) ;
+
+ (* GUI: main status bar *)
+ let ctxt = mainWindow#mainWindowStatusBar#new_context "0" in
+ statusContext <- Some ctxt;
+ ignore (ctxt#push "Ready");
+
+ (* GUI: subscription window *)
+ subscribeWindow#tutorsCList#selection#set_mode `MULTIPLE;
+ ignore (subscribeWindow#subscribeWindow#event#connect#delete
+ (fun _ -> subscribeWindow#subscribeWindow#misc#hide (); true));
+ ignore (subscribeWindow#listTutorsButton#connect#clicked self#listTutors);
+ ignore (subscribeWindow#subscribeButton#connect#clicked
+ self#subscribeSelected);
+ ignore (subscribeWindow#subscribeAllButton#connect#clicked
+ self#subscribeAll);
+ (subscribeWindow#tutorsCList#get_column 0)#set_visible false;
+ let ctxt = subscribeWindow#subscribeWindowStatusBar#new_context "0" in
+ subscribeWindowStatusContext <- Some ctxt;
+ ignore (ctxt#push "Ready");
+
+ (* GUI: message dialog *)
+ ignore (messageDialog#messageDialog#event#connect#delete
+ (fun _ -> messageDialog#messageDialog#misc#hide (); true));
+ ignore (messageDialog#okDialogButton#connect#clicked
+ (fun _ -> messageDialog#messageDialog#misc#hide ()))
+
+ (* accessory methods *)
+
+ (** pop up a (modal) dialog window showing msg to the user *)
+ method private showDialog msg =
+ messageDialog#dialogLabel#set_text msg;
+ messageDialog#messageDialog#show ()
+ (** use showDialog to display an hbugs message to the user *)
+ method private showMsgInDialog msg =
+ self#showDialog (Hbugs_messages.string_of_msg msg)
+
+ (** create a new thread which sends msg to broker, wait for an answer and
+ invoke callback passing response message as argument *)
+ method private sendReq ?(wait = false) ~msg callback =
+ let thread () =
+ try
+ callback (Hbugs_messages.submit_req ~url:(brokerUrl ^ "/act") msg)
+ with
+ | (Hbugs_messages.Parse_error (subj, reason)) as e ->
+ self#showDialog
+ (sprintf
+"Parse_error, unable to fullfill request. Details follow.
+Request: %s
+Error: %s"
+ (Hbugs_messages.string_of_msg msg) (Printexc.to_string e));
+ | (Unix.Unix_error _) as e ->
+ self#showDialog
+ (sprintf
+"Can't connect to HBugs Broker
+Url: %s
+Error: %s"
+ brokerUrl (Printexc.to_string e))
+ | e ->
+ self#showDialog
+ (sprintf "hbugsClient#sendReq: Uncaught exception: %s"
+ (Printexc.to_string e))
+ in
+ let th = Thread.create thread () in
+ if wait then
+ Thread.join th
+ else ()
+
+ (** check if a broker is authenticated using its broker_id
+ [ Background: during client registration, client save broker_id of its
+ broker, further messages from broker are accepted only if they carry the
+ same broker id ] *)
+ method private isAuthenticated id =
+ match brokerId with
+ | None -> false
+ | Some broker_id -> (id = broker_id)
+
+ (* actions *)
+
+ method private startLocalHttpDaemon =
+ (* flatten an hint tree to an hint list *)
+ let rec flatten_hint = function
+ | Hints hints -> List.concat (List.map flatten_hint hints)
+ | hint -> [hint]
+ in
+ fun () ->
+ let callback req outchan =
+ try
+ (match Hbugs_messages.msg_of_string req#body with
+ | Help ->
+ Hbugs_messages.respond_msg
+ (Usage "Local Http Daemon up and running!") outchan
+ | Hint (broker_id, hint) ->
+ if self#isAuthenticated broker_id then begin
+ let received_hints = flatten_hint hint in
+ List.iter
+ (fun h ->
+ (match h with Hints _ -> assert false | _ -> ());
+ ignore(mainWindow#hintsSmartCList#append(string_of_hint h)))
+ received_hints;
+ hints <- hints @ received_hints;
+ Hbugs_messages.respond_msg (Wow myOwnId) outchan
+ end else (* msg from unauthorized broker *)
+ Hbugs_messages.respond_exc "forbidden" broker_id outchan
+ | msg ->
+ Hbugs_messages.respond_exc
+ "unexpected_msg" (Hbugs_messages.string_of_msg msg) outchan)
+ with (Hbugs_messages.Parse_error _) as e ->
+ Hbugs_messages.respond_exc
+ "parse_error" (Printexc.to_string e) outchan
+ in
+ let addr = "0.0.0.0" in (* TODO actually user specified "My URL" is used
+ only as a value to be sent to broker, local HTTP
+ daemon will listen on "0.0.0.0", port is parsed
+ from My URL though *)
+ let httpDaemonThread () =
+ try
+ Http_daemon.start'
+ ~addr ~port:(port_of_http_url myOwnUrl) ~mode:`Single callback
+ with
+ | Invalid_URL url -> self#showDialog (sprintf "Invalid URL: \"%s\"" url)
+ | e ->
+ self#showDialog (sprintf "Can't start local HTTP daemon: %s"
+ (Printexc.to_string e))
+ in
+ ignore (Thread.create httpDaemonThread ())
+
+ method private testLocalHttpDaemon () =
+ try
+ let msg =
+ Hbugs_misc.http_post ~body:(Hbugs_messages.string_of_msg Help)
+ myOwnUrl
+ in
+ ignore msg
+(* self#showDialog msg *)
+ with
+ | Hbugs_misc.Malformed_URL url ->
+ self#showDialog
+ (sprintf
+ "Handshake with local HTTP daemon failed, Invalid URL: \"%s\""
+ url)
+ | Hbugs_misc.Malformed_HTTP_response res ->
+ self#showDialog
+ (sprintf
+ "Handshake with local HTTP daemon failed, can't parse HTTP response: \"%s\""
+ res)
+ | (Unix.Unix_error _) as e ->
+ self#showDialog
+ (sprintf
+ "Handshake with local HTTP daemon failed, can't connect: \"%s\""
+ (Printexc.to_string e))
+
+ method private testBroker () =
+ self#sendReq ~msg:Help
+ (function
+ | Usage _ -> ()
+ | unexpected_msg ->
+ self#showDialog
+ (sprintf
+ "Handshake with HBugs Broker failed, unexpected message:\n%s"
+ (Hbugs_messages.string_of_msg unexpected_msg)))
+
+ method registerToBroker () =
+ (match brokerId with (* undo previous registration, if any *)
+ | Some id -> self#unregisterFromBroker ()
+ | _ -> ());
+ self#sendReq ~msg:(Register_client (myOwnId, myOwnUrl))
+ (function
+ | Client_registered broker_id -> (brokerId <- Some broker_id)
+ | unexpected_msg ->
+ self#showDialog
+ (sprintf "Client NOT registered, unexpected message:\n%s"
+ (Hbugs_messages.string_of_msg unexpected_msg)))
+
+ method unregisterFromBroker () =
+ self#sendReq ~wait:true ~msg:(Unregister_client myOwnId)
+ (function
+ | Client_unregistered _ -> (brokerId <- None)
+ | unexpected_msg -> ())
+(*
+ self#showDialog
+ (sprintf "Client NOT unregistered, unexpected message:\n%s"
+ (Hbugs_messages.string_of_msg unexpected_msg)))
+*)
+
+ method stateChange new_state =
+ mainWindow#hintsSmartCList#clear ();
+ hints <- [];
+ self#sendReq
+ ~msg:(State_change (myOwnId, new_state))
+ (function
+ | State_accepted _ -> ()
+ | unexpected_msg ->
+ self#showDialog
+ (sprintf "State NOT accepted by Hbugs, unexpected message:\n%s"
+ (Hbugs_messages.string_of_msg unexpected_msg)))
+
+ method hint = List.nth hints
+
+ method private listTutors () =
+ (* wait is set to true just to make sure that after invoking listTutors
+ "availableTutors" is correctly filled *)
+ self#sendReq ~wait:true ~msg:(List_tutors myOwnId)
+ (function
+ | Tutor_list (_, descriptions) ->
+ availableTutors <- (* sort accordingly to tutor description *)
+ List.sort (fun (a,b) (c,d) -> compare (b,a) (d,c)) descriptions;
+ subscribeWindow#tutorsSmartCList#clear ();
+ List.iter
+ (fun (id, dsc) ->
+ ignore (subscribeWindow#tutorsSmartCList#append id dsc))
+ availableTutors
+ | unexpected_msg ->
+ self#showDialog
+ (sprintf "Can't list tutors, unexpected message:\n%s"
+ (Hbugs_messages.string_of_msg unexpected_msg)))
+
+ (* low level used by subscribeSelected and subscribeAll *)
+ method private subscribe' tutors_id =
+ self#sendReq ~msg:(Subscribe (myOwnId, tutors_id))
+ (function
+ | (Subscribed (_, subscribedTutors)) as msg ->
+ let sort = List.sort compare in
+ mainWindow#subscriptionSmartCList#clear ();
+ List.iter
+ (fun tutor_id ->
+ ignore
+ (mainWindow#subscriptionSmartCList#append
+ ( try
+ List.assoc tutor_id availableTutors
+ with Not_found -> assert false )))
+ tutors_id;
+ subscribeWindow#subscribeWindow#misc#hide ();
+ if sort subscribedTutors <> sort tutors_id then
+ self#showDialog
+ (sprintf "Subscription mismatch\n: %s"
+ (Hbugs_messages.string_of_msg msg))
+ | unexpected_msg ->
+ mainWindow#subscriptionSmartCList#clear ();
+ self#showDialog
+ (sprintf "Subscription FAILED, unexpected message:\n%s"
+ (Hbugs_messages.string_of_msg unexpected_msg)))
+
+ method private subscribeSelected () =
+ let tutorsSmartCList = subscribeWindow#tutorsSmartCList in
+ let selectedTutors =
+ List.map
+ (fun p ->
+ tutorsSmartCList#model#get
+ ~row:(tutorsSmartCList#model#get_iter p)
+ ~column:tutorsSmartCList#column1)
+ tutorsSmartCList#selection#get_selected_rows
+ in
+ self#subscribe' selectedTutors
+
+ method subscribeAll () =
+ self#listTutors (); (* this fills 'availableTutors' field *)
+ self#subscribe' (List.map fst availableTutors)
+
+ method private quit () =
+ self#unregisterFromBroker ();
+ destroy_callback ()
+
+ (** enable/disable debugging *)
+ method private setDebug value = debug <- value
+
+ method private reconfigDebuggingButtons =
+ List.iter (* debug value changed, reconfigure buttons *)
+ (fun (b: GObj.misc_ops) -> if debug then b#show () else b#hide ())
+ self#debugButtons;
+
+ method private toggleDebug () =
+ self#setDebug (not debug);
+ self#reconfigDebuggingButtons
+
+ end
+;;
+
diff --git a/helm/ocaml/hbugs/hbugs_client.mli b/helm/ocaml/hbugs/hbugs_client.mli
new file mode 100644
index 000000000..0c2e93d80
--- /dev/null
+++ b/helm/ocaml/hbugs/hbugs_client.mli
@@ -0,0 +1,33 @@
+
+open Hbugs_types
+
+exception Invalid_URL of string
+
+ (*
+ @param use_hint_callback is called when the user double click on a hint
+ (default: do nothing)
+ @param describe_hint_callback is called when the user click on a hint
+ (default: do nothing)
+ *)
+class hbugsClient :
+ ?use_hint_callback: (hint -> unit) ->
+ ?describe_hint_callback: (hint -> unit) ->
+ ?destroy_callback: (unit -> unit) ->
+ unit ->
+ object
+
+ method show : unit -> unit
+ method hide : unit -> unit
+
+ method setUseHintCallback : (hint -> unit) -> unit
+ method registerToBroker : unit -> unit
+ method unregisterFromBroker : unit -> unit
+ method subscribeAll : unit -> unit
+
+ method stateChange : state option -> unit
+
+ (** @return an hint by index *)
+ method hint : int -> hint
+
+ end
+
diff --git a/helm/ocaml/hbugs/hbugs_client_gui.glade b/helm/ocaml/hbugs/hbugs_client_gui.glade
new file mode 100644
index 000000000..f88a8c388
--- /dev/null
+++ b/helm/ocaml/hbugs/hbugs_client_gui.glade
@@ -0,0 +1,672 @@
+<?xml version="1.0" standalone="no"?> <!--*- mode: xml -*-->
+<!DOCTYPE glade-interface SYSTEM "http://glade.gnome.org/glade-2.0.dtd">
+
+<glade-interface>
+<requires lib="gnome"/>
+
+<widget class="GtkWindow" id="hbugsMainWindow">
+ <property name="title" translatable="yes">Hbugs: your personal proof trainer!</property>
+ <property name="type">GTK_WINDOW_TOPLEVEL</property>
+ <property name="window_position">GTK_WIN_POS_NONE</property>
+ <property name="modal">False</property>
+ <property name="resizable">True</property>
+ <property name="destroy_with_parent">False</property>
+
+ <child>
+ <widget class="GtkVBox" id="vbox1">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkMenuBar" id="menubar">
+
+ <child>
+ <widget class="GtkMenuItem" id="toolsMenu">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Tools</property>
+ <property name="use_underline">True</property>
+
+ <child>
+ <widget class="GtkMenu" id="toolsMenu_menu">
+ <property name="visible">True</property>
+
+ <child>
+ <widget class="GtkCheckMenuItem" id="toggleDebuggingMenuItem">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Debugging</property>
+ <property name="use_underline">True</property>
+ <property name="active">False</property>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkHBox" id="hbox4">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">2</property>
+
+ <child>
+ <widget class="GtkLabel" id="label11">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">My URL:</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_CENTER</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkEntry" id="clientUrlEntry">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Local HTTP daemon URL</property>
+ <property name="can_focus">True</property>
+ <property name="editable">False</property>
+ <property name="visibility">True</property>
+ <property name="max_length">0</property>
+ <property name="text" translatable="yes"></property>
+ <property name="has_frame">True</property>
+ <property name="invisible_char" translatable="yes">*</property>
+ <property name="activates_default">False</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="startLocalHttpDaemonButton">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">Start the local HTTP daemon listening on the specified URL</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">Start!</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="testLocalHttpDaemonButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">Test!</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkVBox" id="vbox4">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkHBox" id="hbox1">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">2</property>
+
+ <child>
+ <widget class="GtkLabel" id="label1">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Broker:</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_CENTER</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkEntry" id="brokerUrlEntry">
+ <property name="visible">True</property>
+ <property name="tooltip" translatable="yes">HBugs broker URL</property>
+ <property name="can_focus">True</property>
+ <property name="editable">False</property>
+ <property name="visibility">True</property>
+ <property name="max_length">0</property>
+ <property name="text" translatable="yes"></property>
+ <property name="has_frame">True</property>
+ <property name="invisible_char" translatable="yes">*</property>
+ <property name="activates_default">False</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="testBrokerButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">Test!</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkHBox" id="hbox2">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">2</property>
+
+ <child>
+ <widget class="GtkLabel" id="label2">
+ <property name="label" translatable="yes">Client ID:</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_CENTER</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="clientIdLabel">
+ <property name="label" translatable="yes"></property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="registerClientButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">(Re)Register</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkVPaned" id="vpaned1">
+ <property name="visible">True</property>
+ <property name="position">0</property>
+
+ <child>
+ <widget class="GtkFrame" id="frame3">
+ <property name="border_width">4</property>
+ <property name="visible">True</property>
+ <property name="label_xalign">0</property>
+ <property name="label_yalign">0.5</property>
+ <property name="shadow_type">GTK_SHADOW_ETCHED_IN</property>
+
+ <child>
+ <widget class="GtkHBox" id="hbox6">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">2</property>
+
+ <child>
+ <widget class="GtkScrolledWindow" id="scrolledwindow3">
+ <property name="visible">True</property>
+ <property name="hscrollbar_policy">GTK_POLICY_ALWAYS</property>
+ <property name="vscrollbar_policy">GTK_POLICY_ALWAYS</property>
+ <property name="shadow_type">GTK_SHADOW_IN</property>
+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>
+
+ <child>
+ <widget class="GtkTreeView" id="subscriptionCList">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="headers_visible">True</property>
+ <property name="rules_hint">False</property>
+ <property name="reorderable">False</property>
+ <property name="enable_search">True</property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkFixed" id="fixed1">
+ <property name="visible">True</property>
+
+ <child>
+ <widget class="GtkButton" id="showSubscriptionWindowButton">
+ <property name="width_request">0</property>
+ <property name="height_request">0</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">Subscribe ...</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ </widget>
+ <packing>
+ <property name="x">0</property>
+ <property name="y">0</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="label12">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Subscriptions</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ <packing>
+ <property name="type">label_item</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="shrink">False</property>
+ <property name="resize">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkFrame" id="frame2">
+ <property name="border_width">4</property>
+ <property name="visible">True</property>
+ <property name="label_xalign">0</property>
+ <property name="label_yalign">0.5</property>
+ <property name="shadow_type">GTK_SHADOW_ETCHED_IN</property>
+
+ <child>
+ <widget class="GtkVBox" id="vbox6">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkScrolledWindow" id="scrolledwindow2">
+ <property name="visible">True</property>
+ <property name="hscrollbar_policy">GTK_POLICY_ALWAYS</property>
+ <property name="vscrollbar_policy">GTK_POLICY_ALWAYS</property>
+ <property name="shadow_type">GTK_SHADOW_IN</property>
+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>
+
+ <child>
+ <widget class="GtkTreeView" id="hintsCList">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="headers_visible">True</property>
+ <property name="rules_hint">False</property>
+ <property name="reorderable">False</property>
+ <property name="enable_search">True</property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+
+ <child>
+ <widget class="GtkLabel" id="label13">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Hints</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ <packing>
+ <property name="type">label_item</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="shrink">True</property>
+ <property name="resize">True</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkStatusbar" id="mainWindowStatusBar">
+ <property name="has_resize_grip">True</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+</widget>
+
+<widget class="GtkWindow" id="subscribeWindow">
+ <property name="title" translatable="yes">Hbugs: subscribe ...</property>
+ <property name="type">GTK_WINDOW_TOPLEVEL</property>
+ <property name="window_position">GTK_WIN_POS_NONE</property>
+ <property name="modal">False</property>
+ <property name="resizable">True</property>
+ <property name="destroy_with_parent">False</property>
+
+ <child>
+ <widget class="GtkVBox" id="vbox8">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkButton" id="listTutorsButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">Refresh</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkScrolledWindow" id="scrolledwindow4">
+ <property name="visible">True</property>
+ <property name="hscrollbar_policy">GTK_POLICY_ALWAYS</property>
+ <property name="vscrollbar_policy">GTK_POLICY_ALWAYS</property>
+ <property name="shadow_type">GTK_SHADOW_IN</property>
+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>
+
+ <child>
+ <widget class="GtkTreeView" id="tutorsCList">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="headers_visible">True</property>
+ <property name="rules_hint">False</property>
+ <property name="reorderable">False</property>
+ <property name="enable_search">True</property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkHBox" id="hbox5">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child>
+ <widget class="GtkButton" id="subscribeButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">Subscribe to Selected</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkButton" id="subscribeAllButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">Subscribe to All</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkStatusbar" id="subscribeWindowStatusBar">
+ <property name="visible">True</property>
+ <property name="has_resize_grip">True</property>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+</widget>
+
+<widget class="GtkDialog" id="messageDialog">
+ <property name="title" translatable="yes">Message</property>
+ <property name="type">GTK_WINDOW_TOPLEVEL</property>
+ <property name="window_position">GTK_WIN_POS_NONE</property>
+ <property name="modal">True</property>
+ <property name="default_width">220</property>
+ <property name="default_height">150</property>
+ <property name="resizable">True</property>
+ <property name="destroy_with_parent">False</property>
+ <property name="has_separator">True</property>
+
+ <child internal-child="vbox">
+ <widget class="GtkVBox" id="dialogVbox1">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+
+ <child internal-child="action_area">
+ <widget class="GtkHButtonBox" id="dialogAction_area1">
+ <property name="visible">True</property>
+ <property name="layout_style">GTK_BUTTONBOX_END</property>
+
+ <child>
+ <widget class="GtkButton" id="okDialogButton">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="label" translatable="yes">OK</property>
+ <property name="use_underline">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <property name="response_id">0</property>
+ </widget>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="pack_type">GTK_PACK_END</property>
+ </packing>
+ </child>
+
+ <child>
+ <widget class="GtkTable" id="table1">
+ <property name="border_width">5</property>
+ <property name="visible">True</property>
+ <property name="n_rows">1</property>
+ <property name="n_columns">1</property>
+ <property name="homogeneous">False</property>
+ <property name="row_spacing">0</property>
+ <property name="column_spacing">0</property>
+
+ <child>
+ <widget class="GtkLabel" id="dialogLabel">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes"></property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_CENTER</property>
+ <property name="wrap">True</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </widget>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="right_attach">1</property>
+ <property name="top_attach">0</property>
+ <property name="bottom_attach">1</property>
+ </packing>
+ </child>
+ </widget>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </widget>
+ </child>
+</widget>
+
+</glade-interface>
diff --git a/helm/ocaml/hbugs/hbugs_common.ml b/helm/ocaml/hbugs/hbugs_common.ml
new file mode 100644
index 000000000..fe2ecfcae
--- /dev/null
+++ b/helm/ocaml/hbugs/hbugs_common.ml
@@ -0,0 +1,48 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Hbugs_types;;
+open Printf;;
+
+let rec string_of_hint = function
+ | Use_ring -> "Use Ring, Luke!"
+ | Use_fourier -> "Use Fourier, Luke!"
+ | Use_reflexivity -> "Use reflexivity, Luke!"
+ | Use_symmetry -> "Use symmetry, Luke!"
+ | Use_assumption -> "Use assumption, Luke!"
+ | Use_contradiction -> "Use contradiction, Luke!"
+ | Use_exists -> "Use exists, Luke!"
+ | Use_split -> "Use split, Luke!"
+ | Use_left -> "Use left, Luke!"
+ | Use_right -> "Use right, Luke!"
+ | Use_apply term -> sprintf "Apply %s, Luke!" term
+ | Hints hints -> String.concat "; " (List.map string_of_hint hints)
+;;
+
diff --git a/helm/ocaml/hbugs/hbugs_common.mli b/helm/ocaml/hbugs/hbugs_common.mli
new file mode 100644
index 000000000..2d51075f3
--- /dev/null
+++ b/helm/ocaml/hbugs/hbugs_common.mli
@@ -0,0 +1,32 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+open Hbugs_types;;
+
+val string_of_hint: hint -> string
+
diff --git a/helm/ocaml/hbugs/hbugs_id_generator.ml b/helm/ocaml/hbugs/hbugs_id_generator.ml
new file mode 100644
index 000000000..5b1998ac2
--- /dev/null
+++ b/helm/ocaml/hbugs/hbugs_id_generator.ml
@@ -0,0 +1,67 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let _ = Random.self_init ()
+
+let id_length = 32
+let min_ascii = 33
+let max_ascii = 126
+ (* characters forbidden inside an XML attribute value. Well, '>' and '''
+ aren't really forbidden, but are listed here ... just to be sure *)
+let forbidden_chars = (* i.e. [ '"'; '&'; '\''; '<'; '>' ] *)
+ [ 34; 38; 39; 60; 62 ] (* assumption: is sorted! *)
+let chars_range = max_ascii - min_ascii + 1 - (List.length forbidden_chars)
+
+ (* return a random id char c such that
+ (min_ascii <= Char.code c) &&
+ (Char.code c <= max_ascii) &&
+ (not (List.mem (Char.code c) forbidden_chars))
+ *)
+let random_id_char () =
+ let rec nth_char ascii shifts = function
+ | [] -> Char.chr (ascii + shifts)
+ | hd::tl when ascii + shifts < hd -> Char.chr (ascii + shifts)
+ | hd::tl (* when ascii + shifts >= hd *) -> nth_char ascii (shifts + 1) tl
+ in
+ nth_char (Random.int chars_range + min_ascii) 0 forbidden_chars
+
+ (* return a random id string which have length id_length *)
+let new_id () =
+ let str = String.create id_length in
+ for i = 0 to id_length - 1 do
+ String.set str i (random_id_char ())
+ done;
+ str
+
+let new_broker_id = new_id
+let new_client_id = new_id
+let new_musing_id = new_id
+let new_tutor_id = new_id
+
diff --git a/helm/ocaml/hbugs/hbugs_id_generator.mli b/helm/ocaml/hbugs/hbugs_id_generator.mli
new file mode 100644
index 000000000..dad0c9391
--- /dev/null
+++ b/helm/ocaml/hbugs/hbugs_id_generator.mli
@@ -0,0 +1,35 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+open Hbugs_types;;
+
+val new_broker_id: unit -> broker_id
+val new_client_id: unit -> client_id
+val new_musing_id: unit -> musing_id
+val new_tutor_id: unit -> tutor_id
+
diff --git a/helm/ocaml/hbugs/hbugs_messages.ml b/helm/ocaml/hbugs/hbugs_messages.ml
new file mode 100644
index 000000000..4767b2aee
--- /dev/null
+++ b/helm/ocaml/hbugs/hbugs_messages.ml
@@ -0,0 +1,368 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Hbugs_types;;
+open Printf;;
+open Pxp_document;;
+open Pxp_dtd;;
+open Pxp_types;;
+open Pxp_yacc;;
+
+let debug = 2;; (* 0 -> no debug
+ 1 -> waiting for an answer / answer received
+ 2 -> XML messages dumping
+ *)
+
+exception Attribute_not_found of string;;
+exception Empty_node;; (** found a node with no _element_ children *)
+exception No_element_found of string;;
+exception Parse_error of string * string;; (* parsing subject, reason *)
+exception Unexpected_message of message;;
+
+let is_xml_element n = match n#node_type with T_element _ -> true | _ -> false
+let get_attr node name =
+ try
+ (match node#attribute name with
+ | Value s -> s
+ | _ -> raise Not_found)
+ with Not_found -> raise (Attribute_not_found name)
+let assert_element n name =
+ match n#node_type with
+ | T_element n when n = name ->
+ ()
+ | _ -> raise (Parse_error ("", "Expected node: " ^ name))
+
+ (** given a string representation of a proof asistant state (e.g. the first
+ child of the XML root of a State_change or Start_musing message), build from
+ it an HBugs view of a proof assistant state *)
+let parse_state (root: ('a node extension as 'a) node) =
+ if (List.filter is_xml_element root#sub_nodes) = [] then
+ raise Empty_node;
+ let buf = Buffer.create 10240 in
+ let node_to_string (node: ('a node extension as 'a) node) =
+ Buffer.clear buf;
+ node#write (`Out_buffer buf) `Enc_utf8;
+ let res = Buffer.contents buf in
+ Buffer.clear buf;
+ res
+ in
+ let (goal_node, type_node, body_node) =
+ try
+ (find_element "CurrentGoal" root,
+ find_element "ConstantType" root,
+ find_element "CurrentProof" root)
+ with Not_found ->
+ raise (Parse_error ("", "Malformed HBugs status XML document"))
+ in
+ assert_element root "gTopLevelStatus";
+ assert_element goal_node "CurrentGoal";
+ assert_element type_node "ConstantType";
+ assert_element body_node "CurrentProof";
+ goal_node#write (`Out_buffer buf) `Enc_utf8;
+ let (type_string, body_string) =
+ (node_to_string type_node, node_to_string body_node)
+ in
+ let goal =
+ try
+ int_of_string (goal_node#data)
+ with Failure "int_of_string" ->
+ raise (Parse_error (goal_node#data, "can't parse goal"))
+ in
+ (type_string, body_string, goal)
+
+ (** parse an hint from an XML node, XML node should have type 'T_element _'
+ (the name is ignored), attributes on it are ignored *)
+let parse_hint node =
+ let rec parse_hint_node node =
+ match node#node_type with
+ | T_element "ring" -> Use_ring
+ | T_element "fourier" -> Use_fourier
+ | T_element "reflexivity" -> Use_reflexivity
+ | T_element "symmetry" -> Use_symmetry
+ | T_element "assumption" -> Use_assumption
+ | T_element "contradiction" -> Use_contradiction
+ | T_element "exists" -> Use_exists
+ | T_element "split" -> Use_split
+ | T_element "left" -> Use_left
+ | T_element "right" -> Use_right
+ | T_element "apply" -> Use_apply node#data
+ | T_element "hints" ->
+ Hints
+ (List.map parse_hint_node (List.filter is_xml_element node#sub_nodes))
+ | _ -> assert false (* CSC: should this assert false be a raise something? *)
+ in
+ match List.filter is_xml_element node#sub_nodes with
+ [node] -> parse_hint_node node
+ | _ -> assert false (* CSC: should this assert false be a raise something? *)
+
+let parse_hint_type n = n#data (* TODO parsare il possibile tipo di suggerimento *)
+let parse_tutor_dscs n =
+ List.map
+ (fun n -> (get_attr n "id", n#data))
+ (List.filter is_xml_element n#sub_nodes)
+let parse_tutor_ids node =
+ List.map
+ (fun n -> get_attr n "id") (List.filter is_xml_element node#sub_nodes)
+
+let tutors_sep = Pcre.regexp ",\\s*"
+
+let pxp_config = PxpHelmConf.pxp_config
+let msg_of_string' s =
+ let root = (* xml tree's root *)
+ parse_wfcontent_entity pxp_config (from_string s) PxpHelmConf.pxp_spec
+ in
+ match root#node_type with
+
+ (* general purpose *)
+ | T_element "help" -> Help
+ | T_element "usage" -> Usage root#data
+ | T_element "exception" -> Exception (get_attr root "name", root#data)
+
+ (* client -> broker *)
+ | T_element "register_client" ->
+ Register_client (get_attr root "id", get_attr root "url")
+ | T_element "unregister_client" -> Unregister_client (get_attr root "id")
+ | T_element "list_tutors" -> List_tutors (get_attr root "id")
+ | T_element "subscribe" ->
+ Subscribe (get_attr root "id", parse_tutor_ids root)
+ | T_element "state_change" ->
+ let state_node =
+ try
+ Some (find_element ~deeply:false "gTopLevelStatus" root)
+ with Not_found -> None
+ in
+ State_change
+ (get_attr root "id",
+ match state_node with
+ | Some n -> (try Some (parse_state n) with Empty_node -> None)
+ | None -> None)
+ | T_element "wow" -> Wow (get_attr root "id")
+
+ (* tutor -> broker *)
+ | T_element "register_tutor" ->
+ let hint_node = find_element "hint_type" root in
+ let dsc_node = find_element "description" root in
+ Register_tutor
+ (get_attr root "id", get_attr root "url",
+ parse_hint_type hint_node, dsc_node#data)
+ | T_element "unregister_tutor" -> Unregister_tutor (get_attr root "id")
+ | T_element "musing_started" ->
+ Musing_started (get_attr root "id", get_attr root "musing_id")
+ | T_element "musing_aborted" ->
+ Musing_started (get_attr root "id", get_attr root "musing_id")
+ | T_element "musing_completed" ->
+ let main_node =
+ try
+ find_element "eureka" root
+ with Not_found -> find_element "sorry" root
+ in
+ Musing_completed
+ (get_attr root "id", get_attr root "musing_id",
+ (match main_node#node_type with
+ | T_element "eureka" ->
+ Eureka (parse_hint main_node)
+ | T_element "sorry" -> Sorry
+ | _ -> assert false)) (* can't be there, see 'find_element' above *)
+
+ (* broker -> client *)
+ | T_element "client_registered" -> Client_registered (get_attr root "id")
+ | T_element "client_unregistered" -> Client_unregistered (get_attr root "id")
+ | T_element "tutor_list" ->
+ Tutor_list (get_attr root "id", parse_tutor_dscs root)
+ | T_element "subscribed" ->
+ Subscribed (get_attr root "id", parse_tutor_ids root)
+ | T_element "state_accepted" ->
+ State_accepted
+ (get_attr root "id",
+ List.map
+ (fun n -> get_attr n "id")
+ (List.filter is_xml_element (find_element "stopped" root)#sub_nodes),
+ List.map
+ (fun n -> get_attr n "id")
+ (List.filter is_xml_element (find_element "started" root)#sub_nodes))
+ | T_element "hint" -> Hint (get_attr root "id", parse_hint root)
+
+ (* broker -> tutor *)
+ | T_element "tutor_registered" -> Tutor_registered (get_attr root "id")
+ | T_element "tutor_unregistered" -> Tutor_unregistered (get_attr root "id")
+ | T_element "start_musing" ->
+ let state_node =
+ try
+ find_element ~deeply:false "gTopLevelStatus" root
+ with Not_found -> raise (No_element_found "gTopLevelStatus")
+ in
+ Start_musing (get_attr root "id", parse_state state_node)
+ | T_element "abort_musing" ->
+ Abort_musing (get_attr root "id", get_attr root "musing_id")
+ | T_element "thanks" -> Thanks (get_attr root "id", get_attr root "musing_id")
+ | T_element "too_late" ->
+ Too_late (get_attr root "id", get_attr root "musing_id")
+
+ | _ -> raise (No_element_found s)
+
+let msg_of_string s =
+ try
+ msg_of_string' s
+ with e -> raise (Parse_error (s, Printexc.to_string e))
+
+let pp_state = function
+ | Some (type_string, body_string, goal) ->
+ (* ASSUMPTION: type_string and body_string are well formed XML document
+ contents (i.e. they don't contain heading <?xml ... ?> declaration nor
+ DOCTYPE one *)
+ "<gTopLevelStatus>\n" ^
+ (sprintf "<CurrentGoal>%d</CurrentGoal>\n" goal) ^
+ type_string ^ "\n" ^
+ body_string ^ "\n" ^
+ "</gTopLevelStatus>\n"
+ | None -> "<gTopLevelStatus />\n"
+
+let rec pp_hint = function
+ | Use_ring -> sprintf "<ring />"
+ | Use_fourier -> sprintf "<fourier />"
+ | Use_reflexivity -> sprintf "<reflexivity />"
+ | Use_symmetry -> sprintf "<symmetry />"
+ | Use_assumption -> sprintf "<assumption />"
+ | Use_contradiction -> sprintf "<contradiction />"
+ | Use_exists -> sprintf "<exists />"
+ | Use_split -> sprintf "<split />"
+ | Use_left -> sprintf "<left />"
+ | Use_right -> sprintf "<right />"
+ | Use_apply term -> sprintf "<apply>%s</apply>" term
+ | Hints hints ->
+ sprintf "<hints>\n%s\n</hints>"
+ (String.concat "\n" (List.map pp_hint hints))
+
+let pp_hint_type s = s (* TODO pretty print hint_type *)
+let pp_tutor_dscs =
+ List.fold_left
+ (fun s (id, dsc) ->
+ sprintf "%s<tutor_dsc id=\"%s\">%s</tutor_dsc>" s id dsc)
+ ""
+let pp_tutor_ids =
+ List.fold_left (fun s id -> sprintf "%s<tutor id=\"%s\" />" s id) ""
+
+let string_of_msg = function
+ | Help -> "<help />"
+ | Usage usage_string -> sprintf "<usage>%s</usage>" usage_string
+ | Exception (name, value) ->
+ sprintf "<exception name=\"%s\">%s</exception>" name value
+ | Register_client (id, url) ->
+ sprintf "<register_client id=\"%s\" url=\"%s\" />" id url
+ | Unregister_client id -> sprintf "<unregister_client id=\"%s\" />" id
+ | List_tutors id -> sprintf "<list_tutors id=\"%s\" />" id
+ | Subscribe (id, tutor_ids) ->
+ sprintf "<subscribe id=\"%s\">%s</subscribe>"
+ id (pp_tutor_ids tutor_ids)
+ | State_change (id, state) ->
+ sprintf "<state_change id=\"%s\">%s</state_change>"
+ id (pp_state state)
+ | Wow id -> sprintf "<wow id=\"%s\" />" id
+ | Register_tutor (id, url, hint_type, dsc) ->
+ sprintf
+"<register_tutor id=\"%s\" url=\"%s\">
+<hint_type>%s</hint_type>
+<description>%s</description>
+</register_tutor>"
+ id url (pp_hint_type hint_type) dsc
+ | Unregister_tutor id -> sprintf "<unregister_tutor id=\"%s\" />" id
+ | Musing_started (id, musing_id) ->
+ sprintf "<musing_started id=\"%s\" musing_id=\"%s\" />" id musing_id
+ | Musing_aborted (id, musing_id) ->
+ sprintf "<musing_aborted id=\"%s\" musing_id=\"%s\" />" id musing_id
+ | Musing_completed (id, musing_id, result) ->
+ sprintf
+ "<musing_completed id=\"%s\" musing_id=\"%s\">%s</musing_completed>"
+ id musing_id
+ (match result with
+ | Sorry -> "<sorry />"
+ | Eureka hint -> sprintf "<eureka>%s</eureka>" (pp_hint hint))
+ | Client_registered id -> sprintf "<client_registered id=\"%s\" />" id
+ | Client_unregistered id -> sprintf "<client_unregistered id=\"%s\" />" id
+ | Tutor_list (id, tutor_dscs) ->
+ sprintf "<tutor_list id=\"%s\">%s</tutor_list>"
+ id (pp_tutor_dscs tutor_dscs)
+ | Subscribed (id, tutor_ids) ->
+ sprintf "<subscribed id=\"%s\">%s</subscribed>"
+ id (pp_tutor_ids tutor_ids)
+ | State_accepted (id, stop_ids, start_ids) ->
+ sprintf
+"<state_accepted id=\"%s\">
+<stopped>%s</stopped>
+<started>%s</started>
+</state_accepted>"
+ id
+ (String.concat ""
+ (List.map (fun id -> sprintf "<musing id=\"%s\" />" id) stop_ids))
+ (String.concat ""
+ (List.map (fun id -> sprintf "<musing id=\"%s\" />" id) start_ids))
+ | Hint (id, hint) -> sprintf "<hint id=\"%s\">%s</hint>" id (pp_hint hint)
+ | Tutor_registered id -> sprintf "<tutor_registered id=\"%s\" />" id
+ | Tutor_unregistered id -> sprintf "<tutor_unregistered id=\"%s\" />" id
+ | Start_musing (id, state) ->
+ sprintf "<start_musing id=\"%s\">%s</start_musing>"
+ id (pp_state (Some state))
+ | Abort_musing (id, musing_id) ->
+ sprintf "<abort_musing id=\"%s\" musing_id=\"%s\" />" id musing_id
+ | Thanks (id, musing_id) ->
+ sprintf "<thanks id=\"%s\" musing_id=\"%s\" />" id musing_id
+ | Too_late (id, musing_id) ->
+ sprintf "<too_late id=\"%s\" musing_id=\"%s\" />" id musing_id
+;;
+
+ (* debugging function that dump on stderr the sent messages *)
+let dump_msg msg =
+ if debug >= 2 then
+ prerr_endline
+ (sprintf "<SENDING_MESSAGE>\n%s\n</SENDING_MESSAGE>"
+ (match msg with
+ | State_change _ -> "<state_change>omissis ...</state_change>"
+ | msg -> string_of_msg msg))
+;;
+
+let submit_req ~url msg =
+ dump_msg msg;
+ if debug >= 1 then (prerr_string "Waiting for an answer ... "; flush stderr);
+ let res =
+ msg_of_string (Hbugs_misc.http_post ~body:(string_of_msg msg) url)
+ in
+ if debug >= 1 then (prerr_string "answer received!\n"; flush stderr);
+ res
+;;
+let return_xml_msg body outchan =
+ Http_daemon.respond ~headers:["Content-Type", "text/xml"] ~body outchan
+;;
+let respond_msg msg outchan =
+ dump_msg msg;
+ return_xml_msg (string_of_msg msg) outchan
+(* close_out outchan *)
+;;
+let respond_exc name value = respond_msg (Exception (name, value));;
+
diff --git a/helm/ocaml/hbugs/hbugs_messages.mli b/helm/ocaml/hbugs/hbugs_messages.mli
new file mode 100644
index 000000000..642c0b0e2
--- /dev/null
+++ b/helm/ocaml/hbugs/hbugs_messages.mli
@@ -0,0 +1,49 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+open Hbugs_types;;
+
+exception Parse_error of string * string (* parsing subject, reason *)
+exception Unexpected_message of message;;
+
+val msg_of_string: string -> message
+val string_of_msg: message -> string
+
+val submit_req: url:string -> message -> message
+ (** close outchan afterwards *)
+val respond_msg: message -> out_channel -> unit
+ (** close outchan afterwards *)
+ (* exception_name, exception_value, output_channel *)
+val respond_exc: string -> string -> out_channel -> unit
+
+(* TODO the below functions are for debugging only and shouldn't be exposed *)
+val parse_state:
+ ('a Pxp_document.node Pxp_document.extension as 'a) Pxp_document.node ->
+ (string * string * int)
+val pp_state: (string * string * int) option -> string
+
diff --git a/helm/ocaml/hbugs/hbugs_misc.ml b/helm/ocaml/hbugs/hbugs_misc.ml
new file mode 100644
index 000000000..32b8e8b46
--- /dev/null
+++ b/helm/ocaml/hbugs/hbugs_misc.ml
@@ -0,0 +1,122 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf;;
+
+let rec hashtbl_remove_all tbl key =
+ if Hashtbl.mem tbl key then begin
+ Hashtbl.remove tbl key;
+ hashtbl_remove_all tbl key
+ end else
+ ()
+
+ (** follows cut and paste from zack's Http_client_smart module *)
+
+exception Malformed_URL of string;;
+exception Malformed_HTTP_response of string;;
+
+let bufsiz = 16384;;
+let tcp_bufsiz = 4096;;
+
+let body_sep_RE = Pcre.regexp "\r\n\r\n";;
+let http_scheme_RE = Pcre.regexp ~flags:[`CASELESS] "^http://";;
+let url_RE = Pcre.regexp "^([\\w.]+)(:(\\d+))?(/.*)?$";;
+let parse_url url =
+ try
+ let subs =
+ Pcre.extract ~rex:url_RE (Pcre.replace ~rex:http_scheme_RE url)
+ in
+ (subs.(1),
+ (if subs.(2) = "" then 80 else int_of_string subs.(3)),
+ (if subs.(4) = "" then "/" else subs.(4)))
+ with exc -> raise (Malformed_URL url)
+;;
+let get_body answer =
+ match Pcre.split ~rex:body_sep_RE answer with
+ | [_; body] -> body
+ | _ -> raise (Malformed_HTTP_response answer)
+;;
+
+let init_socket addr port =
+ let inet_addr = (Unix.gethostbyname addr).Unix.h_addr_list.(0) in
+ let sockaddr = Unix.ADDR_INET (inet_addr, port) in
+ let suck = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+ Unix.connect suck sockaddr;
+ let outchan = Unix.out_channel_of_descr suck in
+ let inchan = Unix.in_channel_of_descr suck in
+ (inchan, outchan)
+;;
+let rec retrieve inchan buf =
+ Buffer.add_string buf (input_line inchan ^ "\n");
+ retrieve inchan buf
+;;
+
+let http_get_iter_buf ~callback url =
+ let (address, port, path) = parse_url url in
+ let buf = String.create tcp_bufsiz in
+ let (inchan, outchan) = init_socket address port in
+ output_string outchan (sprintf "GET %s\r\n" path);
+ flush outchan;
+ (try
+ while true do
+ match input inchan buf 0 tcp_bufsiz with
+ | 0 -> raise End_of_file
+ | bytes when bytes = tcp_bufsiz -> (* buffer full, no need to slice it *)
+ callback buf
+ | bytes when bytes < tcp_bufsiz -> (* buffer not full, slice it *)
+ callback (String.sub buf 0 bytes)
+ | _ -> (* ( bytes < 0 ) || ( bytes > tcp_bufsiz ) *)
+ assert false
+ done
+ with End_of_file -> ());
+ close_in inchan (* close also outchan, same fd *)
+;;
+
+let http_get url =
+ let buf = Buffer.create (tcp_bufsiz * 10) in
+ http_get_iter_buf (fun data -> Buffer.add_string buf data) url;
+ get_body (Buffer.contents buf)
+;;
+
+let http_post ?(body = "") url =
+ let (address, port, path) = parse_url url in
+ let (inchan, outchan) = init_socket address port in
+ output_string outchan (sprintf "POST %s HTTP/1.0\r\n" path);
+ output_string outchan (sprintf "Content-Length: %d\r\n" (String.length body));
+ output_string outchan "\r\n";
+ output_string outchan body;
+ flush outchan;
+ let buf = Buffer.create bufsiz in
+ (try
+ retrieve inchan buf
+ with End_of_file -> close_in inchan); (* close also outchan, same fd *)
+ get_body (Buffer.contents buf)
+;;
+
diff --git a/helm/ocaml/hbugs/hbugs_misc.mli b/helm/ocaml/hbugs/hbugs_misc.mli
new file mode 100644
index 000000000..b0ef59719
--- /dev/null
+++ b/helm/ocaml/hbugs/hbugs_misc.mli
@@ -0,0 +1,50 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+ (** helpers *)
+
+ (** remove all bindings of a given key from an hash table *)
+val hashtbl_remove_all: ('a, 'b) Hashtbl.t -> 'a -> unit
+
+ (** follows cut and paste from zack's Http_client_smart module *)
+
+ (** can't parse an HTTP url *)
+exception Malformed_URL of string
+ (** can't parse an HTTP response *)
+exception Malformed_HTTP_response of string
+
+ (** HTTP GET request for a given url, return http response's body *)
+val http_get: string -> string
+ (** HTTP POST request for a given url, return http response's body,
+ body argument, if specified, is sent as body along with request *)
+val http_post: ?body:string -> string -> string
+
+ (** perform an HTTP GET request and apply a given function on each
+ 'slice' of HTTP response read from server *)
+val http_get_iter_buf: callback:(string -> unit) -> string -> unit
+
diff --git a/helm/ocaml/hbugs/hbugs_tutors.ml b/helm/ocaml/hbugs/hbugs_tutors.ml
new file mode 100644
index 000000000..6a73e2cc2
--- /dev/null
+++ b/helm/ocaml/hbugs/hbugs_tutors.ml
@@ -0,0 +1,266 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Hbugs_types;;
+open Printf;;
+
+let broker_url = "localhost:49081/act";;
+let dump_environment_on_exit = false;;
+
+let init_tutor = Hbugs_id_generator.new_tutor_id;;
+
+ (** register a tutor to broker *)
+let register_to_broker id url hint_type dsc =
+ try
+ let res =
+ Hbugs_messages.submit_req
+ ~url:broker_url (Register_tutor (id, url, hint_type, dsc))
+ in
+ (match res with
+ | Tutor_registered id ->
+ prerr_endline (sprintf "Tutor registered, broker id: %s" id);
+ id
+ | unexpected_msg ->
+ raise (Hbugs_messages.Unexpected_message unexpected_msg))
+ with e ->
+ failwith (sprintf "Can't register tutor to broker: uncaught exception: %s"
+ (Printexc.to_string e))
+;;
+ (** unregister a tutor from the broker *)
+let unregister_from_broker id =
+ let res = Hbugs_messages.submit_req ~url:broker_url (Unregister_tutor id) in
+ match res with
+ | Tutor_unregistered _ -> prerr_endline "Tutor unregistered!"
+ | unexpected_msg ->
+ failwith
+ (sprintf "Can't unregister from broker, received unexpected msg: %s"
+ (Hbugs_messages.string_of_msg unexpected_msg))
+;;
+
+ (* typecheck a loaded proof *)
+ (* TODO this is a cut and paste from gTopLevel.ml *)
+let typecheck_loaded_proof metasenv bo ty =
+ let module T = CicTypeChecker in
+ ignore (
+ List.fold_left
+ (fun metasenv ((_,context,ty) as conj) ->
+ ignore (T.type_of_aux' metasenv context ty) ;
+ metasenv @ [conj]
+ ) [] metasenv) ;
+ ignore (T.type_of_aux' metasenv [] ty) ;
+ ignore (T.type_of_aux' metasenv [] bo)
+;;
+
+type xml_kind = Body | Type;;
+let mk_dtdname ~ask_dtd_to_the_getter dtd =
+ if ask_dtd_to_the_getter then
+ Helm_registry.get "getter.url" ^ "getdtd?uri=" ^ dtd
+ else
+ "http://mowgli.cs.unibo.it/dtd/" ^ dtd
+;;
+ (** this function must be the inverse function of GTopLevel.strip_xml_headings
+ *)
+let add_xml_headings ~kind s =
+ let dtdname = mk_dtdname ~ask_dtd_to_the_getter:true "cic.dtd" in
+ let root =
+ match kind with
+ | Body -> "CurrentProof"
+ | Type -> "ConstantType"
+ in
+ "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n\n" ^
+ "<!DOCTYPE " ^ root ^ " SYSTEM \""^ dtdname ^ "\">\n\n" ^
+ s
+;;
+
+let load_state (type_string, body_string, goal) =
+ prerr_endline "a0";
+ let ((tmp1, oc1), (tmp2, oc2)) =
+ (Filename.open_temp_file "" "", Filename.open_temp_file "" "")
+ in
+ prerr_endline "a1";
+ output_string oc1 (add_xml_headings ~kind:Type type_string);
+ output_string oc2 (add_xml_headings ~kind:Body body_string);
+ close_out oc1; close_out oc2;
+ prerr_endline (sprintf "Proof Type available in %s" tmp1);
+ prerr_endline (sprintf "Proof Body available in %s" tmp2);
+ let (proof, goal) =
+ prerr_endline "a2";
+ (match CicParser.obj_of_xml tmp1 (Some tmp2) with
+ | Cic.CurrentProof (_,metasenv,bo,ty,_) -> (* TODO il primo argomento e' una URI valida o e' casuale? *)
+ prerr_endline "a3";
+ let uri = UriManager.uri_of_string "cic:/foo.con" in
+ prerr_endline "a4";
+ typecheck_loaded_proof metasenv bo ty;
+ prerr_endline "a5";
+ ((uri, metasenv, bo, ty), goal)
+ | _ -> assert false)
+ in
+ prerr_endline "a6";
+ Sys.remove tmp1; Sys.remove tmp2;
+ (proof, goal)
+
+(* tutors creation stuff from now on *)
+
+module type HbugsTutor =
+ sig
+ val start: unit -> unit
+ end
+
+module type HbugsTutorDescription =
+ sig
+ val addr: string
+ val port: int
+ val tactic: ProofEngineTypes.tactic
+ val hint: hint
+ val hint_type: hint_type
+ val description: string
+ val environment_file: string
+ end
+
+module BuildTutor (Dsc: HbugsTutorDescription) : HbugsTutor =
+ struct
+ let broker_id = ref None
+ let my_own_id = init_tutor ()
+ let my_own_addr, my_own_port = Dsc.addr, Dsc.port
+ let my_own_url = sprintf "%s:%d" my_own_addr my_own_port
+
+ let is_authenticated id =
+ match !broker_id with
+ | None -> false
+ | Some broker_id -> id = broker_id
+
+ (* thread who do the dirty work *)
+ let slave (state, musing_id) =
+ prerr_endline (sprintf "Hi, I'm the slave for musing %s" musing_id);
+ let (proof, goal) = load_state state in
+ let success =
+ try
+ ignore (Dsc.tactic (proof, goal));
+ true
+ with e -> false
+ in
+ let answer =
+ Musing_completed
+ (my_own_id, musing_id, (if success then Eureka Dsc.hint else Sorry))
+ in
+ ignore (Hbugs_messages.submit_req ~url:broker_url answer);
+ prerr_endline
+ (sprintf "Bye, I've completed my duties (success = %b)" success)
+
+ let hbugs_callback =
+ (* hashtbl mapping musings ids to PID of threads doing the related (dirty)
+ work *)
+ let slaves = Hashtbl.create 17 in
+ let forbidden () =
+ prerr_endline "ignoring request from unauthorized broker";
+ Exception ("forbidden", "")
+ in
+ function (* _the_ callback *)
+ | Start_musing (broker_id, state) ->
+ if is_authenticated broker_id then begin
+ prerr_endline "received Start_musing";
+ let new_musing_id = Hbugs_id_generator.new_musing_id () in
+ prerr_endline
+ (sprintf "starting a new musing (id = %s)" new_musing_id);
+(* let slave_thread = Thread.create slave (state, new_musing_id) in *)
+ let slave_thread =
+ ExtThread.create slave (state, new_musing_id)
+ in
+ Hashtbl.add slaves new_musing_id slave_thread;
+ Musing_started (my_own_id, new_musing_id)
+ end else (* broker unauthorized *)
+ forbidden ();
+ | Abort_musing (broker_id, musing_id) ->
+ if is_authenticated broker_id then begin
+ (try (* kill thread responsible for "musing_id" *)
+ let slave_thread = Hashtbl.find slaves musing_id in
+ ExtThread.kill slave_thread;
+ Hashtbl.remove slaves musing_id
+ with
+ | ExtThread.Can_t_kill (_, reason) ->
+ prerr_endline (sprintf "Unable to kill slave: %s" reason)
+ | Not_found ->
+ prerr_endline (sprintf
+ "Can't find slave corresponding to musing %s, can't kill it"
+ musing_id));
+ Musing_aborted (my_own_id, musing_id)
+ end else (* broker unauthorized *)
+ forbidden ();
+ | unexpected_msg ->
+ Exception ("unexpected_msg",
+ Hbugs_messages.string_of_msg unexpected_msg)
+
+ let callback (req: Http_types.request) outchan =
+ try
+ let req_msg = Hbugs_messages.msg_of_string req#body in
+ let answer = hbugs_callback req_msg in
+ Http_daemon.respond ~body:(Hbugs_messages.string_of_msg answer) outchan
+ with Hbugs_messages.Parse_error (subj, reason) ->
+ Http_daemon.respond
+ ~body:(Hbugs_messages.string_of_msg
+ (Exception ("parse_error", reason)))
+ outchan
+
+ let restore_environment () =
+ let ic = open_in Dsc.environment_file in
+ prerr_endline "Restoring environment ...";
+ CicEnvironment.restore_from_channel
+ ~callback:(fun uri -> prerr_endline uri) ic;
+ prerr_endline "... done!";
+ close_in ic
+
+ let dump_environment () =
+ let oc = open_out Dsc.environment_file in
+ prerr_endline "Dumping environment ...";
+ CicEnvironment.dump_to_channel
+ ~callback:(fun uri -> prerr_endline uri) oc;
+ prerr_endline "... done!";
+ close_out oc
+
+ let main () =
+ try
+ Sys.catch_break true;
+ at_exit (fun () ->
+ if dump_environment_on_exit then
+ dump_environment ();
+ unregister_from_broker my_own_id);
+ broker_id :=
+ Some (register_to_broker
+ my_own_id my_own_url Dsc.hint_type Dsc.description);
+ if Sys.file_exists Dsc.environment_file then
+ restore_environment ();
+ Http_daemon.start'
+ ~addr:my_own_addr ~port:my_own_port ~mode:`Thread callback
+ with Sys.Break -> () (* exit nicely, invoking at_exit functions *)
+
+ let start = main
+
+ end
+
diff --git a/helm/ocaml/hbugs/hbugs_tutors.mli b/helm/ocaml/hbugs/hbugs_tutors.mli
new file mode 100644
index 000000000..43cd99cce
--- /dev/null
+++ b/helm/ocaml/hbugs/hbugs_tutors.mli
@@ -0,0 +1,60 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+open Hbugs_types;;
+
+val broker_url: string
+
+val register_to_broker:
+ tutor_id -> string -> hint_type -> string ->
+ broker_id
+val unregister_from_broker: tutor_id -> unit
+
+val init_tutor: unit -> tutor_id
+val load_state:
+ Hbugs_types.state ->
+ ProofEngineTypes.proof * ProofEngineTypes.goal
+
+module type HbugsTutor =
+ sig
+ val start: unit -> unit
+ end
+
+module type HbugsTutorDescription =
+ sig
+ val addr: string
+ val port: int
+ val tactic: ProofEngineTypes.tactic
+ val hint: hint
+ val hint_type: hint_type
+ val description: string
+ val environment_file: string
+ end
+
+module BuildTutor (Dsc: HbugsTutorDescription) : HbugsTutor
+
diff --git a/helm/ocaml/hbugs/hbugs_types.mli b/helm/ocaml/hbugs/hbugs_types.mli
new file mode 100644
index 000000000..e3067f2e9
--- /dev/null
+++ b/helm/ocaml/hbugs/hbugs_types.mli
@@ -0,0 +1,104 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+type broker_id = string
+type client_id = string
+type musing_id = string
+type tutor_id = string
+type tutor_dsc = tutor_id * string (* tutor id, tutor description *)
+
+type state = (* proof assitant's state: proof type, proof body, goal *)
+ string * string * int
+
+type hint =
+ (* tactics usage related hints *)
+ | Use_ring
+ | Use_fourier
+ | Use_reflexivity
+ | Use_symmetry
+ | Use_assumption
+ | Use_contradiction
+ | Use_exists
+ | Use_split
+ | Use_left
+ | Use_right
+ | Use_apply of string (* use apply tactic on embedded term *)
+ (* hints list *)
+ | Hints of hint list
+
+type hint_type = string (* TODO tipo di consiglio per l'utente *)
+
+type musing_result =
+ | Eureka of hint (* extra information, if any, parsed depending
+ on tutor's hint_type *)
+ | Sorry
+
+ (* for each message, first component is an ID that identify the sender *)
+type message =
+
+ (* general purpose *)
+ | Help (* help request *)
+ | Usage of string (* help response *) (* usage string *)
+ | Exception of string * string (* name, value *)
+
+ (* client -> broker *)
+ | Register_client of client_id * string (* client id, client url *)
+ | Unregister_client of client_id (* client id *)
+ | List_tutors of client_id (* client_id *)
+ | Subscribe of client_id * tutor_id list (* client id, tutor id list *)
+ | State_change of client_id * state option (* client_id, new state *)
+ | Wow of client_id (* client_id *)
+
+ (* tutor -> broker *)
+ | Register_tutor of tutor_id * string * hint_type * string
+ (* tutor id, tutor url, hint type,
+ tutor description *)
+ | Unregister_tutor of tutor_id (* tutor id *)
+ | Musing_started of tutor_id * musing_id (* tutor id, musing id *)
+ | Musing_aborted of tutor_id * musing_id (* tutor id, musing id *)
+ | Musing_completed of tutor_id * musing_id * musing_result
+ (* tutor id, musing id, result *)
+
+ (* broker -> client *)
+ | Client_registered of broker_id (* broker id *)
+ | Client_unregistered of broker_id (* broker id *)
+ | Tutor_list of broker_id * tutor_dsc list (* broker id, tutor list *)
+ | Subscribed of broker_id * tutor_id list (* broker id, tutor list *)
+ | State_accepted of broker_id * musing_id list * musing_id list
+ (* broker id, stopped musing ids,
+ started musing ids *)
+ | Hint of broker_id * hint (* broker id, hint *)
+
+ (* broker -> tutor *)
+ | Tutor_registered of broker_id (* broker id *)
+ | Tutor_unregistered of broker_id (* broker id *)
+ | Start_musing of broker_id * state (* broker id, state *)
+ | Abort_musing of broker_id * musing_id (* broker id, musing id *)
+ | Thanks of broker_id * musing_id (* broker id, musing id *)
+ | Too_late of broker_id * musing_id (* broker id, musing id *)
+
diff --git a/helm/ocaml/hbugs/scripts/brokerctl.sh b/helm/ocaml/hbugs/scripts/brokerctl.sh
new file mode 100755
index 000000000..3da998d6c
--- /dev/null
+++ b/helm/ocaml/hbugs/scripts/brokerctl.sh
@@ -0,0 +1,15 @@
+#!/bin/sh
+daemon="broker"
+if [ "$1" = "--help" -o "$1" = "" ]; then
+ echo "ctl.sh { start | stop | --help }"
+ exit 0
+fi
+if [ "$1" = "start" ]; then
+ echo -n "Starting HBugs broker ... "
+ ./$daemon &> run/$daemon.log &
+ echo "done!"
+elif [ "$1" = "stop" ]; then
+ echo -n "Stopping HBugs broker ... "
+ killall -9 $daemon
+ echo "done!"
+fi
diff --git a/helm/ocaml/hbugs/scripts/build_tutors.ml b/helm/ocaml/hbugs/scripts/build_tutors.ml
new file mode 100755
index 000000000..9b742d84d
--- /dev/null
+++ b/helm/ocaml/hbugs/scripts/build_tutors.ml
@@ -0,0 +1,112 @@
+#!/usr/bin/ocamlrun /usr/bin/ocaml
+(*
+ * Copyright (C) 2003-2004:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+#use "topfind"
+#require "pcre"
+#require "pxp"
+open Printf
+open Pxp_document
+open Pxp_dtd
+open Pxp_types
+open Pxp_yacc
+
+let index = "data/tutors_index.xml"
+let template = "data/hbugs_tutor.TPL.ml"
+
+ (* apply a set of regexp substitutions specified as a list of pairs
+ <pattern,template> to a string *)
+let rec apply_subst ~fill s =
+ match fill with
+ | [] -> s
+ | (pat, templ)::rest ->
+ apply_subst ~fill:rest (Pcre.replace ~pat ~templ s)
+ (* fill a ~template file with substitutions specified in ~fill (see
+ apply_subst) and save output to ~output *)
+let fill_template ~template ~fill ~output =
+ printf "Creating %s ... " output; flush stdout;
+ let (ic, oc) = (open_in template, open_out output) in
+ let rec fill_template' () =
+ output_string oc ((apply_subst ~fill (input_line ic)) ^ "\n");
+ fill_template' ()
+ in
+ try
+ output_string oc (sprintf
+"(*
+ THIS CODE IS GENERATED - DO NOT MODIFY!
+
+ the source of this code is template \"%s\"
+ the template was filled with data read from \"%s\"
+*)\n"
+ template index);
+ fill_template' ()
+ with End_of_file ->
+ close_in ic;
+ close_out oc;
+ printf "done!\n"; flush stdout
+let parse_xml fname =
+ parse_wfdocument_entity default_config (from_file fname) default_spec
+let is_tutor node =
+ match node#node_type with T_element "tutor" -> true | _ -> false
+let is_element node =
+ match node#node_type with T_element _ -> true | _ -> false
+let main () =
+ (parse_xml index)#root#iter_nodes
+ (fun node ->
+ try
+ (match node with
+ | node when is_tutor node ->
+ (try (* skip hand-written tutors *)
+ ignore (find_element "no_auto" node);
+ raise Exit
+ with Not_found -> ());
+ let output =
+ try
+ (match node#attribute "source" with
+ | Value s -> s
+ | _ -> assert false)
+ with Not_found -> assert false
+ in
+ let fill =
+ List.map (* create substitution list from index data *)
+ (fun node ->
+ let name = (* node name *)
+ (match node#node_type with
+ | T_element s -> s
+ | _ -> assert false)
+ in
+ let value = node#data in (* node value *)
+ (sprintf "@%s@" (String.uppercase name), (* pattern *)
+ value)) (* substitution *)
+ (List.filter is_element node#sub_nodes)
+ in
+ fill_template ~fill ~template ~output
+ | _ -> ())
+ with Exit -> ())
+
+let _ = main ()
+
diff --git a/helm/ocaml/hbugs/scripts/ls_tutors.ml b/helm/ocaml/hbugs/scripts/ls_tutors.ml
new file mode 100755
index 000000000..5fe796ca1
--- /dev/null
+++ b/helm/ocaml/hbugs/scripts/ls_tutors.ml
@@ -0,0 +1,68 @@
+#!/usr/bin/ocamlrun /usr/bin/ocaml
+(*
+ * Copyright (C) 2003-2004:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* Usage: ls_tutors.ml # lists all tutors
+ * ls_tutors.ml -auto # lists only generated tutors
+ *)
+
+#use "topfind"
+#require "pxp"
+open Printf
+open Pxp_document
+open Pxp_dtd
+open Pxp_types
+open Pxp_yacc
+
+let index = "data/tutors_index.xml"
+let auto_only =
+ try
+ (match Sys.argv.(1) with "-auto" -> true | _ -> false)
+ with Invalid_argument _ -> false
+let parse_xml fname =
+ parse_wfdocument_entity default_config (from_file fname) default_spec
+let is_tutor node =
+ match node#node_type with T_element "tutor" -> true | _ -> false
+let main () =
+ List.iter
+ (fun tutor ->
+ try
+ (match tutor#attribute "source" with
+ | Value s ->
+ if not auto_only then
+ print_endline s
+ else (* we should print only generated tutors *)
+ (try
+ ignore (find_element "no_auto" tutor);
+ with Not_found ->
+ print_endline s)
+ | _ -> assert false)
+ with Not_found -> assert false)
+ (List.filter is_tutor (parse_xml index)#root#sub_nodes)
+let _ = main ()
+
diff --git a/helm/ocaml/hbugs/scripts/sabba.sh b/helm/ocaml/hbugs/scripts/sabba.sh
new file mode 100755
index 000000000..2031e295f
--- /dev/null
+++ b/helm/ocaml/hbugs/scripts/sabba.sh
@@ -0,0 +1,47 @@
+#!/bin/sh
+# Copyright (C) 2003:
+# Stefano Zacchiroli <zack@cs.unibo.it>
+# for the HELM Team http://helm.cs.unibo.it/
+#
+# This file is part of HELM, an Hypertextual, Electronic
+# Library of Mathematics, developed at the Computer Science
+# Department, University of Bologna, Italy.
+#
+# HELM 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 2
+# of the License, or (at your option) any later version.
+#
+# HELM 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 HELM; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+# MA 02111-1307, USA.
+#
+# For details, see the HELM World-Wide-Web page,
+# http://helm.cs.unibo.it/
+if [ "$1" = "--help" -o "$1" = "" ]; then
+ echo "sabba.sh { start | stop | --help }"
+ exit 0
+fi
+
+./scripts/ls_tutors.ml |
+while read line; do
+ tutor=`echo $line | sed 's/\.ml//'`
+ if [ "$1" = "stop" ]; then
+ echo -n "Stopping HBugs tutor $tutor ... "
+ killall -9 $tutor
+ echo "done!"
+ elif [ "$1" = "start" ]; then
+ echo -n "Starting HBugs tutor $tutor ... "
+ nice -n 19 ./$tutor &> run/$tutor.log &
+ echo "done!"
+ else
+ echo "Uh? Try --help"
+ exit 1
+ fi
+done
diff --git a/helm/ocaml/hbugs/search_pattern_apply_tutor.ml b/helm/ocaml/hbugs/search_pattern_apply_tutor.ml
new file mode 100644
index 000000000..79c94beed
--- /dev/null
+++ b/helm/ocaml/hbugs/search_pattern_apply_tutor.ml
@@ -0,0 +1,147 @@
+(* $Id$ *)
+
+open Hbugs_types;;
+open Printf;;
+
+exception Empty_must;;
+
+module MQI = MQueryInterpreter
+module MQIC = MQIConn
+
+let broker_id = ref None
+let my_own_id = Hbugs_tutors.init_tutor ()
+let my_own_addr, my_own_port = "127.0.0.1", 50011
+let my_own_url = sprintf "%s:%d" my_own_addr my_own_port
+let environment_file = "search_pattern_apply.environment"
+let dump_environment_on_exit = false
+
+let is_authenticated id =
+ match !broker_id with
+ | None -> false
+ | Some broker_id -> id = broker_id
+
+ (* thread who do the dirty work *)
+let slave mqi_handle (state, musing_id) =
+ try
+ prerr_endline (sprintf "Hi, I'm the slave for musing %s" musing_id);
+ let (proof, goal) = Hbugs_tutors.load_state state in
+ let hint =
+ try
+ let choose_must must only = (* euristic: use 2nd precision level
+ 1st is more precise but is more slow *)
+ match must with
+ | [] -> raise Empty_must
+ | _::hd::tl -> hd
+ | hd::tl -> hd
+ in
+ let uris =
+ TacticChaser.matchConclusion mqi_handle
+ ~output_html:prerr_endline ~choose_must () ~status:(proof, goal)
+ in
+ if uris = [] then
+ Sorry
+ else
+ Eureka (Hints (List.map (fun uri -> Use_apply uri) uris))
+ with Empty_must -> Sorry
+ in
+ let answer = Musing_completed (my_own_id, musing_id, hint) in
+ ignore (Hbugs_messages.submit_req ~url:Hbugs_tutors.broker_url answer);
+ prerr_endline
+ (sprintf "Bye, I've completed my duties (success = %b)" (hint <> Sorry))
+ with
+ (Pxp_types.At _) as e ->
+ let rec unbox_exception =
+ function
+ Pxp_types.At (_,e) -> unbox_exception e
+ | e -> e
+ in
+ prerr_endline ("Uncaught PXP exception: " ^ Pxp_types.string_of_exn e) ;
+ (* e could be the Thread.exit exception; otherwise we will release an *)
+ (* uncaught exception and the Pxp_types.At was already an uncaught *)
+ (* exception ==> no additional arm *)
+ raise (unbox_exception e)
+
+let hbugs_callback mqi_handle =
+ let ids = Hashtbl.create 17 in
+ let forbidden () =
+ prerr_endline "ignoring request from unauthorized broker";
+ Exception ("forbidden", "")
+ in
+ function
+ | Start_musing (broker_id, state) ->
+ if is_authenticated broker_id then begin
+ prerr_endline "received Start_musing";
+ let new_musing_id = Hbugs_id_generator.new_musing_id () in
+ let id = ExtThread.create (slave mqi_handle) (state, new_musing_id) in
+ prerr_endline (sprintf "starting a new musing (id = %s)" new_musing_id);
+ Hashtbl.add ids new_musing_id id;
+ (*ignore (Thread.create slave (state, new_musing_id));*)
+ Musing_started (my_own_id, new_musing_id)
+ end else (* broker unauthorized *)
+ forbidden ();
+ | Abort_musing (broker_id, musing_id) ->
+ prerr_endline "CSC: Abort_musing received" ;
+ if is_authenticated broker_id then begin
+ (* prerr_endline "Ignoring 'Abort_musing' message ..."; *)
+ (try
+ ExtThread.kill (Hashtbl.find ids musing_id) ;
+ Hashtbl.remove ids musing_id ;
+ with
+ Not_found
+ | ExtThread.Can_t_kill _ ->
+ prerr_endline ("Can not kill slave " ^ musing_id)) ;
+ Musing_aborted (my_own_id, musing_id)
+ end else (* broker unauthorized *)
+ forbidden ();
+ | unexpected_msg ->
+ Exception ("unexpected_msg",
+ Hbugs_messages.string_of_msg unexpected_msg)
+
+let callback mqi_handle (req: Http_types.request) outchan =
+ try
+ let req_msg = Hbugs_messages.msg_of_string req#body in
+ let answer = hbugs_callback mqi_handle req_msg in
+ Http_daemon.respond ~body:(Hbugs_messages.string_of_msg answer) outchan
+ with Hbugs_messages.Parse_error (subj, reason) ->
+ Http_daemon.respond
+ ~body:(Hbugs_messages.string_of_msg
+ (Exception ("parse_error", reason)))
+ outchan
+
+let restore_environment () =
+ let ic = open_in environment_file in
+ prerr_endline "Restoring environment ...";
+ CicEnvironment.restore_from_channel
+ ~callback:(fun uri -> prerr_endline uri) ic;
+ prerr_endline "... done!";
+ close_in ic
+
+let dump_environment () =
+ let oc = open_out environment_file in
+ prerr_endline "Dumping environment ...";
+ CicEnvironment.dump_to_channel
+ ~callback:(fun uri -> prerr_endline uri) oc;
+ prerr_endline "... done!";
+ close_out oc
+
+let main () =
+ try
+ Sys.catch_break true;
+ at_exit (fun () ->
+ if dump_environment_on_exit then
+ dump_environment ();
+ Hbugs_tutors.unregister_from_broker my_own_id);
+ broker_id :=
+ Some (Hbugs_tutors.register_to_broker
+ my_own_id my_own_url "FOO" "Search_pattern_apply tutor");
+ let mqi_handle = MQIC.init ~log:prerr_string () in
+ if Sys.file_exists environment_file then
+ restore_environment ();
+ Http_daemon.start'
+ ~addr:my_own_addr ~port:my_own_port ~mode:`Thread (callback mqi_handle);
+ MQIC.close mqi_handle
+ with Sys.Break -> () (* exit nicely, invoking at_exit functions *)
+;;
+
+main ()
+
diff --git a/helm/ocaml/hbugs/test/HBUGS_MESSAGES.xml b/helm/ocaml/hbugs/test/HBUGS_MESSAGES.xml
new file mode 100644
index 000000000..cf15dde3d
--- /dev/null
+++ b/helm/ocaml/hbugs/test/HBUGS_MESSAGES.xml
@@ -0,0 +1,144 @@
+<test>
+
+ <!-- general purpose -->
+
+ <help />
+
+ <usage>usage string</usage>
+
+ <exception name='eccezione1'>corpo dell'exc</exception>
+
+ <!-- client -> broker -->
+
+ <register_client id='client_id' url='client_url' />
+
+ <unregister_client id='client_id' />
+
+ <list_tutors id='client_id' />
+
+ <subscribe id='client_id'>
+ <tutor id='tutor_id1' />
+ <tutor id='tutor_id2' />
+ <!-- .... -->
+ <tutor id='tutor_idN' />
+ </subscribe>
+
+ <state_change id='client_id'> <!-- new state received -->
+ <gTopLevelStatus>
+ <CurrentGoal>0</CurrentGoal>
+ <ConstantType>
+ </ConstantType>
+ <CurrentProof>
+ </CurrentProof>
+ </gTopLevelStatus>
+ </state_change>
+
+ <state_change id='client_id'> <!-- no state received: proof is completed -->
+ <gTopLevelStatus />
+ </state_change>
+
+ <wow id="client_id" />
+
+ <!-- tutor -> broker -->
+
+ <register_tutor id='tutor_id' url='tutor_url'>
+ <hint_type>
+ <!-- HINT TYPE -->
+ </hint_type>
+ <description>
+ descrizione del tutor
+ </description>
+ </register_tutor>
+
+ <unregister_tutor id='tutor_id' />
+
+ <musing_started id='tutor_id' musing_id='musing_id' />
+
+ <musing_aborted id='tutor_id' musing_id='musing_id' />
+
+ <musing_completed id='tutor_id' musing_id='musing_id'>
+ <sorry />
+ </musing_completed>
+
+ <musing_completed id='tutor_id' musing_id='musing_id'>
+ <eureka>
+ <ring />
+ </eureka>
+ </musing_completed>
+
+ <musing_completed id='tutor_id' musing_id='musing_id'>
+ <eureka>
+ <hints>
+ <ring />
+ <fourier />
+ </hints>
+ </eureka>
+ </musing_completed>
+
+ <!-- broker -> client -->
+
+ <client_registered id='broker_id' />
+
+ <client_unregistered id='broker_id' />
+
+ <tutor_list id='broker_id'>
+ <tutor_dsc id='tutor_id1'> description 1 </tutor_dsc>
+ <tutor_dsc id='tutor_id2'> description 2 </tutor_dsc>
+ <!-- ... -->
+ <tutor_dsc id='tutor_idN'> description N </tutor_dsc>
+ </tutor_list>
+
+ <subscribed id='broker_id'>
+ <tutor_dsc id='tutor_id1'> description 1 </tutor_dsc>
+ <tutor_dsc id='tutor_id2'> description 2 </tutor_dsc>
+ <!-- ... -->
+ <tutor_dsc id='tutor_idN'> description N </tutor_dsc>
+ </subscribed>
+
+ <state_accepted id='broker_id'>
+ <stopped>
+ <musing id='musing_id1' />
+ <!-- ... -->
+ <musing id='musing_idN' />
+ </stopped>
+ <started>
+ <musing id='musing_id1' />
+ <!-- ... -->
+ <musing id='musing_idM' />
+ </started>
+ </state_accepted>
+
+ <hint id='broker_id'>
+ <ring />
+ </hint>
+
+ <hint id='broker_id'>
+ <hints>
+ <ring />
+ <fourier />
+ </hints>
+ </hint>
+
+ <!-- broker -> tutor -->
+
+ <tutor_registered id='broker_id' />
+
+ <tutor_unregistered id='broker_id' />
+
+ <start_musing id='broker_id'>
+ <gTopLevelStatus>
+ <CurrentGoal>0</CurrentGoal>
+ <ConstantType>
+ </ConstantType>
+ <CurrentProof>
+ </CurrentProof>
+ </gTopLevelStatus>
+ </start_musing>
+
+ <abort_musing id='broker_id' musing_id='musing_id' />
+
+ <thanks id='broker_id' musing_id='musing_id' />
+
+ <too_late id='broker_id' musing_id='musing_id' />
+
+</test>
diff --git a/helm/ocaml/hbugs/test/Makefile b/helm/ocaml/hbugs/test/Makefile
new file mode 100644
index 000000000..0b3debf74
--- /dev/null
+++ b/helm/ocaml/hbugs/test/Makefile
@@ -0,0 +1,5 @@
+all: test_serialization
+test_serialization: test_serialization.ml
+ OCAMLPATH="../meta" ocamlfind ocamlc -linkpkg -package hbugs-common -o test_serialization test_serialization.ml
+clean:
+ rm -f *.cm[io] test_serialization
diff --git a/helm/ocaml/hbugs/test/test_serialization.ml b/helm/ocaml/hbugs/test/test_serialization.ml
new file mode 100644
index 000000000..1afd74379
--- /dev/null
+++ b/helm/ocaml/hbugs/test/test_serialization.ml
@@ -0,0 +1,70 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+open Pxp_document;;
+open Pxp_dtd;;
+open Pxp_types;;
+open Pxp_yacc;;
+
+open Printf;;
+
+let test_data = "HBUGS_MESSAGES.xml" ;;
+
+let test_message (n:('a Pxp_document.extension as 'b) Pxp_document.node as 'a) =
+ try
+ let msg_string =
+ let buf = Buffer.create 1000 in
+ n#write (`Out_buffer buf) `Enc_utf8;
+ Buffer.contents buf
+ in
+ let msg = Hbugs_messages.msg_of_string msg_string in
+ let pp = Hbugs_messages.string_of_msg msg in
+ let msg' = Hbugs_messages.msg_of_string pp in
+ if (msg <> msg') then
+ prerr_endline
+ (sprintf "Failure with msg %s"
+ (match n#node_type with T_element name -> name | _ -> assert false))
+ with e ->
+ prerr_endline
+ (sprintf "Failure with msg %s: uncaught exception %s"
+ (match n#node_type with T_element name -> name | _ -> assert false)
+ (Printexc.to_string e))
+;;
+
+let is_xml_element n =
+ match n#node_type with T_element _ -> true | _ -> false
+;;
+
+let root =
+ parse_wfcontent_entity default_config (from_file test_data) default_spec
+in
+printf "Testing all messages from %s ...\n" test_data; flush stdout;
+List.iter test_message (List.filter is_xml_element root#sub_nodes);
+printf "Done!\n"
+;;
+
diff --git a/helm/ocaml/hgdome/.depend b/helm/ocaml/hgdome/.depend
new file mode 100644
index 000000000..bf9c09af7
--- /dev/null
+++ b/helm/ocaml/hgdome/.depend
@@ -0,0 +1,4 @@
+domMisc.cmo: domMisc.cmi
+domMisc.cmx: domMisc.cmi
+xml2Gdome.cmo: xml2Gdome.cmi
+xml2Gdome.cmx: xml2Gdome.cmi
diff --git a/helm/ocaml/hgdome/Makefile b/helm/ocaml/hgdome/Makefile
new file mode 100644
index 000000000..a7bb4dbb6
--- /dev/null
+++ b/helm/ocaml/hgdome/Makefile
@@ -0,0 +1,11 @@
+PACKAGE = hgdome
+
+# modules which have both a .ml and a .mli
+INTERFACE_FILES = \
+ domMisc.mli \
+ xml2Gdome.mli \
+ $(NULL)
+
+IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml)
+
+include ../Makefile.common
diff --git a/helm/ocaml/hgdome/domMisc.ml b/helm/ocaml/hgdome/domMisc.ml
new file mode 100644
index 000000000..97a15b7f8
--- /dev/null
+++ b/helm/ocaml/hgdome/domMisc.ml
@@ -0,0 +1,43 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(******************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Claudio Sacerdoti Coen <sacerdot@cs.unibo.it> *)
+(* 06/01/2002 *)
+(* *)
+(* *)
+(******************************************************************************)
+
+(* $Id$ *)
+
+let domImpl = Gdome.domImplementation ()
+let helm_ns = Gdome.domString "http://www.cs.unibo.it/helm"
+let xlink_ns = Gdome.domString "http://www.w3.org/1999/xlink"
+let mathml_ns = Gdome.domString "http://www.w3.org/1998/Math/MathML"
+let boxml_ns = Gdome.domString "http://helm.cs.unibo.it/2003/BoxML"
+
diff --git a/helm/ocaml/hgdome/domMisc.mli b/helm/ocaml/hgdome/domMisc.mli
new file mode 100644
index 000000000..25d642bc5
--- /dev/null
+++ b/helm/ocaml/hgdome/domMisc.mli
@@ -0,0 +1,42 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(******************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Claudio Sacerdoti Coen <sacerdot@cs.unibo.it> *)
+(* 15/01/2003 *)
+(* *)
+(* *)
+(******************************************************************************)
+
+val domImpl : Gdome.domImplementation
+
+val helm_ns : Gdome.domString (** HELM namespace *)
+val xlink_ns : Gdome.domString (** XLink namespace *)
+val mathml_ns : Gdome.domString (** MathML namespace *)
+val boxml_ns : Gdome.domString (** BoxML namespace *)
+
diff --git a/helm/ocaml/hgdome/xml2Gdome.ml b/helm/ocaml/hgdome/xml2Gdome.ml
new file mode 100644
index 000000000..eb6a7641c
--- /dev/null
+++ b/helm/ocaml/hgdome/xml2Gdome.ml
@@ -0,0 +1,135 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+let document_of_xml (domImplementation : Gdome.domImplementation) strm =
+ let module G = Gdome in
+ let module X = Xml in
+ let rec update_namespaces ((defaultns,bindings) as namespaces) =
+ function
+ [] -> namespaces
+ | (None,"xmlns",value)::tl ->
+ update_namespaces (Some (Gdome.domString value),bindings) tl
+ | (prefix,name,value)::tl when prefix = Some "xmlns" ->
+ update_namespaces (defaultns,(name,Gdome.domString value)::bindings) tl
+ | _::tl -> update_namespaces namespaces tl in
+ let rec namespace_of_prefix (defaultns,bindings) =
+ function
+ None -> None
+ | Some "xmlns" -> Some (Gdome.domString "xml-ns")
+ | Some p' ->
+ try
+ Some (List.assoc p' bindings)
+ with
+ Not_found ->
+ raise
+ (Failure ("The prefix " ^ p' ^ " is not bound to any namespace")) in
+ let get_qualified_name p n =
+ match p with
+ None -> Gdome.domString n
+ | Some p' -> Gdome.domString (p' ^ ":" ^ n) in
+ let root_prefix,root_name,root_attributes,root_content =
+ ignore (Stream.next strm) ; (* to skip the <?xml ...?> declaration *)
+ ignore (Stream.next strm) ; (* to skip the DOCTYPE declaration *)
+ match Stream.next strm with
+ X.Empty(p,n,l) -> p,n,l,[<>]
+ | X.NEmpty(p,n,l,c) -> p,n,l,c
+ | _ -> assert false
+ in
+ let namespaces = update_namespaces (None,[]) root_attributes in
+ let namespaceURI = namespace_of_prefix namespaces root_prefix in
+ let document =
+ domImplementation#createDocument ~namespaceURI
+ ~qualifiedName:(get_qualified_name root_prefix root_name)
+ ~doctype:None
+ in
+ let rec aux namespaces (node : Gdome.node) =
+ parser
+ [< 'X.Str a ; s >] ->
+ let textnode = document#createTextNode ~data:(Gdome.domString a) in
+ ignore (node#appendChild ~newChild:(textnode :> Gdome.node)) ;
+ aux namespaces node s
+ | [< 'X.Empty(p,n,l) ; s >] ->
+ let namespaces' = update_namespaces namespaces l in
+ let namespaceURI = namespace_of_prefix namespaces' p in
+ let element =
+ document#createElementNS ~namespaceURI
+ ~qualifiedName:(get_qualified_name p n)
+ in
+ List.iter
+ (function (p,n,v) ->
+ if p = None then
+ element#setAttribute ~name:(Gdome.domString n)
+ ~value:(Gdome.domString v)
+ else
+ let namespaceURI = namespace_of_prefix namespaces' p in
+ element#setAttributeNS
+ ~namespaceURI
+ ~qualifiedName:(get_qualified_name p n)
+ ~value:(Gdome.domString v)
+ ) l ;
+ ignore
+ (node#appendChild
+ ~newChild:(element : Gdome.element :> Gdome.node)) ;
+ aux namespaces node s
+ | [< 'X.NEmpty(p,n,l,c) ; s >] ->
+ let namespaces' = update_namespaces namespaces l in
+ let namespaceURI = namespace_of_prefix namespaces' p in
+ let element =
+ document#createElementNS ~namespaceURI
+ ~qualifiedName:(get_qualified_name p n)
+ in
+ List.iter
+ (function (p,n,v) ->
+ if p = None then
+ element#setAttribute ~name:(Gdome.domString n)
+ ~value:(Gdome.domString v)
+ else
+ let namespaceURI = namespace_of_prefix namespaces' p in
+ element#setAttributeNS ~namespaceURI
+ ~qualifiedName:(get_qualified_name p n)
+ ~value:(Gdome.domString v)
+ ) l ;
+ ignore (node#appendChild ~newChild:(element :> Gdome.node)) ;
+ aux namespaces' (element :> Gdome.node) c ;
+ aux namespaces node s
+ | [< >] -> ()
+ in
+ let root = document#get_documentElement in
+ List.iter
+ (function (p,n,v) ->
+ if p = None then
+ root#setAttribute ~name:(Gdome.domString n)
+ ~value:(Gdome.domString v)
+ else
+ let namespaceURI = namespace_of_prefix namespaces p in
+ root#setAttributeNS ~namespaceURI
+ ~qualifiedName:(get_qualified_name p n)
+ ~value:(Gdome.domString v)
+ ) root_attributes ;
+ aux namespaces (root : Gdome.element :> Gdome.node) root_content ;
+ document
+;;
diff --git a/helm/ocaml/hgdome/xml2Gdome.mli b/helm/ocaml/hgdome/xml2Gdome.mli
new file mode 100644
index 000000000..45d0e9532
--- /dev/null
+++ b/helm/ocaml/hgdome/xml2Gdome.mli
@@ -0,0 +1,27 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val document_of_xml :
+ Gdome.domImplementation -> Xml.token Stream.t -> Gdome.document
diff --git a/helm/ocaml/hmysql/.depend b/helm/ocaml/hmysql/.depend
new file mode 100644
index 000000000..e67a0660c
--- /dev/null
+++ b/helm/ocaml/hmysql/.depend
@@ -0,0 +1,2 @@
+hMysql.cmo: hMysql.cmi
+hMysql.cmx: hMysql.cmi
diff --git a/helm/ocaml/hmysql/Makefile b/helm/ocaml/hmysql/Makefile
new file mode 100644
index 000000000..2ae1d4e59
--- /dev/null
+++ b/helm/ocaml/hmysql/Makefile
@@ -0,0 +1,11 @@
+PACKAGE = hmysql
+PREDICATES =
+
+INTERFACE_FILES = \
+ hMysql.mli
+IMPLEMENTATION_FILES = \
+ $(INTERFACE_FILES:%.mli=%.ml)
+EXTRA_OBJECTS_TO_INSTALL =
+EXTRA_OBJECTS_TO_CLEAN =
+
+include ../Makefile.common
diff --git a/helm/ocaml/hmysql/hMysql.ml b/helm/ocaml/hmysql/hMysql.ml
new file mode 100644
index 000000000..94f3efe03
--- /dev/null
+++ b/helm/ocaml/hmysql/hMysql.ml
@@ -0,0 +1,80 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+type dbd = Mysql.dbd option
+type result = Mysql.result option
+type error_code = Mysql.error_code
+
+let profiler = HExtlib.profile "mysql"
+
+let use_real_db () =
+ not (Helm_registry.get_opt_default Helm_registry.bool
+ ~default:false "db.nodb")
+
+let quick_connect ?host ?database ?port ?password ?user () =
+ profiler.HExtlib.profile
+ (fun () ->
+ if use_real_db () then
+ (Some (Mysql.quick_connect ?host ?database ?port ?password ?user ()))
+ else
+ None)
+ ()
+
+let disconnect = function
+ | None -> ()
+ | Some dbd -> profiler.HExtlib.profile Mysql.disconnect dbd
+
+let escape s =
+ profiler.HExtlib.profile Mysql.escape s
+
+let exec dbd s =
+ match dbd with
+ | None -> None
+ | Some dbd -> Some (profiler.HExtlib.profile (Mysql.exec dbd) s)
+
+let map res ~f =
+ match res with
+ | None -> []
+ | Some res ->
+ let map f = Mysql.map res ~f in
+ profiler.HExtlib.profile map f
+
+let iter res ~f =
+ match res with
+ | None -> ()
+ | Some res ->
+ let iter f = Mysql.iter res ~f in
+ profiler.HExtlib.profile iter f
+
+let errno = function
+ | None -> Mysql.Connection_error
+ | Some dbd -> profiler.HExtlib.profile Mysql.errno dbd
+
+let status = function
+ | None -> Mysql.StatusError Mysql.Connection_error
+ | Some dbd -> profiler.HExtlib.profile Mysql.status dbd
+
diff --git a/helm/ocaml/hmysql/hMysql.mli b/helm/ocaml/hmysql/hMysql.mli
new file mode 100644
index 000000000..a5b90593e
--- /dev/null
+++ b/helm/ocaml/hmysql/hMysql.mli
@@ -0,0 +1,56 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(**
+ * {2 Proxy module around MySQL conection}
+ *
+ * The behaviour of this module is influenced by the Helm_registry boolean value
+ * of the "db.nodb" key. When set to "false" the module works as expected. When
+ * set to "true" all functions perform dummy action: connect and disconnect do
+ * nothing; exec, iter, and map work like the empty set of results has been
+ * returned; errno and status return Mysql.Connection_error
+ *)
+
+type dbd
+type result
+
+(* the exceptions raised are from the Mysql module *)
+
+val quick_connect :
+ ?host:string ->
+ ?database:string ->
+ ?port:int -> ?password:string -> ?user:string -> unit -> dbd
+
+val disconnect : dbd -> unit
+
+val exec: dbd -> string -> result
+val map : result -> f:(string option array -> 'a) -> 'a list
+val iter : result -> f:(string option array -> unit) -> unit
+
+val errno : dbd -> Mysql.error_code
+val status : dbd -> Mysql.status
+
+val escape: string -> string
+
diff --git a/helm/ocaml/lexicon/.depend b/helm/ocaml/lexicon/.depend
new file mode 100644
index 000000000..452167c72
--- /dev/null
+++ b/helm/ocaml/lexicon/.depend
@@ -0,0 +1,20 @@
+lexiconAstPp.cmi: lexiconAst.cmo
+disambiguatePp.cmi: lexiconAst.cmo
+lexiconMarshal.cmi: lexiconAst.cmo
+cicNotation.cmi: lexiconAst.cmo
+lexiconEngine.cmi: lexiconMarshal.cmi lexiconAst.cmo cicNotation.cmi
+lexiconSync.cmi: lexiconEngine.cmi
+lexiconAstPp.cmo: lexiconAst.cmo lexiconAstPp.cmi
+lexiconAstPp.cmx: lexiconAst.cmx lexiconAstPp.cmi
+disambiguatePp.cmo: lexiconAstPp.cmi lexiconAst.cmo disambiguatePp.cmi
+disambiguatePp.cmx: lexiconAstPp.cmx lexiconAst.cmx disambiguatePp.cmi
+lexiconMarshal.cmo: lexiconAstPp.cmi lexiconAst.cmo lexiconMarshal.cmi
+lexiconMarshal.cmx: lexiconAstPp.cmx lexiconAst.cmx lexiconMarshal.cmi
+cicNotation.cmo: lexiconAst.cmo cicNotation.cmi
+cicNotation.cmx: lexiconAst.cmx cicNotation.cmi
+lexiconEngine.cmo: lexiconMarshal.cmi lexiconAst.cmo disambiguatePp.cmi \
+ cicNotation.cmi lexiconEngine.cmi
+lexiconEngine.cmx: lexiconMarshal.cmx lexiconAst.cmx disambiguatePp.cmx \
+ cicNotation.cmx lexiconEngine.cmi
+lexiconSync.cmo: lexiconEngine.cmi cicNotation.cmi lexiconSync.cmi
+lexiconSync.cmx: lexiconEngine.cmx cicNotation.cmx lexiconSync.cmi
diff --git a/helm/ocaml/lexicon/Makefile b/helm/ocaml/lexicon/Makefile
new file mode 100644
index 000000000..0e9c09526
--- /dev/null
+++ b/helm/ocaml/lexicon/Makefile
@@ -0,0 +1,17 @@
+PACKAGE = lexicon
+PREDICATES =
+
+INTERFACE_FILES = \
+ lexiconAstPp.mli \
+ disambiguatePp.mli \
+ lexiconMarshal.mli \
+ cicNotation.mli \
+ lexiconEngine.mli \
+ lexiconSync.mli \
+ $(NULL)
+IMPLEMENTATION_FILES = \
+ lexiconAst.ml \
+ $(INTERFACE_FILES:%.mli=%.ml)
+
+
+include ../Makefile.common
diff --git a/helm/ocaml/lexicon/cicNotation.ml b/helm/ocaml/lexicon/cicNotation.ml
new file mode 100644
index 000000000..1d18691ff
--- /dev/null
+++ b/helm/ocaml/lexicon/cicNotation.ml
@@ -0,0 +1,83 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open LexiconAst
+
+type notation_id =
+ | RuleId of CicNotationParser.rule_id
+ | InterpretationId of TermAcicContent.interpretation_id
+ | PrettyPrinterId of TermContentPres.pretty_printer_id
+
+let process_notation st =
+ match st with
+ | Notation (loc, dir, l1, associativity, precedence, l2) ->
+ let rule_id =
+ if dir <> Some `RightToLeft then
+ [ RuleId (CicNotationParser.extend l1 ?precedence ?associativity
+ (fun env loc ->
+ CicNotationPt.AttributedTerm
+ (`Loc loc,TermContentPres.instantiate_level2 env l2))) ]
+ else
+ []
+ in
+ let pp_id =
+ if dir <> Some `LeftToRight then
+ [ PrettyPrinterId
+ (TermContentPres.add_pretty_printer ?precedence ?associativity
+ l2 l1) ]
+ else
+ []
+ in
+ rule_id @ pp_id
+ | Interpretation (loc, dsc, l2, l3) ->
+ let interp_id = TermAcicContent.add_interpretation dsc l2 l3 in
+ [InterpretationId interp_id]
+ | st -> []
+
+let remove_notation = function
+ | RuleId id -> CicNotationParser.delete id
+ | PrettyPrinterId id -> TermContentPres.remove_pretty_printer id
+ | InterpretationId id -> TermAcicContent.remove_interpretation id
+
+let get_all_notations () =
+ List.map
+ (fun (interp_id, dsc) ->
+ InterpretationId interp_id, "interpretation: " ^ dsc)
+ (TermAcicContent.get_all_interpretations ())
+
+let get_active_notations () =
+ List.map (fun id -> InterpretationId id)
+ (TermAcicContent.get_active_interpretations ())
+
+let set_active_notations ids =
+ let interp_ids =
+ HExtlib.filter_map
+ (function InterpretationId interp_id -> Some interp_id | _ -> None)
+ ids
+ in
+ TermAcicContent.set_active_interpretations interp_ids
+
diff --git a/helm/ocaml/lexicon/cicNotation.mli b/helm/ocaml/lexicon/cicNotation.mli
new file mode 100644
index 000000000..944438df8
--- /dev/null
+++ b/helm/ocaml/lexicon/cicNotation.mli
@@ -0,0 +1,40 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+type notation_id
+
+val process_notation: LexiconAst.command -> notation_id list
+
+val remove_notation: notation_id -> unit
+
+(** {2 Notation enabling/disabling}
+ * Right now, only disabling of notation during pretty printing is supporting.
+ * If it is useful to disable it also for the input phase is still to be
+ * understood ... *)
+
+val get_all_notations: unit -> (notation_id * string) list (* id, dsc *)
+val get_active_notations: unit -> notation_id list
+val set_active_notations: notation_id list -> unit
+
diff --git a/helm/ocaml/lexicon/disambiguatePp.ml b/helm/ocaml/lexicon/disambiguatePp.ml
new file mode 100644
index 000000000..5f6512477
--- /dev/null
+++ b/helm/ocaml/lexicon/disambiguatePp.ml
@@ -0,0 +1,53 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open DisambiguateTypes
+
+let alias_of_domain_and_codomain_items domain_item (dsc,_) =
+ match domain_item with
+ Id id -> LexiconAst.Ident_alias (id, dsc)
+ | Symbol (symb, i) -> LexiconAst.Symbol_alias (symb, i, dsc)
+ | Num i -> LexiconAst.Number_alias (i, dsc)
+
+let aliases_of_environment env =
+ Environment.fold
+ (fun domain_item codomain_item acc ->
+ alias_of_domain_and_codomain_items domain_item codomain_item::acc
+ ) env []
+
+let aliases_of_domain_and_codomain_items_list l =
+ List.fold_left
+ (fun acc (domain_item,codomain_item) ->
+ alias_of_domain_and_codomain_items domain_item codomain_item::acc
+ ) [] l
+
+let pp_environment env =
+ let aliases = aliases_of_environment env in
+ let strings =
+ List.map (fun alias -> LexiconAstPp.pp_alias alias ^ ".") aliases
+ in
+ String.concat "\n" (List.sort compare strings)
diff --git a/helm/ocaml/lexicon/disambiguatePp.mli b/helm/ocaml/lexicon/disambiguatePp.mli
new file mode 100644
index 000000000..e8d9b94a4
--- /dev/null
+++ b/helm/ocaml/lexicon/disambiguatePp.mli
@@ -0,0 +1,30 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val aliases_of_domain_and_codomain_items_list:
+ (DisambiguateTypes.domain_item * DisambiguateTypes.codomain_item) list ->
+ LexiconAst.alias_spec list
+
+val pp_environment: DisambiguateTypes.environment -> string
diff --git a/helm/ocaml/lexicon/lexiconAst.ml b/helm/ocaml/lexicon/lexiconAst.ml
new file mode 100644
index 000000000..aed4b0b15
--- /dev/null
+++ b/helm/ocaml/lexicon/lexiconAst.ml
@@ -0,0 +1,55 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+type direction = [ `LeftToRight | `RightToLeft ]
+
+type loc = Token.flocation
+
+type alias_spec =
+ | Ident_alias of string * string (* identifier, uri *)
+ | Symbol_alias of string * int * string (* name, instance no, description *)
+ | Number_alias of int * string (* instance no, description *)
+
+(** To be increased each time the command type below changes, used for "safe"
+ * marshalling *)
+let magic = 5
+
+type command =
+ | Include of loc * string
+ | Alias of loc * alias_spec
+ (** parameters, name, type, fields *)
+ | Notation of loc * direction option * CicNotationPt.term * Gramext.g_assoc *
+ int * CicNotationPt.term
+ (* direction, l1 pattern, associativity, precedence, l2 pattern *)
+ | Interpretation of loc *
+ string * (string * CicNotationPt.argument_pattern list) *
+ CicNotationPt.cic_appl_pattern
+ (* description (i.e. id), symbol, arg pattern, appl pattern *)
+
+(* composed magic: term + command magics. No need to change this value *)
+let magic = magic + 10000 * CicNotationPt.magic
+
diff --git a/helm/ocaml/lexicon/lexiconAstPp.ml b/helm/ocaml/lexicon/lexiconAstPp.ml
new file mode 100644
index 000000000..e49a66f60
--- /dev/null
+++ b/helm/ocaml/lexicon/lexiconAstPp.ml
@@ -0,0 +1,84 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+open LexiconAst
+
+let pp_l1_pattern = CicNotationPp.pp_term
+let pp_l2_pattern = CicNotationPp.pp_term
+
+let pp_alias = function
+ | Ident_alias (id, uri) -> sprintf "alias id \"%s\" = \"%s\"" id uri
+ | Symbol_alias (symb, instance, desc) ->
+ sprintf "alias symbol \"%s\" (instance %d) = \"%s\""
+ symb instance desc
+ | Number_alias (instance,desc) ->
+ sprintf "alias num (instance %d) = \"%s\"" instance desc
+
+let pp_associativity = function
+ | Gramext.LeftA -> "left associative"
+ | Gramext.RightA -> "right associative"
+ | Gramext.NonA -> "non associative"
+
+let pp_precedence i = sprintf "with precedence %d" i
+
+let pp_argument_pattern = function
+ | CicNotationPt.IdentArg (eta_depth, name) ->
+ let eta_buf = Buffer.create 5 in
+ for i = 1 to eta_depth do
+ Buffer.add_string eta_buf "\\eta."
+ done;
+ sprintf "%s%s" (Buffer.contents eta_buf) name
+
+let pp_interpretation dsc symbol arg_patterns cic_appl_pattern =
+ sprintf "interpretation \"%s\" '%s %s = %s"
+ dsc symbol
+ (String.concat " " (List.map pp_argument_pattern arg_patterns))
+ (CicNotationPp.pp_cic_appl_pattern cic_appl_pattern)
+
+let pp_dir_opt = function
+ | None -> ""
+ | Some `LeftToRight -> "> "
+ | Some `RightToLeft -> "< "
+
+let pp_notation dir_opt l1_pattern assoc prec l2_pattern =
+ sprintf "notation %s\"%s\" %s %s for %s"
+ (pp_dir_opt dir_opt)
+ (pp_l1_pattern l1_pattern)
+ (pp_associativity assoc)
+ (pp_precedence prec)
+ (pp_l2_pattern l2_pattern)
+
+let pp_command = function
+ | Include (_,path) -> "include " ^ path
+ | Alias (_,s) -> pp_alias s
+ | Interpretation (_, dsc, (symbol, arg_patterns), cic_appl_pattern) ->
+ pp_interpretation dsc symbol arg_patterns cic_appl_pattern
+ | Notation (_, dir_opt, l1_pattern, assoc, prec, l2_pattern) ->
+ pp_notation dir_opt l1_pattern assoc prec l2_pattern
+
diff --git a/helm/ocaml/lexicon/lexiconAstPp.mli b/helm/ocaml/lexicon/lexiconAstPp.mli
new file mode 100644
index 000000000..b7ad59f3c
--- /dev/null
+++ b/helm/ocaml/lexicon/lexiconAstPp.mli
@@ -0,0 +1,29 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val pp_command: LexiconAst.command -> string
+
+val pp_alias: LexiconAst.alias_spec -> string
+
diff --git a/helm/ocaml/lexicon/lexiconEngine.ml b/helm/ocaml/lexicon/lexiconEngine.ml
new file mode 100644
index 000000000..aec759c96
--- /dev/null
+++ b/helm/ocaml/lexicon/lexiconEngine.ml
@@ -0,0 +1,150 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+exception IncludedFileNotCompiled of string (* file name *)
+exception MetadataNotFound of string (* file name *)
+
+type status = {
+ aliases: DisambiguateTypes.environment; (** disambiguation aliases *)
+ multi_aliases: DisambiguateTypes.multiple_environment;
+ lexicon_content_rev: LexiconMarshal.lexicon;
+ notation_ids: CicNotation.notation_id list; (** in-scope notation ids *)
+ metadata: LibraryNoDb.metadata list;
+}
+
+let add_lexicon_content cmds status =
+ let content = status.lexicon_content_rev in
+ let content' =
+ List.fold_right
+ (fun cmd acc -> cmd :: (List.filter ((<>) cmd) acc))
+ cmds content
+ in
+(* prerr_endline ("new lexicon content: " ^ String.concat " " (List.map
+ LexiconAstPp.pp_command content')); *)
+ { status with lexicon_content_rev = content' }
+
+let add_metadata new_metadata status =
+ if Helm_registry.get_bool "db.nodb" then
+ let metadata = status.metadata in
+ let metadata' =
+ List.fold_left
+ (fun acc m ->
+ match m with
+ | LibraryNoDb.Dependency buri ->
+ if List.exists (LibraryNoDb.eq_metadata m) metadata
+ then acc
+ else m :: acc)
+ metadata new_metadata
+ in
+ { status with metadata = metadata' }
+ else
+ status
+
+let set_proof_aliases status new_aliases =
+ let commands_of_aliases =
+ List.map
+ (fun alias -> LexiconAst.Alias (HExtlib.dummy_floc, alias))
+ in
+ let deps_of_aliases =
+ HExtlib.filter_map
+ (function
+ | LexiconAst.Ident_alias (_, suri) ->
+ let buri = UriManager.buri_of_uri (UriManager.uri_of_string suri) in
+ Some (LibraryNoDb.Dependency buri)
+ | _ -> None)
+ in
+ let aliases =
+ List.fold_left (fun acc (d,c) -> DisambiguateTypes.Environment.add d c acc)
+ status.aliases new_aliases in
+ let multi_aliases =
+ List.fold_left (fun acc (d,c) -> DisambiguateTypes.Environment.cons d c acc)
+ status.multi_aliases new_aliases in
+ let new_status =
+ { status with multi_aliases = multi_aliases ; aliases = aliases}
+ in
+ if new_aliases = [] then
+ new_status
+ else
+ let aliases =
+ DisambiguatePp.aliases_of_domain_and_codomain_items_list new_aliases
+ in
+ let status = add_lexicon_content (commands_of_aliases aliases) new_status in
+ let status = add_metadata (deps_of_aliases aliases) status in
+ status
+
+let rec eval_command status cmd =
+ let notation_ids' = CicNotation.process_notation cmd in
+ let status =
+ { status with notation_ids = notation_ids' @ status.notation_ids } in
+ let basedir = Helm_registry.get "matita.basedir" in
+ match cmd with
+ | LexiconAst.Include (loc, baseuri) ->
+ let lexiconpath = LibraryMisc.lexicon_file_of_baseuri ~basedir ~baseuri in
+ if not (Sys.file_exists lexiconpath) then
+ raise (IncludedFileNotCompiled lexiconpath);
+ let lexicon = LexiconMarshal.load_lexicon lexiconpath in
+ let status = List.fold_left eval_command status lexicon in
+ if Helm_registry.get_bool "db.nodb" then
+ let metadatapath = LibraryMisc.metadata_file_of_baseuri ~basedir ~baseuri in
+ if not (Sys.file_exists metadatapath) then
+ raise (MetadataNotFound metadatapath)
+ else
+ add_metadata (LibraryNoDb.load_metadata ~fname:metadatapath) status
+ else
+ status
+ | LexiconAst.Alias (loc, spec) ->
+ let diff =
+ (*CSC: Warning: this code should be factorized with the corresponding
+ code in DisambiguatePp *)
+ match spec with
+ | LexiconAst.Ident_alias (id,uri) ->
+ [DisambiguateTypes.Id id,
+ (uri,(fun _ _ _-> CicUtil.term_of_uri(UriManager.uri_of_string uri)))]
+ | LexiconAst.Symbol_alias (symb, instance, desc) ->
+ [DisambiguateTypes.Symbol (symb,instance),
+ DisambiguateChoices.lookup_symbol_by_dsc symb desc]
+ | LexiconAst.Number_alias (instance,desc) ->
+ [DisambiguateTypes.Num instance,
+ DisambiguateChoices.lookup_num_by_dsc desc]
+ in
+ set_proof_aliases status diff
+ | LexiconAst.Interpretation (_, dsc, (symbol, _), cic_appl_pattern) as stm ->
+ let status = add_lexicon_content [stm] status in
+ let uris =
+ List.map
+ (fun uri -> LibraryNoDb.Dependency (UriManager.buri_of_uri uri))
+ (CicNotationUtil.find_appl_pattern_uris cic_appl_pattern)
+ in
+ let diff =
+ [DisambiguateTypes.Symbol (symbol, 0),
+ DisambiguateChoices.lookup_symbol_by_dsc symbol dsc]
+ in
+ let status = set_proof_aliases status diff in
+ let status = add_metadata uris status in
+ status
+ | LexiconAst.Notation _ as stm -> add_lexicon_content [stm] status
+
diff --git a/helm/ocaml/lexicon/lexiconEngine.mli b/helm/ocaml/lexicon/lexiconEngine.mli
new file mode 100644
index 000000000..a2232fe28
--- /dev/null
+++ b/helm/ocaml/lexicon/lexiconEngine.mli
@@ -0,0 +1,40 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+
+type status = {
+ aliases: DisambiguateTypes.environment; (** disambiguation aliases *)
+ multi_aliases: DisambiguateTypes.multiple_environment;
+ lexicon_content_rev: LexiconMarshal.lexicon;
+ notation_ids: CicNotation.notation_id list; (** in-scope notation ids *)
+ metadata: LibraryNoDb.metadata list;
+}
+
+val eval_command : status -> LexiconAst.command -> status
+
+val set_proof_aliases:
+ status ->
+ (DisambiguateTypes.Environment.key * DisambiguateTypes.codomain_item) list ->
+ status
diff --git a/helm/ocaml/lexicon/lexiconMarshal.ml b/helm/ocaml/lexicon/lexiconMarshal.ml
new file mode 100644
index 000000000..7b9422db5
--- /dev/null
+++ b/helm/ocaml/lexicon/lexiconMarshal.ml
@@ -0,0 +1,67 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+type lexicon = LexiconAst.command list
+
+let format_name = "lexicon"
+
+let save_lexicon_to_file ~fname lexicon =
+ HMarshal.save ~fmt:format_name ~version:LexiconAst.magic ~fname lexicon
+
+let load_lexicon_from_file ~fname =
+ let raw = HMarshal.load ~fmt:format_name ~version:LexiconAst.magic ~fname in
+ (raw: lexicon)
+
+let rehash_cmd_uris =
+ let rehash_uri uri =
+ UriManager.uri_of_string (UriManager.string_of_uri uri) in
+ function
+ | LexiconAst.Interpretation (loc, dsc, args, cic_appl_pattern) ->
+ let rec aux =
+ function
+ | CicNotationPt.UriPattern uri ->
+ CicNotationPt.UriPattern (rehash_uri uri)
+ | CicNotationPt.ApplPattern args ->
+ CicNotationPt.ApplPattern (List.map aux args)
+ | CicNotationPt.VarPattern _
+ | CicNotationPt.ImplicitPattern as pat -> pat
+ in
+ let appl_pattern = aux cic_appl_pattern in
+ LexiconAst.Interpretation (loc, dsc, args, appl_pattern)
+ | LexiconAst.Notation _
+ | LexiconAst.Alias _ as cmd -> cmd
+ | cmd ->
+ prerr_endline "Found a command not expected in a .lexicon:";
+ prerr_endline (LexiconAstPp.pp_command cmd);
+ assert false
+
+let save_lexicon ~fname lexicon = save_lexicon_to_file ~fname (List.rev lexicon)
+
+let load_lexicon ~fname =
+ let lexicon = load_lexicon_from_file ~fname in
+ List.map rehash_cmd_uris lexicon
+
diff --git a/helm/ocaml/lexicon/lexiconMarshal.mli b/helm/ocaml/lexicon/lexiconMarshal.mli
new file mode 100644
index 000000000..930d73f8d
--- /dev/null
+++ b/helm/ocaml/lexicon/lexiconMarshal.mli
@@ -0,0 +1,32 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+type lexicon = LexiconAst.command list
+
+val save_lexicon: fname:string -> lexicon -> unit
+
+ (** @raise HMarshal.* *)
+val load_lexicon: fname:string -> lexicon
+
diff --git a/helm/ocaml/lexicon/lexiconSync.ml b/helm/ocaml/lexicon/lexiconSync.ml
new file mode 100644
index 000000000..d7fa27f90
--- /dev/null
+++ b/helm/ocaml/lexicon/lexiconSync.ml
@@ -0,0 +1,119 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let alias_diff ~from status =
+ let module Map = DisambiguateTypes.Environment in
+ Map.fold
+ (fun domain_item (description1,_ as codomain_item) acc ->
+ try
+ let description2,_ = Map.find domain_item from.LexiconEngine.aliases in
+ if description1 <> description2 then
+ (domain_item,codomain_item)::acc
+ else
+ acc
+ with
+ Not_found ->
+ (domain_item,codomain_item)::acc)
+ status.LexiconEngine.aliases []
+
+let alias_diff =
+ let profiler = HExtlib.profile "alias_diff (conteggiato anche in include)" in
+ fun ~from status -> profiler.HExtlib.profile (alias_diff ~from) status
+
+(** given a uri and a type list (the contructors types) builds a list of pairs
+ * (name,uri) that is used to generate automatic aliases **)
+let extract_alias types uri =
+ fst(List.fold_left (
+ fun (acc,i) (name, _, _, cl) ->
+ (name, UriManager.uri_of_uriref uri i None) ::
+ (fst(List.fold_left (
+ fun (acc,j) (name,_) ->
+ (((name,UriManager.uri_of_uriref uri i
+ (Some j)) :: acc) , j+1)
+ ) (acc,1) cl)),i+1
+ ) ([],0) types)
+
+let build_aliases =
+ List.map
+ (fun (name,uri) ->
+ DisambiguateTypes.Id name,
+ (UriManager.string_of_uri uri, fun _ _ _ -> CicUtil.term_of_uri uri))
+
+let add_aliases_for_inductive_def status types uri =
+ let aliases = build_aliases (extract_alias types uri) in
+ LexiconEngine.set_proof_aliases status aliases
+
+let add_alias_for_constant status uri =
+ let name = UriManager.name_of_uri uri in
+ let new_env = build_aliases [(name,uri)] in
+ LexiconEngine.set_proof_aliases status new_env
+
+let add_aliases_for_object status uri =
+ function
+ Cic.InductiveDefinition (types,_,_,_) ->
+ add_aliases_for_inductive_def status types uri
+ | Cic.Constant _ -> add_alias_for_constant status uri
+ | Cic.Variable _
+ | Cic.CurrentProof _ -> assert false
+
+let add_aliases_for_objs =
+ List.fold_left
+ (fun status uri ->
+ let obj,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ add_aliases_for_object status uri obj)
+
+module OrderedId =
+struct
+ type t = CicNotation.notation_id
+ let compare = Pervasives.compare
+end
+
+module IdSet = Set.Make (OrderedId)
+
+ (** @return l2 \ l1 *)
+let id_list_diff l2 l1 =
+ let module S = IdSet in
+ let s1 = List.fold_left (fun set uri -> S.add uri set) S.empty l1 in
+ let s2 = List.fold_left (fun set uri -> S.add uri set) S.empty l2 in
+ let diff = S.diff s2 s1 in
+ S.fold (fun uri uris -> uri :: uris) diff []
+
+let time_travel ~present ~past =
+ let notation_to_remove =
+ id_list_diff present.LexiconEngine.notation_ids
+ past.LexiconEngine.notation_ids
+ in
+ List.iter CicNotation.remove_notation notation_to_remove
+
+let init =
+ {
+ LexiconEngine.aliases = DisambiguateTypes.Environment.empty;
+ multi_aliases = DisambiguateTypes.Environment.empty;
+ lexicon_content_rev = [];
+ notation_ids = [];
+ metadata = [];
+ }
diff --git a/helm/ocaml/lexicon/lexiconSync.mli b/helm/ocaml/lexicon/lexiconSync.mli
new file mode 100644
index 000000000..62d8b97f5
--- /dev/null
+++ b/helm/ocaml/lexicon/lexiconSync.mli
@@ -0,0 +1,40 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val add_aliases_for_objs:
+ LexiconEngine.status -> UriManager.uri list -> LexiconEngine.status
+
+val time_travel:
+ present:LexiconEngine.status -> past:LexiconEngine.status -> unit
+
+ (** perform a diff between the aliases contained in two statuses, assuming
+ * that the second one can only have more aliases than the first one
+ * @return the list of aliases that should be added to aliases of from in
+ * order to be equal to aliases of the second argument *)
+val alias_diff:
+ from:LexiconEngine.status -> LexiconEngine.status ->
+ (DisambiguateTypes.domain_item * DisambiguateTypes.codomain_item) list
+
+val init: LexiconEngine.status
diff --git a/helm/ocaml/library/.depend b/helm/ocaml/library/.depend
new file mode 100644
index 000000000..5054959da
--- /dev/null
+++ b/helm/ocaml/library/.depend
@@ -0,0 +1,25 @@
+cicCoercion.cmi: coercDb.cmi
+cicElim.cmo: cicElim.cmi
+cicElim.cmx: cicElim.cmi
+cicRecord.cmo: cicRecord.cmi
+cicRecord.cmx: cicRecord.cmi
+libraryMisc.cmo: libraryMisc.cmi
+libraryMisc.cmx: libraryMisc.cmi
+libraryDb.cmo: libraryDb.cmi
+libraryDb.cmx: libraryDb.cmi
+coercDb.cmo: coercDb.cmi
+coercDb.cmx: coercDb.cmi
+cicCoercion.cmo: coercDb.cmi cicCoercion.cmi
+cicCoercion.cmx: coercDb.cmx cicCoercion.cmi
+coercGraph.cmo: coercDb.cmi coercGraph.cmi
+coercGraph.cmx: coercDb.cmx coercGraph.cmi
+librarySync.cmo: libraryDb.cmi coercGraph.cmi coercDb.cmi cicRecord.cmi \
+ cicElim.cmi cicCoercion.cmi librarySync.cmi
+librarySync.cmx: libraryDb.cmx coercGraph.cmx coercDb.cmx cicRecord.cmx \
+ cicElim.cmx cicCoercion.cmx librarySync.cmi
+libraryNoDb.cmo: libraryNoDb.cmi
+libraryNoDb.cmx: libraryNoDb.cmi
+libraryClean.cmo: librarySync.cmi libraryNoDb.cmi libraryMisc.cmi \
+ libraryDb.cmi libraryClean.cmi
+libraryClean.cmx: librarySync.cmx libraryNoDb.cmx libraryMisc.cmx \
+ libraryDb.cmx libraryClean.cmi
diff --git a/helm/ocaml/library/Makefile b/helm/ocaml/library/Makefile
new file mode 100644
index 000000000..74a61aed5
--- /dev/null
+++ b/helm/ocaml/library/Makefile
@@ -0,0 +1,19 @@
+PACKAGE = library
+PREDICATES =
+
+INTERFACE_FILES = \
+ cicElim.mli \
+ cicRecord.mli \
+ libraryMisc.mli \
+ libraryDb.mli \
+ coercDb.mli \
+ cicCoercion.mli \
+ coercGraph.mli \
+ librarySync.mli \
+ libraryNoDb.mli \
+ libraryClean.mli \
+ $(NULL)
+IMPLEMENTATION_FILES = \
+ $(INTERFACE_FILES:%.mli=%.ml)
+
+include ../Makefile.common
diff --git a/helm/ocaml/library/cicCoercion.ml b/helm/ocaml/library/cicCoercion.ml
new file mode 100644
index 000000000..fe636ee35
--- /dev/null
+++ b/helm/ocaml/library/cicCoercion.ml
@@ -0,0 +1,156 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let debug = false
+let debug_print s = if debug then prerr_endline (Lazy.force s) else ()
+
+(* given the new coercion uri from src to tgt returns the list
+ * of new coercions to create. hte list elements are
+ * (source, list of coercions to follow, target)
+ *)
+let get_closure_coercions src tgt uri coercions =
+ let eq_carr s t =
+ try
+ CoercDb.eq_carr s t
+ with
+ | CoercDb.EqCarrNotImplemented _ | CoercDb.EqCarrOnNonMetaClosed -> false
+ in
+ match src,tgt with
+ | CoercDb.Uri _, CoercDb.Uri _ ->
+ let c_from_tgt =
+ List.filter (fun (f,_,_) -> eq_carr f tgt) coercions
+ in
+ let c_to_src =
+ List.filter (fun (_,t,_) -> eq_carr t src) coercions
+ in
+ (List.map (fun (_,t,u) -> src,[uri; u],t) c_from_tgt) @
+ (List.map (fun (s,_,u) -> s,[u; uri],tgt) c_to_src) @
+ (List.fold_left (
+ fun l (s,_,u1) ->
+ ((List.map (fun (_,t,u2) ->
+ (s,[u1;uri;u2],t)
+ )c_from_tgt)@l) )
+ [] c_to_src)
+ | _ -> [] (* do not close in case source or target is not an indty ?? *)
+;;
+
+let obj_attrs = [`Class `Coercion; `Generated]
+
+(* generate_composite_closure (c2 (c1 s)) in the universe graph univ *)
+let generate_composite_closure c1 c2 univ =
+ let c1_ty,univ = CicTypeChecker.type_of_aux' [] [] c1 univ in
+ let rec mk_rels n =
+ match n with
+ | 0 -> []
+ | _ -> (Cic.Rel n) :: (mk_rels (n-1))
+ in
+ let rec compose k =
+ function
+ | Cic.Prod (name,src,tgt) ->
+ let name =
+ match name with
+ | Cic.Anonymous -> Cic.Name "x"
+ | _ -> name
+ in
+ Cic.Lambda (name,src,compose (k+1) tgt)
+ | Cic.Appl (he::tl) ->
+ Cic.Appl (c2 :: tl @ [Cic.Appl (c1 :: (mk_rels k)) ])
+ | _ -> Cic.Appl (c2 :: [Cic.Appl (c1 :: (mk_rels k)) ])
+ in
+ let c = compose 0 c1_ty in
+ let c_ty,univ =
+ try
+ CicTypeChecker.type_of_aux' [] [] c univ
+ with CicTypeChecker.TypeCheckerFailure s as exn ->
+ debug_print (lazy (Printf.sprintf "Generated composite coercion:\n%s\n%s"
+ (CicPp.ppterm c) (Lazy.force s)));
+ raise exn
+ in
+ let cleaned_ty =
+ FreshNamesGenerator.clean_dummy_dependent_types c_ty
+ in
+ let obj = Cic.Constant ("xxxx",Some c,cleaned_ty,[],obj_attrs) in
+ obj,univ
+;;
+
+(* removes from l the coercions that are in !coercions *)
+let filter_duplicates l coercions =
+ List.filter (
+ fun (src,_,tgt) ->
+ not (List.exists (fun (s,t,u) ->
+ CoercDb.eq_carr s src &&
+ CoercDb.eq_carr t tgt)
+ coercions))
+ l
+
+(* given a new coercion uri from src to tgt returns
+ * a list of (new coercion uri, coercion obj, universe graph)
+ *)
+let close_coercion_graph src tgt uri =
+ (* check if the coercion already exists *)
+ let coercions = CoercDb.to_list () in
+ let todo_list = get_closure_coercions src tgt uri coercions in
+ let todo_list = filter_duplicates todo_list coercions in
+ let new_coercions =
+ List.map (
+ fun (src, l , tgt) ->
+ match l with
+ | [] -> assert false
+ | he :: tl ->
+ let first_step =
+ Cic.Constant ("",
+ Some (CoercDb.term_of_carr (CoercDb.Uri he)),
+ Cic.Sort Cic.Prop, [], obj_attrs)
+ in
+ let o,_ =
+ List.fold_left (fun (o,univ) coer ->
+ match o with
+ | Cic.Constant (_,Some c,_,[],_) ->
+ generate_composite_closure c (CoercDb.term_of_carr (CoercDb.Uri
+ coer)) univ
+ | _ -> assert false
+ ) (first_step, CicUniv.empty_ugraph) tl
+ in
+ let name_src = CoercDb.name_of_carr src in
+ let name_tgt = CoercDb.name_of_carr tgt in
+ let name = name_tgt ^ "_of_" ^ name_src in
+ let buri = UriManager.buri_of_uri uri in
+ let c_uri =
+ UriManager.uri_of_string (buri ^ "/" ^ name ^ ".con")
+ in
+ let named_obj =
+ match o with
+ | Cic.Constant (_,bo,ty,vl,attrs) ->
+ Cic.Constant (name,bo,ty,vl,attrs)
+ | _ -> assert false
+ in
+ ((src,tgt,c_uri,named_obj))
+ ) todo_list
+ in
+ new_coercions
+;;
+
diff --git a/helm/ocaml/library/cicCoercion.mli b/helm/ocaml/library/cicCoercion.mli
new file mode 100644
index 000000000..c9eaf0aac
--- /dev/null
+++ b/helm/ocaml/library/cicCoercion.mli
@@ -0,0 +1,31 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* This module implements the Coercions transitive closure *)
+
+val close_coercion_graph:
+ CoercDb.coerc_carr -> CoercDb.coerc_carr -> UriManager.uri ->
+ (CoercDb.coerc_carr * CoercDb.coerc_carr * UriManager.uri * Cic.obj) list
+
diff --git a/helm/ocaml/library/cicElim.ml b/helm/ocaml/library/cicElim.ml
new file mode 100644
index 000000000..fb3c0655c
--- /dev/null
+++ b/helm/ocaml/library/cicElim.ml
@@ -0,0 +1,421 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+exception Elim_failure of string Lazy.t
+exception Can_t_eliminate
+
+let debug_print = fun _ -> ()
+(*let debug_print s = prerr_endline (Lazy.force s) *)
+
+let counter = ref ~-1 ;;
+
+let fresh_binder () = Cic.Name "matita_dummy"
+(*
+ incr counter;
+ Cic.Name ("e" ^ string_of_int !counter) *)
+
+ (** verifies if a given inductive type occurs in a term in target position *)
+let rec recursive uri typeno = function
+ | Cic.Prod (_, _, target) -> recursive uri typeno target
+ | Cic.MutInd (uri', typeno', [])
+ | Cic.Appl (Cic.MutInd (uri', typeno', []) :: _) ->
+ UriManager.eq uri uri' && typeno = typeno'
+ | _ -> false
+
+ (** given a list of constructor types, return true if at least one of them is
+ * recursive, false otherwise *)
+let recursive_type uri typeno constructors =
+ let rec aux = function
+ | Cic.Prod (_, src, tgt) -> recursive uri typeno src || aux tgt
+ | _ -> false
+ in
+ List.exists (fun (_, ty) -> aux ty) constructors
+
+let unfold_appl = function
+ | Cic.Appl ((Cic.Appl args) :: tl) -> Cic.Appl (args @ tl)
+ | t -> t
+
+let rec split l n =
+ match (l,n) with
+ (l,0) -> ([], l)
+ | (he::tl, n) -> let (l1,l2) = split tl (n-1) in (he::l1,l2)
+ | (_,_) -> assert false
+
+ (** build elimination principle part related to a single constructor
+ * @param paramsno number of Prod to ignore in this constructor (i.e. number of
+ * inductive parameters)
+ * @param dependent true if we are in the dependent case (i.e. sort <> Prop) *)
+let rec delta (uri, typeno) dependent paramsno consno t p args =
+ match t with
+ | Cic.MutInd (uri', typeno', []) when
+ UriManager.eq uri uri' && typeno = typeno' ->
+ if dependent then
+ (match args with
+ | [] -> assert false
+ | [arg] -> unfold_appl (Cic.Appl [p; arg])
+ | _ -> unfold_appl (Cic.Appl [p; unfold_appl (Cic.Appl args)]))
+ else
+ p
+ | Cic.Appl (Cic.MutInd (uri', typeno', []) :: tl) when
+ UriManager.eq uri uri' && typeno = typeno' ->
+ let (lparams, rparams) = split tl paramsno in
+ if dependent then
+ (match args with
+ | [] -> assert false
+ | [arg] -> unfold_appl (Cic.Appl (p :: rparams @ [arg]))
+ | _ ->
+ unfold_appl (Cic.Appl (p ::
+ rparams @ [unfold_appl (Cic.Appl args)])))
+ else (* non dependent *)
+ (match rparams with
+ | [] -> p
+ | _ -> Cic.Appl (p :: rparams))
+ | Cic.Prod (binder, src, tgt) ->
+ if recursive uri typeno src then
+ let args = List.map (CicSubstitution.lift 2) args in
+ let phi =
+ let src = CicSubstitution.lift 1 src in
+ delta (uri, typeno) dependent paramsno consno src
+ (CicSubstitution.lift 1 p) [Cic.Rel 1]
+ in
+ let tgt = CicSubstitution.lift 1 tgt in
+ Cic.Prod (fresh_binder (), src,
+ Cic.Prod (Cic.Anonymous, phi,
+ delta (uri, typeno) dependent paramsno consno tgt
+ (CicSubstitution.lift 2 p) (args @ [Cic.Rel 2])))
+ else (* non recursive *)
+ let args = List.map (CicSubstitution.lift 1) args in
+ Cic.Prod (fresh_binder (), src,
+ delta (uri, typeno) dependent paramsno consno tgt
+ (CicSubstitution.lift 1 p) (args @ [Cic.Rel 1]))
+ | _ -> assert false
+
+let rec strip_left_params consno leftno = function
+ | t when leftno = 0 -> t (* no need to lift, the term is (hopefully) closed *)
+ | Cic.Prod (_, _, tgt) (* when leftno > 0 *) ->
+ (* after stripping the parameters we lift of consno. consno is 1 based so,
+ * the first constructor will be lifted by 1 (for P), the second by 2 (1
+ * for P and 1 for the 1st constructor), and so on *)
+ if leftno = 1 then
+ CicSubstitution.lift consno tgt
+ else
+ strip_left_params consno (leftno - 1) tgt
+ | _ -> assert false
+
+let delta (ury, typeno) dependent paramsno consno t p args =
+ let t = strip_left_params consno paramsno t in
+ delta (ury, typeno) dependent paramsno consno t p args
+
+let rec add_params binder indno ty eliminator =
+ if indno = 0 then
+ eliminator
+ else
+ match ty with
+ | Cic.Prod (name, src, tgt) ->
+ let name =
+ match name with
+ Cic.Name _ -> name
+ | Cic.Anonymous -> fresh_binder ()
+ in
+ binder name src (add_params binder (indno - 1) tgt eliminator)
+ | _ -> assert false
+
+let rec mk_rels consno = function
+ | 0 -> []
+ | n -> Cic.Rel (n+consno) :: mk_rels consno (n-1)
+
+let rec strip_pi = function
+ | Cic.Prod (_, _, tgt) -> strip_pi tgt
+ | t -> t
+
+let rec count_pi = function
+ | Cic.Prod (_, _, tgt) -> count_pi tgt + 1
+ | t -> 0
+
+let rec type_of_p sort dependent leftno indty = function
+ | Cic.Prod (n, src, tgt) when leftno = 0 ->
+ let n =
+ if dependent then
+ match n with
+ Cic.Name _ -> n
+ | Cic.Anonymous -> fresh_binder ()
+ else
+ n
+ in
+ Cic.Prod (n, src, type_of_p sort dependent leftno indty tgt)
+ | Cic.Prod (_, _, tgt) -> type_of_p sort dependent (leftno - 1) indty tgt
+ | t ->
+ if dependent then
+ Cic.Prod (Cic.Anonymous, indty, Cic.Sort sort)
+ else
+ Cic.Sort sort
+
+let rec add_right_pi dependent strip liftno liftfrom rightno indty = function
+ | Cic.Prod (_, src, tgt) when strip = 0 ->
+ Cic.Prod (fresh_binder (),
+ CicSubstitution.lift_from liftfrom liftno src,
+ add_right_pi dependent strip liftno (liftfrom + 1) rightno indty tgt)
+ | Cic.Prod (_, _, tgt) ->
+ add_right_pi dependent (strip - 1) liftno liftfrom rightno indty tgt
+ | t ->
+ if dependent then
+ Cic.Prod (fresh_binder (),
+ CicSubstitution.lift_from (rightno + 1) liftno indty,
+ Cic.Appl (Cic.Rel (1 + liftno + rightno) :: mk_rels 0 (rightno + 1)))
+ else
+ Cic.Prod (Cic.Anonymous,
+ CicSubstitution.lift_from (rightno + 1) liftno indty,
+ if rightno = 0 then
+ Cic.Rel (1 + liftno + rightno)
+ else
+ Cic.Appl (Cic.Rel (1 + liftno + rightno) :: mk_rels 1 rightno))
+
+let rec add_right_lambda dependent strip liftno liftfrom rightno indty case =
+function
+ | Cic.Prod (_, src, tgt) when strip = 0 ->
+ Cic.Lambda (fresh_binder (),
+ CicSubstitution.lift_from liftfrom liftno src,
+ add_right_lambda dependent strip liftno (liftfrom + 1) rightno indty
+ case tgt)
+ | Cic.Prod (_, _, tgt) ->
+ add_right_lambda true (strip - 1) liftno liftfrom rightno indty
+ case tgt
+ | t ->
+ Cic.Lambda (fresh_binder (),
+ CicSubstitution.lift_from (rightno + 1) liftno indty, case)
+
+let rec branch (uri, typeno) insource paramsno t fix head args =
+ match t with
+ | Cic.MutInd (uri', typeno', []) when
+ UriManager.eq uri uri' && typeno = typeno' ->
+ if insource then
+ (match args with
+ | [arg] -> Cic.Appl (fix :: args)
+ | _ -> Cic.Appl (head :: [Cic.Appl args]))
+ else
+ (match args with
+ | [] -> head
+ | _ -> Cic.Appl (head :: args))
+ | Cic.Appl (Cic.MutInd (uri', typeno', []) :: tl) when
+ UriManager.eq uri uri' && typeno = typeno' ->
+ if insource then
+ let (lparams, rparams) = split tl paramsno in
+ match args with
+ | [arg] -> Cic.Appl (fix :: rparams @ args)
+ | _ -> Cic.Appl (fix :: rparams @ [Cic.Appl args])
+ else
+ (match args with
+ | [] -> head
+ | _ -> Cic.Appl (head :: args))
+ | Cic.Prod (binder, src, tgt) ->
+ if recursive uri typeno src then
+ let args = List.map (CicSubstitution.lift 1) args in
+ let phi =
+ let fix = CicSubstitution.lift 1 fix in
+ let src = CicSubstitution.lift 1 src in
+ branch (uri, typeno) true paramsno src fix head [Cic.Rel 1]
+ in
+ Cic.Lambda (fresh_binder (), src,
+ branch (uri, typeno) insource paramsno tgt
+ (CicSubstitution.lift 1 fix) (CicSubstitution.lift 1 head)
+ (args @ [Cic.Rel 1; phi]))
+ else (* non recursive *)
+ let args = List.map (CicSubstitution.lift 1) args in
+ Cic.Lambda (fresh_binder (), src,
+ branch (uri, typeno) insource paramsno tgt
+ (CicSubstitution.lift 1 fix) (CicSubstitution.lift 1 head)
+ (args @ [Cic.Rel 1]))
+ | _ -> assert false
+
+let branch (uri, typeno) insource liftno paramsno t fix head args =
+ let t = strip_left_params liftno paramsno t in
+ branch (uri, typeno) insource paramsno t fix head args
+
+let elim_of ~sort uri typeno =
+ counter := ~-1;
+ let (obj, univ) = (CicEnvironment.get_obj CicUniv.empty_ugraph uri) in
+ match obj with
+ | Cic.InductiveDefinition (indTypes, params, leftno, _) ->
+ let (name, inductive, ty, constructors) =
+ try
+ List.nth indTypes typeno
+ with Failure _ -> assert false
+ in
+ let paramsno = count_pi ty in (* number of (left or right) parameters *)
+ let rightno = paramsno - leftno in
+ let dependent = (strip_pi ty <> Cic.Sort Cic.Prop) in
+ let head =
+ match strip_pi ty with
+ Cic.Sort s -> s
+ | _ -> assert false
+ in
+ let conslen = List.length constructors in
+ let consno = ref (conslen + 1) in
+ if
+ not
+ (CicTypeChecker.check_allowed_sort_elimination uri typeno head sort)
+ then
+ raise Can_t_eliminate;
+ let indty =
+ let indty = Cic.MutInd (uri, typeno, []) in
+ if paramsno = 0 then
+ indty
+ else
+ Cic.Appl (indty :: mk_rels 0 paramsno)
+ in
+ let mk_constructor consno =
+ let constructor = Cic.MutConstruct (uri, typeno, consno, []) in
+ if leftno = 0 then
+ constructor
+ else
+ Cic.Appl (constructor :: mk_rels consno leftno)
+ in
+ let p_ty = type_of_p sort dependent leftno indty ty in
+ let final_ty =
+ add_right_pi dependent leftno (conslen + 1) 1 rightno indty ty
+ in
+ let eliminator_type =
+ let cic =
+ Cic.Prod (Cic.Name "P", p_ty,
+ (List.fold_right
+ (fun (_, constructor) acc ->
+ decr consno;
+ let p = Cic.Rel !consno in
+ Cic.Prod (Cic.Anonymous,
+ (delta (uri, typeno) dependent leftno !consno
+ constructor p [mk_constructor !consno]),
+ acc))
+ constructors final_ty))
+ in
+ add_params (fun b s t -> Cic.Prod (b, s, t)) leftno ty cic
+ in
+ let consno = ref (conslen + 1) in
+ let eliminator_body =
+ let fix = Cic.Rel (rightno + 2) in
+ let is_recursive = recursive_type uri typeno constructors in
+ let recshift = if is_recursive then 1 else 0 in
+ let (_, branches) =
+ List.fold_right
+ (fun (_, ty) (shift, branches) ->
+ let head = Cic.Rel (rightno + shift + 1 + recshift) in
+ let b =
+ branch (uri, typeno) false
+ (rightno + conslen + 2 + recshift) leftno ty fix head []
+ in
+ (shift + 1, b :: branches))
+ constructors (1, [])
+ in
+ let shiftno = conslen + rightno + 2 + recshift in
+ let outtype =
+ if dependent then
+ Cic.Rel shiftno
+ else
+ let head =
+ if rightno = 0 then
+ CicSubstitution.lift 1 (Cic.Rel shiftno)
+ else
+ Cic.Appl
+ ((CicSubstitution.lift (rightno + 1) (Cic.Rel shiftno)) ::
+ mk_rels 1 rightno)
+ in
+ add_right_lambda true leftno shiftno 1 rightno indty head ty
+ in
+ let mutcase =
+ Cic.MutCase (uri, typeno, outtype, Cic.Rel 1, branches)
+ in
+ let body =
+ if is_recursive then
+ let fixfun =
+ add_right_lambda dependent leftno (conslen + 2) 1 rightno
+ indty mutcase ty
+ in
+ (* rightno is the decreasing argument, i.e. the argument of
+ * inductive type *)
+ Cic.Fix (0, ["f", rightno, final_ty, fixfun])
+ else
+ add_right_lambda dependent leftno (conslen + 1) 1 rightno indty
+ mutcase ty
+ in
+ let cic =
+ Cic.Lambda (Cic.Name "P", p_ty,
+ (List.fold_right
+ (fun (_, constructor) acc ->
+ decr consno;
+ let p = Cic.Rel !consno in
+ Cic.Lambda (fresh_binder (),
+ (delta (uri, typeno) dependent leftno !consno
+ constructor p [mk_constructor !consno]),
+ acc))
+ constructors body))
+ in
+ add_params (fun b s t -> Cic.Lambda (b, s, t)) leftno ty cic
+ in
+(*
+debug_print (lazy (CicPp.ppterm eliminator_type));
+debug_print (lazy (CicPp.ppterm eliminator_body));
+*)
+ let eliminator_type =
+ FreshNamesGenerator.mk_fresh_names [] [] [] eliminator_type in
+ let eliminator_body =
+ FreshNamesGenerator.mk_fresh_names [] [] [] eliminator_body in
+(*
+debug_print (lazy (CicPp.ppterm eliminator_type));
+debug_print (lazy (CicPp.ppterm eliminator_body));
+*)
+ let (computed_type, ugraph) =
+ try
+ CicTypeChecker.type_of_aux' [] [] eliminator_body CicUniv.empty_ugraph
+ with CicTypeChecker.TypeCheckerFailure msg ->
+ raise (Elim_failure (lazy (sprintf
+ "type checker failure while type checking:\n%s\nerror:\n%s"
+ (CicPp.ppterm eliminator_body) (Lazy.force msg))))
+ in
+ if not (fst (CicReduction.are_convertible []
+ eliminator_type computed_type ugraph))
+ then
+ raise (Failure (sprintf
+ "internal error: type mismatch on eliminator type\n%s\n%s"
+ (CicPp.ppterm eliminator_type) (CicPp.ppterm computed_type)));
+ let suffix =
+ match sort with
+ | Cic.Prop -> "_ind"
+ | Cic.Set -> "_rec"
+ | Cic.Type _ -> "_rect"
+ | _ -> assert false
+ in
+ let name = UriManager.name_of_uri uri ^ suffix in
+ let buri = UriManager.buri_of_uri uri in
+ let uri = UriManager.uri_of_string (buri ^ "/" ^ name ^ ".con") in
+ let obj_attrs = [`Class (`Elim sort); `Generated] in
+ uri,
+ Cic.Constant (name, Some eliminator_body, eliminator_type, [], obj_attrs)
+ | _ ->
+ failwith (sprintf "not an inductive definition (%s)"
+ (UriManager.string_of_uri uri))
+
diff --git a/helm/ocaml/library/cicElim.mli b/helm/ocaml/library/cicElim.mli
new file mode 100644
index 000000000..f1f84c92e
--- /dev/null
+++ b/helm/ocaml/library/cicElim.mli
@@ -0,0 +1,41 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+ (** can't build the required elimination principle (e.g. elimination from Prop
+ * to Set *)
+exception Can_t_eliminate
+
+ (** internal error while generating elimination principle *)
+exception Elim_failure of string Lazy.t
+
+(** @param sort target sort
+* @param uri inductive type uri
+* @param typeno inductive type number
+* @raise Failure
+* @raise Can_t_eliminate
+* @return Cic constant corresponding to the required elimination principle
+* and its uri
+*)
+val elim_of: sort:Cic.sort -> UriManager.uri -> int -> UriManager.uri * Cic.obj
diff --git a/helm/ocaml/library/cicRecord.ml b/helm/ocaml/library/cicRecord.ml
new file mode 100644
index 000000000..775292ccb
--- /dev/null
+++ b/helm/ocaml/library/cicRecord.ml
@@ -0,0 +1,88 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let rec_ty uri leftno =
+ let rec_ty = Cic.MutInd (uri,0,[]) in
+ if leftno = 0 then rec_ty else
+ Cic.Appl (rec_ty :: (CicUtil.mk_rels leftno 0))
+
+let generate_one_proj uri params paramsno fields t i =
+ let mk_lambdas l start =
+ List.fold_right (fun (name,ty) acc ->
+ Cic.Lambda (Cic.Name name,ty,acc)) l start in
+ let recty = rec_ty uri paramsno in
+ let outtype = Cic.Lambda (Cic.Name "w'", CicSubstitution.lift 1 recty, t) in
+ (mk_lambdas params
+ (Cic.Lambda (Cic.Name "w", recty,
+ Cic.MutCase (uri,0,outtype, Cic.Rel 1,
+ [mk_lambdas fields (Cic.Rel i)]))))
+
+let projections_of uri field_names =
+ let buri = UriManager.buri_of_uri uri in
+ let obj,ugraph = CicEnvironment.get_cooked_obj CicUniv.empty_ugraph uri in
+ match obj with
+ Cic.InductiveDefinition ([_,_,sort,[_,ty]],params,paramsno,_) ->
+ assert (params = []); (* general case not implemented *)
+ let leftparams,ty =
+ let rec aux =
+ function
+ 0,ty -> [],ty
+ | n,Cic.Prod (Cic.Name name,s,t) ->
+ let leftparams,ty = aux (n - 1,t) in
+ (name,s)::leftparams,ty
+ | _,_ -> assert false
+ in
+ aux (paramsno,ty)
+ in
+ let fields =
+ let rec aux =
+ function
+ Cic.MutInd _, []
+ | Cic.Appl _, [] -> []
+ | Cic.Prod (_,s,t), name::tl -> (name,s)::aux (t,tl)
+ | _,_ -> assert false
+ in
+ aux ((CicSubstitution.lift 1 ty),field_names)
+ in
+ let rec aux i =
+ function
+ Cic.MutInd _, []
+ | Cic.Appl _, [] -> []
+ | Cic.Prod (_,s,t), name::tl ->
+ let p = generate_one_proj uri leftparams paramsno fields s i in
+ let puri = UriManager.uri_of_string (buri ^ "/" ^ name ^ ".con") in
+ (puri,name,p) ::
+ aux (i - 1)
+ (CicSubstitution.subst
+ (Cic.Appl
+ (Cic.Const (puri,[]) ::
+ CicUtil.mk_rels paramsno 2 @ [Cic.Rel 1])
+ ) t, tl)
+ | _,_ -> assert false
+ in
+ aux (List.length fields) (CicSubstitution.lift 2 ty,field_names)
+ | _ -> assert false
diff --git a/helm/ocaml/library/cicRecord.mli b/helm/ocaml/library/cicRecord.mli
new file mode 100644
index 000000000..b966f317c
--- /dev/null
+++ b/helm/ocaml/library/cicRecord.mli
@@ -0,0 +1,28 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** projections_of [uri] returns uri * name * term *)
+val projections_of:
+ UriManager.uri -> string list -> (UriManager.uri * string * Cic.term) list
diff --git a/helm/ocaml/library/coercDb.ml b/helm/ocaml/library/coercDb.ml
new file mode 100644
index 000000000..01065325f
--- /dev/null
+++ b/helm/ocaml/library/coercDb.ml
@@ -0,0 +1,90 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+type coerc_carr = Uri of UriManager.uri | Sort of Cic.sort | Term of Cic.term
+exception EqCarrNotImplemented of string Lazy.t
+exception EqCarrOnNonMetaClosed
+
+let db = ref []
+
+let coerc_carr_of_term t =
+ try
+ Uri (CicUtil.uri_of_term t)
+ with Invalid_argument _ ->
+ match t with
+ | Cic.Sort s -> Sort s
+ | t -> Term t
+;;
+
+let eq_carr src tgt =
+ match src, tgt with
+ | Uri src, Uri tgt -> UriManager.eq src tgt
+ | Sort (Cic.Type _), Sort (Cic.Type _) -> true
+ | Sort src, Sort tgt when src = tgt -> true
+ | Term t1, Term t2 ->
+ if CicUtil.is_meta_closed t1 && CicUtil.is_meta_closed t2 then
+ raise
+ (EqCarrNotImplemented
+ (lazy ("Unsupported carr for coercions: " ^
+ CicPp.ppterm t1 ^ " or " ^ CicPp.ppterm t2)))
+ else raise EqCarrOnNonMetaClosed
+ | _, _ -> false
+
+let name_of_carr = function
+ | Uri u -> UriManager.name_of_uri u
+ | Sort s -> CicPp.ppsort s
+ | Term t -> CicPp.ppterm t
+
+
+let to_list () =
+ !db
+
+let add_coercion c =
+ db := c :: !db
+
+let remove_coercion p =
+ db := List.filter (fun u -> not(p u)) !db
+
+let find_coercion f =
+ List.map (fun (_,_,x) -> x) (List.filter (fun (s,t,_) -> f (s,t)) !db)
+
+let is_a_coercion u =
+ List.exists (fun (_,_,x) -> UriManager.eq x u) !db
+
+let get_carr uri =
+ try
+ let src, tgt, _ = List.find (fun (_,_,x) -> UriManager.eq x uri) !db in
+ src, tgt
+ with Not_found -> assert false (* uri must be a coercion *)
+
+let term_of_carr = function
+ | Uri u -> CicUtil.term_of_uri u
+ | Sort s -> Cic.Sort s
+ | Term _ -> assert false
+
+
+
diff --git a/helm/ocaml/library/coercDb.mli b/helm/ocaml/library/coercDb.mli
new file mode 100644
index 000000000..9e8bf5e9c
--- /dev/null
+++ b/helm/ocaml/library/coercDb.mli
@@ -0,0 +1,58 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+
+ (** THIS MODULE SHOULD BE USED ONLY BY CoercGraph/CicCoercion/librarySync
+ *
+ * and may be merged with CicCoercion...
+ *
+ * **)
+
+
+ (** XXX WARNING: non-reentrant *)
+type coerc_carr = Uri of UriManager.uri | Sort of Cic.sort | Term of Cic.term
+exception EqCarrNotImplemented of string Lazy.t
+exception EqCarrOnNonMetaClosed
+val eq_carr: coerc_carr -> coerc_carr -> bool
+val coerc_carr_of_term: Cic.term -> coerc_carr
+val name_of_carr: coerc_carr -> string
+
+val to_list:
+ unit ->
+ (coerc_carr * coerc_carr * UriManager.uri) list
+
+val add_coercion:
+ coerc_carr * coerc_carr * UriManager.uri -> unit
+
+val remove_coercion:
+ (coerc_carr * coerc_carr * UriManager.uri -> bool) -> unit
+
+val find_coercion:
+ (coerc_carr * coerc_carr -> bool) -> UriManager.uri list
+
+val is_a_coercion: UriManager.uri -> bool
+val get_carr: UriManager.uri -> coerc_carr * coerc_carr
+
+val term_of_carr: coerc_carr -> Cic.term
diff --git a/helm/ocaml/library/coercGraph.ml b/helm/ocaml/library/coercGraph.ml
new file mode 100644
index 000000000..cd958a8f6
--- /dev/null
+++ b/helm/ocaml/library/coercGraph.ml
@@ -0,0 +1,97 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+open Printf;;
+
+type coercion_search_result =
+ | SomeCoercion of Cic.term
+ | NoCoercion
+ | NotMetaClosed
+ | NotHandled of string Lazy.t
+
+let debug = false
+let debug_print s = if debug then prerr_endline (Lazy.force s) else ()
+
+(* searches a coercion fron src to tgt in the !coercions list *)
+let look_for_coercion src tgt =
+ try
+ let l =
+ CoercDb.find_coercion
+ (fun (s,t) -> CoercDb.eq_carr s src && CoercDb.eq_carr t tgt)
+ in
+ match l with
+ | [] ->
+ debug_print
+ (lazy
+ (sprintf ":-( coercion non trovata da %s a %s"
+ (CoercDb.name_of_carr src)
+ (CoercDb.name_of_carr tgt)));
+ NoCoercion
+ | [u] ->
+ debug_print (lazy (
+ sprintf ":-) TROVATA 1 coercion da %s a %s: %s"
+ (CoercDb.name_of_carr src)
+ (CoercDb.name_of_carr tgt)
+ (UriManager.name_of_uri u)));
+ SomeCoercion (CicUtil.term_of_uri u)
+ | u::_ ->
+ debug_print (lazy (
+ sprintf ":-/ TROVATE %d coercion(s) da %s a %s, prendo la prima: %s"
+ (List.length l)
+ (CoercDb.name_of_carr src)
+ (CoercDb.name_of_carr tgt)
+ (UriManager.name_of_uri u)));
+ SomeCoercion (CicUtil.term_of_uri u)
+ with
+ | CoercDb.EqCarrNotImplemented s -> NotHandled s
+ | CoercDb.EqCarrOnNonMetaClosed -> NotMetaClosed
+;;
+
+let look_for_coercion src tgt =
+ let src_uri = CoercDb.coerc_carr_of_term src in
+ let tgt_uri = CoercDb.coerc_carr_of_term tgt in
+ look_for_coercion src_uri tgt_uri
+
+let is_a_coercion t =
+ try
+ let uri = CicUtil.uri_of_term t in
+ CoercDb.is_a_coercion uri
+ with Invalid_argument _ -> false
+
+let source_of t =
+ try
+ let uri = CicUtil.uri_of_term t in
+ CoercDb.term_of_carr (fst (CoercDb.get_carr uri))
+ with Invalid_argument _ -> assert false (* t must be a coercion *)
+
+let target_of t =
+ try
+ let uri = CicUtil.uri_of_term t in
+ CoercDb.term_of_carr (snd (CoercDb.get_carr uri))
+ with Invalid_argument _ -> assert false (* t must be a coercion *)
+
+(* EOF *)
diff --git a/helm/ocaml/library/coercGraph.mli b/helm/ocaml/library/coercGraph.mli
new file mode 100644
index 000000000..1923a964a
--- /dev/null
+++ b/helm/ocaml/library/coercGraph.mli
@@ -0,0 +1,40 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* This module implements the Query interface to the Coercion Graph *)
+
+type coercion_search_result =
+ | SomeCoercion of Cic.term
+ | NoCoercion
+ | NotMetaClosed
+ | NotHandled of string Lazy.t
+
+val look_for_coercion :
+ Cic.term -> Cic.term -> coercion_search_result
+
+val is_a_coercion: Cic.term -> bool
+val source_of: Cic.term -> Cic.term
+val target_of: Cic.term -> Cic.term
+
diff --git a/helm/ocaml/library/libraryClean.ml b/helm/ocaml/library/libraryClean.ml
new file mode 100644
index 000000000..d09769fc2
--- /dev/null
+++ b/helm/ocaml/library/libraryClean.ml
@@ -0,0 +1,238 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+let debug = false
+let debug_prerr = if debug then prerr_endline else ignore
+
+module HGT = Http_getter_types;;
+module HG = Http_getter;;
+module UM = UriManager;;
+
+let cache_of_processed_baseuri = Hashtbl.create 1024
+
+let one_step_depend suri =
+ let buri =
+ try
+ UM.buri_of_uri (UM.uri_of_string suri)
+ with UM.IllFormedUri _ -> suri
+ in
+ if Hashtbl.mem cache_of_processed_baseuri buri then
+ []
+ else
+ begin
+ Hashtbl.add cache_of_processed_baseuri buri true;
+ let query =
+ let buri = buri ^ "/" in
+ let buri = HMysql.escape buri in
+ let obj_tbl = MetadataTypes.obj_tbl () in
+ sprintf
+ ("SELECT source, h_occurrence FROM %s WHERE " ^^
+ "h_occurrence REGEXP '^%s[^/]*$'")
+ obj_tbl buri
+ in
+ try
+ let rc = HMysql.exec (LibraryDb.instance ()) query in
+ let l = ref [] in
+ HMysql.iter rc (
+ fun row ->
+ match row.(0), row.(1) with
+ | Some uri, Some occ when Filename.dirname occ = buri ->
+ l := uri :: !l
+ | _ -> ());
+ let l = List.sort Pervasives.compare !l in
+ HExtlib.list_uniq l
+ with
+ exn -> raise exn (* no errors should be accepted *)
+ end
+
+let safe_buri_of_suri suri =
+ try
+ UM.buri_of_uri (UM.uri_of_string suri)
+ with
+ UM.IllFormedUri _ -> suri
+
+let close_uri_list uri_to_remove =
+ (* to remove an uri you have to remove the whole script *)
+ let buri_to_remove =
+ HExtlib.list_uniq
+ (List.fast_sort Pervasives.compare
+ (List.map safe_buri_of_suri uri_to_remove))
+ in
+ (* cleand the already visided baseuris *)
+ let buri_to_remove =
+ List.filter
+ (fun buri ->
+ if Hashtbl.mem cache_of_processed_baseuri buri then false
+ else true)
+ buri_to_remove
+ in
+ (* now calculate the list of objects that belong to these baseuris *)
+ let uri_to_remove =
+ try
+ List.fold_left
+ (fun acc buri ->
+ let inhabitants = HG.ls (buri ^ "/") in
+ let inhabitants = List.filter
+ (function HGT.Ls_object _ -> true | _ -> false)
+ inhabitants
+ in
+ let inhabitants = List.map
+ (function
+ | HGT.Ls_object e -> buri ^ "/" ^ e.HGT.uri
+ | _ -> assert false)
+ inhabitants
+ in
+ inhabitants @ acc)
+ [] buri_to_remove
+ with HGT.Invalid_URI u ->
+ HLog.error ("We were listing an invalid buri: " ^ u);
+ exit 1
+ in
+ (* now we want the list of all uri that depend on them *)
+ let depend =
+ List.fold_left
+ (fun acc u -> one_step_depend u @ acc) [] uri_to_remove
+ in
+ let depend =
+ HExtlib.list_uniq (List.fast_sort Pervasives.compare depend)
+ in
+ uri_to_remove, depend
+
+let rec close_db uris next =
+ match next with
+ | [] -> uris
+ | l -> let uris, next = close_uri_list l in close_db uris next @ uris
+
+let cleaned_no = ref 0;;
+
+ (** TODO repellent code ... *)
+let moo_root_dir = lazy (
+ let url =
+ List.assoc "cic:/matita/"
+ (List.map
+ (fun pair ->
+ match
+ Str.split (Str.regexp "[ \t\r\n]+") (HExtlib.trim_blanks pair)
+ with
+ | [a;b] -> a, b
+ | _ -> assert false)
+ (Helm_registry.get_list Helm_registry.string "getter.prefix"))
+ in
+ String.sub url 7 (String.length url - 7) (* remove heading "file:///" *)
+)
+
+let close_nodb ~basedir buris =
+ let rev_deps = Hashtbl.create 97 in
+ let all_metadata =
+ HExtlib.find ~test:(fun name -> Filename.check_suffix name ".metadata")
+ (Lazy.force moo_root_dir)
+ in
+ List.iter
+ (fun path ->
+ let metadata = LibraryNoDb.load_metadata ~fname:path in
+ let baseuri_of_current_metadata =
+ let dirname = Filename.dirname path in
+ let basedirlen = String.length basedir in
+ assert (String.sub dirname 0 basedirlen = basedir);
+ "cic:" ^
+ String.sub dirname basedirlen (String.length dirname - basedirlen) ^
+ Filename.basename path
+ in
+ let deps =
+ HExtlib.filter_map
+ (function LibraryNoDb.Dependency buri -> Some buri)
+ metadata
+ in
+ List.iter
+ (fun buri -> Hashtbl.add rev_deps buri baseuri_of_current_metadata) deps)
+ all_metadata;
+ let buris_to_remove =
+ HExtlib.list_uniq
+ (List.fast_sort Pervasives.compare
+ (List.flatten (List.map (Hashtbl.find_all rev_deps) buris)))
+ in
+ let objects_to_remove =
+ let objs_of_buri buri =
+ HExtlib.filter_map
+ (function
+ | Http_getter_types.Ls_object o ->
+ Some (buri ^ "/" ^ o.Http_getter_types.uri)
+ | _ -> None)
+ (Http_getter.ls buri)
+ in
+ List.flatten (List.map objs_of_buri (buris @ buris_to_remove))
+ in
+ objects_to_remove
+
+let clean_baseuris ?(verbose=true) ~basedir buris =
+ Hashtbl.clear cache_of_processed_baseuri;
+ let buris = List.map Http_getter_misc.strip_trailing_slash buris in
+ debug_prerr "clean_baseuris called on:";
+ if debug then
+ List.iter debug_prerr buris;
+ let l =
+ if Helm_registry.get_bool "db.nodb" then
+ close_nodb ~basedir buris
+ else
+ close_db [] buris
+ in
+ let l = HExtlib.list_uniq (List.fast_sort Pervasives.compare l) in
+ let l = List.map UriManager.uri_of_string l in
+ debug_prerr "clean_baseuri will remove:";
+ if debug then
+ List.iter (fun u -> debug_prerr (UriManager.string_of_uri u)) l;
+ List.iter
+ (fun buri ->
+ HExtlib.safe_remove (LibraryMisc.obj_file_of_baseuri basedir buri);
+ HExtlib.safe_remove (LibraryMisc.metadata_file_of_baseuri basedir buri);
+ HExtlib.safe_remove (LibraryMisc.lexicon_file_of_baseuri basedir buri))
+ (HExtlib.list_uniq (List.fast_sort Pervasives.compare
+ (List.map (UriManager.buri_of_uri) l)));
+ List.iter
+ (let last_baseuri = ref "" in
+ fun uri ->
+ let buri = UriManager.buri_of_uri uri in
+ if buri <> !last_baseuri then
+ begin
+ HLog.message ("Removing: " ^ buri ^ "/*");
+ last_baseuri := buri
+ end;
+ LibrarySync.remove_obj uri
+ ) l;
+ cleaned_no := !cleaned_no + List.length l;
+ if !cleaned_no > 30 then
+ begin
+ cleaned_no := 0;
+ List.iter
+ (function table ->
+ ignore (HMysql.exec (LibraryDb.instance ()) ("OPTIMIZE TABLE " ^ table)))
+ [MetadataTypes.name_tbl (); MetadataTypes.rel_tbl ();
+ MetadataTypes.sort_tbl (); MetadataTypes.obj_tbl();
+ MetadataTypes.count_tbl()]
+ end
diff --git a/helm/ocaml/library/libraryClean.mli b/helm/ocaml/library/libraryClean.mli
new file mode 100644
index 000000000..deca8f4a7
--- /dev/null
+++ b/helm/ocaml/library/libraryClean.mli
@@ -0,0 +1,26 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val clean_baseuris : ?verbose:bool -> basedir:string -> string list -> unit
diff --git a/helm/ocaml/library/libraryDb.ml b/helm/ocaml/library/libraryDb.ml
new file mode 100644
index 000000000..f04043366
--- /dev/null
+++ b/helm/ocaml/library/libraryDb.ml
@@ -0,0 +1,168 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf ;;
+
+let instance =
+ let dbd = lazy (
+ HMysql.quick_connect
+ ~host:(Helm_registry.get "db.host")
+ ~user:(Helm_registry.get "db.user")
+ ~database:(Helm_registry.get "db.database")
+ ())
+ in
+ fun () -> Lazy.force dbd
+
+
+let xpointer_RE = Pcre.regexp "#.*$"
+let file_scheme_RE = Pcre.regexp "^file://"
+
+let clean_owner_environment () =
+ let dbd = instance () in
+ let owner = (Helm_registry.get "matita.owner") in
+ let obj_tbl = MetadataTypes.obj_tbl () in
+ let sort_tbl = MetadataTypes.sort_tbl () in
+ let rel_tbl = MetadataTypes.rel_tbl () in
+ let name_tbl = MetadataTypes.name_tbl () in
+ let count_tbl = MetadataTypes.count_tbl () in
+ let tbls = [
+ (obj_tbl,`RefObj) ; (sort_tbl,`RefSort) ; (rel_tbl,`RefRel) ;
+ (name_tbl,`ObjectName) ; (count_tbl,`Count) ]
+ in
+ let statements =
+ (SqlStatements.drop_tables tbls) @ (SqlStatements.drop_indexes tbls)
+ in
+ let owned_uris =
+ try
+ MetadataDb.clean ~dbd
+ with Mysql.Error _ as exn ->
+ match HMysql.errno dbd with
+ | Mysql.No_such_table -> []
+ | _ -> raise exn
+ in
+ List.iter
+ (fun uri ->
+ let uri = Pcre.replace ~rex:xpointer_RE ~templ:"" uri in
+ List.iter
+ (fun suffix ->
+ try
+ HExtlib.safe_remove (Http_getter.resolve (uri ^ suffix))
+ with Http_getter_types.Key_not_found _ -> ())
+ [""; ".body"; ".types"])
+ owned_uris;
+ List.iter (fun statement ->
+ try
+ ignore (HMysql.exec dbd statement)
+ with Mysql.Error _ as exn ->
+ match HMysql.errno dbd with
+ | Mysql.Bad_table_error
+ | Mysql.No_such_index | Mysql.No_such_table -> ()
+ | _ -> raise exn
+ ) statements;
+;;
+
+let create_owner_environment () =
+ let dbd = instance () in
+ let obj_tbl = MetadataTypes.obj_tbl () in
+ let sort_tbl = MetadataTypes.sort_tbl () in
+ let rel_tbl = MetadataTypes.rel_tbl () in
+ let name_tbl = MetadataTypes.name_tbl () in
+ let count_tbl = MetadataTypes.count_tbl () in
+ let tbls = [
+ (obj_tbl,`RefObj) ; (sort_tbl,`RefSort) ; (rel_tbl,`RefRel) ;
+ (name_tbl,`ObjectName) ; (count_tbl,`Count) ]
+ in
+ let statements =
+ (SqlStatements.create_tables tbls) @ (SqlStatements.create_indexes tbls)
+ in
+ List.iter (fun statement ->
+ try
+ ignore (HMysql.exec dbd statement)
+ with
+ exn ->
+ let status = HMysql.status dbd in
+ match status with
+ | Mysql.StatusError Mysql.Table_exists_error -> ()
+ | Mysql.StatusError Mysql.Dup_keyname -> ()
+ | Mysql.StatusError _ -> raise exn
+ | _ -> ()
+ ) statements
+;;
+
+(* removes uri from the ownerized tables, and returns the list of other objects
+ * (theyr uris) that ref the one removed.
+ * AFAIK there is no need to return it, since the MatitaTypes.staus should
+ * contain all defined objects. but to double check we do not garbage the
+ * metadata...
+ *)
+let remove_uri uri =
+ let obj_tbl = MetadataTypes.obj_tbl () in
+ let sort_tbl = MetadataTypes.sort_tbl () in
+ let rel_tbl = MetadataTypes.rel_tbl () in
+ let name_tbl = MetadataTypes.name_tbl () in
+ (*let conclno_tbl = MetadataTypes.conclno_tbl () in
+ let conclno_hyp_tbl = MetadataTypes.fullno_tbl () in*)
+ let count_tbl = MetadataTypes.count_tbl () in
+
+ let dbd = instance () in
+ let suri = UriManager.string_of_uri uri in
+ let query table suri = sprintf
+ "DELETE FROM %s WHERE source LIKE '%s%%'" table (HMysql.escape suri)
+ in
+ List.iter (fun t ->
+ try
+ ignore (HMysql.exec dbd (query t suri))
+ with
+ exn -> raise exn (* no errors should be accepted *)
+ )
+ [obj_tbl;sort_tbl;rel_tbl;name_tbl;(*conclno_tbl;conclno_hyp_tbl*)count_tbl];
+ (* and now the debug job *)
+ let dbg_q =
+ sprintf "SELECT source FROM %s WHERE h_occurrence LIKE '%s%%'" obj_tbl
+ (HMysql.escape suri)
+ in
+ try
+ let rc = HMysql.exec dbd dbg_q in
+ let l = ref [] in
+ HMysql.iter rc (fun a -> match a.(0) with None ->()|Some a -> l := a:: !l);
+ let l = List.sort Pervasives.compare !l in
+ HExtlib.list_uniq l
+ with
+ exn -> raise exn (* no errors should be accepted *)
+
+let xpointers_of_ind uri =
+ let dbd = instance () in
+ let name_tbl = MetadataTypes.name_tbl () in
+ let query = sprintf
+ "SELECT source FROM %s WHERE source LIKE '%s#xpointer%%'" name_tbl
+ (HMysql.escape (UriManager.string_of_uri uri))
+ in
+ let rc = HMysql.exec dbd query in
+ let l = ref [] in
+ HMysql.iter rc (fun a -> match a.(0) with None ->()|Some a -> l := a:: !l);
+ List.map UriManager.uri_of_string !l
+
diff --git a/helm/ocaml/library/libraryDb.mli b/helm/ocaml/library/libraryDb.mli
new file mode 100644
index 000000000..39aa7c079
--- /dev/null
+++ b/helm/ocaml/library/libraryDb.mli
@@ -0,0 +1,34 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val instance: unit -> HMysql.dbd
+
+val create_owner_environment: unit -> unit
+val clean_owner_environment: unit -> unit
+
+(* returns a list of uri thet must be removed sice they reference uri,
+ * but this is used only for debugging purposes *)
+val remove_uri: UriManager.uri -> string list
+val xpointers_of_ind: UriManager.uri -> UriManager.uri list
diff --git a/helm/ocaml/library/libraryMisc.ml b/helm/ocaml/library/libraryMisc.ml
new file mode 100644
index 000000000..3f1931e42
--- /dev/null
+++ b/helm/ocaml/library/libraryMisc.ml
@@ -0,0 +1,38 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let obj_file_of_baseuri ~basedir ~baseuri =
+ let path = basedir ^ "/xml" ^ Pcre.replace ~pat:"^cic:" ~templ:"" baseuri in
+ path ^ ".moo"
+
+let lexicon_file_of_baseuri ~basedir ~baseuri =
+ let path = basedir ^ "/xml" ^ Pcre.replace ~pat:"^cic:" ~templ:"" baseuri in
+ path ^ ".lexicon"
+
+let metadata_file_of_baseuri ~basedir ~baseuri =
+ let path = basedir ^ "/xml" ^ Pcre.replace ~pat:"^cic:" ~templ:"" baseuri in
+ path ^ ".metadata"
diff --git a/helm/ocaml/library/libraryMisc.mli b/helm/ocaml/library/libraryMisc.mli
new file mode 100644
index 000000000..e4d07faf7
--- /dev/null
+++ b/helm/ocaml/library/libraryMisc.mli
@@ -0,0 +1,28 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val obj_file_of_baseuri: basedir:string -> baseuri:string -> string
+val lexicon_file_of_baseuri: basedir:string -> baseuri:string -> string
+val metadata_file_of_baseuri: basedir:string -> baseuri:string -> string
diff --git a/helm/ocaml/library/libraryNoDb.ml b/helm/ocaml/library/libraryNoDb.ml
new file mode 100644
index 000000000..9ac42a5ea
--- /dev/null
+++ b/helm/ocaml/library/libraryNoDb.ml
@@ -0,0 +1,51 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+exception Checksum_failure of string
+exception Corrupt_metadata of string
+exception Version_mismatch of string
+
+let magic = 1
+let format_name = "metadata"
+
+type metadata =
+ | Dependency of string (* baseuri without trailing slash *)
+
+let eq_metadata (m1:metadata) (m2:metadata) = m1 = m2
+
+let save_metadata_to_file ~fname metadata =
+ HMarshal.save ~fmt:format_name ~version:magic ~fname metadata
+
+let load_metadata_from_file ~fname =
+ let raw = HMarshal.load ~fmt:format_name ~version:magic ~fname in
+ (raw: metadata list)
+
+let save_metadata ~fname metadata = save_metadata_to_file ~fname metadata
+let load_metadata ~fname = load_metadata_from_file ~fname
+
diff --git a/helm/ocaml/library/libraryNoDb.mli b/helm/ocaml/library/libraryNoDb.mli
new file mode 100644
index 000000000..1521f456f
--- /dev/null
+++ b/helm/ocaml/library/libraryNoDb.mli
@@ -0,0 +1,35 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* TODO the strings below should be UriManager.uri, but UriManager ATM does not
+ * support their format *)
+type metadata =
+ | Dependency of string (* baseuri without trailing slash *)
+
+val eq_metadata: metadata -> metadata -> bool
+
+val save_metadata: fname:string -> metadata list -> unit
+val load_metadata: fname:string -> metadata list
+
diff --git a/helm/ocaml/library/librarySync.ml b/helm/ocaml/library/librarySync.ml
new file mode 100644
index 000000000..fe631edd2
--- /dev/null
+++ b/helm/ocaml/library/librarySync.ml
@@ -0,0 +1,406 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+exception AlreadyDefined of UriManager.uri
+
+let auxiliary_lemmas_hashtbl = UriManager.UriHashtbl.create 29
+
+(* uri |--> (derived_coercions_in_the_coercion_DB, derived_coercions_in_lib)
+ *
+ * in case of remove_coercion uri, the first component is removed from the
+ * coercion DB, while the second is passed to remove_obj (and is not [] only if
+ * add_coercion is called with add_composites
+ * *)
+let coercion_hashtbl = UriManager.UriHashtbl.create 3
+
+let merge_coercions obj =
+ let module C = Cic in
+ let rec aux2 = (fun (u,t) -> u,aux t)
+ and aux = function
+ | C.Rel _ | C.Sort _ as t -> t
+ | C.Meta _ | C.Implicit _ -> assert false
+ | C.Cast (te,ty) -> C.Cast (aux te, aux ty)
+ | C.Prod (name,so,dest) ->
+ C.Prod (name, aux so, aux dest)
+ | C.Lambda (name,so,dest) ->
+ C.Lambda (name, aux so, aux dest)
+ | C.LetIn (name,so,dest) ->
+ C.LetIn (name, aux so, aux dest)
+ | (Cic.Appl [ c1 ; (Cic.Appl [c2; head]) ]) as t when
+ CoercGraph.is_a_coercion c1 && CoercGraph.is_a_coercion c2 ->
+ let source_carr = CoercGraph.source_of c2 in
+ let tgt_carr = CoercGraph.target_of c1 in
+ (match CoercGraph.look_for_coercion source_carr tgt_carr
+ with
+ | CoercGraph.SomeCoercion c -> Cic.Appl [ c ; head ]
+ | _ -> assert false) (* the composite coercion must exist *)
+ | C.Appl l -> C.Appl (List.map aux l)
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst = List.map aux2 exp_named_subst in
+ C.Var (uri, exp_named_subst)
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst = List.map aux2 exp_named_subst in
+ C.Const (uri, exp_named_subst)
+ | C.MutInd (uri,tyno,exp_named_subst) ->
+ let exp_named_subst = List.map aux2 exp_named_subst in
+ C.MutInd (uri,tyno,exp_named_subst)
+ | C.MutConstruct (uri,tyno,consno,exp_named_subst) ->
+ let exp_named_subst = List.map aux2 exp_named_subst in
+ C.MutConstruct (uri,tyno,consno,exp_named_subst)
+ | C.MutCase (uri,tyno,out,te,pl) ->
+ let pl = List.map aux pl in
+ C.MutCase (uri,tyno,aux out,aux te,pl)
+ | C.Fix (fno, fl) ->
+ let fl = List.map (fun (name,idx,ty,bo)->(name,idx,aux ty,aux bo)) fl in
+ C.Fix (fno, fl)
+ | C.CoFix (fno, fl) ->
+ let fl = List.map (fun (name,ty,bo) -> (name, aux ty, aux bo)) fl in
+ C.CoFix (fno, fl)
+ in
+ match obj with
+ | C.Constant (id, body, ty, params, attrs) ->
+ let body =
+ match body with
+ | None -> None
+ | Some body -> Some (aux body)
+ in
+ let ty = aux ty in
+ C.Constant (id, body, ty, params, attrs)
+ | C.Variable (name, body, ty, params, attrs) ->
+ let body =
+ match body with
+ | None -> None
+ | Some body -> Some (aux body)
+ in
+ let ty = aux ty in
+ C.Variable (name, body, ty, params, attrs)
+ | C.CurrentProof (_name, _conjectures, _body, _ty, _params, _attrs) ->
+ assert false
+ | C.InductiveDefinition (indtys, params, leftno, attrs) ->
+ let indtys =
+ List.map
+ (fun (name, ind, arity, cl) ->
+ let arity = aux arity in
+ let cl = List.map (fun (name, ty) -> (name,aux ty)) cl in
+ (name, ind, arity, cl))
+ indtys
+ in
+ C.InductiveDefinition (indtys, params, leftno, attrs)
+
+let uris_of_obj uri =
+ let innertypesuri = UriManager.innertypesuri_of_uri uri in
+ let bodyuri = UriManager.bodyuri_of_uri uri in
+ let univgraphuri = UriManager.univgraphuri_of_uri uri in
+ innertypesuri,bodyuri,univgraphuri
+
+let paths_and_uris_of_obj uri ~basedir =
+ let basedir = basedir ^ "/xml" in
+ let innertypesuri, bodyuri, univgraphuri = uris_of_obj uri in
+ let innertypesfilename = Str.replace_first (Str.regexp "^cic:") ""
+ (UriManager.string_of_uri innertypesuri) ^ ".xml.gz" in
+ let innertypespath = basedir ^ "/" ^ innertypesfilename in
+ let xmlfilename = Str.replace_first (Str.regexp "^cic:/") ""
+ (UriManager.string_of_uri uri) ^ ".xml.gz" in
+ let xmlpath = basedir ^ "/" ^ xmlfilename in
+ let xmlbodyfilename = Str.replace_first (Str.regexp "^cic:/") ""
+ (UriManager.string_of_uri uri) ^ ".body.xml.gz" in
+ let xmlbodypath = basedir ^ "/" ^ xmlbodyfilename in
+ let xmlunivgraphfilename = Str.replace_first (Str.regexp "^cic:/") ""
+ (UriManager.string_of_uri univgraphuri) ^ ".xml.gz" in
+ let xmlunivgraphpath = basedir ^ "/" ^ xmlunivgraphfilename in
+ xmlpath, xmlbodypath, innertypespath, bodyuri, innertypesuri,
+ xmlunivgraphpath, univgraphuri
+
+let save_object_to_disk ~basedir uri obj ugraph univlist =
+ let ensure_path_exists path =
+ let dir = Filename.dirname path in
+ HExtlib.mkdir dir
+ in
+ (* generate annobj, ids_to_inner_sorts and ids_to_inner_types *)
+ let annobj = Cic2acic.plain_acic_object_of_cic_object obj in
+ (* prepare XML *)
+ let xml, bodyxml =
+ Cic2Xml.print_object
+ uri ?ids_to_inner_sorts:None ~ask_dtd_to_the_getter:false annobj
+ in
+ let xmlpath, xmlbodypath, innertypespath, bodyuri, innertypesuri,
+ xmlunivgraphpath, univgraphuri =
+ paths_and_uris_of_obj uri basedir
+ in
+ List.iter HExtlib.mkdir (List.map Filename.dirname [xmlpath]);
+ (* now write to disk *)
+ ensure_path_exists xmlpath;
+ Xml.pp ~gzip:true xml (Some xmlpath);
+ CicUniv.write_xml_of_ugraph xmlunivgraphpath ugraph univlist;
+ (* we return a list of uri,path we registered/created *)
+ (uri,xmlpath) ::
+ (univgraphuri,xmlunivgraphpath) ::
+ (* now the optional body, both write and register *)
+ (match bodyxml,bodyuri with
+ None,None -> []
+ | Some bodyxml,Some bodyuri->
+ ensure_path_exists xmlbodypath;
+ Xml.pp ~gzip:true bodyxml (Some xmlbodypath);
+ [bodyuri, xmlbodypath]
+ | _-> assert false)
+
+
+let typecheck_obj =
+ let profiler = HExtlib.profile "add_obj.typecheck_obj" in
+ fun uri obj -> profiler.HExtlib.profile (CicTypeChecker.typecheck_obj uri) obj
+
+let index_obj =
+ let profiler = HExtlib.profile "add_obj.index_obj" in
+ fun ~dbd ~uri ->
+ profiler.HExtlib.profile (fun uri -> MetadataDb.index_obj ~dbd ~uri) uri
+
+let add_single_obj uri obj ~basedir =
+ let obj =
+ if List.mem `Generated (CicUtil.attributes_of_obj obj) &&
+ not (CoercGraph.is_a_coercion (Cic.Const (uri, [])))
+ then
+ merge_coercions obj
+ else
+ obj
+ in
+ let dbd = LibraryDb.instance () in
+ if CicEnvironment.in_library uri then
+ raise (AlreadyDefined uri)
+ else begin
+ typecheck_obj uri obj; (* 1 *)
+ let _, ugraph, univlist =
+ CicEnvironment.get_cooked_obj_with_univlist CicUniv.empty_ugraph uri in
+ try
+ index_obj ~dbd ~uri; (* 2 must be in the env *)
+ try
+ (*3*)
+ let new_stuff = save_object_to_disk ~basedir uri obj ugraph univlist in
+ try
+ HLog.message
+ (Printf.sprintf "%s defined" (UriManager.string_of_uri uri))
+ with exc ->
+ List.iter HExtlib.safe_remove (List.map snd new_stuff); (* -3 *)
+ raise exc
+ with exc ->
+ ignore(LibraryDb.remove_uri uri); (* -2 *)
+ raise exc
+ with exc ->
+ CicEnvironment.remove_obj uri; (* -1 *)
+ raise exc
+ end
+
+let remove_single_obj uri =
+ let derived_uris_of_uri uri =
+ let innertypesuri, bodyuri, univgraphuri = uris_of_obj uri in
+ innertypesuri::univgraphuri::(match bodyuri with None -> [] | Some u -> [u])
+ in
+ let to_remove =
+ uri ::
+ (if UriManager.uri_is_ind uri then LibraryDb.xpointers_of_ind uri else []) @
+ derived_uris_of_uri uri
+ in
+ List.iter
+ (fun uri ->
+ (try
+ let file = Http_getter.resolve' uri in
+ HExtlib.safe_remove file;
+ HExtlib.rmdir_descend (Filename.dirname file)
+ with Http_getter_types.Key_not_found _ -> ());
+ ignore (LibraryDb.remove_uri uri);
+ (*CoercGraph.remove_coercion uri;*)
+ CicEnvironment.remove_obj uri)
+ to_remove
+
+(*** GENERATION OF AUXILIARY LEMMAS ***)
+
+let generate_elimination_principles ~basedir uri =
+ let uris = ref [] in
+ let elim sort =
+ try
+ let uri,obj = CicElim.elim_of ~sort uri 0 in
+ add_single_obj uri obj ~basedir;
+ uris := uri :: !uris
+ with CicElim.Can_t_eliminate -> ()
+ in
+ try
+ List.iter elim [ Cic.Prop; Cic.Set; (Cic.Type (CicUniv.fresh ())) ];
+ !uris
+ with exn ->
+ List.iter remove_single_obj !uris;
+ raise exn
+
+(* COERCIONS ***********************************************************)
+
+let remove_all_coercions () =
+ UriManager.UriHashtbl.clear coercion_hashtbl;
+ CoercDb.remove_coercion (fun (_,_,u1) -> true)
+
+let add_coercion ~basedir ~add_composites uri =
+ let coer_ty,_ =
+ let coer = CicUtil.term_of_uri uri in
+ CicTypeChecker.type_of_aux' [] [] coer CicUniv.empty_ugraph
+ in
+ (* we have to get the source and the tgt type uri
+ * in Coq syntax we have already their names, but
+ * since we don't support Funclass and similar I think
+ * all the coercion should be of the form
+ * (A:?)(B:?)T1->T2
+ * So we should be able to extract them from the coercion type
+ *
+ * Currently only (_:T1)T2 is supported.
+ * should we saturate it with metas in case we insert it?
+ *
+ *)
+ let extract_last_two_p ty =
+ let rec aux = function
+ | Cic.Prod( _, src, Cic.Prod (n,t1,t2)) ->
+ assert false
+ (* not implemented: aux (Cic.Prod(n,t1,t2)) *)
+ | Cic.Prod( _, src, tgt) -> src, tgt
+ | _ -> assert false
+ in
+ aux ty
+ in
+ let ty_src, ty_tgt = extract_last_two_p coer_ty in
+ let src_uri = CoercDb.coerc_carr_of_term (CicReduction.whd [] ty_src) in
+ let tgt_uri = CoercDb.coerc_carr_of_term (CicReduction.whd [] ty_tgt) in
+ let new_coercions = CicCoercion.close_coercion_graph src_uri tgt_uri uri in
+ let composite_uris = List.map (fun (_,_,uri,_) -> uri) new_coercions in
+ (* update the DB *)
+ List.iter
+ (fun (src,tgt,uri,_) -> CoercDb.add_coercion (src,tgt,uri))
+ new_coercions;
+ CoercDb.add_coercion (src_uri, tgt_uri, uri);
+ (* add the composites obj and they eventual lemmas *)
+ let lemmas =
+ if add_composites then
+ List.fold_left
+ (fun acc (_,_,uri,obj) ->
+ add_single_obj ~basedir uri obj;
+ uri::acc)
+ composite_uris new_coercions
+ else
+ []
+ in
+ (* store that composite_uris are related to uri. the first component is the
+ * stuff in the DB while the second is stuff for remove_obj *)
+ UriManager.UriHashtbl.add coercion_hashtbl uri
+ (composite_uris,if add_composites then composite_uris else []);
+ lemmas
+
+let remove_coercion uri =
+ try
+ let (composites_in_db, composites_in_lib) =
+ UriManager.UriHashtbl.find coercion_hashtbl uri
+ in
+ UriManager.UriHashtbl.remove coercion_hashtbl uri;
+ CoercDb.remove_coercion (fun (_,_,u) -> UriManager.eq uri u);
+ (* remove from the DB *)
+ List.iter
+ (fun u -> CoercDb.remove_coercion (fun (_,_,u1) -> UriManager.eq u u1))
+ composites_in_db;
+ (* remove composites from the lib *)
+ List.iter remove_single_obj composites_in_lib
+ with
+ Not_found -> () (* mhh..... *)
+
+
+let generate_projections ~basedir uri fields =
+ let uris = ref [] in
+ let projections = CicRecord.projections_of uri (List.map fst fields) in
+ try
+ List.iter2
+ (fun (uri, name, bo) (_name, coercion) ->
+ try
+ let ty, ugraph =
+ CicTypeChecker.type_of_aux' [] [] bo CicUniv.empty_ugraph in
+ let attrs = [`Class `Projection; `Generated] in
+ let obj = Cic.Constant (name,Some bo,ty,[],attrs) in
+
+ add_single_obj ~basedir uri obj;
+ let composites =
+ if coercion then
+ add_coercion ~basedir ~add_composites:true uri
+ else
+ []
+ in
+ uris := uri :: composites @ !uris
+ with
+ CicTypeChecker.TypeCheckerFailure s ->
+ HLog.message
+ ("Unable to create projection " ^ name ^ " cause: " ^ Lazy.force s);
+ | CicEnvironment.Object_not_found uri ->
+ let depend = UriManager.name_of_uri uri in
+ HLog.message
+ ("Unable to create projection " ^ name ^ " because it requires " ^
+ depend)
+ ) projections fields;
+ !uris
+ with exn ->
+ List.iter remove_single_obj !uris;
+ raise exn
+
+
+let add_obj uri obj ~basedir =
+ add_single_obj uri obj ~basedir;
+ let uris = ref [] in
+ try
+ begin
+ match obj with
+ | Cic.Constant _ -> ()
+ | Cic.InductiveDefinition (_,_,_,attrs) ->
+ uris := !uris @ generate_elimination_principles ~basedir uri;
+ let rec get_record_attrs =
+ function
+ | [] -> None
+ | (`Class (`Record fields))::_ -> Some fields
+ | _::tl -> get_record_attrs tl
+ in
+ (match get_record_attrs attrs with
+ | None -> () (* not a record *)
+ | Some fields ->
+ uris := !uris @ (generate_projections ~basedir uri fields))
+ | Cic.CurrentProof _
+ | Cic.Variable _ -> assert false
+ end;
+ UriManager.UriHashtbl.add auxiliary_lemmas_hashtbl uri !uris;
+ !uris
+ with exn ->
+ List.iter remove_single_obj !uris;
+ raise exn
+
+let remove_obj uri =
+ let uris =
+ try
+ let res = UriManager.UriHashtbl.find auxiliary_lemmas_hashtbl uri in
+ UriManager.UriHashtbl.remove auxiliary_lemmas_hashtbl uri;
+ res
+ with
+ Not_found -> [] (*assert false*)
+ in
+ List.iter remove_single_obj (uri::uris)
+
diff --git a/helm/ocaml/library/librarySync.mli b/helm/ocaml/library/librarySync.mli
new file mode 100644
index 000000000..43ac34da3
--- /dev/null
+++ b/helm/ocaml/library/librarySync.mli
@@ -0,0 +1,52 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+exception AlreadyDefined of UriManager.uri
+
+(* adds an object to the library together with all auxiliary lemmas on it *)
+(* (e.g. elimination principles, projections, etc.) *)
+(* it returns the list of the uris of the auxiliary lemmas generated *)
+val add_obj: UriManager.uri -> Cic.obj -> basedir:string -> UriManager.uri list
+
+(* inverse of add_obj; *)
+(* Warning: it does not remove the dependencies on the object and on its *)
+(* auxiliary lemmas! *)
+val remove_obj: UriManager.uri -> unit
+
+(* Informs the library that [uri] is a coercion. *)
+(* This can generate some composite coercions that, if [add_composites] *)
+(* is true are added to the library. *)
+(* The list of added objects is returned. *)
+val add_coercion:
+ basedir:string -> add_composites:bool -> UriManager.uri ->
+ UriManager.uri list
+
+(* inverse of add_coercion, removes both the eventually created composite *)
+(* coercions and the information that [uri] and the composites are coercion *)
+val remove_coercion: UriManager.uri -> unit
+
+(* mh... *)
+val remove_all_coercions: unit -> unit
+
diff --git a/helm/ocaml/license b/helm/ocaml/license
new file mode 100644
index 000000000..c67e1fc29
--- /dev/null
+++ b/helm/ocaml/license
@@ -0,0 +1,25 @@
+(* Copyright (C) 2006, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
diff --git a/helm/ocaml/logger/.depend b/helm/ocaml/logger/.depend
new file mode 100644
index 000000000..28268d29e
--- /dev/null
+++ b/helm/ocaml/logger/.depend
@@ -0,0 +1,2 @@
+helmLogger.cmo: helmLogger.cmi
+helmLogger.cmx: helmLogger.cmi
diff --git a/helm/ocaml/logger/Makefile b/helm/ocaml/logger/Makefile
new file mode 100644
index 000000000..dab9f5cb3
--- /dev/null
+++ b/helm/ocaml/logger/Makefile
@@ -0,0 +1,9 @@
+
+PACKAGE = logger
+INTERFACE_FILES = \
+ helmLogger.mli
+IMPLEMENTATION_FILES = \
+ $(INTERFACE_FILES:%.mli=%.ml)
+
+include ../Makefile.common
+
diff --git a/helm/ocaml/logger/helmLogger.ml b/helm/ocaml/logger/helmLogger.ml
new file mode 100644
index 000000000..c41674754
--- /dev/null
+++ b/helm/ocaml/logger/helmLogger.ml
@@ -0,0 +1,62 @@
+(* $Id$ *)
+
+open Printf
+
+(* HTML simulator (first in its kind) *)
+
+type html_tag =
+ [ `T of string
+ | `L of html_tag list
+ | `BR
+ | `DIV of int * string option * html_tag
+ ]
+
+type html_msg = [ `Error of html_tag | `Msg of html_tag ]
+
+type logger_fun = ?append_NL:bool -> html_msg -> unit
+
+let rec string_of_html_tag =
+ let rec aux indent =
+ let indent_str = String.make indent ' ' in
+ function
+ | `T s -> s
+ | `L msgs ->
+ String.concat ("\n" ^ indent_str) (List.map (aux indent) msgs)
+ | `BR -> "\n" ^ indent_str
+ | `DIV (local_indent, _, tag) ->
+ "\n" ^ indent_str ^ aux (indent + local_indent) tag
+ in
+ aux 0
+
+let string_of_html_msg = function
+ | `Error tag -> "Error: " ^ string_of_html_tag tag
+ | `Msg tag -> string_of_html_tag tag
+
+let rec html_of_html_tag = function
+ | `T s -> s
+ | `L msgs ->
+ sprintf "<ul>\n%s\n</ul>"
+ (String.concat "\n"
+ (List.map
+ (fun msg -> sprintf "<li>%s</li>" (html_of_html_tag msg))
+ msgs))
+ | `BR -> "<br />\n"
+ | `DIV (indent, color, tag) ->
+ sprintf "<div style=\"%smargin-left:%fcm\">\n%s\n</div>"
+ (match color with None -> "" | Some color -> "color: " ^ color ^ "; ")
+ (float_of_int indent *. 0.5)
+ (html_of_html_tag tag)
+
+let html_of_html_msg =
+ function
+ | `Error tag -> "<b>Error: " ^ html_of_html_tag tag ^ "</b>"
+ | `Msg tag -> html_of_html_tag tag
+
+let log_callbacks = ref []
+
+let register_log_callback logger_fun =
+ log_callbacks := !log_callbacks @ [ logger_fun ]
+
+let log ?append_NL html_msg =
+ List.iter (fun logger_fun -> logger_fun ?append_NL html_msg) !log_callbacks
+
diff --git a/helm/ocaml/logger/helmLogger.mli b/helm/ocaml/logger/helmLogger.mli
new file mode 100644
index 000000000..633b5c3ec
--- /dev/null
+++ b/helm/ocaml/logger/helmLogger.mli
@@ -0,0 +1,27 @@
+
+type html_tag =
+ [ `BR
+ | `L of html_tag list
+ | `T of string
+ | `DIV of int * string option * html_tag (* indentation, color, tag *)
+ ]
+type html_msg = [ `Error of html_tag | `Msg of html_tag ]
+
+ (** html_msg to plain text converter *)
+val string_of_html_msg: html_msg -> string
+
+ (** html_tag to plain text converter *)
+val string_of_html_tag: html_tag -> string
+
+ (** html_msg to html text converter *)
+val html_of_html_msg: html_msg -> string
+
+ (** html_tag to html text converter *)
+val html_of_html_tag: html_tag -> string
+
+type logger_fun = ?append_NL:bool -> html_msg -> unit
+
+val register_log_callback: logger_fun -> unit
+
+val log: logger_fun
+
diff --git a/helm/ocaml/mathql/.depend b/helm/ocaml/mathql/.depend
new file mode 100644
index 000000000..e69de29bb
diff --git a/helm/ocaml/mathql/Makefile b/helm/ocaml/mathql/Makefile
new file mode 100644
index 000000000..17cafb431
--- /dev/null
+++ b/helm/ocaml/mathql/Makefile
@@ -0,0 +1,13 @@
+PACKAGE = mathql
+
+PREDICATES =
+
+INTERFACE_FILES =
+
+IMPLEMENTATION_FILES = mathQL.ml
+
+EXTRA_OBJECTS_TO_INSTALL = mathQL.ml mathQL.cmi
+
+EXTRA_OBJECTS_TO_CLEAN =
+
+include ../Makefile.common
diff --git a/helm/ocaml/mathql/mathQL.ml b/helm/ocaml/mathql/mathQL.ml
new file mode 100644
index 000000000..2504cfb4f
--- /dev/null
+++ b/helm/ocaml/mathql/mathQL.ml
@@ -0,0 +1,133 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://www.cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+(* $Id$ *)
+
+(* output data structures ***************************************************)
+
+type path = string list (* the name of an attribute *)
+
+type value = string list (* the value of an attribute *)
+
+type attribute = path * value (* an attribute *)
+
+type attribute_group = attribute list (* a group of attributes *)
+
+type attribute_set = attribute_group list (* the attributes of an URI *)
+
+type resource = string * attribute_set (* an attributed URI *)
+
+type resource_set = resource list (* the query result *)
+
+type result = resource_set
+
+
+(* input data structures ****************************************************)
+
+type svar = string (* the name of a variable for a resource set *)
+
+type avar = string (* the name of a variable for a resource *)
+
+type vvar = string (* the name of a variable for an attribute value *)
+
+type inverse = bool
+
+type refine = RefineExact
+ | RefineSub
+ | RefineSuper
+
+type main = path
+
+type pattern = bool
+
+type exp = path * (path option)
+
+type exp_list = exp list
+
+type allbut = bool
+
+type xml = bool
+
+type source = bool
+
+type bin = BinFJoin (* full union - with attr handling *)
+ | BinFMeet (* full intersection - with attr handling *)
+ | BinFDiff (* full difference - with attr handling *)
+
+type gen = GenFJoin (* full union - with attr handling *)
+ | GenFMeet (* full intersection - with attr handling *)
+
+type test = Xor
+ | Or
+ | And
+ | Sub
+ | Meet
+ | Eq
+ | Le
+ | Lt
+
+type query = Empty
+ | SVar of svar
+ | AVar of avar
+ | Subj of msval
+ | Property of inverse * refine * path *
+ main * istrue * isfalse list * exp_list *
+ pattern * msval
+ | Select of avar * query * msval
+ | Bin of bin * query * query
+ | LetSVar of svar * query * query
+ | LetVVar of vvar * msval * query
+ | For of gen * avar * query * query
+ | Add of bool * groups * query
+ | If of msval * query * query
+ | Log of xml * source * query
+ | StatQuery of query
+ | Keep of allbut * path list * query
+
+and msval = False
+ | True
+ | Not of msval
+ | Ex of avar list * msval
+ | Test of test * msval * msval
+ | Const of string
+ | Set of msval list
+ | Proj of path option * query
+ | Dot of avar * path
+ | VVar of vvar
+ | StatVal of msval
+ | Count of msval
+ | Align of string * msval
+
+and groups = Attr of (path * msval) list list
+ | From of avar
+
+and con = pattern * path * msval
+
+and istrue = con list
+
+and isfalse = con list
diff --git a/helm/ocaml/mathql_generator/.depend b/helm/ocaml/mathql_generator/.depend
new file mode 100644
index 000000000..0dc5572a0
--- /dev/null
+++ b/helm/ocaml/mathql_generator/.depend
@@ -0,0 +1,15 @@
+mQGUtil.cmi: mQGTypes.cmo
+mQueryGenerator.cmi: mQGTypes.cmo
+cGMatchConclusion.cmi: mQGTypes.cmo
+cGSearchPattern.cmi: mQGTypes.cmo
+cGLocateInductive.cmi: mQGTypes.cmo
+mQGUtil.cmo: mQGTypes.cmo mQGUtil.cmi
+mQGUtil.cmx: mQGTypes.cmx mQGUtil.cmi
+mQueryGenerator.cmo: mQGUtil.cmi mQGTypes.cmo mQueryGenerator.cmi
+mQueryGenerator.cmx: mQGUtil.cmx mQGTypes.cmx mQueryGenerator.cmi
+cGMatchConclusion.cmo: mQGTypes.cmo cGMatchConclusion.cmi
+cGMatchConclusion.cmx: mQGTypes.cmx cGMatchConclusion.cmi
+cGSearchPattern.cmo: mQGUtil.cmi mQGTypes.cmo cGSearchPattern.cmi
+cGSearchPattern.cmx: mQGUtil.cmx mQGTypes.cmx cGSearchPattern.cmi
+cGLocateInductive.cmo: mQGTypes.cmo cGLocateInductive.cmi
+cGLocateInductive.cmx: mQGTypes.cmx cGLocateInductive.cmi
diff --git a/helm/ocaml/mathql_generator/Makefile b/helm/ocaml/mathql_generator/Makefile
new file mode 100644
index 000000000..cf8e820d9
--- /dev/null
+++ b/helm/ocaml/mathql_generator/Makefile
@@ -0,0 +1,15 @@
+PACKAGE = mathql_generator
+
+PREDICATES =
+
+INTERFACE_FILES = mQGUtil.mli mQueryGenerator.mli \
+ cGMatchConclusion.mli cGSearchPattern.mli \
+ cGLocateInductive.mli
+
+IMPLEMENTATION_FILES = mQGTypes.ml $(INTERFACE_FILES:%.mli=%.ml)
+
+EXTRA_OBJECTS_TO_INSTALL = mQGTypes.ml mQGTypes.cmi
+
+EXTRA_OBJECTS_TO_CLEAN =
+
+include ../Makefile.common
diff --git a/helm/ocaml/mathql_generator/cGLocateInductive.ml b/helm/ocaml/mathql_generator/cGLocateInductive.ml
new file mode 100644
index 000000000..261b29388
--- /dev/null
+++ b/helm/ocaml/mathql_generator/cGLocateInductive.ml
@@ -0,0 +1,42 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+(* $Id$ *)
+
+exception NotAnInductiveDefinition
+
+let get_constraints = function
+ | Cic.MutInd (uri, t, _) ->
+ let uri = UriManager.string_of_uriref (uri, [t]) in
+ let constr_obj =
+ [(`InHypothesis, uri); (`MainHypothesis (Some 0), uri)]
+ in
+ let constr_rel = [`MainConclusion None] in
+ let constr_sort = [(`MainHypothesis (Some 1), MQGTypes.Prop)] in
+ (constr_obj, constr_rel, constr_sort)
+ | _ -> raise NotAnInductiveDefinition
diff --git a/helm/ocaml/mathql_generator/cGLocateInductive.mli b/helm/ocaml/mathql_generator/cGLocateInductive.mli
new file mode 100644
index 000000000..b6a51401e
--- /dev/null
+++ b/helm/ocaml/mathql_generator/cGLocateInductive.mli
@@ -0,0 +1,31 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+val get_constraints : Cic.term -> MQGTypes.must_restrictions
+
+exception NotAnInductiveDefinition
diff --git a/helm/ocaml/mathql_generator/cGMatchConclusion.ml b/helm/ocaml/mathql_generator/cGMatchConclusion.ml
new file mode 100644
index 000000000..0a67c2d0d
--- /dev/null
+++ b/helm/ocaml/mathql_generator/cGMatchConclusion.ml
@@ -0,0 +1,161 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+(* $Id$ *)
+
+module T = MQGTypes
+
+let text_of_entries out entries =
+ out "(** MatchConclusion: results of the term inspection **)\n";
+ let text_of_entry (u, b, v) =
+ out (string_of_int v ^ " ");
+ out (if b then "$MC " else "$IC ");
+ out (u ^ "\n")
+ in List.iter text_of_entry entries
+
+let sort_entries entries =
+ let comparator (_, _, v1) (_, _, v2) = compare v1 v2 in
+ List.fast_sort comparator entries
+
+let levels_of_term metasenv context term =
+ let module TC = CicTypeChecker in
+ let module Red = CicReduction in
+ let degree t =
+ let rec degree_aux = function
+ | Cic.Sort _ -> 1
+ | Cic.Cast (u, _) -> degree_aux u
+ | Cic.Prod (_, _, t) -> degree_aux t
+ | _ -> 2
+ in
+ let u,_ = TC.type_of_aux' metasenv context t CicUniv.empty_ugraph in
+ degree_aux (Red.whd context u)
+ in
+ let entry_eq (s1, b1, v1) (s2, b2, v2) =
+ s1 = s2 && b1 = b2
+ in
+ let rec entry_in e = function
+ | [] -> [e]
+ | head :: tail ->
+ head :: if entry_eq head e then tail else entry_in e tail
+ in
+ let inspect_uri main l uri tc v term =
+ let d = degree term in
+ entry_in (UriManager.string_of_uriref (uri, tc), main, 2 * v + d - 1) l
+ in
+ let rec inspect_term main l v term = match term with
+ Cic.Rel _ -> l
+ | Cic.Meta _ -> l
+ | Cic.Sort _ -> l
+ | Cic.Implicit _ -> l
+ | Cic.Var (u,exp_named_subst) ->
+ inspect_exp_named_subst l (succ v) exp_named_subst
+(*
+ let l' = inspect_uri main l u [] v term in
+ inspect_exp_named_subst l' (succ v) exp_named_subst
+*)
+ | Cic.Const (u,exp_named_subst) ->
+ let l' = inspect_uri main l u [] v term in
+ inspect_exp_named_subst l' (succ v) exp_named_subst
+ | Cic.MutInd (u, t, exp_named_subst) ->
+ let l' = inspect_uri main l u [t] v term in
+ inspect_exp_named_subst l' (succ v) exp_named_subst
+ | Cic.MutConstruct (u, t, c, exp_named_subst) ->
+ let l' = inspect_uri main l u [t; c] v term in
+ inspect_exp_named_subst l' (succ v) exp_named_subst
+ | Cic.Cast (uu, _) ->
+ inspect_term main l v uu
+ | Cic.Prod (_, uu, tt) ->
+ let luu = inspect_term false l (succ v) uu in
+ inspect_term main luu (succ v) tt
+ | Cic.Lambda (_, uu, tt) ->
+ let luu = inspect_term false l (succ v) uu in
+ inspect_term false luu (succ v) tt
+ | Cic.LetIn (_, uu, tt) ->
+ let luu = inspect_term false l (succ v) uu in
+ inspect_term false luu (succ v) tt
+ | Cic.Appl m -> inspect_list main l true v m
+ | Cic.MutCase (u, t, tt, uu, m) ->
+ let lu = inspect_uri main l u [t] (succ v) term in
+ let ltt = inspect_term false lu (succ v) tt in
+ let luu = inspect_term false ltt (succ v) uu in
+ inspect_list main luu false (succ v) m
+ | Cic.Fix (_, m) -> inspect_ind l (succ v) m
+ | Cic.CoFix (_, m) -> inspect_coind l (succ v) m
+ and inspect_list main l head v = function
+ | [] -> l
+ | tt :: m ->
+ let ltt = inspect_term main l (if head then v else v + 1) tt in
+ inspect_list false ltt false v m
+ and inspect_exp_named_subst l v = function
+ [] -> l
+ | (_,t) :: tl ->
+ let l' = inspect_term false l v t in
+ inspect_exp_named_subst l' v tl
+ and inspect_ind l v = function
+ | [] -> l
+ | (_, _, tt, uu) :: m ->
+ let ltt = inspect_term false l v tt in
+ let luu = inspect_term false ltt v uu in
+ inspect_ind luu v m
+ and inspect_coind l v = function
+ | [] -> l
+ | (_, tt, uu) :: m ->
+ let ltt = inspect_term false l v tt in
+ let luu = inspect_term false ltt v uu in
+ inspect_coind luu v m
+ in
+ let rec inspect_backbone = function
+ | Cic.Cast (uu, _) -> inspect_backbone uu
+ | Cic.Prod (_, _, tt) -> inspect_backbone tt
+ | Cic.LetIn (_, uu, tt) -> inspect_backbone tt
+ | t -> inspect_term true [] 0 t
+ in
+ inspect_backbone term
+
+let get_constraints e c t =
+ let can = sort_entries (levels_of_term e c t) in (* can restrictions *)
+ text_of_entries prerr_string can; flush stderr; (* logging *)
+ let rest_of (u, b, _) =
+ let p = if b then `MainConclusion None else `InConclusion in (p, u)
+ in
+ let rec split vp = function
+ | [], ((_, _, v) as hd) :: tl -> split v ([rest_of hd], tl)
+ | prev, ((_, _, ve) as hd) :: tl when vp = ve ->
+ split vp (rest_of hd :: prev, tl)
+ | p, l -> p, l
+ in
+ let rec mk_musts prev acc = function
+ | [] -> prev, acc
+ | l ->
+ let slice, next = split 0 ([], l) in
+ let acc = acc @ slice in
+ mk_musts (prev @ [acc]) acc next
+ in
+ mk_musts [] [] can
+
+let universe = [T.MainConclusion; T.InConclusion]
diff --git a/helm/ocaml/mathql_generator/cGMatchConclusion.mli b/helm/ocaml/mathql_generator/cGMatchConclusion.mli
new file mode 100644
index 000000000..a9fbef47f
--- /dev/null
+++ b/helm/ocaml/mathql_generator/cGMatchConclusion.mli
@@ -0,0 +1,33 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+val get_constraints: Cic.metasenv -> Cic.context -> Cic.term ->
+ MQGTypes.r_obj list list *
+ MQGTypes.r_obj list
+
+val universe : MQGTypes.universe
diff --git a/helm/ocaml/mathql_generator/cGSearchPattern.ml b/helm/ocaml/mathql_generator/cGSearchPattern.ml
new file mode 100644
index 000000000..1d7e85937
--- /dev/null
+++ b/helm/ocaml/mathql_generator/cGSearchPattern.ml
@@ -0,0 +1,197 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(******************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Claudio Sacerdoti Coen <sacerdot@cs.unibo.it> *)
+(* 02/12/2002 *)
+(* *)
+(* Missing description *)
+(* *)
+(******************************************************************************)
+
+(* $Id$ *)
+
+module T = MQGTypes
+module U = MQGUtil
+
+type classification =
+ Backbone of int
+ | Branch of int
+ | InConclusion
+ | InHypothesis
+;;
+
+let soften_classification =
+ function
+ Backbone _ -> InConclusion
+ | Branch _ -> InHypothesis
+ | k -> k
+;;
+
+let (!!) =
+ function
+ Backbone n -> `MainConclusion (Some n)
+ | Branch n -> `MainHypothesis (Some n)
+ | _ -> assert false
+;;
+
+let (!!!) =
+ function
+ Backbone n -> `MainConclusion (Some n)
+ | Branch n -> `MainHypothesis (Some n)
+ | InConclusion -> `InConclusion
+ | InHypothesis -> `InHypothesis
+;;
+
+
+let (@@) (l1,l2,l3) (l1',l2',l3') =
+ let merge l1 l2 =
+ List.fold_left (fun i t -> if List.mem t l2 then i else t::i) l2 l1
+ in
+ merge l1 l1', merge l2 l2', merge l3 l3'
+;;
+
+let get_constraints term =
+ let module U = UriManager in
+ let module C = Cic in
+ let rec process_type_aux kind =
+ function
+ C.Var (uri,expl_named_subst) ->
+ (* andrea: this is a bug: variable are not indexedin the db
+ ([!!!kind, UriManager.string_of_uri uri],[],[]) @@ *)
+ (process_type_aux_expl_named_subst kind expl_named_subst)
+ | C.Rel _ ->
+ (match kind with
+ | InConclusion
+ | InHypothesis -> [],[],[]
+ | _ -> [],[!!kind],[])
+ | C.Sort s ->
+ (match kind with
+ Backbone _
+ | Branch _ ->
+ let s' =
+ match s with
+ Cic.Prop -> T.Prop
+ | Cic.Set -> T.Set
+ | Cic.Type _ -> T.Type (* TASSI: ?? *)
+ | Cic.CProp -> T.CProp
+ in
+ [],[],[!!kind,s']
+ | _ -> [],[],[])
+ | C.Meta _ -> [],[],[] (* ???? To be understood *)
+ | C.Implicit _ -> assert false
+ | C.Cast (te,_) ->
+ (* type ignored *)
+ process_type_aux kind te
+ | C.Prod (_,sou,ta) ->
+ let (source_kind,target_kind) =
+ match kind with
+ Backbone n -> (Branch 0, Backbone (n+1))
+ | Branch n -> (InHypothesis, Branch (n+1))
+ | k -> (k,k)
+ in
+ process_type_aux source_kind sou @@
+ process_type_aux target_kind ta
+ | C.Lambda (_,sou,ta) ->
+ let kind' = soften_classification kind in
+ process_type_aux kind' sou @@
+ process_type_aux kind' ta
+ | C.LetIn (_,te,ta)->
+ let kind' = soften_classification kind in
+ process_type_aux kind' te @@
+ process_type_aux kind ta
+ | C.Appl (he::tl) ->
+ let kind' = soften_classification kind in
+ process_type_aux kind he @@
+ List.fold_left (fun i t -> i @@ process_type_aux kind' t) ([],[],[]) tl
+ | C.Appl _ -> assert false
+ | C.Const (uri,_) ->
+ [!!!kind, UriManager.string_of_uri uri],[],[]
+ | C.MutInd (uri,typeno,expl_named_subst) ->
+ ([!!!kind, U.string_of_uri uri ^ "#xpointer(1/" ^
+ string_of_int (typeno + 1) ^ ")"],[],[]) @@
+ (process_type_aux_expl_named_subst kind expl_named_subst)
+ | C.MutConstruct (uri,typeno,consno,expl_named_subst) ->
+ ([!!!kind, U.string_of_uri uri ^ "#xpointer(1/" ^
+ string_of_int (typeno + 1) ^ "/" ^ string_of_int consno ^ ")"],[],[])
+ @@ (process_type_aux_expl_named_subst kind expl_named_subst)
+ | C.MutCase (_,_,_,term,patterns) ->
+ (* outtype ignored *)
+ let kind' = soften_classification kind in
+ process_type_aux kind' term @@
+ List.fold_left (fun i t -> i @@ process_type_aux kind' t)
+ ([],[],[]) patterns
+ | C.Fix (_,funs) ->
+ let kind' = soften_classification kind in
+ List.fold_left
+ (fun i (_,_,bo,ty) ->
+ i @@
+ process_type_aux kind' bo @@
+ process_type_aux kind' ty
+ ) ([],[],[]) funs
+ | C.CoFix (_,funs) ->
+ let kind' = soften_classification kind in
+ List.fold_left
+ (fun i (_,bo,ty) ->
+ i @@
+ process_type_aux kind' bo @@
+ process_type_aux kind' ty
+ ) ([],[],[]) funs
+ and process_type_aux_expl_named_subst kind =
+ List.fold_left
+ (fun i (_,t) -> i @@ (process_type_aux (soften_classification kind) t))
+ ([],[],[])
+in
+ let obj_constraints,rel_constraints,sort_constraints =
+ process_type_aux (Backbone 0) (CicMiniReduction.letin_nf term)
+ in
+ (obj_constraints,rel_constraints,sort_constraints)
+;;
+
+(*CSC: Debugging only *)
+(*
+let get_constraints term =
+ let res = get_constraints term in
+ let (objs,rels,sorts) = res in
+ let text_of_pos p =
+ U.text_of_position p ^ " " ^ U.text_of_depth p "NULL"
+ in
+ prerr_endline "Constraints on objs:" ;
+ List.iter
+ (function (p, u) -> prerr_endline (text_of_pos p ^ " " ^ u)) objs ;
+ prerr_endline "Constraints on Rels:" ;
+ List.iter (function p -> prerr_endline (text_of_pos (p:>T.full_position))) rels ;
+ prerr_endline "Constraints on Sorts:" ;
+ List.iter
+ (function (p, s) -> prerr_endline (text_of_pos (p:>T.full_position) ^ " " ^ U.text_of_sort s)
+ ) sorts ;
+ res
+;; *)
+
+let universe =
+ [T.MainHypothesis; T.InHypothesis; T.MainConclusion; T.InConclusion]
diff --git a/helm/ocaml/mathql_generator/cGSearchPattern.mli b/helm/ocaml/mathql_generator/cGSearchPattern.mli
new file mode 100644
index 000000000..528283387
--- /dev/null
+++ b/helm/ocaml/mathql_generator/cGSearchPattern.mli
@@ -0,0 +1,39 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(******************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Claudio Sacerdoti Coen <sacerdot@cs.unibo.it> *)
+(* 02/12/2002 *)
+(* *)
+(* Missing description *)
+(* *)
+(******************************************************************************)
+
+val get_constraints : Cic.term -> MQGTypes.must_restrictions
+
+val universe : MQGTypes.universe
diff --git a/helm/ocaml/mathql_generator/mQGTypes.ml b/helm/ocaml/mathql_generator/mQGTypes.ml
new file mode 100644
index 000000000..9ed2ce253
--- /dev/null
+++ b/helm/ocaml/mathql_generator/mQGTypes.ml
@@ -0,0 +1,77 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTORS: Ferruccio Guidi <fguidi@cs.unibo.it>
+ * Claudio Sacerdoti Coen <sacerdot@cs.unibo.it>
+ *)
+
+(* $Id$ *)
+
+(* low level types *********************************************************)
+
+type uri = string
+type position = MainHypothesis
+ | InHypothesis
+ | MainConclusion
+ | InConclusion
+ | InBody
+type depth = int
+type sort = Set
+ | Prop
+ | Type
+ | CProp
+
+type spec = MustObj of uri list * position list * depth list
+ | MustSort of sort list * position list * depth list
+ | MustRel of position list * depth list
+ | OnlyObj of uri list * position list * depth list
+ | OnlySort of sort list * position list * depth list
+ | OnlyRel of position list * depth list
+ | Universe of position list
+
+(* high-level types ********************************************************)
+
+type optional_depth = int option
+
+type full_position = [ `MainHypothesis of optional_depth
+ | `MainConclusion of optional_depth
+ | `InHypothesis
+ | `InConclusion
+ | `InBody
+ ]
+
+type main_position = [ `MainHypothesis of optional_depth
+ | `MainConclusion of optional_depth
+ ]
+
+type r_obj = full_position * uri
+type r_sort = main_position * sort
+type r_rel = main_position
+
+type must_restrictions = (r_obj list * r_rel list * r_sort list)
+type only_restrictions =
+ (r_obj list option * r_rel list option * r_sort list option)
+
+type universe = position list
diff --git a/helm/ocaml/mathql_generator/mQGUtil.ml b/helm/ocaml/mathql_generator/mQGUtil.ml
new file mode 100644
index 000000000..7603ab9a6
--- /dev/null
+++ b/helm/ocaml/mathql_generator/mQGUtil.ml
@@ -0,0 +1,150 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+(* $Id$ *)
+
+module T = MQGTypes
+
+(* low level functions *****************************************************)
+
+let string_of_position p =
+ let ns = "http://www.cs.unibo.it/helm/schemas/schema-helm#" in
+ match p with
+ | T.MainHypothesis -> ns ^ "MainHypothesis"
+ | T.InHypothesis -> ns ^ "InHypothesis"
+ | T.MainConclusion -> ns ^ "MainConclusion"
+ | T.InConclusion -> ns ^ "InConclusion"
+ | T.InBody -> ns ^ "InBody"
+
+let string_of_sort = function
+ | T.Set -> "Set"
+ | T.Prop -> "Prop"
+ | T.Type -> "Type"
+ | T.CProp -> "CProp"
+
+let string_of_depth = string_of_int
+
+let mathql_of_position = function
+ | T.MainHypothesis -> "$MH"
+ | T.InHypothesis -> "$IH"
+ | T.MainConclusion -> "$MC"
+ | T.InConclusion -> "$IC"
+ | T.InBody -> "$IB"
+
+let mathql_of_sort = function
+ | T.Set -> "$SET"
+ | T.Prop -> "$PROP"
+ | T.Type -> "$TYPE"
+ | T.CProp -> "$CPROP"
+
+let mathql_of_depth = string_of_int
+
+let mathql_of_uri u = u
+
+let mathql_of_specs out l =
+ let rec iter f = function
+ | [] -> ()
+ | [s] -> out "\""; out (f s); out "\""
+ | s :: tail -> out "\""; out (f s); out "\", "; iter f tail
+ in
+ let txt_uri l = out "{"; iter mathql_of_uri l; out "} " in
+ let txt_pos l = out "{"; iter mathql_of_position l; out "} " in
+ let txt_sort l = out "{"; iter mathql_of_sort l; out "} " in
+ let txt_depth l = out "{"; iter mathql_of_depth l; out "} " in
+ let txt_spec = function
+ | T.MustObj (u, p, d) -> out "mustobj "; txt_uri u; txt_pos p; txt_depth d; out "\n"
+ | T.MustSort (s, p, d) -> out "mustsort "; txt_sort s; txt_pos p; txt_depth d; out "\n"
+ | T.MustRel ( p, d) -> out "mustrel "; txt_pos p; txt_depth d; out "\n"
+ | T.OnlyObj (u, p, d) -> out "onlyobj "; txt_uri u; txt_pos p; txt_depth d; out "\n"
+ | T.OnlySort (s, p, d) -> out "onlysort "; txt_sort s; txt_pos p; txt_depth d; out "\n"
+ | T.OnlyRel ( p, d) -> out "onlyrel "; txt_pos p; txt_depth d; out "\n"
+ | T.Universe ( p ) -> out "universe "; txt_pos p; out "\n"
+ in
+ List.iter txt_spec l
+
+let position_of_mathql = function
+ | "$MH" -> T.MainHypothesis
+ | "$IH" -> T.InHypothesis
+ | "$MC" -> T.MainConclusion
+ | "$IC" -> T.InConclusion
+ | "$IB" -> T.InBody
+ | _ -> raise Parsing.Parse_error
+
+let sort_of_mathql = function
+ | "$SET" -> T.Set
+ | "$PROP" -> T.Prop
+ | "$TYPE" -> T.Type
+ | "$CPROP" -> T.CProp
+ | _ -> raise Parsing.Parse_error
+
+let depth_of_mathql s =
+ try
+ let d = int_of_string s in
+ if d < 0 then raise (Failure "") else d
+ with Failure _ -> raise Parsing.Parse_error
+
+let uri_of_mathql s = s
+
+(* high level functions ****************************************************)
+
+let text_of_position = function
+ | `MainHypothesis _ -> "MainHypothesis"
+ | `MainConclusion _ -> "MainConclusion"
+ | `InHypothesis -> "InHypothesis"
+ | `InConclusion -> "InConclusion"
+ | `InBody -> "InBody"
+
+let text_of_depth pos no_depth_text = match pos with
+ | `MainHypothesis (Some d)
+ | `MainConclusion (Some d) -> string_of_int d
+ | _ -> no_depth_text
+
+let text_of_sort = function
+ | T.Set -> "Set"
+ | T.Prop -> "Prop"
+ | T.Type -> "Type"
+ | T.CProp -> "CProp"
+
+let is_main_position = function
+ | `MainHypothesis _
+ | `MainConclusion _ -> true
+ | _ -> false
+
+let is_conclusion = function
+ | `MainConclusion _
+ | `InConclusion -> true
+ | _ -> false
+
+let set_full_position pos depth = match pos with
+ | `MainHypothesis _ -> `MainHypothesis depth
+ | `MainConclusion _ -> `MainConclusion depth
+ | _ -> pos
+
+let set_main_position pos depth = match pos with
+ | `MainHypothesis _ -> `MainHypothesis depth
+ | `MainConclusion _ -> `MainConclusion depth
diff --git a/helm/ocaml/mathql_generator/mQGUtil.mli b/helm/ocaml/mathql_generator/mQGUtil.mli
new file mode 100644
index 000000000..065abb157
--- /dev/null
+++ b/helm/ocaml/mathql_generator/mQGUtil.mli
@@ -0,0 +1,69 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+(* low level functions *****************************************************)
+
+(* these functions give the string representation used in the db ----------*)
+
+val string_of_position : MQGTypes.position -> string
+val string_of_depth : MQGTypes.depth -> string
+val string_of_sort : MQGTypes.sort -> string
+
+(* these functions give the string representation used in MathQL ----------*)
+
+val mathql_of_position : MQGTypes.position -> string
+val mathql_of_depth : MQGTypes.depth -> string
+val mathql_of_uri : MQGTypes.uri -> string
+val mathql_of_sort : MQGTypes.sort -> string
+
+val mathql_of_specs : (string -> unit) -> MQGTypes.spec list -> unit
+
+val position_of_mathql : string -> MQGTypes.position
+val depth_of_mathql : string -> MQGTypes.depth
+val uri_of_mathql : string -> MQGTypes.uri
+val sort_of_mathql : string -> MQGTypes.sort
+
+(* high level functions ****************************************************)
+
+(* these functions give the textual representation used by umans ----------*)
+
+val text_of_position : MQGTypes.full_position -> string
+val text_of_depth : MQGTypes.full_position -> string -> string
+val text_of_sort : MQGTypes.sort -> string
+
+(* these functions classify the positions ---------------------------------*)
+
+val is_main_position : MQGTypes.full_position -> bool
+val is_conclusion : MQGTypes.full_position -> bool
+
+(* these function apply changes to positions ------------------------------*)
+
+val set_full_position : MQGTypes.full_position -> MQGTypes.optional_depth ->
+ MQGTypes.full_position
+val set_main_position : MQGTypes.main_position -> MQGTypes.optional_depth ->
+ MQGTypes.main_position
diff --git a/helm/ocaml/mathql_generator/mQueryGenerator.ml b/helm/ocaml/mathql_generator/mQueryGenerator.ml
new file mode 100644
index 000000000..784bc11dc
--- /dev/null
+++ b/helm/ocaml/mathql_generator/mQueryGenerator.ml
@@ -0,0 +1,191 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+(* $Id$ *)
+
+module M = MathQL
+module T = MQGTypes
+module U = MQGUtil
+
+(* low level functions *****************************************************)
+
+let locate s =
+ let query =
+ M.Property (true,M.RefineExact,["objectName"],[],[],[],[],false,(M.Const s) )
+ in query
+
+let unreferred target_pattern source_pattern =
+ let query =
+ M.Bin (M.BinFDiff,
+ (
+ M.Property(false,M.RefineExact,[],[],[],[],[],true,(M.Const target_pattern))
+ ), (
+ M.Property(false,M.RefineExact,["refObj"],["h:occurrence"],[],[],[],true,(M.Const source_pattern))
+
+ ))
+ in query
+
+let compose cl =
+ let letin = ref [] in
+ let must = ref [] in
+ let onlyobj = ref [] in
+ let onlysort = ref [] in
+ let onlyrel = ref [] in
+ let only = ref true in
+ let univ = ref [] in
+ let set_val = function
+ | [s] -> M.Const s
+ | l ->
+ let msval = M.Set (List.map (fun s -> M.Const s) l) in
+ if ! only then begin
+ let vvar = "val" ^ string_of_int (List.length ! letin) in
+ letin := (vvar, msval) :: ! letin;
+ M.VVar vvar
+ end else msval
+ in
+ let cons o (r, s, p, d) =
+ let con p = function
+ | [] -> []
+ | l -> [(false, [p], set_val l)]
+ in
+ only := o;
+ con "h:occurrence" r @
+ con "h:sort" (List.map U.string_of_sort s) @
+ con "h:position" (List.map U.string_of_position p) @
+ con "h:depth" (List.map U.string_of_depth d)
+ in
+ let property_must n c =
+ M.Property(true,M.RefineExact,[n],[],(cons false c),[],[],false,(M.Const ""))
+ in
+ let property_only n cl =
+ let rec build = function
+ | [] -> []
+ | c :: tl ->
+ let r = (cons true) c in
+ if r = [] then build tl else r :: build tl
+ in
+ let cll = build cl in
+ M.Property(false,M.RefineExact,[n],[],!univ,cll,[],false,(M.Proj(None,(M.AVar "obj"))))
+ in
+ let rec aux = function
+ | [] -> ()
+ | T.Universe l :: tail ->
+ only := true;
+ let l = List.map U.string_of_position l in
+ univ := [(false, ["h:position"], set_val l)]; aux tail
+ | T.MustObj(r,p,d) :: tail ->
+ must := property_must "refObj" (r, [], p, d) :: ! must; aux tail
+ | T.MustSort(s,p,d) :: tail ->
+ must := property_must "refSort" ([], s, p, d) :: ! must; aux tail
+ | T.MustRel(p,d) :: tail ->
+ must := property_must "refRel" ([], [], p, d) :: ! must; aux tail
+ | T.OnlyObj(r,p,d) :: tail ->
+ onlyobj := (r, [], p, d) :: ! onlyobj; aux tail
+ | T.OnlySort(s,p,d) :: tail ->
+ onlysort := ([], s, p, d) :: ! onlysort; aux tail
+ | T.OnlyRel(p,d) :: tail ->
+ onlyrel := ([], [], p, d) :: ! onlyrel; aux tail
+ in
+ let rec iter f g = function
+ | [] -> raise (Failure "MQueryGenerator.iter")
+ | [head] -> (f head)
+ | head :: tail -> let t = (iter f g tail) in g (f head) t
+ in
+ (* prerr_endline "(** Compose: received constraints **)";
+ U.mathql_of_specs prerr_string cl; flush stderr; *)
+ aux cl;
+ let must_query =
+ if ! must = [] then
+ M.Property(false,M.RefineExact,[],[],[],[],[],true,(M.Const ".*"))
+ else
+ iter (fun x -> x) (fun x y -> M.Bin(M.BinFMeet,x,y)) ! must
+ in
+ let onlyobj_val = M.Not (M.Proj(None,(property_only "refObj" ! onlyobj))) in
+ let onlysort_val = M.Not (M.Proj(None,(property_only "refSort" ! onlysort))) in
+ let onlyrel_val = M.Not (M.Proj(None,(property_only "refRel" ! onlyrel))) in
+ let select_query x =
+ match ! onlyobj, ! onlysort, ! onlyrel with
+ | [], [], [] -> x
+ | _, [], [] -> M.Select("obj",x,onlyobj_val)
+ | [], _, [] -> M.Select("obj",x,onlysort_val)
+ | [], [], _ -> M.Select("obj",x,onlyrel_val)
+ | _, _, [] -> M.Select("obj",x,(M.Test(M.And,onlyobj_val,onlysort_val)))
+ | _, [], _ -> M.Select("obj",x,(M.Test(M.And,onlyobj_val,onlyrel_val)))
+ | [], _, _ -> M.Select("obj",x,(M.Test(M.And,onlysort_val,onlyrel_val)))
+ | _, _, _ -> M.Select("obj",x,(M.Test(M.And,(M.Test(M.And,onlyobj_val,onlysort_val)),onlyrel_val)))
+ in
+ let letin_query =
+ if ! letin = [] then fun x -> x
+ else
+ let f (vvar, msval) x = M.LetVVar(vvar,msval,x) in
+ iter f (fun x y z -> x (y z)) ! letin
+ in
+ letin_query (select_query must_query)
+
+(* high-level functions ****************************************************)
+
+let query_of_constraints u (musts_obj, musts_rel, musts_sort)
+ (onlys_obj, onlys_rel, onlys_sort) =
+ let conv = function
+ | `MainHypothesis None -> [T.MainHypothesis], []
+ | `MainHypothesis (Some d) -> [T.MainHypothesis], [d]
+ | `MainConclusion None -> [T.MainConclusion], []
+ | `MainConclusion (Some d) -> [T.MainConclusion], [d]
+ | `InHypothesis -> [T.InHypothesis], []
+ | `InConclusion -> [T.InConclusion], []
+ | `InBody -> [T.InBody], []
+ in
+ let must_obj (p, u) = let p, d = conv p in T.MustObj ([u], p, d) in
+ let must_sort (p, s) = let p, d = conv p in T.MustSort ([s], p, d) in
+ let must_rel p = let p, d = conv p in T.MustRel (p, d) in
+ let only_obj (p, u) = let p, d = conv p in T.OnlyObj ([u], p, d) in
+ let only_sort (p, s) = let p, d = conv p in T.OnlySort ([s], p, d) in
+ let only_rel p = let p, d = conv p in T.OnlyRel (p, d) in
+ let must = List.map must_obj musts_obj @
+ List.map must_rel musts_rel @
+ List.map must_sort musts_sort
+ in
+ let only =
+ (match onlys_obj with
+ | None -> []
+ | Some [] -> [T.OnlyObj ([], [], [])]
+ | Some l -> List.map only_obj l
+ ) @
+ (match onlys_rel with
+ | None -> []
+ | Some [] -> [T.OnlyRel ([], [])]
+ | Some l -> List.map only_rel l
+ ) @
+ (match onlys_sort with
+ | None -> []
+ | Some [] -> [T.OnlySort ([], [], [])]
+ | Some l -> List.map only_sort l
+ )
+ in
+ let univ = match u with None -> [] | Some l -> [T.Universe l] in
+ compose (must @ only @ univ)
diff --git a/helm/ocaml/mathql_generator/mQueryGenerator.mli b/helm/ocaml/mathql_generator/mQueryGenerator.mli
new file mode 100644
index 000000000..decaa0ea7
--- /dev/null
+++ b/helm/ocaml/mathql_generator/mQueryGenerator.mli
@@ -0,0 +1,42 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+(* interface for the low-level constraints *********************************)
+
+val locate : string -> MathQL.query
+
+val unreferred : string -> string -> MathQL.query
+
+val compose : MQGTypes.spec list -> MathQL.query
+
+(* interface for the high-level constraints ********************************)
+
+val query_of_constraints : MQGTypes.universe option ->
+ MQGTypes.must_restrictions ->
+ MQGTypes.only_restrictions ->
+ MathQL.query
diff --git a/helm/ocaml/mathql_interpreter/.depend b/helm/ocaml/mathql_interpreter/.depend
new file mode 100644
index 000000000..186c81793
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/.depend
@@ -0,0 +1,27 @@
+mQIPostgres.cmi: mQITypes.cmo
+mQIMySql.cmi: mQITypes.cmo
+mQIConn.cmi: mQITypes.cmo mQIMap.cmi
+mQIProperty.cmi: mQITypes.cmo mQIConn.cmi
+mQueryInterpreter.cmi: mQIConn.cmi
+mQueryTParser.cmo: mQueryTParser.cmi
+mQueryTParser.cmx: mQueryTParser.cmi
+mQueryTLexer.cmo: mQueryTParser.cmi
+mQueryTLexer.cmx: mQueryTParser.cmx
+mQueryUtil.cmo: mQueryTParser.cmi mQueryTLexer.cmo mQueryUtil.cmi
+mQueryUtil.cmx: mQueryTParser.cmx mQueryTLexer.cmx mQueryUtil.cmi
+mQIUtil.cmo: mQIUtil.cmi
+mQIUtil.cmx: mQIUtil.cmi
+mQIPostgres.cmo: mQIPostgres.cmi
+mQIPostgres.cmx: mQIPostgres.cmi
+mQIMySql.cmo: mQIMySql.cmi
+mQIMySql.cmx: mQIMySql.cmi
+mQIMap.cmo: mQueryUtil.cmi mQIMap.cmi
+mQIMap.cmx: mQueryUtil.cmx mQIMap.cmi
+mQIConn.cmo: mQIPostgres.cmi mQIMySql.cmi mQIMap.cmi mQIConn.cmi
+mQIConn.cmx: mQIPostgres.cmx mQIMySql.cmx mQIMap.cmx mQIConn.cmi
+mQIProperty.cmo: mQIUtil.cmi mQIMap.cmi mQIConn.cmi mQIProperty.cmi
+mQIProperty.cmx: mQIUtil.cmx mQIMap.cmx mQIConn.cmx mQIProperty.cmi
+mQueryInterpreter.cmo: mQueryUtil.cmi mQIUtil.cmi mQIProperty.cmi mQIConn.cmi \
+ mQueryInterpreter.cmi
+mQueryInterpreter.cmx: mQueryUtil.cmx mQIUtil.cmx mQIProperty.cmx mQIConn.cmx \
+ mQueryInterpreter.cmi
diff --git a/helm/ocaml/mathql_interpreter/Makefile b/helm/ocaml/mathql_interpreter/Makefile
new file mode 100644
index 000000000..bdd738135
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/Makefile
@@ -0,0 +1,19 @@
+PACKAGE = mathql_interpreter
+
+PREDICATES =
+
+INTERFACE_FILES = mQueryUtil.mli mQIUtil.mli \
+ mQIPostgres.mli mQIMySql.mli mQIMap.mli mQIConn.mli \
+ mQIProperty.mli mQueryInterpreter.mli
+
+IMPLEMENTATION_FILES = mQueryTParser.ml mQueryTLexer.ml \
+ mQITypes.ml $(INTERFACE_FILES:%.mli=%.ml)
+
+EXTRA_OBJECTS_TO_INSTALL = mQueryTLexer.cmi \
+ mQueryTLexer.mll mQueryTParser.mly \
+ mQITypes.ml mQITypes.cmi
+
+EXTRA_OBJECTS_TO_CLEAN = mQueryTParser.ml mQueryTParser.mli \
+ mQueryTLexer.ml
+
+include ../Makefile.common
diff --git a/helm/ocaml/mathql_interpreter/mQIConn.ml b/helm/ocaml/mathql_interpreter/mQIConn.ml
new file mode 100644
index 000000000..270d1f9d0
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQIConn.ml
@@ -0,0 +1,130 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+(* $Id$ *)
+
+type connection = MySQL_C of HMysql.dbd
+ | Postgres_C of Postgres.connection
+ | No_C
+
+type flag = Galax | Postgres | Queries | Result | Source | Times | Warn
+
+type handle = {
+ log : string -> unit; (* logging function *)
+ set : flag list; (* options *)
+ pgc : connection; (* PG connection *)
+ pgm : MQIMap.pg_map; (* PG conversion function *)
+ pga : MQIMap.pg_alias (* PG table aliases *)
+}
+
+let tables handle p = MQIMap.get_tables handle.pgm p
+
+let field handle p t = MQIMap.get_field handle.pgm p t
+
+let resolve handle a = MQIMap.resolve handle.pga a
+
+let log handle = handle.log
+
+let set handle flag = List.mem flag handle.set
+
+let pgc handle = handle.pgc
+
+let flags handle = handle.set
+
+let string_of_flag = function
+ | Galax -> "G"
+ | Postgres -> "P"
+ | Queries -> "Q"
+ | Result -> "R"
+ | Source -> "S"
+ | Times -> "T"
+ | Warn -> "W"
+
+let flag_of_char = function
+ | 'G' -> [Galax]
+ | 'P' -> [Postgres]
+ | 'Q' -> [Queries]
+ | 'R' -> [Result]
+ | 'S' -> [Source]
+ | 'T' -> [Times]
+ | 'W' -> [Warn]
+ | _ -> []
+
+let string_fold_left f a s =
+ let l = String.length s in
+ let rec aux b i = if i = l then b else aux (f b s.[i]) (succ i) in
+ aux a 0
+
+let string_of_flags flags =
+ List.fold_left (fun s flag -> s ^ string_of_flag flag) "" flags
+
+let flags_of_string s =
+ string_fold_left (fun l c -> l @ flag_of_char c) [] s
+
+let init ?(flags = []) ?(log = ignore) () =
+ let flags =
+ if flags = [] then
+ flags_of_string (Helm_registry.get "mathql_interpreter.flags")
+ else
+ flags
+ in
+ let m, a =
+ let g =
+ if List.mem Galax flags
+ then MQIMap.empty_map else MQIMap.read_map
+ in g ()
+ in
+ {log = log; set = flags;
+ pgc = begin
+ try
+ if List.mem Galax flags then No_C else
+ if List.mem Postgres flags then Postgres_C (MQIPostgres.init ()) else
+ MySQL_C (MQIMySql.init ())
+ with Failure "mqi_connection" -> No_C
+ end;
+ pgm = m; pga = a
+ }
+
+let close handle =
+ match pgc handle with
+ | MySQL_C c -> MQIMySql.close c
+ | Postgres_C c -> MQIPostgres.close c
+ | No_C -> ()
+
+let exec handle out table cols ct cfl =
+ match pgc handle with
+ | MySQL_C c -> MQIMySql.exec (c, out) table cols ct cfl
+ | Postgres_C c -> MQIPostgres.exec (c, out) table cols ct cfl
+ | No_C -> []
+
+let connected handle =
+ pgc handle <> No_C
+
+let init_if_connected ?(flags = []) ?(log = ignore) () =
+ let handle = init ~flags:flags ~log:log () in
+ if connected handle then handle else raise (Failure "mqi connection failed")
diff --git a/helm/ocaml/mathql_interpreter/mQIConn.mli b/helm/ocaml/mathql_interpreter/mQIConn.mli
new file mode 100644
index 000000000..35c8b3ef0
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQIConn.mli
@@ -0,0 +1,65 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+type connection = MySQL_C of HMysql.dbd
+ | Postgres_C of Postgres.connection
+ | No_C
+
+type flag = Galax | Postgres | Queries | Result | Source | Times | Warn
+
+type handle = {
+ log : string -> unit; (* logging function *)
+ set : flag list; (* options *)
+ pgc : connection; (* PG connection *)
+ pgm : MQIMap.pg_map; (* PG conversion function *)
+ pga : MQIMap.pg_alias (* PG table aliases *)
+}
+
+val string_of_flags : flag list -> string
+val flags_of_string : string -> flag list
+
+val init : ?flags:(flag list) -> ?log:(string -> unit) -> unit -> handle
+val close : handle -> unit
+val connected : handle -> bool
+val exec : handle -> (MQITypes.query -> unit) ->
+ MQITypes.table -> MQITypes.columns ->
+ string MQITypes.con_true -> string MQITypes.con_false ->
+ MQITypes.result
+
+val init_if_connected : ?flags:(flag list) -> ?log:(string -> unit) -> unit -> handle
+
+(* The following functions allow to read the handle internal fields.
+ * For exclusive use of the interpreter.
+ *)
+
+val log : handle -> string -> unit
+val set : handle -> flag -> bool
+val flags : handle -> flag list
+val tables : handle -> MathQL.path -> MQIMap.pg_tables
+val field : handle -> MathQL.path -> string -> string
+val resolve : handle -> string -> string
diff --git a/helm/ocaml/mathql_interpreter/mQIMap.ml b/helm/ocaml/mathql_interpreter/mQIMap.ml
new file mode 100644
index 000000000..a5b6654c8
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQIMap.ml
@@ -0,0 +1,93 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+(* $Id$ *)
+
+module U = MQueryUtil
+
+type pg_map = (MathQL.path * (bool * string * string option)) list
+
+type pg_tables = (bool * string) list
+
+type pg_alias = (string * string) list
+
+let empty_map () = [], []
+
+let read_map () =
+ let map = Helm_registry.get "mathql_interpreter.db_map" in
+ let ich = open_in map in
+ let rec aux r s =
+ let d = input_line ich in
+ match Str.split (Str.regexp "[ \t]+") d with
+ | [] -> aux r s
+ | "#" :: _ -> aux r s
+ | t :: "<-" :: p -> aux ((p, (false, t, None)) :: r) s
+ | t :: c :: "<-" :: p -> aux ((p, (false, t, Some c)) :: r) s
+ | t :: "<+" :: p -> aux ((p, (true, t, None)) :: r) s
+ | t :: c :: "<+" :: p -> aux ((p, (true, t, Some c)) :: r) s
+ | [a; "->"; t] -> aux r ((a, t) :: s)
+ | ["->"] -> r, s
+ | _ -> raise (Failure "MQIMap.read_map")
+ in
+ let pgm, pga = aux [] [] in
+ close_in ich;
+ pgm, pga
+
+let comp c1 c2 = match c1, c2 with
+ | (_, t1), (_, t2) when t1 < t2 -> U.Lt
+ | (_, t1), (_, t2) when t1 > t2 -> U.Gt
+ | (b1, t), (b2, _) -> U.Eq (b1 || b2, t)
+
+let get_tables pgm p =
+ let aux l = function
+ | q, (b, t, _) when q = p -> U.list_join comp l [(b, t)]
+ | _, _ -> l
+ in
+ List.fold_left aux [] pgm
+
+let rec refine_tables l1 l2 =
+ U.list_meet comp l1 l2
+
+let default_table = function
+ | [(_, a)] -> a
+ | l ->
+ try List.assoc true l
+ with Not_found -> raise (Failure "MQIMap.default_table")
+
+let get_field pgm p t =
+ let aux = function
+ | q, (_, u, _) when q = p && u = t -> true
+ | _ -> false
+ in
+ match List.filter aux pgm with
+ | [_, (_, _, None)] -> ""
+ | [_, (_, _, Some c)] -> c
+ | _ -> raise (Failure "MQIMap.get_field")
+
+let resolve pga a =
+ try List.assoc a pga with Not_found -> a
diff --git a/helm/ocaml/mathql_interpreter/mQIMap.mli b/helm/ocaml/mathql_interpreter/mQIMap.mli
new file mode 100644
index 000000000..50f5bb0fa
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQIMap.mli
@@ -0,0 +1,47 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+type pg_map (* mathql path map for postgres *)
+
+type pg_tables
+
+type pg_alias
+
+val empty_map : unit -> pg_map * pg_alias
+
+val read_map : unit -> pg_map * pg_alias
+
+val get_tables : pg_map -> MathQL.path -> pg_tables
+
+val refine_tables : pg_tables -> pg_tables -> pg_tables
+
+val default_table : pg_tables -> string
+
+val get_field : pg_map -> MathQL.path -> string -> string
+
+val resolve : pg_alias -> string -> string
diff --git a/helm/ocaml/mathql_interpreter/mQIMySql.ml b/helm/ocaml/mathql_interpreter/mQIMySql.ml
new file mode 100644
index 000000000..3380e1f1f
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQIMySql.ml
@@ -0,0 +1,96 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+(* $Id$ *)
+
+let init () =
+ let module HR = Helm_registry in
+ let host =
+ HR.get_opt HR.get_string "mathql_interpreter.mysql_connection.host" in
+ let database =
+ HR.get_opt HR.get_string "mathql_interpreter.mysql_connection.database" in
+ let user =
+ HR.get_opt HR.get_string "mathql_interpreter.mysql_connection.user" in
+ let port =
+ HR.get_opt HR.get_int "mathql_interpreter.mysql_connection.port" in
+ let password =
+ HR.get_opt HR.get_string "mathql_interpreter.mysql_connection.password" in
+ try HMysql.quick_connect ?host ?database ?user ?port ?password ()
+ with _ -> raise (Failure "mqi_connecion")
+
+let close c = HMysql.disconnect c
+
+let quote s =
+ let rec quote_aux s =
+ try
+ let l = String.length s in
+ let i = String.index s '\'' in
+ String.sub s 0 i ^ "\\'" ^ quote_aux (String.sub s (succ i) (l - (succ i)))
+ with Not_found -> s
+ in
+ "'" ^ quote_aux s ^ "'"
+
+let exec (c, out) q =
+ let g = function None -> "" | Some v -> v in
+ let f a = List.map g (Array.to_list a) in
+ out q; HMysql.map ~f:f (Mysql.exec c q)
+
+let exec c table cols ct cfl =
+ let rec iter f last sep = function
+ | [] -> last
+ | [head] -> f head
+ | head :: tail -> f head ^ sep ^ iter f last sep tail
+ in
+ let pg_cols = iter (fun x -> x) "" ", " cols in
+ let pg_msval v = iter quote "" ", " v in
+ let pg_con (pat, col, v) =
+ if col <> "" then
+ let f s = col ^ " regexp " ^ quote ("^" ^ s ^ "$") in
+ if pat then "(" ^ iter f "0" " or " v ^ ")"
+ else match v with
+ | [s] -> col ^ " = " ^ (quote s)
+ | v -> col ^ " in (" ^ pg_msval v ^ ")"
+ else "1"
+ in
+ let pg_cons l = iter pg_con "1" " and " l in
+ let pg_cons_not l = "not (" ^ pg_cons l ^ ")" in
+ let pg_cons_not_l ll = iter pg_cons_not "1" " and " ll in
+ let pg_where = match ct, cfl with
+ | [], [] -> ""
+ | lt, [] -> " where " ^ pg_cons lt
+ | [], llf -> " where " ^ pg_cons_not_l llf
+ | lt, llf -> " where " ^ pg_cons lt ^ " and " ^ pg_cons_not_l llf
+ in
+ if cols = [] then
+ let r = exec c ("select count(source) from " ^ table ^ pg_where) in
+ match r with
+ | [[s]] when int_of_string s > 0 -> [[]]
+ | _ -> []
+ else
+ exec c ("select " ^ pg_cols ^ " from " ^ table ^ pg_where ^
+ " order by " ^ List.hd cols ^ " asc")
diff --git a/helm/ocaml/mathql_interpreter/mQIMySql.mli b/helm/ocaml/mathql_interpreter/mQIMySql.mli
new file mode 100644
index 000000000..8afaf401d
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQIMySql.mli
@@ -0,0 +1,36 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+val init : unit -> HMysql.dbd
+
+val close : HMysql.dbd -> unit
+
+val exec : HMysql.dbd * (MQITypes.query -> unit) ->
+ MQITypes.table -> MQITypes.columns ->
+ string MQITypes.con_true -> string MQITypes.con_false ->
+ MQITypes.result
diff --git a/helm/ocaml/mathql_interpreter/mQIPostgres.ml b/helm/ocaml/mathql_interpreter/mQIPostgres.ml
new file mode 100644
index 000000000..bef07230f
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQIPostgres.ml
@@ -0,0 +1,96 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+(* $Id$ *)
+
+let init () =
+ let connection_string =
+ Helm_registry.get "mathql_interpreter.postgresql_connection_string"
+ in
+ try new Postgres.connection connection_string
+ with _ -> raise (Failure "mqi_connecion")
+
+let close c = c#close
+
+let quote s =
+ let rec quote_aux s =
+ try
+ let l = String.length s in
+ let i = String.index s '\'' in
+ String.sub s 0 i ^ "\\'" ^ quote_aux (String.sub s (succ i) (l - (succ i)))
+ with Not_found -> s
+ in
+ "'" ^ quote_aux s ^ "'"
+
+let exec (c, out) q = out q; (c#exec q)#get_list
+
+let exec c table cols ct cfl =
+ let rec iter f last sep = function
+ | [] -> last
+ | [head] -> f head
+ | head :: tail -> f head ^ sep ^ iter f last sep tail
+ in
+ let pg_cols = iter (fun x -> x) "" ", " cols in
+ let pg_msval v = iter quote "" ", " v in
+ let pg_con (pat, col, v) =
+ if col <> "" then
+ let f s = col ^ " ~ " ^ quote ("^" ^ s ^ "$") in
+ if pat then "(" ^ iter f "false" " or " v ^ ")"
+ else match v with
+ | [s] -> col ^ " = " ^ (quote s)
+ | v -> col ^ " in (" ^ pg_msval v ^ ")"
+ else "true"
+ in
+ let pg_cons l = iter pg_con "true" " and " l in
+ let pg_cons_not l = "not (" ^ pg_cons l ^ ")" in
+ let pg_cons_not_l ll = iter pg_cons_not "true" " and " ll in
+ let pg_where = match ct, cfl with
+ | [], [] -> ""
+ | lt, [] -> " where " ^ pg_cons lt
+ | [], llf -> " where " ^ pg_cons_not_l llf
+ | lt, llf -> " where " ^ pg_cons lt ^ " and " ^ pg_cons_not_l llf
+ in
+ if cols = [] then
+ let r = exec c ("select count(source) from " ^ table ^ pg_where) in
+ match r with
+ | [[s]] when int_of_string s > 0 -> [[]]
+ | _ -> []
+ else
+ exec c ("select " ^ pg_cols ^ " from " ^ table ^ pg_where ^
+ " order by " ^ List.hd cols ^ " asc")
+
+(* funzioni vecchie ********************************************************)
+(*
+let pg_name h s =
+ let q = "select id from registry where uri = " ^ quote s in
+ match exec h q with
+ | [[id]] -> "t" ^ id
+ | _ -> ""
+
+let get_id b = if b then ["B"] else ["F"]
+*)
diff --git a/helm/ocaml/mathql_interpreter/mQIPostgres.mli b/helm/ocaml/mathql_interpreter/mQIPostgres.mli
new file mode 100644
index 000000000..cbbf3929d
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQIPostgres.mli
@@ -0,0 +1,36 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+val init : unit -> Postgres.connection
+
+val close : Postgres.connection -> unit
+
+val exec : Postgres.connection * (MQITypes.query -> unit) ->
+ MQITypes.table -> MQITypes.columns ->
+ string MQITypes.con_true -> string MQITypes.con_false ->
+ MQITypes.result
diff --git a/helm/ocaml/mathql_interpreter/mQIProperty.ml b/helm/ocaml/mathql_interpreter/mQIProperty.ml
new file mode 100644
index 000000000..0e3e2be72
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQIProperty.ml
@@ -0,0 +1,103 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+(* $Id$ *)
+
+module M = MathQL
+module C = MQIConn
+module U = MQIUtil
+module A = MQIMap
+
+let not_supported s =
+ raise (Failure ("MQIProperty: feature not supported: " ^ s))
+
+(* debugging ***************************************************************)
+
+let pg_print l =
+ let rec pg_record = function
+ | [] -> prerr_newline ()
+ | head :: tail -> prerr_string (head ^ " "); pg_record tail
+ in
+ List.iter pg_record l
+
+let cl_print l =
+ let c_print (b, p, v) =
+ prerr_string (if b then "match " else "in ");
+ List.iter (fun x -> prerr_string ("/" ^ x)) p;
+ prerr_newline ();
+ List.iter prerr_endline v
+ in
+ List.iter c_print l
+
+(* Common functions ********************************************************)
+
+let pg_result distinct subj el res =
+ let compose = if distinct then List.map else fun f -> U.mql_iter (fun x -> [f x]) in
+ let get_name = function (p, None) -> p | (_, Some p) -> p in
+ let names = List.map get_name el in
+ let mk_grp l =
+ let grp = U.mql_iter2 (fun p s -> [(p, [s])]) names l in
+ if grp = [] then [] else [grp]
+ in
+ let mk_avs l =
+ if subj = "" then ("", mk_grp l) else (List.hd l, mk_grp (List.tl l))
+ in
+ compose mk_avs res
+
+let get_table h mc ct cfl el =
+ let aux_c ts (_, p, _) = A.refine_tables ts (C.tables h p) in
+ let aux_e ts (p, _) = A.refine_tables ts (C.tables h p) in
+ let fst = C.tables h mc in
+ let snd = List.fold_left aux_c fst (ct @ (List.concat cfl)) in
+ let trd = List.fold_left aux_e snd el in
+ A.default_table trd
+
+let exec_single h mc ct cfl el table =
+ let conv p = C.field h p table in
+ let first = conv mc in
+ let mk_con l = List.map (fun (pat, p, v) -> (pat, conv p, v)) l in
+ let cons_true = mk_con ct in
+ let cons_false = List.map mk_con cfl in
+ let other_cols = List.map (fun (p, _) -> conv p) el in
+ let cols = if first = "" then other_cols else first :: other_cols in
+ let out q = if C.set h C.Queries then C.log h (q ^ "\n") in
+ let r = C.exec h out (C.resolve h table) cols cons_true cons_false in
+ pg_result false first el r
+
+let deadline = 100
+
+let exec h refine mc ct cfl el =
+ if refine <> M.RefineExact then not_supported "exec";
+ let table = get_table h mc ct cfl el in
+ let rec exec_aux ct = match ct with
+ | (pat, p, v) :: tail when List.length v > deadline ->
+ let single s = exec_aux ((pat, p, [s]) :: tail) in
+ U.mql_iter single v
+ | _ ->
+ exec_single h mc ct cfl el table
+ in exec_aux ct
diff --git a/helm/ocaml/mathql_interpreter/mQIProperty.mli b/helm/ocaml/mathql_interpreter/mQIProperty.mli
new file mode 100644
index 000000000..f8159aaa8
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQIProperty.mli
@@ -0,0 +1,32 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+val exec: MQIConn.handle ->
+ MathQL.refine -> MathQL.path ->
+ MathQL.path MQITypes.con_true -> MathQL.path MQITypes.con_false ->
+ MathQL.exp_list -> MathQL.result
diff --git a/helm/ocaml/mathql_interpreter/mQITypes.ml b/helm/ocaml/mathql_interpreter/mQITypes.ml
new file mode 100644
index 000000000..ad4a8cb1b
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQITypes.ml
@@ -0,0 +1,43 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+(* $Id$ *)
+
+type 'a con = MathQL.pattern * 'a * MathQL.value
+
+type 'a con_true = 'a con list
+
+type 'a con_false = 'a con list list
+
+type table = string
+
+type columns = string list
+
+type result = string list list
+
+type query = string
diff --git a/helm/ocaml/mathql_interpreter/mQIUtil.ml b/helm/ocaml/mathql_interpreter/mQIUtil.ml
new file mode 100644
index 000000000..3f3fe6591
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQIUtil.ml
@@ -0,0 +1,155 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+(* $Id$ *)
+
+(* boolean constants *******************************************************)
+
+let mql_false = []
+
+let mql_true = [""]
+
+(* set theoretic operations *************************************************)
+
+let rec set_sub v1 v2 =
+ match v1, v2 with
+ | [], _ -> mql_true
+ | _, [] -> mql_false
+ | h1 :: _, h2 :: _ when h1 < h2 -> mql_false
+ | h1 :: _, h2 :: t2 when h1 > h2 -> set_sub v1 t2
+ | _ :: t1, _ :: t2 -> set_sub t1 t2
+
+let rec set_meet v1 v2 =
+ match v1, v2 with
+ | [], _ -> mql_false
+ | _, [] -> mql_false
+ | h1 :: t1, h2 :: _ when h1 < h2 -> set_meet t1 v2
+ | h1 :: _, h2 :: t2 when h1 > h2 -> set_meet v1 t2
+ | _, _ -> mql_true
+
+let set_eq v1 v2 =
+ if v1 = v2 then mql_true else mql_false
+
+let rec set_union v1 v2 =
+ match v1, v2 with
+ | [], v -> v
+ | v, [] -> v
+ | h1 :: t1, h2 :: t2 when h1 < h2 -> h1 :: set_union t1 v2
+ | h1 :: t1, h2 :: t2 when h1 > h2 -> h2 :: set_union v1 t2
+ | h1 :: t1, _ :: t2 -> h1 :: set_union t1 t2
+
+let rec set_intersect v1 v2 =
+ match v1, v2 with
+ | [], v -> []
+ | v, [] -> []
+ | h1 :: t1, h2 :: _ when h1 < h2 -> set_intersect t1 v2
+ | h1 :: _, h2 :: t2 when h1 > h2 -> set_intersect v1 t2
+ | h1 :: t1, _ :: t2 -> h1 :: set_intersect t1 t2
+
+let rec iter f = function
+ | [] -> []
+ | head :: tail -> set_union (f head) (iter f tail)
+
+(* MathQL specific set operations ******************************************)
+
+let rec mql_union s1 s2 =
+ match s1, s2 with
+ | [], s -> s
+ | s, [] -> s
+ | (r1, g1) :: t1, (r2, _) :: _ when r1 < r2 ->
+ (r1, g1) :: mql_union t1 s2
+ | (r1, _) :: _, (r2, g2) :: t2 when r1 > r2 ->
+ (r2, g2) :: mql_union s1 t2
+ | (r1, g1) :: t1, (_, g2) :: t2 ->
+ (r1, set_union g1 g2) :: mql_union t1 t2
+
+let rec mql_iter f = function
+ | [] -> []
+ | head :: tail -> mql_union (f head) (mql_iter f tail)
+
+let rec mql_iter2 f l1 l2 = match l1, l2 with
+ | [], [] -> []
+ | h1 :: t1, h2 :: t2 -> mql_union (f h1 h2) (mql_iter2 f t1 t2)
+ | _ -> raise (Invalid_argument "mql_iter2")
+
+let rec mql_prod g1 g2 =
+ let mql_prod_aux a = iter (fun h -> [mql_union a h]) g2 in
+ iter mql_prod_aux g1
+
+let rec mql_intersect s1 s2 =
+ match s1, s2 with
+ | [], s -> []
+ | s, [] -> []
+ | (r1, _) :: t1, (r2, _) :: _ when r1 < r2 -> mql_intersect t1 s2
+ | (r1, _) :: _, (r2, _) :: t2 when r1 > r2 -> mql_intersect s1 t2
+ | (r1, g1) :: t1, (_, g2) :: t2 ->
+ (r1, set_intersect g1 g2) :: mql_intersect t1 t2
+
+let rec mql_diff s1 s2 =
+ match s1, s2 with
+ | [], _ -> []
+ | s, [] -> s
+ | (r1, g1) :: t1 , (r2, _) ::_ when r1 < r2 ->
+ (r1, g1) :: (mql_diff t1 s2)
+ | (r1, _) :: _, (r2, _) :: t2 when r1 > r2 -> mql_diff s1 t2
+ | _ :: t1, _ :: t2 -> mql_diff t1 t2
+
+(* logic operations ********************************************************)
+
+let xor v1 v2 =
+ let b = v1 <> mql_false in
+ if b && v2 <> mql_false then mql_false else
+ if b then v1 else v2
+
+(* numeric operations ******************************************************)
+
+let int_of_list = function
+ | [s] -> int_of_string s
+ | _ -> raise (Failure "int_of_list")
+
+let le v1 v2 =
+ try if int_of_list v1 <= int_of_list v2 then mql_true else mql_false
+ with _ -> mql_false
+
+let lt v1 v2 =
+ try if int_of_list v1 < int_of_list v2 then mql_true else mql_false
+ with _ -> mql_false
+
+let align n v =
+ let c = String.length v in
+ try
+ let l = int_of_list [n] in
+ if c < l then [(String.make (l - c) ' ') ^ v] else [v]
+ with _ -> [v]
+
+(* context handling ********************************************************)
+
+let rec set ap = function
+ | [] -> [ap]
+ | head :: tail when fst head = fst ap -> ap :: tail
+ | head :: tail -> head :: set ap tail
diff --git a/helm/ocaml/mathql_interpreter/mQIUtil.mli b/helm/ocaml/mathql_interpreter/mQIUtil.mli
new file mode 100644
index 000000000..76735a863
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQIUtil.mli
@@ -0,0 +1,69 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+val mql_true : MathQL.value
+
+val mql_false : MathQL.value
+
+val set_sub : MathQL.value -> MathQL.value -> MathQL.value
+
+val set_meet : MathQL.value -> MathQL.value -> MathQL.value
+
+val set_eq : MathQL.value -> MathQL.value -> MathQL.value
+
+val set_union : 'a list -> 'a list -> 'a list
+
+val set_intersect : 'a list -> 'a list -> 'a list
+
+val mql_union : ('a * 'b list) list -> ('a * 'b list) list ->
+ ('a * 'b list) list
+
+val mql_prod : MathQL.attribute_set -> MathQL.attribute_set ->
+ MathQL.attribute_set
+
+val mql_intersect : MathQL.result -> MathQL.result -> MathQL.result
+
+val mql_diff : MathQL.result -> MathQL.result -> MathQL.result
+
+val iter : ('a -> 'b list) -> 'a list -> 'b list
+
+val mql_iter : ('c -> ('a * 'b list) list) -> 'c list ->
+ ('a * 'b list) list
+
+val mql_iter2 : ('c -> 'd -> ('a * 'b list) list) -> 'c list ->
+ 'd list -> ('a * 'b list) list
+
+val xor : MathQL.value -> MathQL.value -> MathQL.value
+
+val le : MathQL.value -> MathQL.value -> MathQL.value
+
+val lt : MathQL.value -> MathQL.value -> MathQL.value
+
+val align : string -> string -> MathQL.value
+
+val set : string * 'a -> (string * 'a) list -> (string * 'a) list
diff --git a/helm/ocaml/mathql_interpreter/mQueryInterpreter.ml b/helm/ocaml/mathql_interpreter/mQueryInterpreter.ml
new file mode 100644
index 000000000..9280a2c2a
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQueryInterpreter.ml
@@ -0,0 +1,247 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+(* $Id$ *)
+
+(* contexts *****************************************************************)
+
+type svar_context = (MathQL.svar * MathQL.resource_set) list
+
+type avar_context = (MathQL.avar * MathQL.resource) list
+
+type group_context = (MathQL.avar * MathQL.attribute_group) list
+
+type vvar_context = (MathQL.vvar * MathQL.value) list
+
+type context = {svars: svar_context;
+ avars: avar_context;
+ groups: group_context; (* auxiliary context *)
+ vvars: vvar_context
+ }
+
+(* execute *****************************************************************)
+
+exception Found
+
+module M = MathQL
+module P = MQueryUtil
+module C = MQIConn
+module U = MQIUtil
+
+let execute h x =
+ let warn q =
+ if C.set h C.Warn then
+ begin
+ C.log h "MQIExecute: waring: reference to undefined variables: ";
+ P.text_of_query (C.log h) "\n" q
+ end
+ in
+ let rec eval_val c = function
+ | M.False -> U.mql_false
+ | M.True -> U.mql_true
+ | M.Const s -> [s]
+ | M.Set l -> U.iter (eval_val c) l
+ | M.Test (k,y1,y2) ->
+ let cand y1 y2 =
+ if eval_val c y1 = U.mql_false then U.mql_false else eval_val c y2
+ in
+ let cor y1 y2 =
+ let v1 = eval_val c y1 in
+ if v1 = U.mql_false then eval_val c y2 else v1
+ in
+ let h f y1 y2 = f (eval_val c y1) (eval_val c y2) in
+ let f = match k with
+ | M.And -> cand
+ | M.Or -> cor
+ | M.Xor -> h U.xor
+ | M.Sub -> h U.set_sub
+ | M.Meet -> h U.set_meet
+ | M.Eq -> h U.set_eq
+ | M.Le -> h U.le
+ | M.Lt -> h U.lt
+ in
+ f y1 y2
+ | M.Not y ->
+ if eval_val c y = U.mql_false then U.mql_true else U.mql_false
+ | M.VVar i -> begin
+ try List.assoc i c.vvars
+ with Not_found -> warn (M.Subj (M.VVar i)); [] end
+ | M.Dot (i,p) -> begin
+ try List.assoc p (List.assoc i c.groups)
+ with Not_found -> warn (M.Subj (M.Dot (i,p))); [] end
+ | M.Proj (None,x) -> List.map (fun (r, _) -> r) (eval_query c x)
+ | M.Proj ((Some p),x) ->
+ let proj_group_aux (q, v) = if q = p then v else [] in
+ let proj_group a = U.iter proj_group_aux a in
+ let proj_set (_, g) = U.iter proj_group g in
+ U.iter proj_set (eval_query c x)
+ | M.Ex (l,y) ->
+ let rec ex_aux h = function
+ | [] ->
+ let d = {c with groups = h} in
+ if eval_val d y = U.mql_false then () else raise Found
+ | i :: tail ->
+ begin
+ try
+ let (_, a) = List.assoc i c.avars in
+ let rec add_group = function
+ | [] -> ()
+ | g :: t -> ex_aux ((i, g) :: h) tail; add_group t
+ in
+ add_group a
+ with Not_found -> ()
+ end
+ in
+ (try ex_aux [] l; U.mql_false with Found -> U.mql_true)
+ | M.StatVal y ->
+ let t = P.start_time () in
+ let r = (eval_val c y) in
+ let s = P.stop_time t in
+ C.log h (Printf.sprintf "Stat: %s,%i\n" s (List.length r));
+ r
+ | M.Count y -> [string_of_int (List.length (eval_val c y))]
+ | M.Align (s,y) -> U.iter (U.align s) (eval_val c y)
+ and eval_query c = function
+ | M.Empty -> []
+ | M.Subj x ->
+ List.map (fun s -> (s, [])) (eval_val c x)
+ | M.Log (_,b,x) ->
+ if b then begin
+ let t = P.start_time () in
+ P.text_of_query (C.log h) "\n" x;
+ let s = P.stop_time t in
+ if C.set h C.Times then
+ C.log h (Printf.sprintf "Log source: %s\n" s);
+ eval_query c x
+ end else begin
+ let s = (eval_query c x) in
+ let t = P.start_time () in
+ P.text_of_result (C.log h) "\n" s;
+ let r = P.stop_time t in
+ if C.set h C.Times then
+ C.log h (Printf.sprintf "Log: %s\n" r);
+ s
+ end
+ | M.If (y,x1,x2) ->
+ if (eval_val c y) = U.mql_false
+ then (eval_query c x2) else (eval_query c x1)
+ | M.Bin (k,x1,x2) ->
+ let f = match k with
+ | M.BinFJoin -> U.mql_union
+ | M.BinFMeet -> U.mql_intersect
+ | M.BinFDiff -> U.mql_diff
+ in
+ f (eval_query c x1) (eval_query c x2)
+ | M.SVar i -> begin
+ try List.assoc i c.svars
+ with Not_found -> warn (M.SVar i); [] end
+ | M.AVar i -> begin
+ try [List.assoc i c.avars]
+ with Not_found -> warn (M.AVar i); [] end
+ | M.LetSVar (i,x1,x2) ->
+ let d = {c with svars = U.set (i, eval_query c x1) c.svars} in
+ eval_query d x2
+ | M.LetVVar (i,y,x) ->
+ let d = {c with vvars = U.set (i, eval_val c y) c.vvars} in
+ eval_query d x
+ | M.For (k,i,x1,x2) ->
+ let f = match k with
+ | M.GenFJoin -> U.mql_union
+ | M.GenFMeet -> U.mql_intersect
+ in
+ let rec for_aux = function
+ | [] -> []
+ | h :: t ->
+ let d = {c with avars = U.set (i, h) c.avars} in
+ f (eval_query d x2) (for_aux t)
+ in
+ for_aux (eval_query c x1)
+ | M.Add (b,z,x) ->
+ let f = if b then U.mql_prod else U.set_union in
+ let g a s = (fst a, f (snd a) (eval_grp c z)) :: s in
+ List.fold_right g (eval_query c x) []
+ | M.Property (q0,q1,q2,mc,ct,cfl,el,pat,y) ->
+ let subj, mct =
+ if q0 then [], (pat, q2 @ mc, eval_val c y)
+ else (q2 @ mc), (pat, [], eval_val c y)
+ in
+ let eval_cons (pat, p, y) = (pat, q2 @ p, eval_val c y) in
+ let cons_true = mct :: List.map eval_cons ct in
+ let cons_false = List.map (List.map eval_cons) cfl in
+ let eval_exp (p, po) = (q2 @ p, po) in
+ let exp = List.map eval_exp el in
+ let t = P.start_time () in
+ let r = MQIProperty.exec h q1 subj cons_true cons_false exp in
+ let s = P.stop_time t in
+ if C.set h C.Times then
+ C.log h (Printf.sprintf "Property: %s,%i\n" s (List.length r));
+ r
+ | M.StatQuery x ->
+ let t = P.start_time () in
+ let r = (eval_query c x) in
+ let s = P.stop_time t in
+ C.log h (Printf.sprintf "Stat: %s,%i\n" s (List.length r));
+ r
+ | M.Select (i,x,y) ->
+ let rec select_aux = function
+ | [] -> []
+ | h :: t ->
+ let d = {c with avars = U.set (i, h) c.avars} in
+ if eval_val d y = U.mql_false
+ then select_aux t else h :: select_aux t
+ in
+ select_aux (eval_query c x)
+ | M.Keep (b,l,x) ->
+ let keep_path (p, v) t =
+ if List.mem p l = b then t else (p, v) :: t in
+ let keep_grp a = List.fold_right keep_path a [] in
+ let keep_set a g =
+ let kg = keep_grp a in
+ if kg = [] then g else kg :: g
+ in
+ let keep_av (s, g) = (s, List.fold_right keep_set g []) in
+ List.map keep_av (eval_query c x)
+ and eval_grp c = function
+ | M.Attr gs ->
+ let attr_aux g (p, y) = U.mql_union g [(p, eval_val c y)] in
+ let attr_auxs s l = U.set_union s [List.fold_left attr_aux [] l] in
+ List.fold_left attr_auxs [] gs
+ | M.From i ->
+ try snd (List.assoc i c.avars)
+ with Not_found -> warn (M.AVar i); []
+ in
+ let c = {svars = []; avars = []; groups = []; vvars = []} in
+ let t = P.start_time () in
+ if C.set h C.Source then P.text_of_query (C.log h) "\n" x;
+ let r = eval_query c x in
+ if C.set h C.Result then P.text_of_result (C.log h) "\n" r;
+ let s = P.stop_time t in
+ if C.set h C.Times then
+ C.log h (Printf.sprintf "MQIExecute: %s,%s\n" s
+ (C.string_of_flags (C.flags h)));
+ r
diff --git a/helm/ocaml/mathql_interpreter/mQueryInterpreter.mli b/helm/ocaml/mathql_interpreter/mQueryInterpreter.mli
new file mode 100644
index 000000000..9d7081fff
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQueryInterpreter.mli
@@ -0,0 +1,29 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+val execute : MQIConn.handle -> MathQL.query -> MathQL.result
diff --git a/helm/ocaml/mathql_interpreter/mQueryTLexer.mll b/helm/ocaml/mathql_interpreter/mQueryTLexer.mll
new file mode 100644
index 000000000..ca51751f0
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQueryTLexer.mll
@@ -0,0 +1,133 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+{
+ open MQueryTParser
+
+ let debug = false
+
+ let out s = if debug then prerr_endline s
+}
+
+let SPC = [' ' '\t' '\n']+
+let ALPHA = ['A'-'Z' 'a'-'z' '_']
+let NUM = ['0'-'9']
+let IDEN = ALPHA (NUM | ALPHA)*
+let QSTR = [^ '"' '\\']+
+
+rule comm_token = parse
+ | "(*" { comm_token lexbuf; comm_token lexbuf }
+ | "*)" { () }
+ | ['*' '('] { comm_token lexbuf }
+ | [^ '*' '(']* { comm_token lexbuf }
+and string_token = parse
+ | '"' { DQ }
+ | '\\' _ { STR (String.sub (Lexing.lexeme lexbuf) 1 1) }
+ | QSTR { STR (Lexing.lexeme lexbuf) }
+ | eof { EOF }
+and query_token = parse
+ | "(*" { comm_token lexbuf; query_token lexbuf }
+ | SPC { query_token lexbuf }
+ | '"' { let str = qstr string_token lexbuf in
+ out ("STR " ^ str); STR str }
+ | '(' { out "LP"; LP }
+ | ')' { out "RP"; RP }
+ | '{' { out "LC"; LC }
+ | '}' { out "RC"; RC }
+ | '@' { out "AT"; AT }
+ | '%' { out "PC"; PC }
+ | '$' { out "DL"; DL }
+ | '.' { out "FS"; FS }
+ | ',' { out "CM"; CM }
+ | ';' { out "SC"; SC }
+ | '/' { out "SL"; SL }
+ | "add" { out "ADD" ; ADD }
+ | "align" { out "ALIGN" ; ALIGN }
+ | "allbut" { out "BUT" ; BUT }
+ | "and" { out "AND" ; AND }
+ | "as" { out "AS" ; AS }
+ | "attr" { out "ATTR" ; ATTR }
+ | "be" { out "BE" ; BE }
+ | "count" { out "COUNT" ; COUNT }
+ | "diff" { out "DIFF" ; DIFF }
+ | "distr" { out "DISTR" ; DISTR }
+ | "else" { out "ELSE" ; ELSE }
+ | "empty" { out "EMPTY" ; EMPTY }
+ | "eq" { out "EQ" ; EQ }
+ | "ex" { out "EX" ; EX }
+ | "false" { out "FALSE" ; FALSE }
+ | "for" { out "FOR" ; FOR }
+ | "from" { out "FROM" ; FROM }
+ | "if" { out "IF" ; IF }
+ | "in" { out "IN" ; IN }
+ | "inf" { out "INF" ; INF }
+ | "intersect" { out "INTER" ; INTER }
+ | "inverse" { out "INV" ; INV }
+ | "istrue" { out "IST" ; IST }
+ | "isfalse" { out "ISF" ; ISF }
+ | "keep" { out "KEEP" ; KEEP }
+ | "le" { out "LE" ; LE }
+ | "let" { out "LET" ; LET }
+ | "log" { out "LOG" ; LOG }
+ | "lt" { out "LT" ; LT }
+ | "main" { out "MAIN" ; MAIN }
+ | "match" { out "MATCH" ; MATCH }
+ | "meet" { out "MEET" ; MEET }
+ | "not" { out "NOT" ; NOT }
+ | "of" { out "OF" ; OF }
+ | "or" { out "OR" ; OR }
+ | "pattern" { out "PAT" ; PAT }
+ | "proj" { out "PROJ" ; PROJ }
+ | "property" { out "PROP" ; PROP }
+ | "select" { out "SELECT"; SELECT }
+ | "source" { out "SOURCE"; SOURCE }
+ | "stat" { out "STAT" ; STAT }
+ | "sub" { out "SUB" ; SUB }
+ | "subj" { out "SUBJ" ; SUBJ }
+ | "sup" { out "SUP" ; SUP }
+ | "super" { out "SUPER" ; SUPER }
+ | "then" { out "THEN" ; THEN }
+ | "true" { out "TRUE" ; TRUE }
+ | "union" { out "UNION" ; UNION }
+ | "where" { out "WHERE" ; WHERE }
+ | "xor" { out "XOR" ; XOR }
+ | IDEN { let id = Lexing.lexeme lexbuf in
+ out ("ID " ^ id); ID id }
+ | eof { out "EOF" ; EOF }
+and result_token = parse
+ | SPC { result_token lexbuf }
+ | "(*" { comm_token lexbuf; result_token lexbuf }
+ | '"' { STR (qstr string_token lexbuf) }
+ | '/' { out "SL"; SL }
+ | '{' { LC }
+ | '}' { RC }
+ | ',' { CM }
+ | ';' { SC }
+ | '=' { IS }
+ | "attr" { ATTR }
+ | eof { EOF }
diff --git a/helm/ocaml/mathql_interpreter/mQueryTParser.mly b/helm/ocaml/mathql_interpreter/mQueryTParser.mly
new file mode 100644
index 000000000..2f8896185
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQueryTParser.mly
@@ -0,0 +1,314 @@
+/* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ */
+
+/* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ */
+
+%{
+ module M = MathQL
+
+ let analyze x =
+ let rec join l1 l2 = match l1, l2 with
+ | [], _ -> l2
+ | _, [] -> l1
+ | s1 :: tl1, s2 :: _ when s1 < s2 -> s1 :: join tl1 l2
+ | s1 :: _, s2 :: tl2 when s2 < s1 -> s2 :: join l1 tl2
+ | s1 :: tl1, s2 :: tl2 -> s1 :: join tl1 tl2
+ in
+ let rec iter f = function
+ | [] -> []
+ | head :: tail -> join (f head) (iter f tail)
+ in
+ let rec an_val = function
+ | M.True -> []
+ | M.False -> []
+ | M.Const _ -> []
+ | M.VVar _ -> []
+ | M.Ex _ -> []
+ | M.Dot (rv,_) -> [rv]
+ | M.Not x -> an_val x
+ | M.StatVal x -> an_val x
+ | M.Count x -> an_val x
+ | M.Align (_,x) -> an_val x
+ | M.Proj (_,x) -> an_set x
+ | M.Test (_,x,y) -> iter an_val [x; y]
+ | M.Set l -> iter an_val l
+ and an_set = function
+ | M.Empty -> []
+ | M.SVar _ -> []
+ | M.AVar _ -> []
+ | M.Subj x -> an_val x
+ | M.Keep (_,_,x) -> an_set x
+ | M.Log (_,_,x) -> an_set x
+ | M.StatQuery x -> an_set x
+ | M.Bin (_,x,y) -> iter an_set [x; y]
+ | M.LetSVar (_,x,y) -> iter an_set [x; y]
+ | M.For (_,_,x,y) -> iter an_set [x; y]
+ | M.Add (_,g,x) -> join (an_grp g) (an_set x)
+ | M.LetVVar (_,x,y) -> join (an_val x) (an_set y)
+ | M.Select (_,x,y) -> join (an_set x) (an_val y)
+ | M.Property (_,_,_,_,c,d,_,_,x) ->
+ join (an_val x) (iter an_con [c; List.concat d])
+ | M.If (x,y,z) -> join (an_val x) (iter an_set [y; z])
+ and fc (_, _, v) = an_val v
+ and an_con c = iter fc c
+ and fg (_, v) = an_val v
+ and an_grp = function
+ | M.Attr g -> iter (iter fg) g
+ | M.From _ -> []
+ in
+ an_val x
+
+ let f (x, y, z) = x
+ let s (x, y, z) = y
+ let t (x, y, z) = z
+%}
+ %token <string> ID STR
+ %token SL IS LC RC CM SC LP RP AT PC DL FS DQ EOF
+ %token ADD ALIGN AND AS ATTR BE BUT COUNT DIFF DISTR ELSE EMPTY EQ EX
+ %token FALSE FOR FROM IF IN INF INTER INV ISF IST KEEP LE LET LOG LT
+ %token MAIN MATCH MEET NOT OF OR PAT PROJ PROP SELECT SOURCE STAT SUB
+ %token SUBJ SUP SUPER THEN TRUE UNION WHERE XOR
+ %nonassoc IN SUP INF ELSE LOG STAT
+ %left DIFF
+ %left UNION
+ %left INTER
+ %nonassoc WHERE EX
+ %left XOR OR
+ %left AND
+ %nonassoc NOT
+ %nonassoc SUB MEET EQ LT LE
+ %nonassoc SUBJ OF PROJ COUNT ALIGN
+
+ %start qstr query result
+ %type <string> qstr
+ %type <MathQL.query> query
+ %type <MathQL.result> result
+%%
+ qstr:
+ | DQ { "" }
+ | STR qstr { $1 ^ $2 }
+ ;
+ svar:
+ | PC ID { $2 }
+ ;
+ avar:
+ | AT ID { $2 }
+ ;
+ vvar:
+ | DL ID { $2 }
+ ;
+ strs:
+ | STR CM strs { $1 :: $3 }
+ | STR { [$1] }
+ ;
+ subpath:
+ | STR SL subpath { $1 :: $3 }
+ | STR { [$1] }
+ ;
+ path:
+ | subpath { $1 }
+ | SL subpath { $2 }
+ | SL { [] }
+ ;
+ paths:
+ | path CM paths { $1 :: $3 }
+ | path { [$1] }
+ inv:
+ | INV { true }
+ | { false }
+ ;
+ ref:
+ | SUB { M.RefineSub }
+ | SUPER { M.RefineSuper }
+ | { M.RefineExact }
+ ;
+ qualif:
+ | inv ref path { $1, $2, $3 }
+ ;
+ cons:
+ | path IN val_exp { (false, $1, $3) }
+ | path MATCH val_exp { (true, $1, $3) }
+ ;
+ conss:
+ | cons CM conss { $1 :: $3 }
+ | cons { [$1] }
+ ;
+ istrue:
+ | IST conss { $2 }
+ | { [] }
+ ;
+ isfalse:
+ | { [] }
+ | ISF conss isfalse { $2 :: $3 }
+ ;
+ mainc:
+ | MAIN path { $2 }
+ | { [] }
+ ;
+ exp:
+ | path AS path { $1, Some $3 }
+ | path { $1, None }
+ ;
+ exps:
+ | exp CM exps { $1 :: $3 }
+ | exp { [$1] }
+ ;
+ attrc:
+ | ATTR exps { $2 }
+ | { [] }
+ ;
+ pattern:
+ | PAT { true }
+ | { false }
+ ;
+ opt_path:
+ | path { Some $1 }
+ | { None }
+ ;
+ ass:
+ | val_exp AS path { ($3, $1) }
+ ;
+ asss:
+ | ass CM asss { $1 :: $3 }
+ | ass { [$1] }
+ ;
+ assg:
+ | asss SC assg { $1 :: $3 }
+ | asss { [$1] }
+ ;
+ distr:
+ | DISTR { true }
+ | { false }
+ ;
+ allbut:
+ | BUT { true }
+ | { false }
+ ;
+ bin_op:
+ | set_exp DIFF set_exp { M.BinFDiff, $1, $3 }
+ | set_exp UNION set_exp { M.BinFJoin, $1, $3 }
+ | set_exp INTER set_exp { M.BinFMeet, $1, $3 }
+ ;
+ gen_op:
+ | SUP set_exp { M.GenFJoin, $2 }
+ | INF set_exp { M.GenFMeet, $2 }
+ ;
+ test_op:
+ | val_exp XOR val_exp { M.Xor, $1, $3 }
+ | val_exp OR val_exp { M.Or, $1, $3 }
+ | val_exp AND val_exp { M.And, $1, $3 }
+ | val_exp SUB val_exp { M.Sub, $1, $3 }
+ | val_exp MEET val_exp { M.Meet, $1, $3 }
+ | val_exp EQ val_exp { M.Eq, $1, $3 }
+ | val_exp LE val_exp { M.Le, $1, $3 }
+ | val_exp LT val_exp { M.Lt, $1, $3 }
+ ;
+ source:
+ | SOURCE { true }
+ | { false }
+ ;
+ xml:
+ | { false}
+ ;
+ grp_exp:
+ | assg { M.Attr $1 }
+ | avar { M.From $1 }
+ ;
+ val_exp:
+ | TRUE { M.True }
+ | FALSE { M.False }
+ | STR { M.Const $1 }
+ | avar FS path { M.Dot ($1,$3) }
+ | vvar { M.VVar $1 }
+ | LC vals RC { M.Set $2 }
+ | LC RC { M.Set [] }
+ | LP val_exp RP { $2 }
+ | STAT val_exp { M.StatVal $2 }
+ | EX val_exp { M.Ex ((analyze $2),$2) }
+ | NOT val_exp { M.Not $2 }
+ | test_op { M.Test ((f $1),(s $1),(t $1)) }
+ | PROJ opt_path set_exp { M.Proj ($2,$3) }
+ | COUNT val_exp { M.Count $2 }
+ | ALIGN STR IN val_exp { M.Align ($2,$4) }
+ ;
+ vals:
+ | val_exp CM vals { $1 :: $3 }
+ | val_exp { [$1] }
+ ;
+ set_exp:
+ | EMPTY { M.Empty }
+ | LP set_exp RP { $2 }
+ | svar { M.SVar $1 }
+ | avar { M.AVar $1 }
+ | LET svar BE set_exp IN set_exp { M.LetSVar ($2,$4,$6) }
+ | LET vvar BE val_exp IN set_exp { M.LetVVar ($2,$4,$6) }
+ | FOR avar IN set_exp gen_op
+ { M.For ((fst $5),$2,$4,(snd $5)) }
+ | ADD distr grp_exp IN set_exp { M.Add ($2,$3,$5) }
+ | IF val_exp THEN set_exp ELSE set_exp { M.If ($2,$4,$6) }
+ | PROP qualif mainc istrue isfalse attrc OF pattern val_exp
+ { M.Property ((f $2),(s $2),(t $2),$3,$4,$5,$6,$8,$9) }
+ | LOG xml source set_exp { M.Log ($2,$3,$4) }
+ | STAT set_exp { M.StatQuery $2 }
+ | KEEP allbut paths IN set_exp { M.Keep ($2,$3,$5) }
+ | KEEP allbut IN set_exp { M.Keep ($2,[],$4) }
+ | bin_op
+ { M.Bin ((f $1),(s $1),(t $1)) }
+ | SELECT avar FROM set_exp WHERE val_exp { M.Select ($2,$4,$6) }
+ | SUBJ val_exp { M.Subj $2 }
+ ;
+ query:
+ | set_exp { $1 }
+ | set_exp error { $1 }
+ | EOF { raise End_of_file }
+ ;
+ attr:
+ | path IS strs { $1, $3 }
+ | path { $1, [] }
+ ;
+ attrs:
+ | attr SC attrs { $1 :: $3 }
+ | attr { [$1] }
+ ;
+ group:
+ LC attrs RC { $2 }
+ ;
+ groups:
+ | group CM groups { $1 :: $3 }
+ | group { [$1] }
+ ;
+ resource:
+ | STR ATTR groups { ($1, $3) }
+ | STR { ($1, []) }
+ ;
+ resources:
+ | resource SC resources { $1 :: $3 }
+ | resource { [$1] }
+ | { [] }
+ ;
+ result:
+ | resources { $1 }
+ | EOF { raise End_of_file }
diff --git a/helm/ocaml/mathql_interpreter/mQueryUtil.ml b/helm/ocaml/mathql_interpreter/mQueryUtil.ml
new file mode 100644
index 000000000..6323cc950
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQueryUtil.ml
@@ -0,0 +1,220 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+(* $Id$ *)
+
+(* text linearization and parsing *******************************************)
+
+let rec txt_list out f s = function
+ | [] -> ()
+ | [a] -> f a
+ | a :: tail -> f a; out s; txt_list out f s tail
+
+let txt_str out s = out ("\"" ^ s ^ "\"")
+
+let txt_path out p = out "/"; txt_list out (txt_str out) "/" p
+
+let text_of_query out sep x =
+ let module M = MathQL in
+ let txt_path_list l = txt_list out (txt_path out) ", " l in
+ let txt_svar sv = out ("%" ^ sv) in
+ let txt_avar av = out ("@" ^ av) in
+ let txt_vvar vv = out ("$" ^ vv) in
+ let txt_inv i = if i then out "inverse " in
+ let txt_ref = function
+ | M.RefineExact -> ()
+ | M.RefineSub -> out "sub "
+ | M.RefineSuper -> out "super "
+ in
+ let txt_qualif i r p = txt_inv i; txt_ref r; txt_path out p in
+ let main = function
+ | [] -> ()
+ | p -> out " main "; txt_path out p
+ in
+ let txt_exp = function
+ | (pl, None) -> txt_path out pl
+ | (pl, Some pr) -> txt_path out pl; out " as "; txt_path out pr
+ in
+ let txt_exp_list = function
+ | [] -> ()
+ | l -> out " attr "; txt_list out txt_exp ", " l
+ in
+ let pattern b = if b then out "pattern " in
+ let txt_opt_path = function
+ | None -> ()
+ | Some p -> txt_path out p; out " "
+ in
+ let txt_distr d = if d then out "distr " in
+ let txt_bin = function
+ | M.BinFJoin -> out " union "
+ | M.BinFMeet -> out " intersect "
+ | M.BinFDiff -> out " diff "
+ in
+ let txt_gen = function
+ | M.GenFJoin -> out " sup "
+ | M.GenFMeet -> out " inf "
+ in
+ let txt_test = function
+ | M.Xor -> out " xor "
+ | M.Or -> out " or "
+ | M.And -> out " and "
+ | M.Sub -> out " sub "
+ | M.Meet -> out " meet "
+ | M.Eq -> out " eq "
+ | M.Le -> out " le "
+ | M.Lt -> out " lt "
+ in
+ let txt_log a b =
+ if a then out "xml ";
+ if b then out "source "
+ in
+ let txt_allbut b = if b then out "allbut " in
+ let rec txt_con (pat, p, x) =
+ txt_path out p;
+ if pat then out " match " else out " in ";
+ txt_val x
+ and txt_con_list s = function
+ | [] -> ()
+ | l -> out s; txt_list out txt_con ", " l
+ and txt_istrue lt = txt_con_list " istrue " lt
+ and txt_isfalse lf = txt_con_list " isfalse " lf
+ and txt_ass (p, x) = txt_val x; out " as "; txt_path out p
+ and txt_ass_list l = txt_list out txt_ass ", " l
+ and txt_assg_list g = txt_list out txt_ass_list "; " g
+ and txt_val_list = function
+ | [v] -> txt_val v
+ | l -> out "{"; txt_list out txt_val ", " l; out "}"
+ and txt_grp = function
+ | M.Attr g -> txt_assg_list g
+ | M.From av -> txt_avar av
+ and txt_val = function
+ | M.True -> out "true"
+ | M.False -> out "false"
+ | M.Const s -> txt_str out s
+ | M.Set l -> txt_val_list l
+ | M.VVar vv -> txt_vvar vv
+ | M.Dot (av,p) -> txt_avar av; out "."; txt_path out p
+ | M.Proj (op,x) -> out "proj "; txt_opt_path op; txt_set x
+ | M.Ex (b,x) -> out "ex "; txt_val x
+(* | M.Ex b x -> out "ex ["; txt_list out txt_avar "," b; out "] "; txt_val x
+*) | M.Not x -> out "not "; txt_val x
+ | M.Test (k,x,y) -> out "("; txt_val x; txt_test k; txt_val y; out ")"
+ | M.StatVal x -> out "stat "; txt_val x
+ | M.Count x -> out "count "; txt_val x
+ | M.Align (s,x) -> out "align "; txt_str out s; out " in "; txt_val x
+ and txt_set = function
+ | M.Empty -> out "empty"
+ | M.SVar sv -> txt_svar sv
+ | M.AVar av -> txt_avar av
+ | M.Property (q0,q1,q2,mc,ct,cfl,xl,b,x) ->
+ out "property "; txt_qualif q0 q1 q2; main mc;
+ txt_istrue ct; txt_list out txt_isfalse "" cfl; txt_exp_list xl;
+ out " of "; pattern b; txt_val x
+ | M.Bin (k,x,y) -> out "("; txt_set x; txt_bin k; txt_set y;
+ out ")"
+ | M.LetSVar (sv,x,y) -> out "let "; txt_svar sv; out " be ";
+ txt_set x; out " in "; txt_set y
+ | M.LetVVar (vv,x,y) -> out "let "; txt_vvar vv; out " be ";
+ txt_val x; out " in "; txt_set y
+ | M.Select (av,x,y) -> out "select "; txt_avar av; out " from ";
+ txt_set x; out " where "; txt_val y
+ | M.Subj x -> out "subj "; txt_val x
+ | M.For (k,av,x,y) -> out "for "; txt_avar av; out " in ";
+ txt_set x; txt_gen k; txt_set y
+ | M.If (x,y,z) -> out "if "; txt_val x; out " then ";
+ txt_set y; out " else "; txt_set z
+ | M.Add (d,g,x) -> out "add "; txt_distr d; txt_grp g;
+ out " in "; txt_set x
+ | M.Log (a,b,x) -> out "log "; txt_log a b; txt_set x
+ | M.StatQuery x -> out "stat "; txt_set x
+ | M.Keep (b,l,x) -> out "keep "; txt_allbut b; txt_path_list l;
+ txt_set x
+ in
+ txt_set x; out sep
+
+let text_of_result out sep x =
+ let txt_attr = function
+ | (p, []) -> txt_path out p
+ | (p, l) -> txt_path out p; out " = "; txt_list out (txt_str out) ", " l
+ in
+ let txt_group l = out "{"; txt_list out txt_attr "; " l; out "}" in
+ let txt_res = function
+ | (s, []) -> txt_str out s
+ | (s, l) -> txt_str out s; out " attr "; txt_list out txt_group ", " l
+ in
+ let txt_set l = txt_list out txt_res ("; " ^ sep) l; out sep in
+ txt_set x
+
+let query_of_text lexbuf =
+ MQueryTParser.query MQueryTLexer.query_token lexbuf
+
+let result_of_text lexbuf =
+ MQueryTParser.result MQueryTLexer.result_token lexbuf
+
+(* time handling ***********************************************************)
+
+type time = float * float
+
+let start_time () =
+ (Sys.time (), Unix.time ())
+
+let stop_time (s0, u0) =
+ let s1 = Sys.time () in
+ let u1 = Unix.time () in
+ Printf.sprintf "%.2fs,%.2fs" (s1 -. s0) (u1 -. u0)
+
+(* operations on lists *****************************************************)
+
+type 'a comparison = Lt
+ | Gt
+ | Eq of 'a
+
+let list_join f l1 l2 =
+ let rec aux = function
+ | [], v
+ | v, [] -> v
+ | ((h1 :: t1) as v1), ((h2 :: t2) as v2) -> begin
+ match f h1 h2 with
+ | Lt -> h1 :: aux (t1, v2)
+ | Gt -> h2 :: aux (v1, t2)
+ | Eq h -> h :: aux (t1, t2)
+ end
+ in aux (l1, l2)
+
+let list_meet f l1 l2 =
+ let rec aux = function
+ | [], v
+ | v, [] -> []
+ | ((h1 :: t1) as v1), ((h2 :: t2) as v2) -> begin
+ match f h1 h2 with
+ | Lt -> aux (t1, v2)
+ | Gt -> aux (v1, t2)
+ | Eq h -> h :: aux (t1, t2)
+ end
+ in aux (l1, l2)
+
diff --git a/helm/ocaml/mathql_interpreter/mQueryUtil.mli b/helm/ocaml/mathql_interpreter/mQueryUtil.mli
new file mode 100644
index 000000000..575400298
--- /dev/null
+++ b/helm/ocaml/mathql_interpreter/mQueryUtil.mli
@@ -0,0 +1,49 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ *)
+
+val text_of_query : (string -> unit) -> string -> MathQL.query -> unit
+
+val text_of_result : (string -> unit) -> string -> MathQL.result -> unit
+
+val query_of_text : Lexing.lexbuf -> MathQL.query
+
+val result_of_text : Lexing.lexbuf -> MathQL.result
+
+type time
+
+val start_time : unit -> time
+
+val stop_time : time -> string
+
+type 'a comparison = Lt
+ | Gt
+ | Eq of 'a
+
+val list_join : ('a -> 'a -> 'a comparison) -> 'a list -> 'a list -> 'a list
+
+val list_meet : ('a -> 'a -> 'a comparison) -> 'a list -> 'a list -> 'a list
diff --git a/helm/ocaml/metadata/.depend b/helm/ocaml/metadata/.depend
new file mode 100644
index 000000000..04197957b
--- /dev/null
+++ b/helm/ocaml/metadata/.depend
@@ -0,0 +1,20 @@
+metadataExtractor.cmi: metadataTypes.cmi
+metadataPp.cmi: metadataTypes.cmi
+metadataConstraints.cmi: metadataTypes.cmi
+metadataDb.cmi: metadataTypes.cmi
+sqlStatements.cmo: sqlStatements.cmi
+sqlStatements.cmx: sqlStatements.cmi
+metadataTypes.cmo: metadataTypes.cmi
+metadataTypes.cmx: metadataTypes.cmi
+metadataExtractor.cmo: metadataTypes.cmi metadataExtractor.cmi
+metadataExtractor.cmx: metadataTypes.cmx metadataExtractor.cmi
+metadataPp.cmo: metadataTypes.cmi metadataPp.cmi
+metadataPp.cmx: metadataTypes.cmx metadataPp.cmi
+metadataConstraints.cmo: metadataTypes.cmi metadataPp.cmi \
+ metadataConstraints.cmi
+metadataConstraints.cmx: metadataTypes.cmx metadataPp.cmx \
+ metadataConstraints.cmi
+metadataDb.cmo: metadataTypes.cmi metadataPp.cmi metadataExtractor.cmi \
+ metadataConstraints.cmi metadataDb.cmi
+metadataDb.cmx: metadataTypes.cmx metadataPp.cmx metadataExtractor.cmx \
+ metadataConstraints.cmx metadataDb.cmi
diff --git a/helm/ocaml/metadata/Makefile b/helm/ocaml/metadata/Makefile
new file mode 100644
index 000000000..29ca2d3bc
--- /dev/null
+++ b/helm/ocaml/metadata/Makefile
@@ -0,0 +1,37 @@
+PACKAGE = metadata
+PREDICATES =
+
+INTERFACE_FILES = \
+ sqlStatements.mli \
+ metadataTypes.mli \
+ metadataExtractor.mli \
+ metadataPp.mli \
+ metadataConstraints.mli \
+ metadataDb.mli
+IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml)
+EXTRA_OBJECTS_TO_INSTALL =
+EXTRA_OBJECTS_TO_CLEAN =
+
+include ../Makefile.common
+
+all: all_table_creator all_extractor
+opt: opt_table_creator opt_extractor
+
+all_table_creator:
+ make -C table_creator/ all
+opt_table_creator:
+ make -C table_creator/ opt
+
+all_extractor:
+ make -C extractor/ all
+opt_extractor:
+ make -C extractor/ opt
+
+clean: clean_table_creator clean_extractor
+
+clean_table_creator:
+ make -C table_creator/ clean
+
+clean_extractor:
+ make -C extractor/ clean
+
diff --git a/helm/ocaml/metadata/dump_db/dump.sh b/helm/ocaml/metadata/dump_db/dump.sh
new file mode 100755
index 000000000..e7b43666e
--- /dev/null
+++ b/helm/ocaml/metadata/dump_db/dump.sh
@@ -0,0 +1,20 @@
+ALL_TABLES=`../table_creator/table_creator list all`
+
+if [ -z "$1" ]; then
+ echo "Dumps to stdout some tables of a given db on mowgli."
+ echo "If no tables are given the dump will contain:"
+ echo " $ALL_TABLES"
+ echo ""
+ echo "usage: dump.sh dbname [tables...]"
+ echo ""
+ exit 1
+fi
+DB=$1
+shift
+if [ -z "$1" ]; then
+ TABLES=$ALL_TABLES
+else
+ TABLES=$@
+fi
+
+mysqldump -e --add-drop-table -u helm -h mowgli.cs.unibo.it $DB $TABLES
diff --git a/helm/ocaml/metadata/extractor/.depend b/helm/ocaml/metadata/extractor/.depend
new file mode 100644
index 000000000..e69de29bb
diff --git a/helm/ocaml/metadata/extractor/Makefile b/helm/ocaml/metadata/extractor/Makefile
new file mode 100644
index 000000000..e58064b41
--- /dev/null
+++ b/helm/ocaml/metadata/extractor/Makefile
@@ -0,0 +1,30 @@
+OCAMLFIND=ocamlfind
+
+all: extractor extractor_manager
+opt: extractor.opt extractor_manager.opt
+
+clean:
+ rm -f *.cm[ixo] *.[ao] extractor extractor.opt *.err *.out extractor_manager extractor_manager.opt
+
+extractor: extractor.ml
+ $(OCAMLFIND) ocamlc \
+ -thread -package mysql,helm-metadata -linkpkg -o $@ $<
+
+extractor.opt: extractor.ml
+ $(OCAMLFIND) ocamlopt \
+ -thread -package mysql,helm-metadata -linkpkg -o $@ $<
+
+extractor_manager: extractor_manager.ml
+ $(OCAMLFIND) ocamlc \
+ -thread -package mysql,helm-metadata -linkpkg -o $@ $<
+
+extractor_manager.opt: extractor_manager.ml
+ $(OCAMLFIND) ocamlopt \
+ -thread -package mysql,helm-metadata -linkpkg -o $@ $<
+
+export: extractor.opt extractor_manager.opt
+ nice -n 20 \
+ time \
+ ./extractor_manager.opt 1>export.out 2>export.err
+
+include .depend
diff --git a/helm/ocaml/metadata/extractor/extractor.conf.xml b/helm/ocaml/metadata/extractor/extractor.conf.xml
new file mode 100644
index 000000000..8dbc9a935
--- /dev/null
+++ b/helm/ocaml/metadata/extractor/extractor.conf.xml
@@ -0,0 +1,19 @@
+<?xml version="1.0" encoding="utf-8"?>
+<helm_registry>
+ <section name="tmp">
+ <key name="dir">.tmp/</key>
+ </section>
+ <section name="db">
+ <key name="host">localhost</key>
+ <key name="user">helm</key>
+ <key name="database">mowgli</key>
+ </section>
+ <section name="getter">
+ <key name="servers">
+ file:///projects/helm/library/coq_contribs
+ </key>
+ <key name="cache_dir">$(tmp.dir)/cache</key>
+ <key name="maps_dir">$(tmp.dir)/maps</key>
+ <key name="dtd_dir">/projects/helm/xml/dtd</key>
+ </section>
+</helm_registry>
diff --git a/helm/ocaml/metadata/extractor/extractor.ml b/helm/ocaml/metadata/extractor/extractor.ml
new file mode 100644
index 000000000..418d5ff7c
--- /dev/null
+++ b/helm/ocaml/metadata/extractor/extractor.ml
@@ -0,0 +1,78 @@
+let _ = Helm_registry.load_from "extractor.conf.xml"
+
+let usage () =
+ prerr_endline "
+
+!! This binary should not be called by hand, use the extractor_manager. !!
+
+usage: ./extractor[.opt] path owner
+
+path: the path for the getter maps
+owner: the owner of the tables to update
+
+"
+
+let _ =
+ try
+ let _ = Sys.argv.(2), Sys.argv.(1) in
+ if Sys.argv.(1) = "-h"||Sys.argv.(1) = "-help"||Sys.argv.(1) = "--help" then
+ begin
+ usage ();
+ exit 1
+ end
+ with
+ Invalid_argument _ -> usage (); exit 1
+
+let owner = Sys.argv.(2)
+let path = Sys.argv.(1)
+
+let main () =
+ print_endline (Printf.sprintf "%d alive on path:%s owner:%s"
+ (Unix.getpid()) path owner);
+ Helm_registry.set "tmp.dir" path;
+ Http_getter.init ();
+ let dbd =
+ HMysql.quick_connect
+ ~host:(Helm_registry.get "db.host")
+ ~user:(Helm_registry.get "db.user")
+ ~database:(Helm_registry.get "db.database") ()
+ in
+ MetadataTypes.ownerize_tables owner;
+ let uris =
+ let ic = open_in (path ^ "/todo") in
+ let acc = ref [] in
+ (try
+ while true do
+ let l = input_line ic in
+ acc := l :: !acc
+ done
+ with
+ End_of_file -> ());
+ close_in ic;
+ !acc
+ in
+ let len = float_of_int (List.length uris) in
+ let i = ref 0 in
+ let magic = 45 in
+ List.iter (fun u ->
+ incr i;
+ let perc = ((float_of_int !i) /. len *. 100.0) in
+ let l = String.length u in
+ let short =
+ if l < magic then
+ u ^ String.make (magic + 3 - l) ' '
+ else
+ "..." ^ String.sub u (l - magic) magic
+ in
+ Printf.printf "%d (%d of %.0f = %3.1f%%): %s\n"
+ (Unix.getpid ()) !i len perc short;
+ flush stdout;
+ let uri = UriManager.uri_of_string u in
+ MetadataDb.index_obj ~dbd ~uri;
+ CicEnvironment.empty ())
+ uris;
+ print_string "END "; Unix.system "date"
+;;
+
+main ()
+
diff --git a/helm/ocaml/metadata/extractor/extractor_manager.ml b/helm/ocaml/metadata/extractor/extractor_manager.ml
new file mode 100644
index 000000000..05393b63e
--- /dev/null
+++ b/helm/ocaml/metadata/extractor/extractor_manager.ml
@@ -0,0 +1,306 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* HELPERS *)
+
+let create_all dbd =
+ let obj_tbl = MetadataTypes.obj_tbl () in
+ let sort_tbl = MetadataTypes.sort_tbl () in
+ let rel_tbl = MetadataTypes.rel_tbl () in
+ let name_tbl = MetadataTypes.name_tbl () in
+ let count_tbl = MetadataTypes.count_tbl () in
+ let tbls = [
+ (obj_tbl,`RefObj) ; (sort_tbl,`RefSort) ; (rel_tbl,`RefRel) ;
+ (name_tbl,`ObjectName) ; (count_tbl,`Count) ]
+ in
+ let statements =
+ (SqlStatements.create_tables tbls) @ (SqlStatements.create_indexes tbls)
+ in
+ List.iter (fun statement ->
+ try
+ ignore (Mysql.exec dbd statement)
+ with
+ exn ->
+ let status = Mysql.status dbd in
+ match status with
+ | Mysql.StatusError Mysql.Table_exists_error -> ()
+ | Mysql.StatusError _ -> raise exn
+ | _ -> ()
+ ) statements
+
+let drop_all dbd =
+ let obj_tbl = MetadataTypes.obj_tbl () in
+ let sort_tbl = MetadataTypes.sort_tbl () in
+ let rel_tbl = MetadataTypes.rel_tbl () in
+ let name_tbl = MetadataTypes.name_tbl () in
+ let count_tbl = MetadataTypes.count_tbl () in
+ let tbls = [
+ (obj_tbl,`RefObj) ; (sort_tbl,`RefSort) ; (rel_tbl,`RefRel) ;
+ (name_tbl,`ObjectName) ; (count_tbl,`Count) ]
+ in
+ let statements =
+ (SqlStatements.drop_tables tbls) @ (SqlStatements.drop_indexes tbls)
+ in
+ List.iter (fun statement ->
+ try
+ ignore (Mysql.exec dbd statement)
+ with Mysql.Error _ as exn ->
+ match Mysql.errno dbd with
+ | Mysql.Bad_table_error
+ | Mysql.No_such_index | Mysql.No_such_table -> ()
+ | _ -> raise exn
+ ) statements
+
+let slash_RE = Str.regexp "/"
+
+let partition l =
+ let l = List.fast_sort Pervasives.compare l in
+ let matches s1 s2 =
+ let l1,l2 = Str.split slash_RE s1, Str.split slash_RE s2 in
+ match l1,l2 with
+ | _::x::_,_::y::_ -> x = y
+ | _ -> false
+ in
+ let rec chunk l =
+ match l with
+ | [] -> [],[]
+ | h::(h1::tl as rest) when matches h h1 ->
+ let ch,todo = chunk rest in
+ (h::ch),todo
+ | h::(h1::tl as rest)-> [h],rest
+ | h::_ -> [h],[]
+ in
+ let rec split l =
+ let ch, todo = chunk l in
+ match todo with
+ | [] -> [ch]
+ | _ -> ch :: split todo
+ in
+ split l
+
+
+(* ARGV PARSING *)
+
+let _ =
+ try
+ if Sys.argv.(1) = "-h"||Sys.argv.(1) = "-help"||Sys.argv.(1) = "--help" then
+ begin
+ prerr_endline "
+usage: ./extractor_manager[.opt] [processes] [owner]
+
+defaults:
+ processes = 2
+ owner = NEW
+
+";
+ exit 1
+ end
+ with Invalid_argument _ -> ()
+
+let processes =
+ try
+ int_of_string (Sys.argv.(1))
+ with
+ Invalid_argument _ -> 2
+
+let owner =
+ try
+ Sys.argv.(2)
+ with Invalid_argument _ -> "NEW"
+
+let create_peons i =
+ let rec aux = function
+ | 0 -> []
+ | n -> (n,0) :: aux (n-1)
+ in
+ ref (aux i)
+
+let is_a_peon_idle peons =
+ List.exists (fun (_,x) -> x = 0) !peons
+
+let get_ide_peon peons =
+ let p = fst(List.find (fun (_,x) -> x = 0) !peons) in
+ peons := List.filter (fun (x,_) -> x <> p) !peons;
+ p
+
+let assign_peon peon pid peons =
+ peons := (peon,pid) :: !peons
+
+let wait_a_peon peons =
+ let pid,status = Unix.wait () in
+ (match status with
+ | Unix.WEXITED 0 -> ()
+ | Unix.WEXITED s ->
+ prerr_endline (Printf.sprintf "PEON %d EXIT STATUS %d" pid s)
+ | Unix.WSIGNALED s ->
+ prerr_endline
+ (Printf.sprintf "PEON %d HAD A PROBLEM, KILLED BY SIGNAL %d" pid s)
+ | Unix.WSTOPPED s ->
+ prerr_endline
+ (Printf.sprintf "PEON %d HAD A PROBLEM, STOPPED BY %d" pid s));
+ let p = fst(List.find (fun (_,x) -> x = pid) !peons) in
+ peons := List.filter (fun (x,_) -> x <> p) !peons;
+ peons := (p,0) :: !peons
+
+let is_a_peon_busy peons =
+ List.exists (fun (_,x) -> x <> 0) !peons
+
+(* MAIN *)
+let main () =
+ Helm_registry.load_from "extractor.conf.xml";
+ Http_getter.init ();
+ print_endline "Updating the getter....";
+ let base = (Helm_registry.get "tmp.dir") ^ "/maps" in
+ let formats i =
+ (Helm_registry.get "tmp.dir") ^ "/"^(string_of_int i)^"/maps"
+ in
+ for i = 1 to processes do
+ let fmt = formats i in
+ ignore(Unix.system ("rm -rf " ^ fmt));
+ ignore(Unix.system ("mkdir -p " ^ fmt));
+ ignore(Unix.system ("cp -r " ^ base ^ " " ^ fmt ^ "/../"));
+ done;
+ let dbd =
+ Mysql.quick_connect
+ ~host:(Helm_registry.get "db.host")
+ ~user:(Helm_registry.get "db.user")
+ ~database:(Helm_registry.get "db.database") ()
+ in
+ MetadataTypes.ownerize_tables owner;
+ let uri_RE = Str.regexp ".*\\(ind\\|var\\|con\\)$" in
+ drop_all dbd;
+ create_all dbd;
+ let uris = Http_getter.getalluris () in
+ let uris = List.filter (fun u -> Str.string_match uri_RE u 0) uris in
+ let todo = partition uris in
+ let cur = ref 0 in
+ let tot = List.length todo in
+ let peons = create_peons processes in
+ print_string "START "; flush stdout;
+ ignore(Unix.system "date");
+ while !cur < tot do
+ if is_a_peon_idle peons then
+ let peon = get_ide_peon peons in
+ let fmt = formats peon in
+ let oc = open_out (fmt ^ "/../todo") in
+ List.iter (fun s -> output_string oc (s^"\n")) (List.nth todo !cur);
+ close_out oc;
+ let pid = Unix.fork () in
+ if pid = 0 then
+ Unix.execv
+ "./extractor.opt" [| "./extractor.opt" ; fmt ^ "/../" ; owner|]
+ else
+ begin
+ assign_peon peon pid peons;
+ incr cur
+ end
+ else
+ wait_a_peon peons
+ done;
+ while is_a_peon_busy peons do wait_a_peon peons done;
+ print_string "END "; flush stdout;
+ ignore(Unix.system "date");
+ (* and now the rename table stuff *)
+ let obj_tbl = MetadataTypes.library_obj_tbl in
+ let sort_tbl = MetadataTypes.library_sort_tbl in
+ let rel_tbl = MetadataTypes.library_rel_tbl in
+ let name_tbl = MetadataTypes.library_name_tbl in
+ let count_tbl = MetadataTypes.library_count_tbl in
+ let hits_tbl = MetadataTypes.library_hits_tbl in
+ let obj_tbl_b = obj_tbl ^ "_BACKUP" in
+ let sort_tbl_b = sort_tbl ^ "_BACKUP" in
+ let rel_tbl_b = rel_tbl ^ "_BACKUP" in
+ let name_tbl_b = name_tbl ^ "_BACKUP" in
+ let count_tbl_b = count_tbl ^ "_BACKUP" in
+ let obj_tbl_c = MetadataTypes.obj_tbl () in
+ let sort_tbl_c = MetadataTypes.sort_tbl () in
+ let rel_tbl_c = MetadataTypes.rel_tbl () in
+ let name_tbl_c = MetadataTypes.name_tbl () in
+ let count_tbl_c = MetadataTypes.count_tbl () in
+ let stats =
+ SqlStatements.drop_tables [
+ (obj_tbl_b,`RefObj);
+ (sort_tbl_b,`RefSort);
+ (rel_tbl_b,`RefRel);
+ (name_tbl_b,`ObjectName);
+ (count_tbl_b,`Count);
+ (hits_tbl,`Hits) ] @
+ SqlStatements.drop_indexes [
+ (obj_tbl,`RefObj);
+ (sort_tbl,`RefSort);
+ (rel_tbl,`RefRel);
+ (name_tbl,`ObjectName);
+ (count_tbl,`Count);
+ (obj_tbl_c,`RefObj);
+ (sort_tbl_c,`RefSort);
+ (rel_tbl_c,`RefRel);
+ (name_tbl_c,`ObjectName);
+ (count_tbl_c,`Count);
+ (hits_tbl,`Hits) ] @
+ SqlStatements.rename_tables [
+ (obj_tbl,obj_tbl_b);
+ (sort_tbl,sort_tbl_b);
+ (rel_tbl,rel_tbl_b);
+ (name_tbl,name_tbl_b);
+ (count_tbl,count_tbl_b) ] @
+ SqlStatements.rename_tables [
+ (obj_tbl_c,obj_tbl);
+ (sort_tbl_c,sort_tbl);
+ (rel_tbl_c,rel_tbl);
+ (name_tbl_c,name_tbl);
+ (count_tbl_c,count_tbl) ] @
+ SqlStatements.create_tables [
+ (hits_tbl,`Hits) ] @
+ SqlStatements.fill_hits obj_tbl hits_tbl @
+ SqlStatements.create_indexes [
+ (obj_tbl,`RefObj);
+ (sort_tbl,`RefSort);
+ (rel_tbl,`RefRel);
+ (name_tbl,`ObjectName);
+ (count_tbl,`Count);
+ (hits_tbl,`Hits) ]
+ in
+ List.iter (fun statement ->
+ try
+(* prerr_endline statement;*)
+ ignore (Mysql.exec dbd statement)
+ with exn ->
+ let status = Mysql.status dbd in
+ match status with
+ | Mysql.StatusError Mysql.Table_exists_error
+ | Mysql.StatusError Mysql.Bad_table_error
+ | Mysql.StatusError Mysql.Cant_drop_field_or_key
+ | Mysql.StatusError Mysql.Unknown_table -> ()
+ | Mysql.StatusError status ->
+(* prerr_endline (string_of_int (Obj.magic status));*)
+ prerr_endline (Printexc.to_string exn);
+ raise exn
+ | _ ->
+ prerr_endline (Printexc.to_string exn);
+ ())
+ stats
+;;
+
+main ()
diff --git a/helm/ocaml/metadata/metadataConstraints.ml b/helm/ocaml/metadata/metadataConstraints.ml
new file mode 100644
index 000000000..07fcc738b
--- /dev/null
+++ b/helm/ocaml/metadata/metadataConstraints.ml
@@ -0,0 +1,649 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+open MetadataTypes
+
+let critical_value = 7
+let just_factor = 3
+
+module UriManagerSet = UriManager.UriSet
+module SetSet = Set.Make (UriManagerSet)
+
+type term_signature = (UriManager.uri * UriManager.uri list) option * UriManagerSet.t
+
+type cardinality_condition =
+ | Eq of int
+ | Gt of int
+ | Lt of int
+
+type rating_criterion =
+ [ `Hits (** order by number of hits, most used objects first *)
+ ]
+
+let default_tables =
+ (library_obj_tbl,library_rel_tbl,library_sort_tbl,library_count_tbl)
+
+let current_tables () =
+ (obj_tbl (),rel_tbl (),sort_tbl (), count_tbl ())
+
+let tbln n = "table" ^ string_of_int n
+
+(*
+let add_depth_constr depth_opt cur_tbl where =
+ match depth_opt with
+ | None -> where
+ | Some depth -> (sprintf "%s.h_depth = %d" cur_tbl depth) :: where
+*)
+
+let mk_positions positions cur_tbl =
+ "(" ^
+ String.concat " or "
+ (List.map
+ (fun pos ->
+ let pos_str = MetadataPp.pp_position_tag pos in
+ match pos with
+ | `InBody
+ | `InConclusion
+ | `InHypothesis
+ | `MainConclusion None
+ | `MainHypothesis None ->
+ sprintf "%s.h_position = \"%s\"" cur_tbl pos_str
+ | `MainConclusion (Some r)
+ | `MainHypothesis (Some r) ->
+ let depth = MetadataPp.pp_relation r in
+ sprintf "(%s.h_position = \"%s\" and %s.h_depth %s)"
+ cur_tbl pos_str cur_tbl depth)
+ (positions :> MetadataTypes.position list)) ^
+ ")"
+
+let explode_card_constr = function
+ | Eq card -> "=", card
+ | Gt card -> ">", card
+ | Lt card -> "<", card
+
+let add_card_constr tbl col where = function
+ | None -> where
+ | Some constr ->
+ let op, card = explode_card_constr constr in
+ (* count(_utente).hypothesis = 3 *)
+ (sprintf "%s.%s %s %d" tbl col op card :: where)
+
+let add_diff_constr tbl where = function
+ | None -> where
+ | Some constr ->
+ let op, card = explode_card_constr constr in
+ (sprintf "%s.hypothesis - %s.conclusion %s %d" tbl tbl op card :: where)
+
+let add_all_constr ?(tbl=library_count_tbl) (n,from,where) concl full diff =
+ match (concl, full, diff) with
+ | None, None, None -> (n,from,where)
+ | _ ->
+ let cur_tbl = tbln n in
+ let from = (sprintf "%s as %s" tbl cur_tbl) :: from in
+ let where = add_card_constr cur_tbl "conclusion" where concl in
+ let where = add_card_constr cur_tbl "statement" where full in
+ let where = add_diff_constr cur_tbl where diff in
+ (n+2,from,
+ (if n > 0 then
+ sprintf "table0.source = %s.source" cur_tbl :: where
+ else
+ where))
+
+
+let add_constraint ?(start=0) ?(tables=default_tables) (n,from,where) metadata =
+ let obj_tbl,rel_tbl,sort_tbl,count_tbl = tables
+ in
+ let cur_tbl = tbln n in
+ let start_table = tbln start in
+ match metadata with
+ | `Obj (uri, positions) ->
+ let from = (sprintf "%s as %s" obj_tbl cur_tbl) :: from in
+ let where =
+ (sprintf "(%s.h_occurrence = \"%s\")" cur_tbl (UriManager.string_of_uri uri)) ::
+ mk_positions positions cur_tbl ::
+ (if n=start then []
+ else [sprintf "%s.source = %s.source" start_table cur_tbl]) @
+ where
+ in
+ ((n+2), from, where)
+ | `Rel positions ->
+ let from = (sprintf "%s as %s" rel_tbl cur_tbl) :: from in
+ let where =
+ mk_positions positions cur_tbl ::
+ (if n=start then []
+ else [sprintf "%s.source = %s.source" start_table cur_tbl]) @
+ where
+ in
+ ((n+2), from, where)
+ | `Sort (sort, positions) ->
+ let sort_str = CicPp.ppsort sort in
+ let from = (sprintf "%s as %s" sort_tbl cur_tbl) :: from in
+ let where =
+ (sprintf "%s.h_sort = \"%s\"" cur_tbl sort_str ) ::
+ mk_positions positions cur_tbl ::
+ (if n=start then
+ []
+ else
+ [sprintf "%s.source = %s.source" start_table cur_tbl ]) @ where
+ in
+ ((n+2), from, where)
+
+let exec ~(dbd:HMysql.dbd) ?rating (n,from,where) =
+ let from = String.concat ", " from in
+ let where = String.concat " and " where in
+ let query =
+ match rating with
+ | None -> sprintf "select distinct table0.source from %s where %s" from where
+ | Some `Hits ->
+ sprintf
+ ("select distinct table0.source from %s, hits where %s
+ and table0.source = hits.source order by hits.no desc")
+ from where
+ in
+ (* prerr_endline query; *)
+ let result = HMysql.exec dbd query in
+ HMysql.map result
+ (fun row -> match row.(0) with Some s -> UriManager.uri_of_string s | _ -> assert false)
+
+
+let at_least ~(dbd:HMysql.dbd) ?concl_card ?full_card ?diff ?rating tables
+ (metadata: MetadataTypes.constr list)
+=
+ let obj_tbl,rel_tbl,sort_tbl, count_tbl = tables
+ in
+ if (metadata = []) && concl_card = None && full_card = None then
+ failwith "MetadataQuery.at_least: no constraints given";
+ let (n,from,where) =
+ List.fold_left (add_constraint ~tables) (0,[],[]) metadata
+ in
+ let (n,from,where) =
+ add_all_constr ~tbl:count_tbl (n,from,where) concl_card full_card diff
+ in
+ exec ~dbd ?rating (n,from,where)
+
+let at_least
+ ~(dbd:HMysql.dbd) ?concl_card ?full_card ?diff ?rating
+ (metadata: MetadataTypes.constr list)
+=
+ if are_tables_ownerized () then
+ (at_least
+ ~dbd ?concl_card ?full_card ?diff ?rating default_tables metadata) @
+ (at_least
+ ~dbd ?concl_card ?full_card ?diff ?rating (current_tables ()) metadata)
+ else
+ at_least
+ ~dbd ?concl_card ?full_card ?diff ?rating default_tables metadata
+
+
+ (** Prefix handling *)
+
+let filter_by_card n =
+ SetSet.filter (fun t -> (UriManagerSet.cardinal t) <= n)
+
+let merge n a b =
+ let init = SetSet.union a b in
+ let merge_single_set s1 b =
+ SetSet.fold
+ (fun s2 res -> SetSet.add (UriManagerSet.union s1 s2) res)
+ b SetSet.empty in
+ let res =
+ SetSet.fold (fun s1 res -> SetSet.union (merge_single_set s1 b) res) a init
+ in
+ filter_by_card n res
+
+let rec inspect_children n childs =
+ List.fold_left
+ (fun res term -> merge n (inspect_conclusion n term) res)
+ SetSet.empty childs
+
+and add_root n root childs =
+ let childunion = inspect_children n childs in
+ let addroot = UriManagerSet.add root in
+ SetSet.fold
+ (fun child newsets -> SetSet.add (addroot child) newsets)
+ childunion
+ (SetSet.singleton (UriManagerSet.singleton root))
+
+and inspect_conclusion n t =
+ if n = 0 then SetSet.empty
+ else match t with
+ Cic.Rel _
+ | Cic.Meta _
+ | Cic.Sort _
+ | Cic.Implicit _ -> SetSet.empty
+ | Cic.Var (u,exp_named_subst) -> SetSet.empty
+ | Cic.Const (u,exp_named_subst) ->
+ SetSet.singleton (UriManagerSet.singleton u)
+ | Cic.MutInd (u, t, exp_named_subst) ->
+ SetSet.singleton (UriManagerSet.singleton
+ (UriManager.uri_of_uriref u t None))
+ | Cic.MutConstruct (u, t, c, exp_named_subst) ->
+ SetSet.singleton (UriManagerSet.singleton
+ (UriManager.uri_of_uriref u t (Some c)))
+ | Cic.Cast (t, _) -> inspect_conclusion n t
+ | Cic.Prod (_, s, t) ->
+ merge n (inspect_conclusion n s) (inspect_conclusion n t)
+ | Cic.Lambda (_, s, t) ->
+ merge n (inspect_conclusion n s) (inspect_conclusion n t)
+ | Cic.LetIn (_, s, t) ->
+ merge n (inspect_conclusion n s) (inspect_conclusion n t)
+ | Cic.Appl ((Cic.Const (u,exp_named_subst))::l) ->
+ add_root (n-1) u l
+ | Cic.Appl ((Cic.MutInd (u, t, exp_named_subst))::l) ->
+ let uri = UriManager.uri_of_uriref u t None in
+ add_root (n-1) uri l
+ | Cic.Appl ((Cic.MutConstruct (u, t, c, exp_named_subst))::l) ->
+ let suri = UriManager.uri_of_uriref u t (Some c) in
+ add_root (n-1) suri l
+ | Cic.Appl l ->
+ SetSet.empty
+ | Cic.MutCase (u, t, tt, uu, m) ->
+ SetSet.empty
+ | Cic.Fix (_, m) ->
+ SetSet.empty
+ | Cic.CoFix (_, m) ->
+ SetSet.empty
+
+let rec inspect_term n t =
+ if n = 0 then
+ assert false
+ else
+ match t with
+ Cic.Rel _
+ | Cic.Meta _
+ | Cic.Sort _
+ | Cic.Implicit _ -> None, SetSet.empty
+ | Cic.Var (u,exp_named_subst) -> None, SetSet.empty
+ | Cic.Const (u,exp_named_subst) ->
+ Some u, SetSet.empty
+ | Cic.MutInd (u, t, exp_named_subst) ->
+ let uri = UriManager.uri_of_uriref u t None in
+ Some uri, SetSet.empty
+ | Cic.MutConstruct (u, t, c, exp_named_subst) ->
+ let uri = UriManager.uri_of_uriref u t (Some c) in
+ Some uri, SetSet.empty
+ | Cic.Cast (t, _) -> inspect_term n t
+ | Cic.Prod (_, _, t) -> inspect_term n t
+ | Cic.LetIn (_, _, t) -> inspect_term n t
+ | Cic.Appl ((Cic.Const (u,exp_named_subst))::l) ->
+ let childunion = inspect_children (n-1) l in
+ Some u, childunion
+ | Cic.Appl ((Cic.MutInd (u, t, exp_named_subst))::l) ->
+ let suri = UriManager.uri_of_uriref u t None in
+ if u = HelmLibraryObjects.Logic.eq_URI && n>1 then
+ (* equality is handled in a special way: in particular,
+ the type, if defined, is always added to the prefix,
+ and n is not decremented - it should have been n-2 *)
+ match l with
+ Cic.Const (u1,exp_named_subst1)::l1 ->
+ let inconcl = add_root (n-1) u1 l1 in
+ Some suri, inconcl
+ | Cic.MutInd (u1, t1, exp_named_subst1)::l1 ->
+ let suri1 = UriManager.uri_of_uriref u1 t1 None in
+ let inconcl = add_root (n-1) suri1 l1 in
+ Some suri, inconcl
+ | Cic.MutConstruct (u1, t1, c1, exp_named_subst1)::l1 ->
+ let suri1 = UriManager.uri_of_uriref u1 t1 (Some c1) in
+ let inconcl = add_root (n-1) suri1 l1 in
+ Some suri, inconcl
+ | _ :: _ -> Some suri, SetSet.empty
+ | _ -> assert false (* args number must be > 0 *)
+ else
+ let childunion = inspect_children (n-1) l in
+ Some suri, childunion
+ | Cic.Appl ((Cic.MutConstruct (u, t, c, exp_named_subst))::l) ->
+ let suri = UriManager.uri_of_uriref u t(Some c) in
+ let childunion = inspect_children (n-1) l in
+ Some suri, childunion
+ | _ -> None, SetSet.empty
+
+let add_cardinality s =
+ let l = SetSet.elements s in
+ let res =
+ List.map
+ (fun set ->
+ let el = UriManagerSet.elements set in
+ (List.length el, el)) l in
+ (* ordered by descending cardinality *)
+ List.sort (fun (n,_) (m,_) -> m - n) ((0,[])::res)
+
+let prefixes n t =
+ match inspect_term n t with
+ Some a, set -> Some a, add_cardinality set
+ | None, set when (SetSet.is_empty set) -> None, []
+ | _, _ -> assert false
+
+
+let rec add children =
+ List.fold_left
+ (fun acc t -> UriManagerSet.union (signature_concl t) acc)
+ (UriManagerSet.empty) children
+
+(* this function creates the set of all different constants appearing in
+ the conclusion of the term *)
+and signature_concl =
+ function
+ Cic.Rel _
+ | Cic.Meta _
+ | Cic.Sort _
+ | Cic.Implicit _ -> UriManagerSet.empty
+ | Cic.Var (u,exp_named_subst) ->
+ (*CSC: TODO if the var has a body it must be processed *)
+ UriManagerSet.empty
+ | Cic.Const (u,exp_named_subst) ->
+ UriManagerSet.singleton u
+ | Cic.MutInd (u, t, exp_named_subst) ->
+ let uri = UriManager.uri_of_uriref u t None in
+ UriManagerSet.singleton uri
+ | Cic.MutConstruct (u, t, c, exp_named_subst) ->
+ let uri = UriManager.uri_of_uriref u t (Some c) in
+ UriManagerSet.singleton uri
+ | Cic.Cast (t, _) -> signature_concl t
+ | Cic.Prod (_, s, t) ->
+ UriManagerSet.union (signature_concl s) (signature_concl t)
+ | Cic.Lambda (_, s, t) ->
+ UriManagerSet.union (signature_concl s) (signature_concl t)
+ | Cic.LetIn (_, s, t) ->
+ UriManagerSet.union (signature_concl s) (signature_concl t)
+ | Cic.Appl l -> add l
+ | Cic.MutCase _
+ | Cic.Fix _
+ | Cic.CoFix _ ->
+ UriManagerSet.empty
+
+let rec signature_of = function
+ | Cic.Cast (t, _) -> signature_of t
+ | Cic.Prod (_, _, t) -> signature_of t
+ | Cic.LetIn (_, _, t) -> signature_of t
+ | Cic.Appl ((Cic.Const (u,exp_named_subst))::l) ->
+ Some (u, []), add l
+ | Cic.Appl ((Cic.MutInd (u, t, exp_named_subst))::l) ->
+ let suri = UriManager.uri_of_uriref u t None in
+ if u = HelmLibraryObjects.Logic.eq_URI then
+ (* equality is handled in a special way: in particular,
+ the type, if defined, is always added to the prefix,
+ and n is not decremented - it should have been n-2 *)
+ match l with
+ Cic.Const (u1,exp_named_subst1)::l1 ->
+ let inconcl = UriManagerSet.remove u1 (add l1) in
+ Some (suri, [u1]), inconcl
+ | Cic.MutInd (u1, t1, exp_named_subst1)::l1 ->
+ let suri1 = UriManager.uri_of_uriref u1 t1 None in
+ let inconcl = UriManagerSet.remove suri1 (add l1) in
+ Some (suri, [suri1]), inconcl
+ | Cic.MutConstruct (u1, t1, c1, exp_named_subst1)::l1 ->
+ let suri1 = UriManager.uri_of_uriref u1 t1 (Some c1) in
+ let inconcl = UriManagerSet.remove suri1 (add l1) in
+ Some (suri, [suri1]), inconcl
+ | _ :: _ -> Some (suri, []), UriManagerSet.empty
+ | _ -> assert false (* args number must be > 0 *)
+ else
+ Some (suri, []), add l
+ | Cic.Appl ((Cic.MutConstruct (u, t, c, exp_named_subst))::l) ->
+ let suri = UriManager.uri_of_uriref u t (Some c) in
+ Some (suri, []), add l
+ | t -> None, signature_concl t
+
+(* takes a list of lists and returns the list of all elements
+ without repetitions *)
+let union l =
+ let rec drop_repetitions = function
+ [] -> []
+ | [a] -> [a]
+ | u1::u2::l when u1 = u2 -> drop_repetitions (u2::l)
+ | u::l -> u::(drop_repetitions l) in
+ drop_repetitions (List.sort Pervasives.compare (List.concat l))
+
+let must_of_prefix ?(where = `Conclusion) m s =
+ let positions =
+ match where with
+ | `Conclusion -> [`InConclusion]
+ | `Statement -> [`InConclusion; `InHypothesis; `MainHypothesis None]
+ in
+ let positions =
+ if m = None then `MainConclusion None :: positions else positions in
+ let s' = List.map (fun (u:UriManager.uri) -> `Obj (u, positions)) s in
+ match m with
+ None -> s'
+ | Some m -> `Obj (m, [`MainConclusion None]) :: s'
+
+let escape = Str.global_replace (Str.regexp_string "\'") "\\'"
+
+let get_constants (dbd:HMysql.dbd) ~where uri =
+ let uri = escape (UriManager.string_of_uri uri) in
+ let positions =
+ match where with
+ | `Conclusion -> [ MetadataTypes.mainconcl_pos; MetadataTypes.inconcl_pos ]
+ | `Statement ->
+ [ MetadataTypes.mainconcl_pos; MetadataTypes.inconcl_pos;
+ MetadataTypes.inhyp_pos; MetadataTypes.mainhyp_pos ]
+ in
+ let query =
+ let pos_predicate =
+ String.concat " OR "
+ (List.map (fun pos -> sprintf "(h_position = \"%s\")" pos) positions)
+ in
+ sprintf ("SELECT h_occurrence FROM %s WHERE source=\"%s\" AND (%s) UNION "^^
+ "SELECT h_occurrence FROM %s WHERE source=\"%s\" AND (%s)")
+ (MetadataTypes.obj_tbl ()) uri pos_predicate
+ MetadataTypes.library_obj_tbl uri pos_predicate
+
+ in
+ let result = HMysql.exec dbd query in
+ let set = ref UriManagerSet.empty in
+ HMysql.iter result
+ (fun col ->
+ match col.(0) with
+ | Some uri -> set := UriManagerSet.add (UriManager.uri_of_string uri) !set
+ | _ -> assert false);
+ !set
+
+let at_most ~(dbd:HMysql.dbd) ?(where = `Conclusion) only u =
+ let inconcl = get_constants dbd ~where u in
+ UriManagerSet.subset inconcl only
+
+ (* Special handling of equality. The problem is filtering out theorems just
+ * containing variables (e.g. all the theorems in cic:/Coq/Ring/). Really
+ * ad-hoc, no better solution found at the moment *)
+let myspeciallist_of_facts =
+ [0,UriManager.uri_of_string "cic:/Coq/Init/Logic/eq.ind#xpointer(1/1/1)"]
+let myspeciallist =
+ [0,UriManager.uri_of_string "cic:/Coq/Init/Logic/eq.ind#xpointer(1/1/1)";
+ (* 0,"cic:/Coq/Init/Logic/sym_eq.con"; *)
+ 0,UriManager.uri_of_string "cic:/Coq/Init/Logic/trans_eq.con";
+ 0,UriManager.uri_of_string "cic:/Coq/Init/Logic/f_equal.con";
+ 0,UriManager.uri_of_string "cic:/Coq/Init/Logic/f_equal2.con";
+ 0,UriManager.uri_of_string "cic:/Coq/Init/Logic/f_equal3.con"]
+
+
+let compute_exactly ~(dbd:HMysql.dbd) ?(facts=false) ~where main prefixes =
+ List.concat
+ (List.map
+ (fun (m,s) ->
+ let is_eq,card =
+ match main with
+ None -> false,m
+ | Some main ->
+ (m = 0 &&
+ UriManager.eq main
+ (UriManager.uri_of_string (HelmLibraryObjects.Logic.eq_XURI))),
+ m+1
+ in
+ if m = 0 && is_eq then
+ (if facts then myspeciallist_of_facts
+ else myspeciallist)
+ else
+ let res =
+ (* this gets rid of the ~750 objects of type Set/Prop/Type *)
+ if card = 0 then []
+ else
+ let must = must_of_prefix ~where main s in
+ match where with
+ | `Conclusion -> at_least ~dbd ~concl_card:(Eq card) must
+ | `Statement -> at_least ~dbd ~full_card:(Eq card) must
+ in
+ List.map (fun uri -> (card, uri)) res)
+ prefixes)
+
+ (* critical value reached, fallback to "only" constraints *)
+
+let compute_with_only ~(dbd:HMysql.dbd) ?(facts=false) ?(where = `Conclusion)
+ main prefixes constants
+=
+ let max_prefix_length =
+ match prefixes with
+ | [] -> assert false
+ | (max,_)::_ -> max in
+ let maximal_prefixes =
+ let rec filter res = function
+ [] -> res
+ | (n,s)::l when n = max_prefix_length -> filter ((n,s)::res) l
+ | _::_-> res in
+ filter [] prefixes in
+ let greater_than =
+ let all =
+ union
+ (List.map
+ (fun (m,s) ->
+ let card = if main = None then m else m + 1 in
+ let must = must_of_prefix ~where main s in
+ (let res =
+ match where with
+ | `Conclusion -> at_least ~dbd ~concl_card:(Gt card) must
+ | `Statement -> at_least ~dbd ~full_card:(Gt card) must
+ in
+ (* we tag the uri with m+1, for sorting purposes *)
+ List.map (fun uri -> (card, uri)) res))
+ maximal_prefixes)
+ in
+ Printf.fprintf stderr "all: %d\n" (List.length all);flush_all ();
+ List.filter (function (_,uri) -> at_most ~dbd ~where constants uri) all in
+ let equal_to = compute_exactly ~dbd ~facts ~where main prefixes in
+ greater_than @ equal_to
+
+ (* real match query implementation *)
+
+let cmatch ~(dbd:HMysql.dbd) ?(facts=false) t =
+ let (main, constants) = signature_of t in
+ match main with
+ | None -> []
+ | Some (main, types) ->
+ (* the type of eq is not counted in constants_no *)
+ let types_no = List.length types in
+ let constants_no = UriManagerSet.cardinal constants in
+ if (constants_no > critical_value) then
+ let prefixes = prefixes just_factor t in
+ (match prefixes with
+ | Some main, all_concl ->
+ let all_constants =
+ List.fold_right UriManagerSet.add types (UriManagerSet.add main constants)
+ in
+ compute_with_only ~dbd ~facts (Some main) all_concl all_constants
+ | _, _ -> [])
+ else
+ (* in this case we compute all prefixes, and we do not need
+ to apply the only constraints *)
+ let prefixes =
+ if constants_no = 0 then
+ (if types_no = 0 then
+ Some main, [0, []]
+ else
+ Some main, [0, []; types_no, types])
+ else
+ prefixes (constants_no+types_no+1) t
+ in
+ (match prefixes with
+ Some main, all_concl ->
+ compute_exactly ~dbd ~facts ~where:`Conclusion (Some main) all_concl
+ | _, _ -> [])
+
+let power_upto upto consts =
+ let l = UriManagerSet.elements consts in
+ List.sort (fun (n,_) (m,_) -> m - n)
+ (List.fold_left
+ (fun res a ->
+ let res' =
+ List.filter (function (n,l) -> n <= upto)
+ (List.map (function (n,l) -> (n+1,a::l)) res) in
+ res@res')
+ [(0,[])] l)
+
+let power consts =
+ let l = UriManagerSet.elements consts in
+ List.sort (fun (n,_) (m,_) -> m - n)
+ (List.fold_left
+ (fun res a -> res@(List.map (function (n,l) -> (n+1,a::l)) res))
+ [(0,[])] l)
+
+type where = [ `Conclusion | `Statement ]
+
+let sigmatch ~(dbd:HMysql.dbd) ?(facts=false) ?(where = `Conclusion)
+ (main, constants)
+=
+ let main,types =
+ match main with
+ None -> None,[]
+ | Some (main, types) -> Some main,types
+ in
+ let constants_no = UriManagerSet.cardinal constants in
+ (* prerr_endline (("constants_no: ")^(string_of_int constants_no)); *)
+ if (constants_no > critical_value) then
+ let subsets =
+ let subsets = power_upto just_factor constants in
+ (* let _ = prerr_endline (("subsets: ")^
+ (string_of_int (List.length subsets))) in *)
+ let types_no = List.length types in
+ List.map (function (n,l) -> (n+types_no,types@l)) subsets
+ in
+ let all_constants =
+ let all = match main with None -> types | Some m -> m::types in
+ List.fold_right UriManagerSet.add all constants
+ in
+ compute_with_only ~dbd ~where main subsets all_constants
+ else
+ let subsets =
+ let subsets = power constants in
+ let types_no = List.length types in
+ if types_no > 0 then
+ (0,[]) :: List.map (function (n,l) -> (n+types_no,types@l)) subsets
+ else subsets
+ in
+ compute_exactly ~dbd ~facts ~where main subsets
+
+ (* match query wrappers *)
+
+let cmatch'= cmatch
+
+let cmatch ~dbd ?(facts=false) term =
+ List.map snd
+ (List.sort
+ (fun x y -> Pervasives.compare (fst y) (fst x))
+ (cmatch' ~dbd ~facts term))
+
+let constants_of = signature_concl
+
diff --git a/helm/ocaml/metadata/metadataConstraints.mli b/helm/ocaml/metadata/metadataConstraints.mli
new file mode 100644
index 000000000..63757ae47
--- /dev/null
+++ b/helm/ocaml/metadata/metadataConstraints.mli
@@ -0,0 +1,111 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+module UriManagerSet : Set.S with type elt = UriManager.uri
+
+
+ (** @return <main, constants>
+ * main: constant in main position and, for polymorphic constants, type
+ * instantitation
+ * constants: constants appearing in term *)
+type term_signature = (UriManager.uri * UriManager.uri list) option * UriManagerSet.t
+
+(** {2 Candidates filtering} *)
+
+ (** @return sorted list of theorem URIs, first URIs in the least have higher
+ * relevance *)
+val cmatch: dbd:HMysql.dbd -> ?facts:bool -> Cic.term -> UriManager.uri list
+
+ (** as cmatch, but returned list is not sorted but rather tagged with
+ * relevance information: higher the tag, higher the relevance *)
+val cmatch': dbd:HMysql.dbd -> ?facts:bool -> Cic.term -> (int * UriManager.uri) list
+
+type where = [ `Conclusion | `Statement ] (** signature matching extent *)
+
+ (** @param where defaults to `Conclusion *)
+val sigmatch:
+ dbd:HMysql.dbd ->
+ ?facts:bool ->
+ ?where:where ->
+ term_signature ->
+ (int * UriManager.uri) list
+
+(** {2 Constraint engine} *)
+
+ (** constraing on the number of distinct constants *)
+type cardinality_condition =
+ | Eq of int
+ | Gt of int
+ | Lt of int
+
+type rating_criterion =
+ [ `Hits (** order by number of hits, most used objects first *)
+ ]
+
+val add_constraint:
+ ?start:int ->
+ ?tables:string * string * string * string ->
+ int * string list * string list ->
+ MetadataTypes.constr ->
+ int * string list * string list
+
+ (** @param concl_card cardinality condition on conclusion only
+ * @param full_card cardinality condition on the whole statement
+ * @param diff required difference between the number of different constants in
+ * hypothesis and the number of different constants in body
+ * @return list of URI satisfying given constraints *)
+
+val at_least:
+ dbd:HMysql.dbd ->
+ ?concl_card:cardinality_condition ->
+ ?full_card:cardinality_condition ->
+ ?diff:cardinality_condition ->
+ ?rating:rating_criterion ->
+ MetadataTypes.constr list ->
+ UriManager.uri list
+
+ (** @param where defaults to `Conclusion *)
+val at_most:
+ dbd:HMysql.dbd ->
+ ?where:where -> UriManagerSet.t ->
+ (UriManager.uri -> bool)
+
+val add_all_constr:
+ ?tbl:string ->
+ int * string list * string list ->
+ cardinality_condition option ->
+ cardinality_condition option ->
+ cardinality_condition option ->
+ int * string list * string list
+
+val exec:
+ dbd:HMysql.dbd ->
+ ?rating:[ `Hits ] ->
+ int * string list * string list ->
+ UriManager.uri list
+
+val signature_of: Cic.term -> term_signature
+val constants_of: Cic.term -> UriManagerSet.t
+
diff --git a/helm/ocaml/metadata/metadataDb.ml b/helm/ocaml/metadata/metadataDb.ml
new file mode 100644
index 000000000..457545dee
--- /dev/null
+++ b/helm/ocaml/metadata/metadataDb.ml
@@ -0,0 +1,193 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open MetadataTypes
+
+open Printf
+
+let execute_insert dbd uri (sort_cols, rel_cols, obj_cols) =
+ let sort_tuples =
+ List.fold_left (fun s l -> match l with
+ | [`String a; `String b; `Int c; `String d] ->
+ sprintf "(\"%s\", \"%s\", %d, \"%s\")" a b c d :: s
+ | _ -> assert false )
+ [] sort_cols
+ in
+ let rel_tuples =
+ List.fold_left (fun s l -> match l with
+ | [`String a; `String b; `Int c] ->
+ sprintf "(\"%s\", \"%s\", %d)" a b c :: s
+ | _ -> assert false)
+ [] rel_cols
+ in
+ let obj_tuples = List.fold_left (fun s l -> match l with
+ | [`String a; `String b; `String c; `Int d] ->
+ sprintf "(\"%s\", \"%s\", \"%s\", %d)" a b c d :: s
+ | [`String a; `String b; `String c; `Null] ->
+ sprintf "(\"%s\", \"%s\", \"%s\", %s)" a b c "NULL" :: s
+ | _ -> assert false)
+ [] obj_cols
+ in
+ if sort_tuples <> [] then
+ begin
+ let query_sort =
+ sprintf "INSERT %s VALUES %s;" (sort_tbl ()) (String.concat "," sort_tuples)
+ in
+ ignore (HMysql.exec dbd query_sort)
+ end;
+ if rel_tuples <> [] then
+ begin
+ let query_rel =
+ sprintf "INSERT %s VALUES %s;" (rel_tbl ()) (String.concat "," rel_tuples)
+ in
+ ignore (HMysql.exec dbd query_rel)
+ end;
+ if obj_tuples <> [] then
+ begin
+ let query_obj =
+ sprintf "INSERT %s VALUES %s;" (obj_tbl ()) (String.concat "," obj_tuples)
+ in
+ ignore (HMysql.exec dbd query_obj)
+ end
+
+
+let count_distinct position l =
+ MetadataConstraints.UriManagerSet.cardinal
+ (List.fold_left (fun acc d ->
+ match position with
+ | `Conclusion ->
+ (match d with
+ | `Obj (name,`InConclusion)
+ | `Obj (name,`MainConclusion _ ) ->
+ MetadataConstraints.UriManagerSet.add name acc
+ | _ -> acc)
+ | `Hypothesis ->
+ (match d with
+ | `Obj (name,`InHypothesis)
+ | `Obj (name,`MainHypothesis _) ->
+ MetadataConstraints.UriManagerSet.add name acc
+ | _ -> acc)
+ | `Statement ->
+ (match d with
+ | `Obj (name,`InBody) -> acc
+ | `Obj (name,_) -> MetadataConstraints.UriManagerSet.add name acc
+ | _ -> acc)
+ ) MetadataConstraints.UriManagerSet.empty l)
+
+let insert_const_no ~dbd l =
+ let data =
+ List.fold_left
+ (fun acc (uri,_,metadata) ->
+ let no_concl = count_distinct `Conclusion metadata in
+ let no_hyp = count_distinct `Hypothesis metadata in
+ let no_full = count_distinct `Statement metadata in
+ (sprintf "(\"%s\", %d, %d, %d)"
+ (UriManager.string_of_uri uri) no_concl no_hyp no_full) :: acc
+ ) [] l in
+ let insert =
+ sprintf "INSERT INTO %s VALUES %s" (count_tbl ()) (String.concat "," data)
+ in
+ ignore (HMysql.exec dbd insert)
+
+let insert_name ~dbd l =
+ let data =
+ List.fold_left
+ (fun acc (uri,name,_) ->
+ (sprintf "(\"%s\", \"%s\")" (UriManager.string_of_uri uri) name) :: acc
+ ) [] l in
+ let insert =
+ sprintf "INSERT INTO %s VALUES %s" (name_tbl ()) (String.concat "," data)
+ in
+ ignore (HMysql.exec dbd insert)
+
+type columns =
+ MetadataPp.t list list * MetadataPp.t list list * MetadataPp.t list list
+
+ (* TODO ZACK: verify if an object has already been indexed *)
+let already_indexed _ = false
+
+(***** TENTATIVE HACK FOR THE DB SLOWDOWN - BEGIN *******)
+let analyze_index = ref 0
+let eventually_analyze dbd =
+ incr analyze_index;
+ if !analyze_index > 30 then
+ begin
+ let analyze t = "OPTIMIZE TABLE " ^ t ^ ";" in
+ List.iter
+ (fun table -> ignore (HMysql.exec dbd (analyze table)))
+ [name_tbl (); rel_tbl (); sort_tbl (); obj_tbl(); count_tbl()]
+ end
+
+(***** TENTATIVE HACK FOR THE DB SLOWDOWN - END *******)
+
+let index_obj ~dbd ~uri =
+ if not (already_indexed uri) then begin
+ eventually_analyze dbd;
+ let metadata = MetadataExtractor.compute_obj uri in
+ let uri = UriManager.string_of_uri uri in
+ let columns = MetadataPp.columns_of_metadata metadata in
+ execute_insert dbd uri (columns :> columns);
+ insert_const_no ~dbd metadata;
+ insert_name ~dbd metadata
+ end
+
+
+let tables_to_clean =
+ [sort_tbl; rel_tbl; obj_tbl; name_tbl; count_tbl]
+
+let clean ~(dbd:HMysql.dbd) =
+ let owned_uris = (* list of uris in list-of-columns format *)
+ let query = sprintf "SELECT source FROM %s" (name_tbl ()) in
+ let result = HMysql.exec dbd query in
+ let uris = HMysql.map result (fun cols ->
+ match cols.(0) with
+ | Some src -> src
+ | None -> assert false) in
+ (* and now some stuff to remove #xpointers and duplicates *)
+ uris
+ in
+ let del_from tbl =
+ let query s =
+ sprintf "DELETE FROM %s WHERE source LIKE \"%s%%\"" (tbl ()) s
+ in
+ List.iter
+ (fun source_col -> ignore (HMysql.exec dbd (query source_col)))
+ owned_uris
+ in
+ List.iter del_from tables_to_clean;
+ owned_uris
+
+let unindex ~dbd ~uri =
+ let uri = UriManager.string_of_uri uri in
+ let del_from tbl =
+ let query tbl =
+ sprintf "DELETE FROM %s WHERE source LIKE \"%s%%\"" (tbl ()) uri
+ in
+ ignore (HMysql.exec dbd (query tbl))
+ in
+ List.iter del_from tables_to_clean
+
diff --git a/helm/ocaml/metadata/metadataDb.mli b/helm/ocaml/metadata/metadataDb.mli
new file mode 100644
index 000000000..86820aafb
--- /dev/null
+++ b/helm/ocaml/metadata/metadataDb.mli
@@ -0,0 +1,41 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+
+
+val index_obj: dbd:HMysql.dbd -> uri:UriManager.uri -> unit
+
+(* TODO Zack indexing of variables and (perhaps?) incomplete proofs *)
+
+ (** remove from the db all metadata pertaining to a given owner
+ * @return list of uris removed from the db *)
+val clean: dbd:HMysql.dbd -> string list
+
+val unindex: dbd:HMysql.dbd -> uri:UriManager.uri -> unit
+
+val count_distinct:
+ [`Conclusion | `Hypothesis | `Statement ] ->
+ MetadataTypes.metadata list ->
+ int
diff --git a/helm/ocaml/metadata/metadataExtractor.ml b/helm/ocaml/metadata/metadataExtractor.ml
new file mode 100644
index 000000000..4fbae1ba7
--- /dev/null
+++ b/helm/ocaml/metadata/metadataExtractor.ml
@@ -0,0 +1,350 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+open MetadataTypes
+
+let is_main_pos = function
+ | `MainConclusion _
+ | `MainHypothesis _ -> true
+ | _ -> false
+
+let main_pos (pos: position): main_position =
+ match pos with
+ | `MainConclusion depth -> `MainConclusion depth
+ | `MainHypothesis depth -> `MainHypothesis depth
+ | _ -> assert false
+
+let next_pos = function
+ | `MainConclusion _ -> `InConclusion
+ | `MainHypothesis _ -> `InHypothesis
+ | pos -> pos
+
+let string_of_uri = UriManager.string_of_uri
+
+module OrderedMetadata =
+ struct
+ type t = MetadataTypes.metadata
+ let compare m1 m2 = (* ignore universes in Cic.Type sort *)
+ match (m1, m2) with
+ | `Sort (Cic.Type _, pos1), `Sort (Cic.Type _, pos2) ->
+ Pervasives.compare pos1 pos2
+ | _ -> Pervasives.compare m1 m2
+ end
+
+module MetadataSet = Set.Make (OrderedMetadata)
+module UriManagerSet = UriManager.UriSet
+
+module S = MetadataSet
+
+let unopt = function Some x -> x | None -> assert false
+
+let incr_depth = function
+ | `MainConclusion (Some (Eq depth)) -> `MainConclusion (Some (Eq (depth + 1)))
+ | `MainHypothesis (Some (Eq depth)) -> `MainHypothesis (Some (Eq (depth + 1)))
+ | _ -> assert false
+
+let var_has_body uri =
+ match CicEnvironment.get_obj CicUniv.empty_ugraph uri with
+ | Cic.Variable (_, Some body, _, _, _), _ -> true
+ | _ -> false
+
+let compute_term pos term =
+ let rec aux (pos: position) set = function
+ | Cic.Var (uri, subst) when var_has_body uri ->
+ (* handles variables with body as constants *)
+ aux pos set (Cic.Const (uri, subst))
+ | Cic.Rel _
+ | Cic.Var _ ->
+ if is_main_pos pos then
+ S.add (`Rel (main_pos pos)) set
+ else
+ set
+ | Cic.Meta (_, local_context) ->
+ List.fold_left
+ (fun set context ->
+ match context with
+ | None -> set
+ | Some term -> aux (next_pos pos) set term)
+ set
+ local_context
+ | Cic.Sort sort ->
+ if is_main_pos pos then
+ S.add (`Sort (sort, main_pos pos)) set
+ else
+ set
+ | Cic.Implicit _ -> assert false
+ | Cic.Cast (term, ty) ->
+ (* TODO consider also ty? *)
+ aux pos set term
+ | Cic.Prod (_, source, target) ->
+ (match pos with
+ | `MainConclusion _ ->
+ let set = aux (`MainHypothesis (Some (Eq 0))) set source in
+ aux (incr_depth pos) set target
+ | `MainHypothesis _ ->
+ let set = aux `InHypothesis set source in
+ aux (incr_depth pos) set target
+ | `InConclusion
+ | `InHypothesis
+ | `InBody ->
+ let set = aux pos set source in
+ aux pos set target)
+ | Cic.Lambda (_, source, target) ->
+ (*assert (not (is_main_pos pos));*)
+ let set = aux (next_pos pos) set source in
+ aux (next_pos pos) set target
+ | Cic.LetIn (_, term, target) ->
+ if is_main_pos pos then
+ aux pos set (CicSubstitution.subst term target)
+ else
+ let set = aux pos set term in
+ aux pos set target
+ | Cic.Appl [] -> assert false
+ | Cic.Appl (hd :: tl) ->
+ let set = aux pos set hd in
+ List.fold_left
+ (fun set term -> aux (next_pos pos) set term)
+ set tl
+ | Cic.Const (uri, subst) ->
+ let set = S.add (`Obj (uri, pos)) set in
+ List.fold_left
+ (fun set (_, term) -> aux (next_pos pos) set term)
+ set subst
+ | Cic.MutInd (uri, typeno, subst) ->
+ let uri = UriManager.uri_of_uriref uri typeno None in
+ let set = S.add (`Obj (uri, pos)) set in
+ List.fold_left (fun set (_, term) -> aux (next_pos pos) set term)
+ set subst
+ | Cic.MutConstruct (uri, typeno, consno, subst) ->
+ let uri = UriManager.uri_of_uriref uri typeno (Some consno) in
+ let set = S.add (`Obj (uri, pos)) set in
+ List.fold_left (fun set (_, term) -> aux (next_pos pos) set term)
+ set subst
+ | Cic.MutCase (uri, _, outtype, term, pats) ->
+ let pos = next_pos pos in
+ let set = aux pos set term in
+ let set = aux pos set outtype in
+ List.fold_left (fun set term -> aux pos set term) set pats
+ | Cic.Fix (_, funs) ->
+ let pos = next_pos pos in
+ List.fold_left
+ (fun set (_, _, ty, body) ->
+ let set = aux pos set ty in
+ aux pos set body)
+ set funs
+ | Cic.CoFix (_, funs) ->
+ let pos = next_pos pos in
+ List.fold_left
+ (fun set (_, ty, body) ->
+ let set = aux pos set ty in
+ aux pos set body)
+ set funs
+ in
+ aux pos S.empty term
+
+module OrderedInt =
+struct
+ type t = int
+ let compare = Pervasives.compare
+end
+
+module IntSet = Set.Make (OrderedInt)
+
+let compute_metas term =
+ let rec aux in_hyp ((concl_metas, hyp_metas) as acc) cic =
+ match cic with
+ | Cic.Rel _
+ | Cic.Sort _
+ | Cic.Var _ -> acc
+ | Cic.Meta (no, local_context) ->
+ let acc =
+ if in_hyp then
+ (concl_metas, IntSet.add no hyp_metas)
+ else
+ (IntSet.add no concl_metas, hyp_metas)
+ in
+ List.fold_left
+ (fun set context ->
+ match context with
+ | None -> set
+ | Some term -> aux in_hyp set term)
+ acc
+ local_context
+ | Cic.Implicit _ -> assert false
+ | Cic.Cast (term, ty) ->
+ (* TODO consider also ty? *)
+ aux in_hyp acc term
+ | Cic.Prod (_, source, target) ->
+ if in_hyp then
+ let acc = aux in_hyp acc source in
+ aux in_hyp acc target
+ else
+ let acc = aux true acc source in
+ aux in_hyp acc target
+ | Cic.Lambda (_, source, target) ->
+ let acc = aux in_hyp acc source in
+ aux in_hyp acc target
+ | Cic.LetIn (_, term, target) ->
+ aux in_hyp acc (CicSubstitution.subst term target)
+ | Cic.Appl [] -> assert false
+ | Cic.Appl (hd :: tl) ->
+ let acc = aux in_hyp acc hd in
+ List.fold_left (fun acc term -> aux in_hyp acc term) acc tl
+ | Cic.Const (_, subst)
+ | Cic.MutInd (_, _, subst)
+ | Cic.MutConstruct (_, _, _, subst) ->
+ List.fold_left (fun acc (_, term) -> aux in_hyp acc term) acc subst
+ | Cic.MutCase (uri, _, outtype, term, pats) ->
+ let acc = aux in_hyp acc term in
+ let acc = aux in_hyp acc outtype in
+ List.fold_left (fun acc term -> aux in_hyp acc term) acc pats
+ | Cic.Fix (_, funs) ->
+ List.fold_left
+ (fun acc (_, _, ty, body) ->
+ let acc = aux in_hyp acc ty in
+ aux in_hyp acc body)
+ acc funs
+ | Cic.CoFix (_, funs) ->
+ List.fold_left
+ (fun acc (_, ty, body) ->
+ let acc = aux in_hyp acc ty in
+ aux in_hyp acc body)
+ acc funs
+ in
+ aux false (IntSet.empty, IntSet.empty) term
+
+ (** type of inductiveType *)
+let compute_type pos uri typeno (name, _, ty, constructors) =
+ let consno = ref 0 in
+ let type_metadata =
+ (UriManager.uri_of_uriref uri typeno None, name, (compute_term pos ty))
+ in
+ let constructors_metadata =
+ List.map
+ (fun (name, term) ->
+ incr consno;
+ let uri = UriManager.uri_of_uriref uri typeno (Some !consno) in
+ (uri, name, (compute_term pos term)))
+ constructors
+ in
+ type_metadata :: constructors_metadata
+
+let compute_ind pos ~uri ~types =
+ let idx = ref ~-1 in
+ List.map (fun ty -> incr idx; compute_type pos uri !idx ty) types
+
+let compute (pos:position) ~body ~ty =
+ let type_metadata = compute_term pos ty in
+ let body_metadata =
+ match body with
+ | None -> S.empty
+ | Some body -> compute_term `InBody body
+ in
+ let uris =
+ S.fold
+ (fun metadata uris ->
+ match metadata with
+ | `Obj (uri, _) -> UriManagerSet.add uri uris
+ | _ -> uris)
+ type_metadata UriManagerSet.empty
+ in
+ S.union
+ (S.filter
+ (function
+ | `Obj (uri, _) when UriManagerSet.mem uri uris -> false
+ | _ -> true)
+ body_metadata)
+ type_metadata
+
+let depth_offset params =
+ let non p x = not (p x) in
+ List.length (List.filter (non var_has_body) params)
+
+let rec compute_var pos uri =
+ let o, _ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ | Cic.Variable (_, Some _, _, _, _) -> S.empty
+ | Cic.Variable (_, None, ty, params, _) ->
+ let var_metadata =
+ List.fold_left
+ (fun metadata uri ->
+ S.union metadata (compute_var (next_pos pos) uri))
+ S.empty
+ params
+ in
+ (match pos with
+ | `MainHypothesis (Some (Eq 0)) ->
+ let pos = `MainHypothesis (Some (Eq (depth_offset params))) in
+ let ty_metadata = compute_term pos ty in
+ S.union ty_metadata var_metadata
+ | `InHypothesis ->
+ let ty_metadata = compute_term pos ty in
+ S.union ty_metadata var_metadata
+ | _ -> assert false)
+ | _ -> assert false
+
+let compute_obj uri =
+ let o, _ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ | Cic.Variable (_, body, ty, params, _)
+ | Cic.Constant (_, body, ty, params, _) ->
+ let pos = `MainConclusion (Some (Eq (depth_offset params))) in
+ let metadata = compute pos ~body ~ty in
+ let var_metadata =
+ List.fold_left
+ (fun metadata uri ->
+ S.union metadata (compute_var (`MainHypothesis (Some (Eq 0))) uri))
+ S.empty
+ params
+ in
+ [ uri,
+ UriManager.name_of_uri uri,
+ S.union metadata var_metadata ]
+ | Cic.InductiveDefinition (types, params, _, _) ->
+ let pos = `MainConclusion(Some (Eq (depth_offset params))) in
+ let metadata = compute_ind pos ~uri ~types in
+ let var_metadata =
+ List.fold_left
+ (fun metadata uri ->
+ S.union metadata (compute_var (`MainHypothesis (Some (Eq 0))) uri))
+ S.empty params
+ in
+ List.fold_left
+ (fun acc m ->
+ (List.map (fun (uri,name,md) -> (uri,name,S.union md var_metadata)) m)
+ @ acc)
+ [] metadata
+ | Cic.CurrentProof _ -> assert false
+
+let compute_obj uri =
+ List.map (fun (u, n, md) -> (u, n, S.elements md)) (compute_obj uri)
+
+let compute ~body ~ty =
+ S.elements (compute (`MainConclusion (Some (Eq 0))) ~body ~ty)
+
diff --git a/helm/ocaml/metadata/metadataExtractor.mli b/helm/ocaml/metadata/metadataExtractor.mli
new file mode 100644
index 000000000..68af269a9
--- /dev/null
+++ b/helm/ocaml/metadata/metadataExtractor.mli
@@ -0,0 +1,42 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val compute:
+ body:Cic.term option ->
+ ty:Cic.term ->
+ MetadataTypes.metadata list
+
+ (** @return tuples <uri, shortname, metadata> *)
+val compute_obj:
+ UriManager.uri ->
+ (UriManager.uri * string * MetadataTypes.metadata list) list
+
+module IntSet: Set.S with type elt = int
+
+ (** given a term, returns a pair of sets corresponding respectively to the set
+ * of meta numbers occurring in term's conclusion and the set of meta numbers
+ * occurring in term's hypotheses *)
+val compute_metas: Cic.term -> IntSet.t * IntSet.t
+
diff --git a/helm/ocaml/metadata/metadataPp.ml b/helm/ocaml/metadata/metadataPp.ml
new file mode 100644
index 000000000..373ec540f
--- /dev/null
+++ b/helm/ocaml/metadata/metadataPp.ml
@@ -0,0 +1,117 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+open MetadataTypes
+
+let pp_relation r =
+ match r with
+ | Eq i -> sprintf "= %d" i
+ | Ge i -> sprintf ">= %d" i
+ | Gt i -> sprintf "> %d" i
+ | Le i -> sprintf "<= %d" i
+ | Lt i -> sprintf "< %d" i
+
+let pp_position = function
+ | `MainConclusion (Some d) -> sprintf "MainConclusion(%s)" (pp_relation d)
+ | `MainConclusion None -> sprintf "MainConclusion"
+ | `MainHypothesis (Some d) -> sprintf "MainHypothesis(%s)" (pp_relation d)
+ | `MainHypothesis None -> "MainHypothesis"
+ | `InConclusion -> "InConclusion"
+ | `InHypothesis -> "InHypothesis"
+ | `InBody -> "InBody"
+
+let pp_position_tag = function
+ | `MainConclusion _ -> mainconcl_pos
+ | `MainHypothesis _ -> mainhyp_pos
+ | `InConclusion -> inconcl_pos
+ | `InHypothesis -> inhyp_pos
+ | `InBody -> inbody_pos
+
+let columns_of_position pos =
+ match pos with
+ | `MainConclusion (Some (Eq d)) -> `String mainconcl_pos, `Int d
+ | `MainConclusion None -> `String mainconcl_pos, `Null
+ | `MainHypothesis (Some (Eq d)) -> `String mainhyp_pos, `Int d
+ | `MainHypothesis None -> `String mainhyp_pos, `Null
+ | `InConclusion -> `String inconcl_pos, `Null
+ | `InHypothesis -> `String inhyp_pos, `Null
+ | `InBody -> `String inbody_pos, `Null
+ | _ -> assert false
+
+(*
+let metadata_ns = "http://www.cs.unibo.it/helm/schemas/schema-helm"
+let uri_of_pos pos = String.concat "#" [metadata_ns; pp_position pos]
+*)
+
+type t = [ `Int of int | `String of string | `Null ]
+
+let columns_of_metadata_aux ~about metadata =
+ let sort s = `String (CicPp.ppsort s) in
+ let source = `String (UriManager.string_of_uri about) in
+ let occurrence u = `String (UriManager.string_of_uri u) in
+ List.fold_left
+ (fun (sort_cols, rel_cols, obj_cols) metadata ->
+ match metadata with
+ | `Sort (s, p) ->
+ let (p, d) = columns_of_position (p :> position) in
+ [source; p; d; sort s] :: sort_cols, rel_cols, obj_cols
+ | `Rel p ->
+ let (p, d) = columns_of_position (p :> position) in
+ sort_cols, [source; p; d] :: rel_cols, obj_cols
+ | `Obj (o, p) ->
+ let (p, d) = columns_of_position p in
+ sort_cols, rel_cols,
+ [source; occurrence o; p; d] :: obj_cols)
+ ([], [], []) metadata
+
+let columns_of_metadata metadata =
+ List.fold_left
+ (fun (sort_cols, rel_cols, obj_cols) (uri, _, metadata) ->
+ let (s, r, o) = columns_of_metadata_aux ~about:uri metadata in
+ (List.append sort_cols s, List.append rel_cols r, List.append obj_cols o))
+ ([], [], []) metadata
+
+let pp_constr =
+ function
+ | `Sort (sort, p) ->
+ sprintf "Sort %s; [%s]"
+ (CicPp.ppsort sort) (String.concat ";" (List.map pp_position p))
+ | `Rel p -> sprintf "Rel [%s]" (String.concat ";" (List.map pp_position p))
+ | `Obj (uri, p) -> sprintf "Obj %s; [%s]"
+ (UriManager.string_of_uri uri) (String.concat ";" (List.map pp_position p))
+
+(*
+let pp_columns ?(sep = "\n") (sort_cols, rel_cols, obj_cols) =
+ String.concat sep
+ ([ "Sort" ] @ List.map Dbi.sdebug (sort_cols :> Dbi.sql_t list list) @
+ [ "Rel" ] @ List.map Dbi.sdebug (rel_cols :> Dbi.sql_t list list) @
+ [ "Obj" ] @ List.map Dbi.sdebug (obj_cols :> Dbi.sql_t list list))
+*)
+
+
diff --git a/helm/ocaml/metadata/metadataPp.mli b/helm/ocaml/metadata/metadataPp.mli
new file mode 100644
index 000000000..cffb24c48
--- /dev/null
+++ b/helm/ocaml/metadata/metadataPp.mli
@@ -0,0 +1,49 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** metadata -> string *)
+
+val pp_position: MetadataTypes.position -> string
+val pp_position_tag: MetadataTypes.position -> string
+val pp_constr: MetadataTypes.constr -> string
+
+(** Pretty printer and OCamlDBI friendly interface *)
+
+type t =
+ [ `Int of int
+ | `String of string
+ | `Null ]
+
+ (** @return columns for Sort, Rel, and Obj respectively *)
+val columns_of_metadata:
+ (UriManager.uri * string * MetadataTypes.metadata list) list ->
+ t list list * t list list * t list list
+
+(*
+val pp_columns: ?sep:string -> t list list * t list list * t list list -> string
+*)
+
+val pp_relation: MetadataTypes.relation -> string
+
diff --git a/helm/ocaml/metadata/metadataTypes.ml b/helm/ocaml/metadata/metadataTypes.ml
new file mode 100644
index 000000000..e186b377a
--- /dev/null
+++ b/helm/ocaml/metadata/metadataTypes.ml
@@ -0,0 +1,115 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let position_prefix = "http://www.cs.unibo.it/helm/schemas/schema-helm#"
+(* let position_prefix = "" *)
+
+let inconcl_pos = position_prefix ^ "InConclusion"
+let mainconcl_pos = position_prefix ^ "MainConclusion"
+let mainhyp_pos = position_prefix ^ "MainHypothesis"
+let inhyp_pos = position_prefix ^ "InHypothesis"
+let inbody_pos = position_prefix ^ "InBody"
+
+type relation =
+ | Eq of int
+ | Le of int
+ | Lt of int
+ | Ge of int
+ | Gt of int
+
+type main_position =
+ [ `MainConclusion of relation option (* Pi depth *)
+ | `MainHypothesis of relation option (* Pi depth *)
+ ]
+
+type position =
+ [ main_position
+ | `InConclusion
+ | `InHypothesis
+ | `InBody
+ ]
+
+type pi_depth = int
+
+type metadata =
+ [ `Sort of Cic.sort * main_position
+ | `Rel of main_position
+ | `Obj of UriManager.uri * position
+ ]
+
+type constr =
+ [ `Sort of Cic.sort * main_position list
+ | `Rel of main_position list
+ | `Obj of UriManager.uri * position list
+ ]
+
+let constr_of_metadata: metadata -> constr = function
+ | `Sort (sort, pos) -> `Sort (sort, [pos])
+ | `Rel pos -> `Rel [pos]
+ | `Obj (uri, pos) -> `Obj (uri, [pos])
+
+ (** the name of the tables in the DB *)
+let sort_tbl_original = "refSort"
+let rel_tbl_original = "refRel"
+let obj_tbl_original = "refObj"
+let name_tbl_original = "objectName"
+let count_tbl_original = "count"
+let hits_tbl_original = "hits"
+
+ (** the names currently used *)
+let sort_tbl_real = ref sort_tbl_original
+let rel_tbl_real = ref rel_tbl_original
+let obj_tbl_real = ref obj_tbl_original
+let name_tbl_real = ref name_tbl_original
+let count_tbl_real = ref count_tbl_original
+
+ (** the exported symbols *)
+let sort_tbl () = ! sort_tbl_real ;;
+let rel_tbl () = ! rel_tbl_real ;;
+let obj_tbl () = ! obj_tbl_real ;;
+let name_tbl () = ! name_tbl_real ;;
+let count_tbl () = ! count_tbl_real ;;
+
+ (** to use the owned tables *)
+let ownerize_tables owner =
+ sort_tbl_real := ( sort_tbl_original ^ "_" ^ owner) ;
+ rel_tbl_real := ( rel_tbl_original ^ "_" ^ owner) ;
+ obj_tbl_real := ( obj_tbl_original ^ "_" ^ owner) ;
+ name_tbl_real := ( name_tbl_original ^ "_" ^ owner);
+ count_tbl_real := ( count_tbl_original ^ "_" ^ owner)
+;;
+
+let library_sort_tbl = sort_tbl_original
+let library_rel_tbl = rel_tbl_original
+let library_obj_tbl = obj_tbl_original
+let library_name_tbl = name_tbl_original
+let library_count_tbl = count_tbl_original
+let library_hits_tbl = hits_tbl_original
+
+let are_tables_ownerized () =
+ sort_tbl () <> library_sort_tbl
+
diff --git a/helm/ocaml/metadata/metadataTypes.mli b/helm/ocaml/metadata/metadataTypes.mli
new file mode 100644
index 000000000..f86ff84f5
--- /dev/null
+++ b/helm/ocaml/metadata/metadataTypes.mli
@@ -0,0 +1,84 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val inconcl_pos : string
+val mainconcl_pos : string
+val mainhyp_pos : string
+val inhyp_pos : string
+val inbody_pos : string
+
+type relation =
+ | Eq of int
+ | Le of int
+ | Lt of int
+ | Ge of int
+ | Gt of int
+
+type main_position =
+ [ `MainConclusion of relation option (* Pi depth *)
+ | `MainHypothesis of relation option (* Pi depth *)
+ ]
+
+type position =
+ [ main_position
+ | `InConclusion
+ | `InHypothesis
+ | `InBody
+ ]
+
+type pi_depth = int
+
+type metadata =
+ [ `Sort of Cic.sort * main_position
+ | `Rel of main_position
+ | `Obj of UriManager.uri * position
+ ]
+
+type constr =
+ [ `Sort of Cic.sort * main_position list
+ | `Rel of main_position list
+ | `Obj of UriManager.uri * position list
+ ]
+
+val constr_of_metadata: metadata -> constr
+
+ (** invoke this function to set the current owner. Afterwards the functions
+ * below will return the name of the table of the set owner *)
+val ownerize_tables : string -> unit
+val are_tables_ownerized : unit -> bool
+
+val sort_tbl: unit -> string
+val rel_tbl: unit -> string
+val obj_tbl: unit -> string
+val name_tbl: unit -> string
+val count_tbl: unit -> string
+
+val library_sort_tbl: string
+val library_rel_tbl: string
+val library_obj_tbl: string
+val library_name_tbl: string
+val library_count_tbl: string
+val library_hits_tbl: string
+
diff --git a/helm/ocaml/metadata/sqlStatements.ml b/helm/ocaml/metadata/sqlStatements.ml
new file mode 100644
index 000000000..a08073965
--- /dev/null
+++ b/helm/ocaml/metadata/sqlStatements.ml
@@ -0,0 +1,200 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf;;
+type tbl = [ `RefObj| `RefSort| `RefRel| `ObjectName| `Hits| `Count]
+
+(* TABLES *)
+
+let sprintf_refObj_format name = [
+sprintf "CREATE TABLE %s (
+ source varchar(255) binary not null,
+ h_occurrence varchar(255) binary not null,
+ h_position varchar(62) binary not null,
+ h_depth integer
+);" name]
+
+let sprintf_refSort_format name = [
+sprintf "CREATE TABLE %s (
+ source varchar(255) binary not null,
+ h_position varchar(62) binary not null,
+ h_depth integer not null,
+ h_sort varchar(5) binary not null
+);" name]
+
+let sprintf_refRel_format name = [
+sprintf "CREATE TABLE %s (
+ source varchar(255) binary not null,
+ h_position varchar(62) binary not null,
+ h_depth integer not null
+);" name]
+
+let sprintf_objectName_format name = [
+sprintf "CREATE TABLE %s (
+ source varchar(255) binary not null,
+ value varchar(255) binary not null
+);" name]
+
+let sprintf_hits_format name = [
+sprintf "CREATE TABLE %s (
+ source varchar(255) binary not null,
+ no integer not null
+);" name]
+
+let sprintf_count_format name = [
+sprintf "CREATE TABLE %s (
+ source varchar(255) binary unique not null,
+ conclusion smallint(6) not null,
+ hypothesis smallint(6) not null,
+ statement smallint(6) not null
+);" name]
+
+let sprintf_refObj_drop name = [sprintf "DROP TABLE %s;" name]
+
+let sprintf_refSort_drop name = [sprintf "DROP TABLE %s;" name]
+
+let sprintf_refRel_drop name = [sprintf "DROP TABLE %s;" name]
+
+let sprintf_objectName_drop name = [sprintf "DROP TABLE %s;" name]
+
+let sprintf_hits_drop name = [sprintf "DROP TABLE %s;" name]
+
+let sprintf_count_drop name = [sprintf "DROP TABLE %s;" name]
+
+(* INDEXES *)
+
+let sprintf_refObj_index name = [
+sprintf "CREATE INDEX %s_index ON %s (source(219),h_occurrence(219),h_position);" name name;
+sprintf "CREATE INDEX %s_occurrence ON %s (h_occurrence);" name name ]
+
+let sprintf_refSort_index name = [
+sprintf "CREATE INDEX %s_index ON %s (source,h_sort,h_position,h_depth);" name name]
+
+let sprintf_objectName_index name = [
+sprintf "CREATE INDEX %s_value ON %s (value);" name name]
+
+let sprintf_hits_index name = [
+sprintf "CREATE INDEX %s_source ON %s (source);" name name ;
+sprintf "CREATE INDEX %s_no ON %s (no);" name name]
+
+let sprintf_count_index name = [
+sprintf "CREATE INDEX %s_conclusion ON %s (conclusion);" name name;
+sprintf "CREATE INDEX %s_hypothesis ON %s (hypothesis);" name name;
+sprintf "CREATE INDEX %s_statement ON %s (statement);" name name]
+
+let sprintf_refRel_index name = [
+sprintf "CREATE INDEX %s_index ON %s (source,h_position,h_depth);" name name]
+
+let sprintf_refObj_index_drop name = [
+sprintf "DROP INDEX %s_index ON %s;" name name ]
+
+let sprintf_refSort_index_drop name = [
+sprintf "DROP INDEX %s_index ON %s;" name name ]
+
+let sprintf_objectName_index_drop name = [
+sprintf "DROP INDEX %s_value ON %s;" name name]
+
+let sprintf_hits_index_drop name = [
+sprintf "DROP INDEX %s_source ON %s;" name name ;
+sprintf "DROP INDEX %s_no ON %s;" name name]
+
+let sprintf_count_index_drop name = [
+sprintf "DROP INDEX %s_source ON %s;" name name;
+sprintf "DROP INDEX %s_conclusion ON %s;" name name;
+sprintf "DROP INDEX %s_hypothesis ON %s;" name name;
+sprintf "DROP INDEX %s_statement ON %s;" name name]
+
+let sprintf_refRel_index_drop name = [
+sprintf "DROP INDEX %s_index ON %s;" name name]
+
+let sprintf_rename_table oldname newname = [
+sprintf "RENAME TABLE %s TO %s;" oldname newname
+]
+
+
+(* FUNCTIONS *)
+
+let get_table_format t named =
+ match t with
+ | `RefObj -> sprintf_refObj_format named
+ | `RefSort -> sprintf_refSort_format named
+ | `RefRel -> sprintf_refRel_format named
+ | `ObjectName -> sprintf_objectName_format named
+ | `Hits -> sprintf_hits_format named
+ | `Count -> sprintf_count_format named
+
+let get_index_format t named =
+ match t with
+ | `RefObj -> sprintf_refObj_index named
+ | `RefSort -> sprintf_refSort_index named
+ | `RefRel -> sprintf_refRel_index named
+ | `ObjectName -> sprintf_objectName_index named
+ | `Hits -> sprintf_hits_index named
+ | `Count -> sprintf_count_index named
+
+let get_table_drop t named =
+ match t with
+ | `RefObj -> sprintf_refObj_drop named
+ | `RefSort -> sprintf_refSort_drop named
+ | `RefRel -> sprintf_refRel_drop named
+ | `ObjectName -> sprintf_objectName_drop named
+ | `Hits -> sprintf_hits_drop named
+ | `Count -> sprintf_count_drop named
+
+let get_index_drop t named =
+ match t with
+ | `RefObj -> sprintf_refObj_index_drop named
+ | `RefSort -> sprintf_refSort_index_drop named
+ | `RefRel -> sprintf_refRel_index_drop named
+ | `ObjectName -> sprintf_objectName_index_drop named
+ | `Hits -> sprintf_hits_index_drop named
+ | `Count -> sprintf_count_index_drop named
+
+let create_tables l =
+ List.fold_left (fun s (name,table) -> s @ get_table_format table name) [] l
+
+let create_indexes l =
+ List.fold_left (fun s (name,table) -> s @ get_index_format table name) [] l
+
+let drop_tables l =
+ List.fold_left (fun s (name,table) -> s @ get_table_drop table name) [] l
+
+let drop_indexes l =
+ List.fold_left (fun s (name,table) -> s @ get_index_drop table name) [] l
+
+let rename_tables l =
+ List.fold_left (fun s (o,n) -> s @ sprintf_rename_table o n) [] l
+
+let fill_hits refObj hits =
+ [ sprintf
+ "INSERT INTO %s
+ SELECT h_occurrence, COUNT(source)
+ FROM %s
+ GROUP BY h_occurrence;"
+ hits refObj ]
+
+
diff --git a/helm/ocaml/metadata/sqlStatements.mli b/helm/ocaml/metadata/sqlStatements.mli
new file mode 100644
index 000000000..9f9af55ef
--- /dev/null
+++ b/helm/ocaml/metadata/sqlStatements.mli
@@ -0,0 +1,45 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** table shape kinds *)
+type tbl = [ `RefObj| `RefSort| `RefRel| `ObjectName| `Hits| `Count]
+
+(** all functions below return either an SQL statement or a list of SQL
+ * statements.
+ * For functions taking as argument (string * tbl) list, the meaning is a list
+ * of pairs <table name, table type>; where the type specify the desired kind of
+ * table and name the desired name (e.g. create a `RefObj like table name
+ * refObj_NEW) *)
+
+val create_tables: (string * tbl) list -> string list
+val create_indexes: (string * tbl) list -> string list
+val drop_tables: (string * tbl) list -> string list
+val drop_indexes: (string * tbl) list -> string list
+val rename_tables: (string * string) list -> string list
+
+(** @param refObj name of the refObj table
+ * @param hits name of the hits table *)
+val fill_hits: string -> string -> string list
+
diff --git a/helm/ocaml/metadata/table_creator/.depend b/helm/ocaml/metadata/table_creator/.depend
new file mode 100644
index 000000000..1cf113d91
--- /dev/null
+++ b/helm/ocaml/metadata/table_creator/.depend
@@ -0,0 +1,4 @@
+sql.cmo: sql.cmi
+sql.cmx: sql.cmi
+table_creator.cmo: sql.cmi
+table_creator.cmx: sql.cmx
diff --git a/helm/ocaml/metadata/table_creator/Makefile b/helm/ocaml/metadata/table_creator/Makefile
new file mode 100644
index 000000000..cb8ab7636
--- /dev/null
+++ b/helm/ocaml/metadata/table_creator/Makefile
@@ -0,0 +1,31 @@
+REQUIRES = mysql helm-metadata
+OCAMLFIND = ocamlfind
+
+INTERFACE_FILES =
+IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml)
+EXTRA_OBJECTS_TO_INSTALL =
+EXTRA_OBJECTS_TO_CLEAN = \
+ table_creator table_creator.opt table_destructor table_destructor.opt
+
+all: table_creator table_destructor
+opt: table_creator.opt table_destructor.opt
+
+table_creator: table_creator.ml ../metadata.cma
+ $(OCAMLFIND) ocamlc \
+ -thread -package mysql,helm-metadata -linkpkg -o $@ $<
+
+table_destructor: table_creator
+ ln -f $< $@
+
+table_creator.opt: table_creator.ml ../metadata.cmxa
+ $(OCAMLFIND) ocamlopt \
+ -thread -package mysql,helm-metadata -linkpkg -o $@ $<
+
+table_destructor.opt: table_creator.opt
+ ln -f $< $@
+
+clean:
+ rm -f *.cm[iox] *.a *.o
+ rm -f table_creator table_creator.opt table_destructor table_destructor.opt
+
+include .depend
diff --git a/helm/ocaml/metadata/table_creator/sync_db.sh b/helm/ocaml/metadata/table_creator/sync_db.sh
new file mode 100755
index 000000000..7b201382a
--- /dev/null
+++ b/helm/ocaml/metadata/table_creator/sync_db.sh
@@ -0,0 +1,28 @@
+#!/bin/sh
+
+# sync metadata from a source database (usually "mowgli") to a target one
+# (usually "matita")
+# Created: Fri, 13 May 2005 13:50:16 +0200 zacchiro
+# Last-Modified: Fri, 13 May 2005 13:50:16 +0200 zacchiro
+
+SOURCE_DB="mowgli"
+TARGET_DB="matita"
+MYSQL_FLAGS="-u helm -h localhost"
+
+MYSQL="mysql $MYSQL_FLAGS -f"
+MYSQLDUMP="mysqldump $MYSQL_FLAGS"
+MYSQLRESTORE="mysqlrestore $MYSQL_FLAGS"
+TABLES=`./table_creator list all`
+DUMP="${SOURCE_DB}_dump.gz"
+
+echo "Dumping source db $SOURCE_DB ..."
+$MYSQLDUMP $SOURCE_DB $TABLES | gzip -c > $DUMP
+echo "Destroying old tables in target db $TARGET_DB ..."
+./table_destructor table all | $MYSQL $TARGET_DB
+echo "Creating table structure in target db $TARGET_DB ..."
+echo "Filling target db $TARGET_DB ..."
+zcat $DUMP | $MYSQL $TARGET_DB
+./table_creator index all | $MYSQL $TARGET_DB
+rm $DUMP
+echo "Done."
+
diff --git a/helm/ocaml/metadata/table_creator/table_creator.ml b/helm/ocaml/metadata/table_creator/table_creator.ml
new file mode 100644
index 000000000..423edfb27
--- /dev/null
+++ b/helm/ocaml/metadata/table_creator/table_creator.ml
@@ -0,0 +1,83 @@
+
+open Printf
+
+let map =
+ (MetadataTypes.library_obj_tbl,`RefObj) ::
+ (MetadataTypes.library_sort_tbl,`RefSort) ::
+ (MetadataTypes.library_rel_tbl,`RefRel) ::
+ (MetadataTypes.library_name_tbl,`ObjectName) ::
+ (MetadataTypes.library_hits_tbl,`Hits) ::
+ (MetadataTypes.library_count_tbl,`Count) :: []
+
+let usage argv_o =
+ prerr_string "\nusage:";
+ prerr_string ("\t" ^ argv_o ^ " what tablename[=rename]\n");
+ prerr_string ("\t" ^ argv_o ^ " what all\n\n");
+ prerr_endline "what:";
+ prerr_endline "\tlist\tlist table names";
+ prerr_endline "\ttable\toutput SQL regarding tables";
+ prerr_endline "\tindex\toutput SQL regarding indexes";
+ prerr_endline "\tfill\toutput SQL filling tables (only \"hits\" supported)\n";
+ prerr_string "known tables:\n\t";
+ List.iter (fun (n,_) -> prerr_string (" " ^ n)) map;
+ prerr_endline "\n"
+
+let eq_RE = Str.regexp "="
+
+let parse_args l =
+ List.map (fun s ->
+ let parts = Str.split eq_RE s in
+ let len = List.length parts in
+ assert (len = 1 || len = 2);
+ if len = 1 then (s,s) else (List.nth parts 0, List.nth parts 1))
+ l
+
+let destructor_RE = Str.regexp "table_destructor\\(\\|\\.opt\\)$"
+
+let am_i_destructor () =
+ try
+ let _ = Str.search_forward destructor_RE Sys.argv.(0) 0 in true
+ with Not_found -> false
+
+let main () =
+ let len = Array.length Sys.argv in
+ if len < 3 then
+ begin
+ usage Sys.argv.(0);
+ exit 1
+ end
+ else
+ begin
+ let tab,idx,fill =
+ if am_i_destructor () then
+ (SqlStatements.drop_tables,SqlStatements.drop_indexes,
+ fun _ t -> [sprintf "DELETE * FROM %s;" t])
+ else
+ (SqlStatements.create_tables,SqlStatements.create_indexes,
+ SqlStatements.fill_hits)
+ in
+ let from = 2 in
+ let what =
+ match Sys.argv.(1) with
+ | "list" -> `List
+ | "index" -> `Index
+ | "table" -> `Table
+ | "fill" -> `Fill
+ | _ -> failwith "what must be one of \"index\", \"table\", \"fill\""
+ in
+ let todo = Array.to_list (Array.sub Sys.argv from (len - from)) in
+ let todo = match todo with ["all"] -> List.map fst map | todo -> todo in
+ let todo = parse_args todo in
+ let todo = List.map (fun (x,name) -> name, (List.assoc x map)) todo in
+ match what with
+ | `Index -> print_endline (String.concat "\n" (idx todo))
+ | `Table -> print_endline (String.concat "\n" (tab todo))
+ | `Fill ->
+ print_endline (String.concat "\n"
+ (fill MetadataTypes.library_obj_tbl MetadataTypes.library_hits_tbl))
+ | `List -> print_endline (String.concat " " (List.map fst map))
+ end
+
+let _ = main ()
+
+
diff --git a/helm/ocaml/paramodulation/.depend b/helm/ocaml/paramodulation/.depend
new file mode 100644
index 000000000..7c6673bad
--- /dev/null
+++ b/helm/ocaml/paramodulation/.depend
@@ -0,0 +1,12 @@
+inference.cmi: utils.cmi
+equality_indexing.cmi: utils.cmi inference.cmi
+utils.cmo: utils.cmi
+utils.cmx: utils.cmi
+inference.cmo: utils.cmi inference.cmi
+inference.cmx: utils.cmx inference.cmi
+equality_indexing.cmo: utils.cmi inference.cmi equality_indexing.cmi
+equality_indexing.cmx: utils.cmx inference.cmx equality_indexing.cmi
+indexing.cmo: utils.cmi inference.cmi equality_indexing.cmi
+indexing.cmx: utils.cmx inference.cmx equality_indexing.cmx
+saturation.cmo: utils.cmi inference.cmi indexing.cmo
+saturation.cmx: utils.cmx inference.cmx indexing.cmx
diff --git a/helm/ocaml/paramodulation/Makefile b/helm/ocaml/paramodulation/Makefile
new file mode 100644
index 000000000..35b650ea7
--- /dev/null
+++ b/helm/ocaml/paramodulation/Makefile
@@ -0,0 +1,38 @@
+PACKAGE = paramodulation
+
+INTERFACE_FILES = \
+ utils.mli \
+ inference.mli\
+ equality_indexing.mli
+
+IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml) \
+ indexing.ml \
+ saturation.ml
+
+include ../Makefile.common
+
+paramodulation.cmo: $(IMPLEMENTATION_FILES:%.ml=%.cmo)
+ $(OCAMLC) -pack -o $@ $(IMPLEMENTATION_FILES:%.ml=%.cmo)
+
+paramodulation.cmx: OCAMLOPTIONS=-package "$(REQUIRES)" -predicates "$(PREDICATES)" -thread
+paramodulation.cmx: $(IMPLEMENTATION_FILES:%.ml=%.cmx)
+ $(OCAMLOPT) -pack -o $@ $(IMPLEMENTATION_FILES:%.ml=%.cmx)
+
+OCAMLOPTIONS+=-for-pack Paramodulation
+
+$(ARCHIVE): paramodulation.cmo $(LIBRARIES)
+ $(OCAMLC) $(OCAMLARCHIVEOPTIONS) -a -o $@ \
+ paramodulation.cmo
+
+$(ARCHIVE_OPT): paramodulation.cmx $(LIBRARIES_OPT)
+ $(OCAMLOPT) $(OCAMLARCHIVEOPTIONS) -a -o $@ \
+ paramodulation.cmx
+
+PARAMOD_OBJS = $(IMPLEMENTATION_FILES:%.ml=%.cmo)
+PARAMOD_OBJS_OPT = $(IMPLEMENTATION_FILES:%.ml=%.cmx)
+
+LOCALLINKOPTS = -package helm-cic_disambiguation,helm-content_pres,helm-grafite,helm-grafite_parser
+saturate: saturate_main.ml $(PARAMOD_OBJS) $(LIBRARIES)
+ $(OCAMLC) $(LOCALLINKOPTS) -thread -linkpkg -o $@ $(PARAMOD_OBJS) $<
+saturate.opt: saturate_main.ml $(PARAMOD_OBJS_OPT) $(LIBRARIES)
+ $(OCAMLOPT) $(LOCALLINKOPTS) -thread -linkpkg -o $@ $(PARAMOD_OBJS_OPT) $<
diff --git a/helm/ocaml/paramodulation/README b/helm/ocaml/paramodulation/README
new file mode 100644
index 000000000..98deef5ad
--- /dev/null
+++ b/helm/ocaml/paramodulation/README
@@ -0,0 +1,43 @@
+make saturate per compilare l'eseguibile da riga di comando (make saturate.opt per la versione ottimizzata)
+
+./saturate -h per vedere una lista di parametri:
+
+./saturate: unknown option `-h'.
+Usage:
+ -full Enable full mode
+ -f Enable/disable full-reduction strategy (default: enabled)
+ -r Weight-Age equality selection ratio (default: 4)
+ -s symbols-based selection ratio (relative to the weight ratio, default: 0)
+ -c Configuration file (for the db connection)
+ -o Term ordering. Possible values are:
+ kbo: Knuth-Bendix ordering
+ nr-kbo: Non-recursive variant of kbo (default)
+ lpo: Lexicographic path ordering
+ -l Time limit in seconds (default: no limit)
+ -w Maximal width (default: 3)
+ -d Maximal depth (default: 3)
+ -retrieve retrieve only
+ -help Display this list of options
+ --help Display this list of options
+
+
+./saturate -l 10 -demod-equalities
+
+dove -l 10 e` il timeout in secondi.
+
+Il programma legge da standard input il teorema, per esempio
+
+\forall n:nat.n + n = 2 * n
+
+l'input termina con una riga vuota (quindi basta un doppio invio alla fine)
+
+In output, oltre ai vari messaggi di debug, vengono stampati gli insiemi
+active e passive alla fine dell'esecuzione. Consiglio di redirigere l'output
+su file, per esempio usando tee:
+
+./saturate -l 10 -demod-equalities | tee output.txt
+
+Il formato di stampa e` quello per gli oggetti di tipo equality (usa la
+funzione Inference.string_of_equality)
+
+
diff --git a/helm/ocaml/paramodulation/equality_indexing.ml b/helm/ocaml/paramodulation/equality_indexing.ml
new file mode 100644
index 000000000..1dffb6399
--- /dev/null
+++ b/helm/ocaml/paramodulation/equality_indexing.ml
@@ -0,0 +1,131 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+module type EqualityIndex =
+ sig
+ module PosEqSet : Set.S with type elt = Utils.pos * Inference.equality
+ val arities : (Cic.term, int) Hashtbl.t
+ type key = Cic.term
+ type t = Discrimination_tree.DiscriminationTreeIndexing(PosEqSet).t
+ val empty : t
+ val retrieve_generalizations : t -> key -> PosEqSet.t
+ val retrieve_unifiables : t -> key -> PosEqSet.t
+ val init_index : unit -> unit
+ val remove_index : t -> Inference.equality -> t
+ val index : t -> Inference.equality -> t
+ val in_index : t -> Inference.equality -> bool
+ end
+
+module DT =
+struct
+ module OrderedPosEquality = struct
+ type t = Utils.pos * Inference.equality
+ let compare = Pervasives.compare
+ end
+
+ module PosEqSet = Set.Make(OrderedPosEquality);;
+
+ include Discrimination_tree.DiscriminationTreeIndexing(PosEqSet)
+
+
+ (* DISCRIMINATION TREES *)
+ let init_index () =
+ Hashtbl.clear arities;
+ ;;
+
+ let remove_index tree equality =
+ let _, _, (_, l, r, ordering), _, _ = equality in
+ match ordering with
+ | Utils.Gt -> remove_index tree l (Utils.Left, equality)
+ | Utils.Lt -> remove_index tree r (Utils.Right, equality)
+ | _ ->
+ let tree = remove_index tree r (Utils.Right, equality) in
+ remove_index tree l (Utils.Left, equality)
+
+ let index tree equality =
+ let _, _, (_, l, r, ordering), _, _ = equality in
+ match ordering with
+ | Utils.Gt -> index tree l (Utils.Left, equality)
+ | Utils.Lt -> index tree r (Utils.Right, equality)
+ | _ ->
+ let tree = index tree r (Utils.Right, equality) in
+ index tree l (Utils.Left, equality)
+
+
+ let in_index tree equality =
+ let _, _, (_, l, r, ordering), _, _ = equality in
+ let meta_convertibility (pos,equality') =
+ Inference.meta_convertibility_eq equality equality'
+ in
+ in_index tree l meta_convertibility || in_index tree r meta_convertibility
+
+ end
+
+module PT =
+ struct
+ module OrderedPosEquality = struct
+ type t = Utils.pos * Inference.equality
+ let compare = Pervasives.compare
+ end
+
+ module PosEqSet = Set.Make(OrderedPosEquality);;
+
+ include Discrimination_tree.DiscriminationTreeIndexing(PosEqSet)
+
+
+ (* DISCRIMINATION TREES *)
+ let init_index () =
+ Hashtbl.clear arities;
+ ;;
+
+ let remove_index tree equality =
+ let _, _, (_, l, r, ordering), _, _ = equality in
+ match ordering with
+ | Utils.Gt -> remove_index tree l (Utils.Left, equality)
+ | Utils.Lt -> remove_index tree r (Utils.Right, equality)
+ | _ ->
+ let tree = remove_index tree r (Utils.Right, equality) in
+ remove_index tree l (Utils.Left, equality)
+
+ let index tree equality =
+ let _, _, (_, l, r, ordering), _, _ = equality in
+ match ordering with
+ | Utils.Gt -> index tree l (Utils.Left, equality)
+ | Utils.Lt -> index tree r (Utils.Right, equality)
+ | _ ->
+ let tree = index tree r (Utils.Right, equality) in
+ index tree l (Utils.Left, equality)
+
+
+ let in_index tree equality =
+ let _, _, (_, l, r, ordering), _, _ = equality in
+ let meta_convertibility (pos,equality') =
+ Inference.meta_convertibility_eq equality equality'
+ in
+ in_index tree l meta_convertibility || in_index tree r meta_convertibility
+end
+
diff --git a/helm/ocaml/paramodulation/equality_indexing.mli b/helm/ocaml/paramodulation/equality_indexing.mli
new file mode 100644
index 000000000..d7c3bec5e
--- /dev/null
+++ b/helm/ocaml/paramodulation/equality_indexing.mli
@@ -0,0 +1,43 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+module type EqualityIndex =
+ sig
+ module PosEqSet : Set.S with type elt = Utils.pos * Inference.equality
+ val arities : (Cic.term, int) Hashtbl.t
+ type key = Cic.term
+ type t = Discrimination_tree.DiscriminationTreeIndexing(PosEqSet).t
+ val empty : t
+ val retrieve_generalizations : t -> key -> PosEqSet.t
+ val retrieve_unifiables : t -> key -> PosEqSet.t
+ val init_index : unit -> unit
+ val remove_index : t -> Inference.equality -> t
+ val index : t -> Inference.equality -> t
+ val in_index : t -> Inference.equality -> bool
+ end
+
+module DT : EqualityIndex
+module PT : EqualityIndex
+
diff --git a/helm/ocaml/paramodulation/indexing.ml b/helm/ocaml/paramodulation/indexing.ml
new file mode 100644
index 000000000..2d9076ad5
--- /dev/null
+++ b/helm/ocaml/paramodulation/indexing.ml
@@ -0,0 +1,1021 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+module Index = Equality_indexing.DT (* discrimination tree based indexing *)
+(*
+module Index = Equality_indexing.DT (* path tree based indexing *)
+*)
+
+let debug_print = Utils.debug_print;;
+
+
+type retrieval_mode = Matching | Unification;;
+
+let print_candidates mode term res =
+ let _ =
+ match mode with
+ | Matching ->
+ Printf.printf "| candidates Matching %s\n" (CicPp.ppterm term)
+ | Unification ->
+ Printf.printf "| candidates Unification %s\n" (CicPp.ppterm term)
+ in
+ print_endline
+ (String.concat "\n"
+ (List.map
+ (fun (p, e) ->
+ Printf.sprintf "| (%s, %s)" (Utils.string_of_pos p)
+ (Inference.string_of_equality e))
+ res));
+ print_endline "|";
+;;
+
+
+let indexing_retrieval_time = ref 0.;;
+
+
+let apply_subst = CicMetaSubst.apply_subst
+
+let index = Index.index
+let remove_index = Index.remove_index
+let in_index = Index.in_index
+let empty = Index.empty
+let init_index = Index.init_index
+
+(* returns a list of all the equalities in the tree that are in relation
+ "mode" with the given term, where mode can be either Matching or
+ Unification.
+
+ Format of the return value: list of tuples in the form:
+ (position - Left or Right - of the term that matched the given one in this
+ equality,
+ equality found)
+
+ Note that if equality is "left = right", if the ordering is left > right,
+ the position will always be Left, and if the ordering is left < right,
+ position will be Right.
+*)
+let get_candidates mode tree term =
+ let t1 = Unix.gettimeofday () in
+ let res =
+ let s =
+ match mode with
+ | Matching -> Index.retrieve_generalizations tree term
+ | Unification -> Index.retrieve_unifiables tree term
+ in
+ Index.PosEqSet.elements s
+ in
+ (* print_candidates mode term res; *)
+(* print_endline (Discrimination_tree.string_of_discrimination_tree tree); *)
+(* print_newline (); *)
+ let t2 = Unix.gettimeofday () in
+ indexing_retrieval_time := !indexing_retrieval_time +. (t2 -. t1);
+ res
+;;
+
+
+let match_unif_time_ok = ref 0.;;
+let match_unif_time_no = ref 0.;;
+
+
+(*
+ finds the first equality in the index that matches "term", of type "termty"
+ termty can be Implicit if it is not needed. The result (one of the sides of
+ the equality, actually) should be not greater (wrt the term ordering) than
+ term
+
+ Format of the return value:
+
+ (term to substitute, [Cic.Rel 1 properly lifted - see the various
+ build_newtarget functions inside the various
+ demodulation_* functions]
+ substitution used for the matching,
+ metasenv,
+ ugraph, [substitution, metasenv and ugraph have the same meaning as those
+ returned by CicUnification.fo_unif]
+ (equality where the matching term was found, [i.e. the equality to use as
+ rewrite rule]
+ uri [either eq_ind_URI or eq_ind_r_URI, depending on the direction of
+ the equality: this is used to build the proof term, again see one of
+ the build_newtarget functions]
+ ))
+*)
+let rec find_matches metasenv context ugraph lift_amount term termty =
+ let module C = Cic in
+ let module U = Utils in
+ let module S = CicSubstitution in
+ let module M = CicMetaSubst in
+ let module HL = HelmLibraryObjects in
+ let cmp = !Utils.compare_terms in
+ let check = match termty with C.Implicit None -> false | _ -> true in
+ function
+ | [] -> None
+ | candidate::tl ->
+ let pos, (_, proof, (ty, left, right, o), metas, args) = candidate in
+ if check && not (fst (CicReduction.are_convertible
+ ~metasenv context termty ty ugraph)) then (
+ find_matches metasenv context ugraph lift_amount term termty tl
+ ) else
+ let do_match c eq_URI =
+ let subst', metasenv', ugraph' =
+ let t1 = Unix.gettimeofday () in
+ try
+ let r =
+ Inference.matching (metasenv @ metas) context
+ term (S.lift lift_amount c) ugraph in
+ let t2 = Unix.gettimeofday () in
+ match_unif_time_ok := !match_unif_time_ok +. (t2 -. t1);
+ r
+ with Inference.MatchingFailure as e ->
+ let t2 = Unix.gettimeofday () in
+ match_unif_time_no := !match_unif_time_no +. (t2 -. t1);
+ raise e
+ in
+ Some (C.Rel (1 + lift_amount), subst', metasenv', ugraph',
+ (candidate, eq_URI))
+ in
+ let c, other, eq_URI =
+ if pos = Utils.Left then left, right, Utils.eq_ind_URI ()
+ else right, left, Utils.eq_ind_r_URI ()
+ in
+ if o <> U.Incomparable then
+ try
+ do_match c eq_URI
+ with Inference.MatchingFailure ->
+ find_matches metasenv context ugraph lift_amount term termty tl
+ else
+ let res =
+ try do_match c eq_URI
+ with Inference.MatchingFailure -> None
+ in
+ match res with
+ | Some (_, s, _, _, _) ->
+ let c' = apply_subst s c in
+ let other' = U.guarded_simpl context (apply_subst s other) in
+ let order = cmp c' other' in
+ let names = U.names_of_context context in
+ if order = U.Gt then
+ res
+ else
+ find_matches
+ metasenv context ugraph lift_amount term termty tl
+ | None ->
+ find_matches metasenv context ugraph lift_amount term termty tl
+;;
+
+
+(*
+ as above, but finds all the matching equalities, and the matching condition
+ can be either Inference.matching or Inference.unification
+*)
+let rec find_all_matches ?(unif_fun=Inference.unification)
+ metasenv context ugraph lift_amount term termty =
+ let module C = Cic in
+ let module U = Utils in
+ let module S = CicSubstitution in
+ let module M = CicMetaSubst in
+ let module HL = HelmLibraryObjects in
+ let cmp = !Utils.compare_terms in
+ function
+ | [] -> []
+ | candidate::tl ->
+ let pos, (_, _, (ty, left, right, o), metas, args) = candidate in
+ let do_match c eq_URI =
+ let subst', metasenv', ugraph' =
+ let t1 = Unix.gettimeofday () in
+ try
+ let r =
+ unif_fun (metasenv @ metas) context
+ term (S.lift lift_amount c) ugraph in
+ let t2 = Unix.gettimeofday () in
+ match_unif_time_ok := !match_unif_time_ok +. (t2 -. t1);
+ r
+ with
+ | Inference.MatchingFailure
+ | CicUnification.UnificationFailure _
+ | CicUnification.Uncertain _ as e ->
+ let t2 = Unix.gettimeofday () in
+ match_unif_time_no := !match_unif_time_no +. (t2 -. t1);
+ raise e
+ in
+ (C.Rel (1 + lift_amount), subst', metasenv', ugraph',
+ (candidate, eq_URI))
+ in
+ let c, other, eq_URI =
+ if pos = Utils.Left then left, right, Utils.eq_ind_URI ()
+ else right, left, Utils.eq_ind_r_URI ()
+ in
+ if o <> U.Incomparable then
+ try
+ let res = do_match c eq_URI in
+ res::(find_all_matches ~unif_fun metasenv context ugraph
+ lift_amount term termty tl)
+ with
+ | Inference.MatchingFailure
+ | CicUnification.UnificationFailure _
+ | CicUnification.Uncertain _ ->
+ find_all_matches ~unif_fun metasenv context ugraph
+ lift_amount term termty tl
+ else
+ try
+ let res = do_match c eq_URI in
+ match res with
+ | _, s, _, _, _ ->
+ let c' = apply_subst s c
+ and other' = apply_subst s other in
+ let order = cmp c' other' in
+ let names = U.names_of_context context in
+ if order <> U.Lt && order <> U.Le then
+ res::(find_all_matches ~unif_fun metasenv context ugraph
+ lift_amount term termty tl)
+ else
+ find_all_matches ~unif_fun metasenv context ugraph
+ lift_amount term termty tl
+ with
+ | Inference.MatchingFailure
+ | CicUnification.UnificationFailure _
+ | CicUnification.Uncertain _ ->
+ find_all_matches ~unif_fun metasenv context ugraph
+ lift_amount term termty tl
+;;
+
+
+(*
+ returns true if target is subsumed by some equality in table
+*)
+let subsumption env table target =
+ let _, _, (ty, left, right, _), tmetas, _ = target in
+ let metasenv, context, ugraph = env in
+ let metasenv = metasenv @ tmetas in
+ let samesubst subst subst' =
+ let tbl = Hashtbl.create (List.length subst) in
+ List.iter (fun (m, (c, t1, t2)) -> Hashtbl.add tbl m (c, t1, t2)) subst;
+ List.for_all
+ (fun (m, (c, t1, t2)) ->
+ try
+ let c', t1', t2' = Hashtbl.find tbl m in
+ if (c = c') && (t1 = t1') && (t2 = t2') then true
+ else false
+ with Not_found ->
+ true)
+ subst'
+ in
+ let leftr =
+ match left with
+ | Cic.Meta _ -> []
+ | _ ->
+ let leftc = get_candidates Matching table left in
+ find_all_matches ~unif_fun:Inference.matching
+ metasenv context ugraph 0 left ty leftc
+ in
+ let rec ok what = function
+ | [] -> false, []
+ | (_, subst, menv, ug, ((pos, (_, _, (_, l, r, o), m, _)), _))::tl ->
+ try
+ let other = if pos = Utils.Left then r else l in
+ let subst', menv', ug' =
+ let t1 = Unix.gettimeofday () in
+ try
+ let r =
+ Inference.matching (metasenv @ menv @ m) context what other ugraph
+ in
+ let t2 = Unix.gettimeofday () in
+ match_unif_time_ok := !match_unif_time_ok +. (t2 -. t1);
+ r
+ with Inference.MatchingFailure as e ->
+ let t2 = Unix.gettimeofday () in
+ match_unif_time_no := !match_unif_time_no +. (t2 -. t1);
+ raise e
+ in
+ if samesubst subst subst' then
+ true, subst
+ else
+ ok what tl
+ with Inference.MatchingFailure ->
+ ok what tl
+ in
+ let r, subst = ok right leftr in
+ let r, s =
+ if r then
+ true, subst
+ else
+ let rightr =
+ match right with
+ | Cic.Meta _ -> []
+ | _ ->
+ let rightc = get_candidates Matching table right in
+ find_all_matches ~unif_fun:Inference.matching
+ metasenv context ugraph 0 right ty rightc
+ in
+ ok left rightr
+ in
+(* (if r then *)
+(* debug_print *)
+(* (lazy *)
+(* (Printf.sprintf "SUBSUMPTION! %s\n%s\n" *)
+(* (Inference.string_of_equality target) (Utils.print_subst s)))); *)
+ r, s
+;;
+
+
+let rec demodulation_aux ?(typecheck=false)
+ metasenv context ugraph table lift_amount term =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ let module M = CicMetaSubst in
+ let module HL = HelmLibraryObjects in
+ let candidates = get_candidates Matching table term in
+ match term with
+ | C.Meta _ -> None
+ | term ->
+ let termty, ugraph =
+ if typecheck then
+ CicTypeChecker.type_of_aux' metasenv context term ugraph
+ else
+ C.Implicit None, ugraph
+ in
+ let res =
+ find_matches metasenv context ugraph lift_amount term termty candidates
+ in
+ if res <> None then
+ res
+ else
+ match term with
+ | C.Appl l ->
+ let res, ll =
+ List.fold_left
+ (fun (res, tl) t ->
+ if res <> None then
+ (res, tl @ [S.lift 1 t])
+ else
+ let r =
+ demodulation_aux metasenv context ugraph table
+ lift_amount t
+ in
+ match r with
+ | None -> (None, tl @ [S.lift 1 t])
+ | Some (rel, _, _, _, _) -> (r, tl @ [rel]))
+ (None, []) l
+ in (
+ match res with
+ | None -> None
+ | Some (_, subst, menv, ug, eq_found) ->
+ Some (C.Appl ll, subst, menv, ug, eq_found)
+ )
+ | C.Prod (nn, s, t) ->
+ let r1 =
+ demodulation_aux metasenv context ugraph table lift_amount s in (
+ match r1 with
+ | None ->
+ let r2 =
+ demodulation_aux metasenv
+ ((Some (nn, C.Decl s))::context) ugraph
+ table (lift_amount+1) t
+ in (
+ match r2 with
+ | None -> None
+ | Some (t', subst, menv, ug, eq_found) ->
+ Some (C.Prod (nn, (S.lift 1 s), t'),
+ subst, menv, ug, eq_found)
+ )
+ | Some (s', subst, menv, ug, eq_found) ->
+ Some (C.Prod (nn, s', (S.lift 1 t)),
+ subst, menv, ug, eq_found)
+ )
+ | C.Lambda (nn, s, t) ->
+ let r1 =
+ demodulation_aux metasenv context ugraph table lift_amount s in (
+ match r1 with
+ | None ->
+ let r2 =
+ demodulation_aux metasenv
+ ((Some (nn, C.Decl s))::context) ugraph
+ table (lift_amount+1) t
+ in (
+ match r2 with
+ | None -> None
+ | Some (t', subst, menv, ug, eq_found) ->
+ Some (C.Lambda (nn, (S.lift 1 s), t'),
+ subst, menv, ug, eq_found)
+ )
+ | Some (s', subst, menv, ug, eq_found) ->
+ Some (C.Lambda (nn, s', (S.lift 1 t)),
+ subst, menv, ug, eq_found)
+ )
+ | t ->
+ None
+;;
+
+
+let build_newtarget_time = ref 0.;;
+
+
+let demod_counter = ref 1;;
+
+(** demodulation, when target is an equality *)
+let rec demodulation_equality newmeta env table sign target =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ let module M = CicMetaSubst in
+ let module HL = HelmLibraryObjects in
+ let module U = Utils in
+ let metasenv, context, ugraph = env in
+ let _, proof, (eq_ty, left, right, order), metas, args = target in
+ let metasenv' = metasenv @ metas in
+
+ let maxmeta = ref newmeta in
+
+ let build_newtarget is_left (t, subst, menv, ug, (eq_found, eq_URI)) =
+ let time1 = Unix.gettimeofday () in
+
+ let pos, (_, proof', (ty, what, other, _), menv', args') = eq_found in
+ let ty =
+ try fst (CicTypeChecker.type_of_aux' metasenv context what ugraph)
+ with CicUtil.Meta_not_found _ -> ty
+ in
+ let what, other = if pos = Utils.Left then what, other else other, what in
+ let newterm, newproof =
+ let bo = U.guarded_simpl context (apply_subst subst (S.subst other t)) in
+ let name = C.Name ("x_Demod_" ^ (string_of_int !demod_counter)) in
+ incr demod_counter;
+ let bo' =
+ let l, r = if is_left then t, S.lift 1 right else S.lift 1 left, t in
+ C.Appl [C.MutInd (LibraryObjects.eq_URI (), 0, []);
+ S.lift 1 eq_ty; l; r]
+ in
+ if sign = Utils.Positive then
+ (bo,
+ Inference.ProofBlock (
+ subst, eq_URI, (name, ty), bo'(* t' *), eq_found, proof))
+ else
+ let metaproof =
+ incr maxmeta;
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context in
+(* debug_print (lazy (Printf.sprintf "\nADDING META: %d\n" !maxmeta)); *)
+(* print_newline (); *)
+ C.Meta (!maxmeta, irl)
+ in
+ let eq_found =
+ let proof' =
+ let termlist =
+ if pos = Utils.Left then [ty; what; other]
+ else [ty; other; what]
+ in
+ Inference.ProofSymBlock (termlist, proof')
+ in
+ let what, other =
+ if pos = Utils.Left then what, other else other, what
+ in
+ pos, (0, proof', (ty, other, what, Utils.Incomparable),
+ menv', args')
+ in
+ let target_proof =
+ let pb =
+ Inference.ProofBlock (subst, eq_URI, (name, ty), bo',
+ eq_found, Inference.BasicProof metaproof)
+ in
+ match proof with
+ | Inference.BasicProof _ ->
+ print_endline "replacing a BasicProof";
+ pb
+ | Inference.ProofGoalBlock (_, parent_proof) ->
+ print_endline "replacing another ProofGoalBlock";
+ Inference.ProofGoalBlock (pb, parent_proof)
+ | _ -> assert false
+ in
+ let refl =
+ C.Appl [C.MutConstruct (* reflexivity *)
+ (LibraryObjects.eq_URI (), 0, 1, []);
+ eq_ty; if is_left then right else left]
+ in
+ (bo,
+ Inference.ProofGoalBlock (Inference.BasicProof refl, target_proof))
+ in
+ let left, right = if is_left then newterm, right else left, newterm in
+ let m = (Inference.metas_of_term left) @ (Inference.metas_of_term right) in
+ let newmetasenv = List.filter (fun (i, _, _) -> List.mem i m) metas
+ and newargs = args
+ in
+ let ordering = !Utils.compare_terms left right in
+
+ let time2 = Unix.gettimeofday () in
+ build_newtarget_time := !build_newtarget_time +. (time2 -. time1);
+
+ let res =
+ let w = Utils.compute_equality_weight eq_ty left right in
+ (w, newproof, (eq_ty, left, right, ordering), newmetasenv, newargs)
+ in
+ !maxmeta, res
+ in
+ let res = demodulation_aux metasenv' context ugraph table 0 left in
+ let newmeta, newtarget =
+ match res with
+ | Some t ->
+ let newmeta, newtarget = build_newtarget true t in
+ if (Inference.is_identity (metasenv', context, ugraph) newtarget) ||
+ (Inference.meta_convertibility_eq target newtarget) then
+ newmeta, newtarget
+ else
+ demodulation_equality newmeta env table sign newtarget
+ | None ->
+ let res = demodulation_aux metasenv' context ugraph table 0 right in
+ match res with
+ | Some t ->
+ let newmeta, newtarget = build_newtarget false t in
+ if (Inference.is_identity (metasenv', context, ugraph) newtarget) ||
+ (Inference.meta_convertibility_eq target newtarget) then
+ newmeta, newtarget
+ else
+ demodulation_equality newmeta env table sign newtarget
+ | None ->
+ newmeta, target
+ in
+ (* newmeta, newtarget *)
+ (* tentiamo di ridurre usando CicReduction.normalize *)
+ let w, p, (ty, left, right, o), m, a = newtarget in
+ let left' = ProofEngineReduction.simpl context left in
+ let right' = ProofEngineReduction.simpl context right in
+ let newleft =
+ if !Utils.compare_terms left' left = Utils.Lt then left' else left in
+ let newright =
+ if !Utils.compare_terms right' right = Utils.Lt then right' else right in
+(* if newleft != left || newright != right then ( *)
+(* debug_print *)
+(* (lazy *)
+(* (Printf.sprintf "left: %s, left': %s\nright: %s, right': %s\n" *)
+(* (CicPp.ppterm left) (CicPp.ppterm left') (CicPp.ppterm right) *)
+(* (CicPp.ppterm right'))) *)
+(* ); *)
+ let w' = Utils.compute_equality_weight ty newleft newright in
+ let o' = !Utils.compare_terms newleft newright in
+ newmeta, (w', p, (ty, newleft, newright, o'), m, a)
+;;
+
+
+(**
+ Performs the beta expansion of the term "term" w.r.t. "table",
+ i.e. returns the list of all the terms t s.t. "(t term) = t2", for some t2
+ in table.
+*)
+let rec betaexpand_term metasenv context ugraph table lift_amount term =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ let module M = CicMetaSubst in
+ let module HL = HelmLibraryObjects in
+ let candidates = get_candidates Unification table term in
+ let res, lifted_term =
+ match term with
+ | C.Meta (i, l) ->
+ let l', lifted_l =
+ List.fold_right
+ (fun arg (res, lifted_tl) ->
+ match arg with
+ | Some arg ->
+ let arg_res, lifted_arg =
+ betaexpand_term metasenv context ugraph table
+ lift_amount arg in
+ let l1 =
+ List.map
+ (fun (t, s, m, ug, eq_found) ->
+ (Some t)::lifted_tl, s, m, ug, eq_found)
+ arg_res
+ in
+ (l1 @
+ (List.map
+ (fun (l, s, m, ug, eq_found) ->
+ (Some lifted_arg)::l, s, m, ug, eq_found)
+ res),
+ (Some lifted_arg)::lifted_tl)
+ | None ->
+ (List.map
+ (fun (r, s, m, ug, eq_found) ->
+ None::r, s, m, ug, eq_found) res,
+ None::lifted_tl)
+ ) l ([], [])
+ in
+ let e =
+ List.map
+ (fun (l, s, m, ug, eq_found) ->
+ (C.Meta (i, l), s, m, ug, eq_found)) l'
+ in
+ e, C.Meta (i, lifted_l)
+
+ | C.Rel m ->
+ [], if m <= lift_amount then C.Rel m else C.Rel (m+1)
+
+ | C.Prod (nn, s, t) ->
+ let l1, lifted_s =
+ betaexpand_term metasenv context ugraph table lift_amount s in
+ let l2, lifted_t =
+ betaexpand_term metasenv ((Some (nn, C.Decl s))::context) ugraph
+ table (lift_amount+1) t in
+ let l1' =
+ List.map
+ (fun (t, s, m, ug, eq_found) ->
+ C.Prod (nn, t, lifted_t), s, m, ug, eq_found) l1
+ and l2' =
+ List.map
+ (fun (t, s, m, ug, eq_found) ->
+ C.Prod (nn, lifted_s, t), s, m, ug, eq_found) l2 in
+ l1' @ l2', C.Prod (nn, lifted_s, lifted_t)
+
+ | C.Lambda (nn, s, t) ->
+ let l1, lifted_s =
+ betaexpand_term metasenv context ugraph table lift_amount s in
+ let l2, lifted_t =
+ betaexpand_term metasenv ((Some (nn, C.Decl s))::context) ugraph
+ table (lift_amount+1) t in
+ let l1' =
+ List.map
+ (fun (t, s, m, ug, eq_found) ->
+ C.Lambda (nn, t, lifted_t), s, m, ug, eq_found) l1
+ and l2' =
+ List.map
+ (fun (t, s, m, ug, eq_found) ->
+ C.Lambda (nn, lifted_s, t), s, m, ug, eq_found) l2 in
+ l1' @ l2', C.Lambda (nn, lifted_s, lifted_t)
+
+ | C.Appl l ->
+ let l', lifted_l =
+ List.fold_right
+ (fun arg (res, lifted_tl) ->
+ let arg_res, lifted_arg =
+ betaexpand_term metasenv context ugraph table lift_amount arg
+ in
+ let l1 =
+ List.map
+ (fun (a, s, m, ug, eq_found) ->
+ a::lifted_tl, s, m, ug, eq_found)
+ arg_res
+ in
+ (l1 @
+ (List.map
+ (fun (r, s, m, ug, eq_found) ->
+ lifted_arg::r, s, m, ug, eq_found)
+ res),
+ lifted_arg::lifted_tl)
+ ) l ([], [])
+ in
+ (List.map
+ (fun (l, s, m, ug, eq_found) -> (C.Appl l, s, m, ug, eq_found)) l',
+ C.Appl lifted_l)
+
+ | t -> [], (S.lift lift_amount t)
+ in
+ match term with
+ | C.Meta (i, l) -> res, lifted_term
+ | term ->
+ let termty, ugraph =
+ C.Implicit None, ugraph
+(* CicTypeChecker.type_of_aux' metasenv context term ugraph *)
+ in
+ let r =
+ find_all_matches
+ metasenv context ugraph lift_amount term termty candidates
+ in
+ r @ res, lifted_term
+;;
+
+
+let sup_l_counter = ref 1;;
+
+(**
+ superposition_left
+ returns a list of new clauses inferred with a left superposition step
+ the negative equation "target" and one of the positive equations in "table"
+*)
+let superposition_left newmeta (metasenv, context, ugraph) table target =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ let module M = CicMetaSubst in
+ let module HL = HelmLibraryObjects in
+ let module CR = CicReduction in
+ let module U = Utils in
+ let weight, proof, (eq_ty, left, right, ordering), _, _ = target in
+ let expansions, _ =
+ let term = if ordering = U.Gt then left else right in
+ betaexpand_term metasenv context ugraph table 0 term
+ in
+ let maxmeta = ref newmeta in
+ let build_new (bo, s, m, ug, (eq_found, eq_URI)) =
+
+(* debug_print (lazy "\nSUPERPOSITION LEFT\n"); *)
+
+ let time1 = Unix.gettimeofday () in
+
+ let pos, (_, proof', (ty, what, other, _), menv', args') = eq_found in
+ let what, other = if pos = Utils.Left then what, other else other, what in
+ let newgoal, newproof =
+ let bo' = U.guarded_simpl context (apply_subst s (S.subst other bo)) in
+ let name = C.Name ("x_SupL_" ^ (string_of_int !sup_l_counter)) in
+ incr sup_l_counter;
+ let bo'' =
+ let l, r =
+ if ordering = U.Gt then bo, S.lift 1 right else S.lift 1 left, bo in
+ C.Appl [C.MutInd (LibraryObjects.eq_URI (), 0, []);
+ S.lift 1 eq_ty; l; r]
+ in
+ incr maxmeta;
+ let metaproof =
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context in
+ C.Meta (!maxmeta, irl)
+ in
+ let eq_found =
+ let proof' =
+ let termlist =
+ if pos = Utils.Left then [ty; what; other]
+ else [ty; other; what]
+ in
+ Inference.ProofSymBlock (termlist, proof')
+ in
+ let what, other =
+ if pos = Utils.Left then what, other else other, what
+ in
+ pos, (0, proof', (ty, other, what, Utils.Incomparable), menv', args')
+ in
+ let target_proof =
+ let pb =
+ Inference.ProofBlock (s, eq_URI, (name, ty), bo'', eq_found,
+ Inference.BasicProof metaproof)
+ in
+ match proof with
+ | Inference.BasicProof _ ->
+(* debug_print (lazy "replacing a BasicProof"); *)
+ pb
+ | Inference.ProofGoalBlock (_, parent_proof) ->
+(* debug_print (lazy "replacing another ProofGoalBlock"); *)
+ Inference.ProofGoalBlock (pb, parent_proof)
+ | _ -> assert false
+ in
+ let refl =
+ C.Appl [C.MutConstruct (* reflexivity *)
+ (LibraryObjects.eq_URI (), 0, 1, []);
+ eq_ty; if ordering = U.Gt then right else left]
+ in
+ (bo',
+ Inference.ProofGoalBlock (Inference.BasicProof refl, target_proof))
+ in
+ let left, right =
+ if ordering = U.Gt then newgoal, right else left, newgoal in
+ let neworder = !Utils.compare_terms left right in
+
+ let time2 = Unix.gettimeofday () in
+ build_newtarget_time := !build_newtarget_time +. (time2 -. time1);
+
+ let res =
+ let w = Utils.compute_equality_weight eq_ty left right in
+ (w, newproof, (eq_ty, left, right, neworder), [], [])
+ in
+ res
+ in
+ !maxmeta, List.map build_new expansions
+;;
+
+
+let sup_r_counter = ref 1;;
+
+(**
+ superposition_right
+ returns a list of new clauses inferred with a right superposition step
+ between the positive equation "target" and one in the "table" "newmeta" is
+ the first free meta index, i.e. the first number above the highest meta
+ index: its updated value is also returned
+*)
+let superposition_right newmeta (metasenv, context, ugraph) table target =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ let module M = CicMetaSubst in
+ let module HL = HelmLibraryObjects in
+ let module CR = CicReduction in
+ let module U = Utils in
+ let _, eqproof, (eq_ty, left, right, ordering), newmetas, args = target in
+ let metasenv' = metasenv @ newmetas in
+ let maxmeta = ref newmeta in
+ let res1, res2 =
+ match ordering with
+ | U.Gt -> fst (betaexpand_term metasenv' context ugraph table 0 left), []
+ | U.Lt -> [], fst (betaexpand_term metasenv' context ugraph table 0 right)
+ | _ ->
+ let res l r =
+ List.filter
+ (fun (_, subst, _, _, _) ->
+ let subst = apply_subst subst in
+ let o = !Utils.compare_terms (subst l) (subst r) in
+ o <> U.Lt && o <> U.Le)
+ (fst (betaexpand_term metasenv' context ugraph table 0 l))
+ in
+ (res left right), (res right left)
+ in
+ let build_new ordering (bo, s, m, ug, (eq_found, eq_URI)) =
+
+ let time1 = Unix.gettimeofday () in
+
+ let pos, (_, proof', (ty, what, other, _), menv', args') = eq_found in
+ let what, other = if pos = Utils.Left then what, other else other, what in
+ let newgoal, newproof =
+ let bo' = apply_subst s (S.subst other bo) in
+ let t' =
+ let name = C.Name ("x_SupR_" ^ (string_of_int !sup_r_counter)) in
+ incr sup_r_counter;
+ let l, r =
+ if ordering = U.Gt then bo, S.lift 1 right else S.lift 1 left, bo in
+ (name, ty, S.lift 1 eq_ty, l, r)
+ in
+ let name = C.Name ("x_SupR_" ^ (string_of_int !sup_r_counter)) in
+ incr sup_r_counter;
+ let bo'' =
+ let l, r =
+ if ordering = U.Gt then bo, S.lift 1 right else S.lift 1 left, bo in
+ C.Appl [C.MutInd (LibraryObjects.eq_URI (), 0, []);
+ S.lift 1 eq_ty; l; r]
+ in
+ bo',
+ Inference.ProofBlock (s, eq_URI, (name, ty), bo'', eq_found, eqproof)
+ in
+ let newmeta, newequality =
+ let left, right =
+ if ordering = U.Gt then newgoal, apply_subst s right
+ else apply_subst s left, newgoal in
+ let neworder = !Utils.compare_terms left right
+ and newmenv = newmetas @ menv'
+ and newargs = args @ args' in
+ let eq' =
+ let w = Utils.compute_equality_weight eq_ty left right in
+ (w, newproof, (eq_ty, left, right, neworder), newmenv, newargs)
+ and env = (metasenv, context, ugraph) in
+ let newm, eq' = Inference.fix_metas !maxmeta eq' in
+ newm, eq'
+ in
+ maxmeta := newmeta;
+
+ let time2 = Unix.gettimeofday () in
+ build_newtarget_time := !build_newtarget_time +. (time2 -. time1);
+
+ newequality
+ in
+ let new1 = List.map (build_new U.Gt) res1
+ and new2 = List.map (build_new U.Lt) res2 in
+ let ok e = not (Inference.is_identity (metasenv, context, ugraph) e) in
+ (!maxmeta,
+ (List.filter ok (new1 @ new2)))
+;;
+
+
+(** demodulation, when the target is a goal *)
+let rec demodulation_goal newmeta env table goal =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ let module M = CicMetaSubst in
+ let module HL = HelmLibraryObjects in
+ let metasenv, context, ugraph = env in
+ let maxmeta = ref newmeta in
+ let proof, metas, term = goal in
+ let metasenv' = metasenv @ metas in
+
+ let build_newgoal (t, subst, menv, ug, (eq_found, eq_URI)) =
+ let pos, (_, proof', (ty, what, other, _), menv', args') = eq_found in
+ let what, other = if pos = Utils.Left then what, other else other, what in
+ let ty =
+ try fst (CicTypeChecker.type_of_aux' metasenv context what ugraph)
+ with CicUtil.Meta_not_found _ -> ty
+ in
+ let newterm, newproof =
+ let bo = apply_subst subst (S.subst other t) in
+ let bo' = apply_subst subst t in
+ let name = C.Name ("x_DemodGoal_" ^ (string_of_int !demod_counter)) in
+ incr demod_counter;
+ let metaproof =
+ incr maxmeta;
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context in
+(* debug_print (lazy (Printf.sprintf "\nADDING META: %d\n" !maxmeta)); *)
+ C.Meta (!maxmeta, irl)
+ in
+ let eq_found =
+ let proof' =
+ let termlist =
+ if pos = Utils.Left then [ty; what; other]
+ else [ty; other; what]
+ in
+ Inference.ProofSymBlock (termlist, proof')
+ in
+ let what, other =
+ if pos = Utils.Left then what, other else other, what
+ in
+ pos, (0, proof', (ty, other, what, Utils.Incomparable), menv', args')
+ in
+ let goal_proof =
+ let pb =
+ Inference.ProofBlock (subst, eq_URI, (name, ty), bo',
+ eq_found, Inference.BasicProof metaproof)
+ in
+ let rec repl = function
+ | Inference.NoProof ->
+(* debug_print (lazy "replacing a NoProof"); *)
+ pb
+ | Inference.BasicProof _ ->
+(* debug_print (lazy "replacing a BasicProof"); *)
+ pb
+ | Inference.ProofGoalBlock (_, parent_proof) ->
+(* debug_print (lazy "replacing another ProofGoalBlock"); *)
+ Inference.ProofGoalBlock (pb, parent_proof)
+ | (Inference.SubProof (term, meta_index, p) as subproof) ->
+(* debug_print *)
+(* (lazy *)
+(* (Printf.sprintf "replacing %s" *)
+(* (Inference.string_of_proof subproof))); *)
+ Inference.SubProof (term, meta_index, repl p)
+ | _ -> assert false
+ in repl proof
+ in
+ bo, Inference.ProofGoalBlock (Inference.NoProof, goal_proof)
+ in
+ let m = Inference.metas_of_term newterm in
+ let newmetasenv = List.filter (fun (i, _, _) -> List.mem i m) metas in
+ !maxmeta, (newproof, newmetasenv, newterm)
+ in
+ let res =
+ demodulation_aux ~typecheck:true metasenv' context ugraph table 0 term
+ in
+ match res with
+ | Some t ->
+ let newmeta, newgoal = build_newgoal t in
+ let _, _, newg = newgoal in
+ if Inference.meta_convertibility term newg then
+ newmeta, newgoal
+ else
+ demodulation_goal newmeta env table newgoal
+ | None ->
+ newmeta, goal
+;;
+
+
+(** demodulation, when the target is a theorem *)
+let rec demodulation_theorem newmeta env table theorem =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ let module M = CicMetaSubst in
+ let module HL = HelmLibraryObjects in
+ let metasenv, context, ugraph = env in
+ let maxmeta = ref newmeta in
+ let proof, metas, term = theorem in
+ let term, termty, metas = theorem in
+ let metasenv' = metasenv @ metas in
+
+ let build_newtheorem (t, subst, menv, ug, (eq_found, eq_URI)) =
+ let pos, (_, proof', (ty, what, other, _), menv', args') = eq_found in
+ let what, other = if pos = Utils.Left then what, other else other, what in
+ let newterm, newty =
+ let bo = apply_subst subst (S.subst other t) in
+ let bo' = apply_subst subst t in
+ let name = C.Name ("x_DemodThm_" ^ (string_of_int !demod_counter)) in
+ incr demod_counter;
+ let newproof =
+ Inference.ProofBlock (subst, eq_URI, (name, ty), bo', eq_found,
+ Inference.BasicProof term)
+ in
+ (Inference.build_proof_term newproof, bo)
+ in
+ let m = Inference.metas_of_term newterm in
+ let newmetasenv = List.filter (fun (i, _, _) -> List.mem i m) metas in
+ !maxmeta, (newterm, newty, newmetasenv)
+ in
+ let res =
+ demodulation_aux ~typecheck:true metasenv' context ugraph table 0 termty
+ in
+ match res with
+ | Some t ->
+ let newmeta, newthm = build_newtheorem t in
+ let newt, newty, _ = newthm in
+ if Inference.meta_convertibility termty newty then
+ newmeta, newthm
+ else
+ demodulation_theorem newmeta env table newthm
+ | None ->
+ newmeta, theorem
+;;
diff --git a/helm/ocaml/paramodulation/inference.ml b/helm/ocaml/paramodulation/inference.ml
new file mode 100644
index 000000000..04cdb0aeb
--- /dev/null
+++ b/helm/ocaml/paramodulation/inference.ml
@@ -0,0 +1,952 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+open Utils;;
+
+
+type equality =
+ int * (* weight *)
+ proof *
+ (Cic.term * (* type *)
+ Cic.term * (* left side *)
+ Cic.term * (* right side *)
+ Utils.comparison) * (* ordering *)
+ Cic.metasenv * (* environment for metas *)
+ Cic.term list (* arguments *)
+
+and proof =
+ | NoProof
+ | BasicProof of Cic.term
+ | ProofBlock of
+ Cic.substitution * UriManager.uri *
+ (Cic.name * Cic.term) * Cic.term * (Utils.pos * equality) * proof
+ | ProofGoalBlock of proof * proof
+ | ProofSymBlock of Cic.term list * proof
+ | SubProof of Cic.term * int * proof
+;;
+
+
+let string_of_equality ?env =
+ match env with
+ | None -> (
+ function
+ | w, _, (ty, left, right, o), _, _ ->
+ Printf.sprintf "Weight: %d, {%s}: %s =(%s) %s" w (CicPp.ppterm ty)
+ (CicPp.ppterm left) (string_of_comparison o) (CicPp.ppterm right)
+ )
+ | Some (_, context, _) -> (
+ let names = names_of_context context in
+ function
+ | w, _, (ty, left, right, o), _, _ ->
+ Printf.sprintf "Weight: %d, {%s}: %s =(%s) %s" w (CicPp.pp ty names)
+ (CicPp.pp left names) (string_of_comparison o)
+ (CicPp.pp right names)
+ )
+;;
+
+
+let rec string_of_proof = function
+ | NoProof -> "NoProof"
+ | BasicProof t -> "BasicProof " ^ (CicPp.ppterm t)
+ | SubProof (t, i, p) ->
+ Printf.sprintf "SubProof(%s, %s, %s)"
+ (CicPp.ppterm t) (string_of_int i) (string_of_proof p)
+ | ProofSymBlock _ -> "ProofSymBlock"
+ | ProofBlock _ -> "ProofBlock"
+ | ProofGoalBlock (p1, p2) ->
+ Printf.sprintf "ProofGoalBlock(%s, %s)"
+ (string_of_proof p1) (string_of_proof p2)
+;;
+
+
+(* returns an explicit named subst and a list of arguments for sym_eq_URI *)
+let build_ens_for_sym_eq sym_eq_URI termlist =
+ let obj, _ = CicEnvironment.get_obj CicUniv.empty_ugraph sym_eq_URI in
+ match obj with
+ | Cic.Constant (_, _, _, uris, _) ->
+ assert (List.length uris <= List.length termlist);
+ let rec aux = function
+ | [], tl -> [], tl
+ | (uri::uris), (term::tl) ->
+ let ens, args = aux (uris, tl) in
+ (uri, term)::ens, args
+ | _, _ -> assert false
+ in
+ aux (uris, termlist)
+ | _ -> assert false
+;;
+
+
+let build_proof_term proof =
+ let rec do_build_proof proof =
+ match proof with
+ | NoProof ->
+ Printf.fprintf stderr "WARNING: no proof!\n";
+ Cic.Implicit None
+ | BasicProof term -> term
+ | ProofGoalBlock (proofbit, proof) ->
+ print_endline "found ProofGoalBlock, going up...";
+ do_build_goal_proof proofbit proof
+ | ProofSymBlock (termlist, proof) ->
+ let proof = do_build_proof proof in
+ let ens, args = build_ens_for_sym_eq (Utils.sym_eq_URI ()) termlist in
+ Cic.Appl ([Cic.Const (Utils.sym_eq_URI (), ens)] @ args @ [proof])
+ | ProofBlock (subst, eq_URI, (name, ty), bo, (pos, eq), eqproof) ->
+ let t' = Cic.Lambda (name, ty, bo) in
+ let proof' =
+ let _, proof', _, _, _ = eq in
+ do_build_proof proof'
+ in
+ let eqproof = do_build_proof eqproof in
+ let _, _, (ty, what, other, _), menv', args' = eq in
+ let what, other =
+ if pos = Utils.Left then what, other else other, what
+ in
+ CicMetaSubst.apply_subst subst
+ (Cic.Appl [Cic.Const (eq_URI, []); ty;
+ what; t'; eqproof; other; proof'])
+ | SubProof (term, meta_index, proof) ->
+ let proof = do_build_proof proof in
+ let eq i = function
+ | Cic.Meta (j, _) -> i = j
+ | _ -> false
+ in
+ ProofEngineReduction.replace
+ ~equality:eq ~what:[meta_index] ~with_what:[proof] ~where:term
+
+ and do_build_goal_proof proofbit proof =
+ match proof with
+ | ProofGoalBlock (pb, p) ->
+ do_build_proof (ProofGoalBlock (replace_proof proofbit pb, p))
+ | _ -> do_build_proof (replace_proof proofbit proof)
+
+ and replace_proof newproof = function
+ | ProofBlock (subst, eq_URI, namety, bo, poseq, eqproof) ->
+ let eqproof' = replace_proof newproof eqproof in
+ ProofBlock (subst, eq_URI, namety, bo, poseq, eqproof')
+ | ProofGoalBlock (pb, p) ->
+ let pb' = replace_proof newproof pb in
+ ProofGoalBlock (pb', p)
+ | BasicProof _ -> newproof
+ | SubProof (term, meta_index, p) ->
+ SubProof (term, meta_index, replace_proof newproof p)
+ | p -> p
+ in
+ do_build_proof proof
+;;
+
+
+let rec metas_of_term = function
+ | Cic.Meta (i, c) -> [i]
+ | Cic.Var (_, ens)
+ | Cic.Const (_, ens)
+ | Cic.MutInd (_, _, ens)
+ | Cic.MutConstruct (_, _, _, ens) ->
+ List.flatten (List.map (fun (u, t) -> metas_of_term t) ens)
+ | Cic.Cast (s, t)
+ | Cic.Prod (_, s, t)
+ | Cic.Lambda (_, s, t)
+ | Cic.LetIn (_, s, t) -> (metas_of_term s) @ (metas_of_term t)
+ | Cic.Appl l -> List.flatten (List.map metas_of_term l)
+ | Cic.MutCase (uri, i, s, t, l) ->
+ (metas_of_term s) @ (metas_of_term t) @
+ (List.flatten (List.map metas_of_term l))
+ | Cic.Fix (i, il) ->
+ List.flatten
+ (List.map (fun (s, i, t1, t2) ->
+ (metas_of_term t1) @ (metas_of_term t2)) il)
+ | Cic.CoFix (i, il) ->
+ List.flatten
+ (List.map (fun (s, t1, t2) ->
+ (metas_of_term t1) @ (metas_of_term t2)) il)
+ | _ -> []
+;;
+
+
+exception NotMetaConvertible;;
+
+let meta_convertibility_aux table t1 t2 =
+ let module C = Cic in
+ let print_table t =
+ String.concat ", "
+ (List.map
+ (fun (k, v) -> Printf.sprintf "(%d, %d)" k v) t)
+ in
+ let rec aux ((table_l, table_r) as table) t1 t2 =
+ match t1, t2 with
+ | C.Meta (m1, tl1), C.Meta (m2, tl2) ->
+ let m1_binding, table_l =
+ try List.assoc m1 table_l, table_l
+ with Not_found -> m2, (m1, m2)::table_l
+ and m2_binding, table_r =
+ try List.assoc m2 table_r, table_r
+ with Not_found -> m1, (m2, m1)::table_r
+ in
+ if (m1_binding <> m2) || (m2_binding <> m1) then
+ raise NotMetaConvertible
+ else (
+ try
+ List.fold_left2
+ (fun res t1 t2 ->
+ match t1, t2 with
+ | None, Some _ | Some _, None -> raise NotMetaConvertible
+ | None, None -> res
+ | Some t1, Some t2 -> (aux res t1 t2))
+ (table_l, table_r) tl1 tl2
+ with Invalid_argument _ ->
+ raise NotMetaConvertible
+ )
+ | C.Var (u1, ens1), C.Var (u2, ens2)
+ | C.Const (u1, ens1), C.Const (u2, ens2) when (UriManager.eq u1 u2) ->
+ aux_ens table ens1 ens2
+ | C.Cast (s1, t1), C.Cast (s2, t2)
+ | C.Prod (_, s1, t1), C.Prod (_, s2, t2)
+ | C.Lambda (_, s1, t1), C.Lambda (_, s2, t2)
+ | C.LetIn (_, s1, t1), C.LetIn (_, s2, t2) ->
+ let table = aux table s1 s2 in
+ aux table t1 t2
+ | C.Appl l1, C.Appl l2 -> (
+ try List.fold_left2 (fun res t1 t2 -> (aux res t1 t2)) table l1 l2
+ with Invalid_argument _ -> raise NotMetaConvertible
+ )
+ | C.MutInd (u1, i1, ens1), C.MutInd (u2, i2, ens2)
+ when (UriManager.eq u1 u2) && i1 = i2 -> aux_ens table ens1 ens2
+ | C.MutConstruct (u1, i1, j1, ens1), C.MutConstruct (u2, i2, j2, ens2)
+ when (UriManager.eq u1 u2) && i1 = i2 && j1 = j2 ->
+ aux_ens table ens1 ens2
+ | C.MutCase (u1, i1, s1, t1, l1), C.MutCase (u2, i2, s2, t2, l2)
+ when (UriManager.eq u1 u2) && i1 = i2 ->
+ let table = aux table s1 s2 in
+ let table = aux table t1 t2 in (
+ try List.fold_left2 (fun res t1 t2 -> (aux res t1 t2)) table l1 l2
+ with Invalid_argument _ -> raise NotMetaConvertible
+ )
+ | C.Fix (i1, il1), C.Fix (i2, il2) when i1 = i2 -> (
+ try
+ List.fold_left2
+ (fun res (n1, i1, s1, t1) (n2, i2, s2, t2) ->
+ if i1 <> i2 then raise NotMetaConvertible
+ else
+ let res = (aux res s1 s2) in aux res t1 t2)
+ table il1 il2
+ with Invalid_argument _ -> raise NotMetaConvertible
+ )
+ | C.CoFix (i1, il1), C.CoFix (i2, il2) when i1 = i2 -> (
+ try
+ List.fold_left2
+ (fun res (n1, s1, t1) (n2, s2, t2) ->
+ let res = aux res s1 s2 in aux res t1 t2)
+ table il1 il2
+ with Invalid_argument _ -> raise NotMetaConvertible
+ )
+ | t1, t2 when t1 = t2 -> table
+ | _, _ -> raise NotMetaConvertible
+
+ and aux_ens table ens1 ens2 =
+ let cmp (u1, t1) (u2, t2) =
+ compare (UriManager.string_of_uri u1) (UriManager.string_of_uri u2)
+ in
+ let ens1 = List.sort cmp ens1
+ and ens2 = List.sort cmp ens2 in
+ try
+ List.fold_left2
+ (fun res (u1, t1) (u2, t2) ->
+ if not (UriManager.eq u1 u2) then raise NotMetaConvertible
+ else aux res t1 t2)
+ table ens1 ens2
+ with Invalid_argument _ -> raise NotMetaConvertible
+ in
+ aux table t1 t2
+;;
+
+
+let meta_convertibility_eq eq1 eq2 =
+ let _, _, (ty, left, right, _), _, _ = eq1
+ and _, _, (ty', left', right', _), _, _ = eq2 in
+ if ty <> ty' then
+ false
+ else if (left = left') && (right = right') then
+ true
+ else if (left = right') && (right = left') then
+ true
+ else
+ try
+ let table = meta_convertibility_aux ([], []) left left' in
+ let _ = meta_convertibility_aux table right right' in
+ true
+ with NotMetaConvertible ->
+ try
+ let table = meta_convertibility_aux ([], []) left right' in
+ let _ = meta_convertibility_aux table right left' in
+ true
+ with NotMetaConvertible ->
+ false
+;;
+
+
+let meta_convertibility t1 t2 =
+ let f t =
+ String.concat ", "
+ (List.map
+ (fun (k, v) -> Printf.sprintf "(%d, %d)" k v) t)
+ in
+ if t1 = t2 then
+ true
+ else
+ try
+ let l, r = meta_convertibility_aux ([], []) t1 t2 in
+ true
+ with NotMetaConvertible ->
+ false
+;;
+
+
+let rec check_irl start = function
+ | [] -> true
+ | None::tl -> check_irl (start+1) tl
+ | (Some (Cic.Rel x))::tl ->
+ if x = start then check_irl (start+1) tl else false
+ | _ -> false
+;;
+
+
+let rec is_simple_term = function
+ | Cic.Appl ((Cic.Meta _)::_) -> false
+ | Cic.Appl l -> List.for_all is_simple_term l
+ | Cic.Meta (i, l) -> check_irl 1 l
+ | Cic.Rel _ -> true
+ | Cic.Const _ -> true
+ | Cic.MutInd (_, _, []) -> true
+ | Cic.MutConstruct (_, _, _, []) -> true
+ | _ -> false
+;;
+
+
+let lookup_subst meta subst =
+ match meta with
+ | Cic.Meta (i, _) -> (
+ try let _, (_, t, _) = List.find (fun (m, _) -> m = i) subst in t
+ with Not_found -> meta
+ )
+ | _ -> assert false
+;;
+
+
+let unification_simple metasenv context t1 t2 ugraph =
+ let module C = Cic in
+ let module M = CicMetaSubst in
+ let module U = CicUnification in
+ let lookup = lookup_subst in
+ let rec occurs_check subst what where =
+ match where with
+ | t when what = t -> true
+ | C.Appl l -> List.exists (occurs_check subst what) l
+ | C.Meta _ ->
+ let t = lookup where subst in
+ if t <> where then occurs_check subst what t else false
+ | _ -> false
+ in
+ let rec unif subst menv s t =
+ let s = match s with C.Meta _ -> lookup s subst | _ -> s
+ and t = match t with C.Meta _ -> lookup t subst | _ -> t
+ in
+ match s, t with
+ | s, t when s = t -> subst, menv
+ | C.Meta (i, _), C.Meta (j, _) when i > j ->
+ unif subst menv t s
+ | C.Meta _, t when occurs_check subst s t ->
+ raise
+ (U.UnificationFailure (lazy "Inference.unification.unif"))
+ | C.Meta (i, l), t -> (
+ try
+ let _, _, ty = CicUtil.lookup_meta i menv in
+ let subst =
+ if not (List.mem_assoc i subst) then (i, (context, t, ty))::subst
+ else subst
+ in
+ let menv = menv in (* List.filter (fun (m, _, _) -> i <> m) menv in *)
+ subst, menv
+ with CicUtil.Meta_not_found m ->
+ let names = names_of_context context in
+ debug_print
+ (lazy
+ (Printf.sprintf "Meta_not_found %d!: %s %s\n%s\n\n%s" m
+ (CicPp.pp t1 names) (CicPp.pp t2 names)
+ (print_metasenv menv) (print_metasenv metasenv)));
+ assert false
+ )
+ | _, C.Meta _ -> unif subst menv t s
+ | C.Appl (hds::_), C.Appl (hdt::_) when hds <> hdt ->
+ raise (U.UnificationFailure (lazy "Inference.unification.unif"))
+ | C.Appl (hds::tls), C.Appl (hdt::tlt) -> (
+ try
+ List.fold_left2
+ (fun (subst', menv) s t -> unif subst' menv s t)
+ (subst, menv) tls tlt
+ with Invalid_argument _ ->
+ raise (U.UnificationFailure (lazy "Inference.unification.unif"))
+ )
+ | _, _ ->
+ raise (U.UnificationFailure (lazy "Inference.unification.unif"))
+ in
+ let subst, menv = unif [] metasenv t1 t2 in
+ let menv =
+ List.filter
+ (fun (m, _, _) ->
+ try let _ = List.find (fun (i, _) -> m = i) subst in false
+ with Not_found -> true)
+ menv
+ in
+ List.rev subst, menv, ugraph
+;;
+
+
+let unification metasenv context t1 t2 ugraph =
+ let subst, menv, ug =
+ if not (is_simple_term t1) || not (is_simple_term t2) then (
+ debug_print
+ (lazy
+ (Printf.sprintf "NOT SIMPLE TERMS: %s %s"
+ (CicPp.ppterm t1) (CicPp.ppterm t2)));
+ CicUnification.fo_unif metasenv context t1 t2 ugraph
+ ) else
+ unification_simple metasenv context t1 t2 ugraph
+ in
+ let rec fix_term = function
+ | (Cic.Meta (i, l) as t) ->
+ let t' = lookup_subst t subst in
+ if t <> t' then fix_term t' else t
+ | Cic.Appl l -> Cic.Appl (List.map fix_term l)
+ | t -> t
+ in
+ let rec fix_subst = function
+ | [] -> []
+ | (i, (c, t, ty))::tl -> (i, (c, fix_term t, fix_term ty))::(fix_subst tl)
+ in
+ fix_subst subst, menv, ug
+;;
+
+
+let unification = CicUnification.fo_unif;;
+
+exception MatchingFailure;;
+
+
+(*
+let matching_simple metasenv context t1 t2 ugraph =
+ let module C = Cic in
+ let module M = CicMetaSubst in
+ let module U = CicUnification in
+ let lookup meta subst =
+ match meta with
+ | C.Meta (i, _) -> (
+ try let _, (_, t, _) = List.find (fun (m, _) -> m = i) subst in t
+ with Not_found -> meta
+ )
+ | _ -> assert false
+ in
+ let rec do_match subst menv s t =
+ match s, t with
+ | s, t when s = t -> subst, menv
+ | s, C.Meta (i, l) ->
+ let filter_menv i menv =
+ List.filter (fun (m, _, _) -> i <> m) menv
+ in
+ let subst, menv =
+ let value = lookup t subst in
+ match value with
+ | value when value = t ->
+ let _, _, ty = CicUtil.lookup_meta i menv in
+ (i, (context, s, ty))::subst, filter_menv i menv
+ | value when value <> s ->
+ raise MatchingFailure
+ | value -> do_match subst menv s value
+ in
+ subst, menv
+ | C.Appl ls, C.Appl lt -> (
+ try
+ List.fold_left2
+ (fun (subst, menv) s t -> do_match subst menv s t)
+ (subst, menv) ls lt
+ with Invalid_argument _ ->
+ raise MatchingFailure
+ )
+ | _, _ ->
+ raise MatchingFailure
+ in
+ let subst, menv = do_match [] metasenv t1 t2 in
+ subst, menv, ugraph
+;;
+*)
+
+
+let matching metasenv context t1 t2 ugraph =
+ try
+ let subst, metasenv, ugraph =
+ unification metasenv context t1 t2 ugraph
+ in
+ let t' = CicMetaSubst.apply_subst subst t1 in
+ if not (meta_convertibility t1 t') then
+ raise MatchingFailure
+ else
+ let metas = metas_of_term t1 in
+ let fix_subst = function
+ | (i, (c, Cic.Meta (j, lc), ty)) when List.mem i metas ->
+ (j, (c, Cic.Meta (i, lc), ty))
+ | s -> s
+ in
+ let subst = List.map fix_subst subst in
+ subst, metasenv, ugraph
+ with
+ | CicUnification.UnificationFailure _
+ | CicUnification.Uncertain _ ->
+ raise MatchingFailure
+;;
+
+
+let find_equalities context proof =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ let module T = CicTypeChecker in
+ let eq_uri = LibraryObjects.eq_URI () in
+ let newmeta = ProofEngineHelpers.new_meta_of_proof ~proof in
+ let ok_types ty menv =
+ List.for_all (fun (_, _, mt) -> mt = ty) menv
+ in
+ let rec aux index newmeta = function
+ | [] -> [], newmeta
+ | (Some (_, C.Decl (term)))::tl ->
+ let do_find context term =
+ match term with
+ | C.Prod (name, s, t) ->
+ let (head, newmetas, args, newmeta) =
+ ProofEngineHelpers.saturate_term newmeta []
+ context (S.lift index term) 0
+ in
+ let p =
+ if List.length args = 0 then
+ C.Rel index
+ else
+ C.Appl ((C.Rel index)::args)
+ in (
+ match head with
+ | C.Appl [C.MutInd (uri, _, _); ty; t1; t2]
+ when (UriManager.eq uri eq_uri) && (ok_types ty newmetas) ->
+ debug_print
+ (lazy
+ (Printf.sprintf "OK: %s" (CicPp.ppterm term)));
+ let o = !Utils.compare_terms t1 t2 in
+ let w = compute_equality_weight ty t1 t2 in
+ let proof = BasicProof p in
+ let e = (w, proof, (ty, t1, t2, o), newmetas, args) in
+ Some e, (newmeta+1)
+ | _ -> None, newmeta
+ )
+ | C.Appl [C.MutInd (uri, _, _); ty; t1; t2]
+ when UriManager.eq uri eq_uri ->
+ let t1 = S.lift index t1
+ and t2 = S.lift index t2 in
+ let o = !Utils.compare_terms t1 t2 in
+ let w = compute_equality_weight ty t1 t2 in
+ let e = (w, BasicProof (C.Rel index), (ty, t1, t2, o), [], []) in
+ Some e, (newmeta+1)
+ | _ -> None, newmeta
+ in (
+ match do_find context term with
+ | Some p, newmeta ->
+ let tl, newmeta' = (aux (index+1) newmeta tl) in
+ (index, p)::tl, max newmeta newmeta'
+ | None, _ ->
+ aux (index+1) newmeta tl
+ )
+ | _::tl ->
+ aux (index+1) newmeta tl
+ in
+ let il, maxm = aux 1 newmeta context in
+ let indexes, equalities = List.split il in
+ indexes, equalities, maxm
+;;
+
+
+(*
+let equations_blacklist =
+ List.fold_left
+ (fun s u -> UriManager.UriSet.add (UriManager.uri_of_string u) s)
+ UriManager.UriSet.empty [
+ "cic:/Coq/Init/Logic/eq.ind#xpointer(1/1/1)";
+ "cic:/Coq/Init/Logic/trans_eq.con";
+ "cic:/Coq/Init/Logic/f_equal.con";
+ "cic:/Coq/Init/Logic/f_equal2.con";
+ "cic:/Coq/Init/Logic/f_equal3.con";
+ "cic:/Coq/Init/Logic/f_equal4.con";
+ "cic:/Coq/Init/Logic/f_equal5.con";
+ "cic:/Coq/Init/Logic/sym_eq.con";
+ "cic:/Coq/Init/Logic/eq_ind.con";
+ "cic:/Coq/Init/Logic/eq_ind_r.con";
+ "cic:/Coq/Init/Logic/eq_rec.con";
+ "cic:/Coq/Init/Logic/eq_rec_r.con";
+ "cic:/Coq/Init/Logic/eq_rect.con";
+ "cic:/Coq/Init/Logic/eq_rect_r.con";
+ "cic:/Coq/Logic/Eqdep/UIP.con";
+ "cic:/Coq/Logic/Eqdep/UIP_refl.con";
+ "cic:/Coq/Logic/Eqdep_dec/eq2eqT.con";
+ "cic:/Coq/ZArith/Zcompare/rename.con";
+ (* ALB !!!! questo e` imbrogliare, ma x ora lo lasciamo cosi`...
+ perche' questo cacchio di teorema rompe le scatole :'( *)
+ "cic:/Rocq/SUBST/comparith/mult_n_2.con";
+
+ "cic:/matita/logic/equality/eq_f.con";
+ "cic:/matita/logic/equality/eq_f2.con";
+ "cic:/matita/logic/equality/eq_rec.con";
+ "cic:/matita/logic/equality/eq_rect.con";
+ ]
+;;
+*)
+let equations_blacklist = UriManager.UriSet.empty;;
+
+
+let find_library_equalities dbd context status maxmeta =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ let module T = CicTypeChecker in
+ let blacklist =
+ List.fold_left
+ (fun s u -> UriManager.UriSet.add u s)
+ equations_blacklist
+ [eq_XURI (); sym_eq_URI (); trans_eq_URI (); eq_ind_URI ();
+ eq_ind_r_URI ()]
+ in
+ let candidates =
+ List.fold_left
+ (fun l uri ->
+ let suri = UriManager.string_of_uri uri in
+ if UriManager.UriSet.mem uri blacklist then
+ l
+ else
+ let t = CicUtil.term_of_uri uri in
+ let ty, _ =
+ CicTypeChecker.type_of_aux' [] context t CicUniv.empty_ugraph
+ in
+ (uri, t, ty)::l)
+ []
+ (let t1 = Unix.gettimeofday () in
+ let eqs = (MetadataQuery.equations_for_goal ~dbd status) in
+ let t2 = Unix.gettimeofday () in
+ (debug_print
+ (lazy
+ (Printf.sprintf "Tempo di MetadataQuery.equations_for_goal: %.9f\n"
+ (t2 -. t1))));
+ eqs)
+ in
+ let eq_uri1 = eq_XURI ()
+ and eq_uri2 = LibraryObjects.eq_URI () in
+ let iseq uri =
+ (UriManager.eq uri eq_uri1) || (UriManager.eq uri eq_uri2)
+ in
+ let ok_types ty menv =
+ List.for_all (fun (_, _, mt) -> mt = ty) menv
+ in
+ let rec has_vars = function
+ | C.Meta _ | C.Rel _ | C.Const _ -> false
+ | C.Var _ -> true
+ | C.Appl l -> List.exists has_vars l
+ | C.Prod (_, s, t) | C.Lambda (_, s, t)
+ | C.LetIn (_, s, t) | C.Cast (s, t) ->
+ (has_vars s) || (has_vars t)
+ | _ -> false
+ in
+ let rec aux newmeta = function
+ | [] -> [], newmeta
+ | (uri, term, termty)::tl ->
+ debug_print
+ (lazy
+ (Printf.sprintf "Examining: %s (%s)"
+ (CicPp.ppterm term) (CicPp.ppterm termty)));
+ let res, newmeta =
+ match termty with
+ | C.Prod (name, s, t) when not (has_vars termty) ->
+ let head, newmetas, args, newmeta =
+ ProofEngineHelpers.saturate_term newmeta [] context termty 0
+ in
+ let p =
+ if List.length args = 0 then
+ term
+ else
+ C.Appl (term::args)
+ in (
+ match head with
+ | C.Appl [C.MutInd (uri, _, _); ty; t1; t2]
+ when (iseq uri) && (ok_types ty newmetas) ->
+ debug_print
+ (lazy
+ (Printf.sprintf "OK: %s" (CicPp.ppterm term)));
+ let o = !Utils.compare_terms t1 t2 in
+ let w = compute_equality_weight ty t1 t2 in
+ let proof = BasicProof p in
+ let e = (w, proof, (ty, t1, t2, o), newmetas, args) in
+ Some e, (newmeta+1)
+ | _ -> None, newmeta
+ )
+ | C.Appl [C.MutInd (uri, _, _); ty; t1; t2]
+ when iseq uri && not (has_vars termty) ->
+ let o = !Utils.compare_terms t1 t2 in
+ let w = compute_equality_weight ty t1 t2 in
+ let e = (w, BasicProof term, (ty, t1, t2, o), [], []) in
+ Some e, (newmeta+1)
+ | _ -> None, newmeta
+ in
+ match res with
+ | Some e ->
+ let tl, newmeta' = aux newmeta tl in
+ (uri, e)::tl, max newmeta newmeta'
+ | None ->
+ aux newmeta tl
+ in
+ let found, maxm = aux maxmeta candidates in
+ let uriset, eqlist =
+ (List.fold_left
+ (fun (s, l) (u, e) ->
+ if List.exists (meta_convertibility_eq e) (List.map snd l) then (
+ debug_print
+ (lazy
+ (Printf.sprintf "NO!! %s already there!"
+ (string_of_equality e)));
+ (UriManager.UriSet.add u s, l)
+ ) else (UriManager.UriSet.add u s, (u, e)::l))
+ (UriManager.UriSet.empty, []) found)
+ in
+ uriset, eqlist, maxm
+;;
+
+
+let find_library_theorems dbd env status equalities_uris =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ let module T = CicTypeChecker in
+ let blacklist =
+ let refl_equal =
+ UriManager.uri_of_string "cic:/Coq/Init/Logic/eq.ind#xpointer(1/1/1)" in
+ let s =
+ UriManager.UriSet.remove refl_equal
+ (UriManager.UriSet.union equalities_uris equations_blacklist)
+ in
+ List.fold_left
+ (fun s u -> UriManager.UriSet.add u s)
+ s [eq_XURI () ;sym_eq_URI (); trans_eq_URI (); eq_ind_URI ();
+ eq_ind_r_URI ()]
+ in
+ let metasenv, context, ugraph = env in
+ let candidates =
+ List.fold_left
+ (fun l uri ->
+ if UriManager.UriSet.mem uri blacklist then l
+ else
+ let t = CicUtil.term_of_uri uri in
+ let ty, _ = CicTypeChecker.type_of_aux' metasenv context t ugraph in
+ (t, ty, [])::l)
+ [] (MetadataQuery.signature_of_goal ~dbd status)
+ in
+ let refl_equal =
+ let u = eq_XURI () in
+ let t = CicUtil.term_of_uri u in
+ let ty, _ = CicTypeChecker.type_of_aux' [] [] t CicUniv.empty_ugraph in
+ (t, ty, [])
+ in
+ refl_equal::candidates
+;;
+
+
+let find_context_hypotheses env equalities_indexes =
+ let metasenv, context, ugraph = env in
+ let _, res =
+ List.fold_left
+ (fun (n, l) entry ->
+ match entry with
+ | None -> (n+1, l)
+ | Some _ ->
+ if List.mem n equalities_indexes then
+ (n+1, l)
+ else
+ let t = Cic.Rel n in
+ let ty, _ =
+ CicTypeChecker.type_of_aux' metasenv context t ugraph in
+ (n+1, (t, ty, [])::l))
+ (1, []) context
+ in
+ res
+;;
+
+
+let fix_metas newmeta ((w, p, (ty, left, right, o), menv, args) as equality) =
+ let table = Hashtbl.create (List.length args) in
+ let newargs, newmeta =
+ List.fold_right
+ (fun t (newargs, index) ->
+ match t with
+ | Cic.Meta (i, l) ->
+ if Hashtbl.mem table i then
+ let idx = Hashtbl.find table i in
+ ((Cic.Meta (idx, l))::newargs, index+1)
+ else
+ let _ = Hashtbl.add table i index in
+ ((Cic.Meta (index, l))::newargs, index+1)
+ | _ -> assert false)
+ args ([], newmeta+1)
+ in
+ let repl where =
+ ProofEngineReduction.replace ~equality:(=) ~what:args ~with_what:newargs
+ ~where
+ in
+ let menv' =
+ List.fold_right
+ (fun (i, context, term) menv ->
+ try
+ let index = Hashtbl.find table i in
+ (index, context, term)::menv
+ with Not_found ->
+ (i, context, term)::menv)
+ menv []
+ in
+ let ty = repl ty
+ and left = repl left
+ and right = repl right in
+ let metas = (metas_of_term left) @ (metas_of_term right) in
+ let menv' = List.filter (fun (i, _, _) -> List.mem i metas) menv' in
+ let newargs =
+ List.filter
+ (function Cic.Meta (i, _) -> List.mem i metas | _ -> assert false) newargs
+ in
+ let _ =
+ if List.length metas > 0 then
+ let first = List.hd metas in
+ (* this new equality might have less variables than its parents: here
+ we fill the gap with a dummy arg. Example:
+ with (f X Y) = X we can simplify
+ (g X) = (f X Y) in
+ (g X) = X.
+ So the new equation has only one variable, but it still has type like
+ \lambda X,Y:..., so we need to pass a dummy arg for Y
+ (I hope this makes some sense...)
+ *)
+ Hashtbl.iter
+ (fun k v ->
+ if not (List.exists
+ (function Cic.Meta (i, _) -> i = v | _ -> assert false)
+ newargs) then
+ Hashtbl.replace table k first)
+ (Hashtbl.copy table)
+ in
+ let rec fix_proof = function
+ | NoProof -> NoProof
+ | BasicProof term -> BasicProof (repl term)
+ | ProofBlock (subst, eq_URI, namety, bo, (pos, eq), p) ->
+ let subst' =
+ List.fold_left
+ (fun s arg ->
+ match arg with
+ | Cic.Meta (i, l) -> (
+ try
+ let j = Hashtbl.find table i in
+ if List.mem_assoc i subst then
+ s
+ else
+ let _, context, ty = CicUtil.lookup_meta i menv in
+ (i, (context, Cic.Meta (j, l), ty))::s
+ with Not_found | CicUtil.Meta_not_found _ ->
+ s
+ )
+ | _ -> assert false)
+ [] args
+ in
+ ProofBlock (subst' @ subst, eq_URI, namety, bo(* t' *), (pos, eq), p)
+ | p -> assert false
+ in
+ let neweq = (w, fix_proof p, (ty, left, right, o), menv', newargs) in
+ (newmeta + 1, neweq)
+;;
+
+
+let term_is_equality term =
+ let iseq uri = UriManager.eq uri (LibraryObjects.eq_URI ()) in
+ match term with
+ | Cic.Appl [Cic.MutInd (uri, _, _); _; _; _] when iseq uri -> true
+ | _ -> false
+;;
+
+
+exception TermIsNotAnEquality;;
+
+let equality_of_term proof term =
+ let eq_uri = LibraryObjects.eq_URI () in
+ let iseq uri = UriManager.eq uri eq_uri in
+ match term with
+ | Cic.Appl [Cic.MutInd (uri, _, _); ty; t1; t2] when iseq uri ->
+ let o = !Utils.compare_terms t1 t2 in
+ let w = compute_equality_weight ty t1 t2 in
+ let e = (w, BasicProof proof, (ty, t1, t2, o), [], []) in
+ e
+ | _ ->
+ raise TermIsNotAnEquality
+;;
+
+
+type environment = Cic.metasenv * Cic.context * CicUniv.universe_graph;;
+
+
+let is_identity ((metasenv, context, ugraph) as env) = function
+ | ((_, _, (ty, left, right, _), menv, _) as equality) ->
+ (left = right ||
+ (* (meta_convertibility left right) || *)
+ (fst (CicReduction.are_convertible
+ ~metasenv:(metasenv @ menv) context left right ugraph)))
+;;
+
+
+let term_of_equality equality =
+ let _, _, (ty, left, right, _), menv, args = equality in
+ let eq i = function Cic.Meta (j, _) -> i = j | _ -> false in
+ let argsno = List.length args in
+ let t =
+ CicSubstitution.lift argsno
+ (Cic.Appl [Cic.MutInd (LibraryObjects.eq_URI (), 0, []); ty; left; right])
+ in
+ snd (
+ List.fold_right
+ (fun a (n, t) ->
+ match a with
+ | Cic.Meta (i, _) ->
+ let name = Cic.Name ("X" ^ (string_of_int n)) in
+ let _, _, ty = CicUtil.lookup_meta i menv in
+ let t =
+ ProofEngineReduction.replace
+ ~equality:eq ~what:[i]
+ ~with_what:[Cic.Rel (argsno - (n - 1))] ~where:t
+ in
+ (n-1, Cic.Prod (name, ty, t))
+ | _ -> assert false)
+ args (argsno, t))
+;;
diff --git a/helm/ocaml/paramodulation/inference.mli b/helm/ocaml/paramodulation/inference.mli
new file mode 100644
index 000000000..30927dc72
--- /dev/null
+++ b/helm/ocaml/paramodulation/inference.mli
@@ -0,0 +1,133 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+type equality =
+ int * (* weight *)
+ proof * (* proof *)
+ (Cic.term * (* type *)
+ Cic.term * (* left side *)
+ Cic.term * (* right side *)
+ Utils.comparison) * (* ordering *)
+ Cic.metasenv * (* environment for metas *)
+ Cic.term list (* arguments *)
+
+and proof =
+ | NoProof
+ | BasicProof of Cic.term (* already a proof of a goal *)
+ | ProofBlock of (* proof of a rewrite step *)
+ Cic.substitution * UriManager.uri * (* eq_ind or eq_ind_r *)
+ (Cic.name * Cic.term) * Cic.term * (Utils.pos * equality) * proof
+ | ProofGoalBlock of proof * proof
+ (* proof of the new meta, proof of the goal from which this comes *)
+ | ProofSymBlock of Cic.term list * proof (* expl.named subst, proof *)
+ | SubProof of Cic.term * int * proof
+ (* parent proof, subgoal, proof of the subgoal *)
+
+type environment = Cic.metasenv * Cic.context * CicUniv.universe_graph
+
+(** builds the Cic.term encoded by proof *)
+val build_proof_term: proof -> Cic.term
+
+val string_of_proof: proof -> string
+
+exception MatchingFailure
+
+(** matching between two terms. Can raise MatchingFailure *)
+val matching:
+ Cic.metasenv -> Cic.context -> Cic.term -> Cic.term ->
+ CicUniv.universe_graph ->
+ Cic.substitution * Cic.metasenv * CicUniv.universe_graph
+
+(**
+ special unification that checks if the two terms are "simple", and in
+ such case should be significantly faster than CicUnification.fo_unif
+*)
+val unification:
+ Cic.metasenv -> Cic.context -> Cic.term -> Cic.term ->
+ CicUniv.universe_graph ->
+ Cic.substitution * Cic.metasenv * CicUniv.universe_graph
+
+
+(**
+ scans the context to find all Declarations "left = right"; returns a
+ list of tuples (proof, (type, left, right), newmetas). Uses
+ PrimitiveTactics.new_metasenv_for_apply to replace bound variables with
+ fresh metas...
+*)
+val find_equalities:
+ Cic.context -> ProofEngineTypes.proof -> int list * equality list * int
+
+(**
+ searches the library for equalities that can be applied to the current goal
+*)
+val find_library_equalities:
+ HMysql.dbd -> Cic.context -> ProofEngineTypes.status -> int ->
+ UriManager.UriSet.t * (UriManager.uri * equality) list * int
+
+(**
+ searches the library for theorems that are not equalities (returned by the
+ function above)
+*)
+val find_library_theorems:
+ HMysql.dbd -> environment -> ProofEngineTypes.status -> UriManager.UriSet.t ->
+ (Cic.term * Cic.term * Cic.metasenv) list
+
+(**
+ searches the context for hypotheses that are not equalities
+*)
+val find_context_hypotheses:
+ environment -> int list -> (Cic.term * Cic.term * Cic.metasenv) list
+
+
+exception TermIsNotAnEquality;;
+
+(**
+ raises TermIsNotAnEquality if term is not an equation.
+ The first Cic.term is a proof of the equation
+*)
+val equality_of_term: Cic.term -> Cic.term -> equality
+
+(**
+ Re-builds the term corresponding to this equality
+*)
+val term_of_equality: equality -> Cic.term
+
+val term_is_equality: Cic.term -> bool
+
+(** tests a sort of alpha-convertibility between the two terms, but on the
+ metavariables *)
+val meta_convertibility: Cic.term -> Cic.term -> bool
+
+(** meta convertibility between two equations *)
+val meta_convertibility_eq: equality -> equality -> bool
+
+val is_identity: environment -> equality -> bool
+
+val string_of_equality: ?env:environment -> equality -> string
+
+val metas_of_term: Cic.term -> int list
+
+(** ensures that metavariables in equality are unique *)
+val fix_metas: int -> equality -> int * equality
diff --git a/helm/ocaml/paramodulation/saturate_main.ml b/helm/ocaml/paramodulation/saturate_main.ml
new file mode 100644
index 000000000..bec597645
--- /dev/null
+++ b/helm/ocaml/paramodulation/saturate_main.ml
@@ -0,0 +1,161 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+module Trivial_disambiguate:
+sig
+ exception Ambiguous_term of string Lazy.t
+ (** disambiguate an _unanmbiguous_ term using dummy callbacks which fail if a
+ * choice from the user is needed to disambiguate the term
+ * @raise Ambiguous_term for ambiguous term *)
+ val disambiguate_string:
+ dbd:HMysql.dbd ->
+ ?context:Cic.context ->
+ ?metasenv:Cic.metasenv ->
+ ?initial_ugraph:CicUniv.universe_graph ->
+ ?aliases:DisambiguateTypes.environment ->(* previous interpretation status*)
+ string ->
+ ((DisambiguateTypes.domain_item * DisambiguateTypes.codomain_item) list *
+ Cic.metasenv * (* new metasenv *)
+ Cic.term *
+ CicUniv.universe_graph) list (* disambiguated term *)
+end
+=
+struct
+ exception Ambiguous_term of string Lazy.t
+ exception Exit
+ module Callbacks =
+ struct
+ let non p x = not (p x)
+ let interactive_user_uri_choice ~selection_mode ?ok
+ ?(enable_button_for_non_vars = true) ~title ~msg ~id uris =
+ List.filter (non UriManager.uri_is_var) uris
+ let interactive_interpretation_choice interp = raise Exit
+ let input_or_locate_uri ~(title:string) ?id = raise Exit
+ end
+ module Disambiguator = Disambiguate.Make (Callbacks)
+ let disambiguate_string ~dbd ?(context = []) ?(metasenv = []) ?initial_ugraph
+ ?(aliases = DisambiguateTypes.Environment.empty) term
+ =
+ let ast =
+ CicNotationParser.parse_level2_ast (Ulexing.from_utf8_string term)
+ in
+ try
+ fst (Disambiguator.disambiguate_term ~dbd ~context ~metasenv ast
+ ?initial_ugraph ~aliases ~universe:None)
+ with Exit -> raise (Ambiguous_term (lazy term))
+end
+
+let configuration_file = ref "../../matita/matita.conf.xml";;
+
+let core_notation_script = "../../matita/core_notation.moo";;
+
+let get_from_user ~(dbd:HMysql.dbd) =
+ let rec get () =
+ match read_line () with
+ | "" -> []
+ | t -> t::(get ())
+ in
+ let term_string = String.concat "\n" (get ()) in
+ let env, metasenv, term, ugraph =
+ List.nth (Trivial_disambiguate.disambiguate_string dbd term_string) 0
+ in
+ term, metasenv, ugraph
+;;
+
+let full = ref false;;
+
+let retrieve_only = ref false;;
+
+let demod_equalities = ref false;;
+
+let _ =
+ let module S = Saturation in
+ let set_ratio v = S.weight_age_ratio := v; S.weight_age_counter := v
+ and set_sel v = S.symbols_ratio := v; S.symbols_counter := v;
+ and set_conf f = configuration_file := f
+ and set_ordering o =
+ match o with
+ | "lpo" -> Utils.compare_terms := Utils.lpo
+ | "kbo" -> Utils.compare_terms := Utils.kbo
+ | "nr-kbo" -> Utils.compare_terms := Utils.nonrec_kbo
+ | "ao" -> Utils.compare_terms := Utils.ao
+ | o -> raise (Arg.Bad ("Unknown term ordering: " ^ o))
+ and set_fullred b = S.use_fullred := b
+ and set_time_limit v = S.time_limit := float_of_int v
+ and set_width w = S.maxwidth := w
+ and set_depth d = S.maxdepth := d
+ and set_full () = full := true
+ and set_retrieve () = retrieve_only := true
+ and set_demod_equalities () = demod_equalities := true
+ in
+ Arg.parse [
+ "-full", Arg.Unit set_full, "Enable full mode";
+ "-f", Arg.Bool set_fullred,
+ "Enable/disable full-reduction strategy (default: enabled)";
+
+ "-r", Arg.Int set_ratio, "Weight-Age equality selection ratio (default: 4)";
+
+ "-s", Arg.Int set_sel,
+ "symbols-based selection ratio (relative to the weight ratio, default: 0)";
+
+ "-c", Arg.String set_conf, "Configuration file (for the db connection)";
+
+ "-o", Arg.String set_ordering,
+ "Term ordering. Possible values are:\n" ^
+ "\tkbo: Knuth-Bendix ordering\n" ^
+ "\tnr-kbo: Non-recursive variant of kbo (default)\n" ^
+ "\tlpo: Lexicographic path ordering";
+
+ "-l", Arg.Int set_time_limit, "Time limit in seconds (default: no limit)";
+
+ "-w", Arg.Int set_width,
+ Printf.sprintf "Maximal width (default: %d)" !Saturation.maxwidth;
+
+ "-d", Arg.Int set_depth,
+ Printf.sprintf "Maximal depth (default: %d)" !Saturation.maxdepth;
+
+ "-retrieve", Arg.Unit set_retrieve, "retrieve only";
+ "-demod-equalities", Arg.Unit set_demod_equalities, "demod equalities";
+ ] (fun a -> ()) "Usage:"
+in
+Helm_registry.load_from !configuration_file;
+ignore (CicNotation2.load_notation [] core_notation_script);
+ignore (CicNotation2.load_notation [] "../../matita/coq.ma");
+let dbd = HMysql.quick_connect
+ ~host:(Helm_registry.get "db.host")
+ ~user:(Helm_registry.get "db.user")
+ ~database:(Helm_registry.get "db.database")
+ ()
+in
+let term, metasenv, ugraph = get_from_user ~dbd in
+if !retrieve_only then
+ Saturation.retrieve_and_print dbd term metasenv ugraph
+else if !demod_equalities then
+ Saturation.main_demod_equalities dbd term metasenv ugraph
+else
+ Saturation.main dbd !full term metasenv ugraph
+;;
diff --git a/helm/ocaml/paramodulation/saturation.ml b/helm/ocaml/paramodulation/saturation.ml
new file mode 100644
index 000000000..eb4a35d6c
--- /dev/null
+++ b/helm/ocaml/paramodulation/saturation.ml
@@ -0,0 +1,2379 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+open Inference;;
+open Utils;;
+
+
+(* set to false to disable paramodulation inside auto_tac *)
+let connect_to_auto = true;;
+
+
+(* profiling statistics... *)
+let infer_time = ref 0.;;
+let forward_simpl_time = ref 0.;;
+let forward_simpl_new_time = ref 0.;;
+let backward_simpl_time = ref 0.;;
+let passive_maintainance_time = ref 0.;;
+
+(* limited-resource-strategy related globals *)
+let processed_clauses = ref 0;; (* number of equalities selected so far... *)
+let time_limit = ref 0.;; (* in seconds, settable by the user... *)
+let start_time = ref 0.;; (* time at which the execution started *)
+let elapsed_time = ref 0.;;
+(* let maximal_weight = ref None;; *)
+let maximal_retained_equality = ref None;;
+
+(* equality-selection related globals *)
+let use_fullred = ref true;;
+let weight_age_ratio = ref (* 5 *) 4;; (* settable by the user *)
+let weight_age_counter = ref !weight_age_ratio;;
+let symbols_ratio = ref (* 0 *) 3;;
+let symbols_counter = ref 0;;
+
+(* non-recursive Knuth-Bendix term ordering by default *)
+Utils.compare_terms := Utils.nonrec_kbo;;
+(* Utils.compare_terms := Utils.ao;; *)
+
+(* statistics... *)
+let derived_clauses = ref 0;;
+let kept_clauses = ref 0;;
+
+(* index of the greatest Cic.Meta created - TODO: find a better way! *)
+let maxmeta = ref 0;;
+
+(* varbiables controlling the search-space *)
+let maxdepth = ref 3;;
+let maxwidth = ref 3;;
+
+
+type result =
+ | ParamodulationFailure
+ | ParamodulationSuccess of Inference.proof option * environment
+;;
+
+type goal = proof * Cic.metasenv * Cic.term;;
+
+type theorem = Cic.term * Cic.term * Cic.metasenv;;
+
+
+let symbols_of_equality ((_, _, (_, left, right, _), _, _) as equality) =
+ let m1 = symbols_of_term left in
+ let m =
+ TermMap.fold
+ (fun k v res ->
+ try
+ let c = TermMap.find k res in
+ TermMap.add k (c+v) res
+ with Not_found ->
+ TermMap.add k v res)
+ (symbols_of_term right) m1
+ in
+ m
+;;
+
+
+module OrderedEquality = struct
+ type t = Inference.equality
+
+ let compare eq1 eq2 =
+ match meta_convertibility_eq eq1 eq2 with
+ | true -> 0
+ | false ->
+ let w1, _, (ty, left, right, _), _, a = eq1
+ and w2, _, (ty', left', right', _), _, a' = eq2 in
+ match Pervasives.compare w1 w2 with
+ | 0 ->
+ let res = (List.length a) - (List.length a') in
+ if res <> 0 then res else (
+ try
+ let res = Pervasives.compare (List.hd a) (List.hd a') in
+ if res <> 0 then res else Pervasives.compare eq1 eq2
+ with Failure "hd" -> Pervasives.compare eq1 eq2
+ )
+ | res -> res
+end
+
+module EqualitySet = Set.Make(OrderedEquality);;
+
+
+(**
+ selects one equality from passive. The selection strategy is a combination
+ of weight, age and goal-similarity
+*)
+let select env goals passive (active, _) =
+ processed_clauses := !processed_clauses + 1;
+ let goal =
+ match (List.rev goals) with (_, goal::_)::_ -> goal | _ -> assert false
+ in
+ let (neg_list, neg_set), (pos_list, pos_set), passive_table = passive in
+ let remove eq l =
+ List.filter (fun e -> e <> eq) l
+ in
+ if !weight_age_ratio > 0 then
+ weight_age_counter := !weight_age_counter - 1;
+ match !weight_age_counter with
+ | 0 -> (
+ weight_age_counter := !weight_age_ratio;
+ match neg_list, pos_list with
+ | hd::tl, pos ->
+ (* Negatives aren't indexed, no need to remove them... *)
+ (Negative, hd),
+ ((tl, EqualitySet.remove hd neg_set), (pos, pos_set), passive_table)
+ | [], (hd:EqualitySet.elt)::tl ->
+ let passive_table =
+ Indexing.remove_index passive_table hd
+ in
+ (Positive, hd),
+ (([], neg_set), (tl, EqualitySet.remove hd pos_set), passive_table)
+ | _, _ -> assert false
+ )
+ | _ when (!symbols_counter > 0) && (EqualitySet.is_empty neg_set) -> (
+ symbols_counter := !symbols_counter - 1;
+ let cardinality map =
+ TermMap.fold (fun k v res -> res + v) map 0
+ in
+ let symbols =
+ let _, _, term = goal in
+ symbols_of_term term
+ in
+ let card = cardinality symbols in
+ let foldfun k v (r1, r2) =
+ if TermMap.mem k symbols then
+ let c = TermMap.find k symbols in
+ let c1 = abs (c - v) in
+ let c2 = v - c1 in
+ r1 + c2, r2 + c1
+ else
+ r1, r2 + v
+ in
+ let f equality (i, e) =
+ let common, others =
+ TermMap.fold foldfun (symbols_of_equality equality) (0, 0)
+ in
+ let c = others + (abs (common - card)) in
+ if c < i then (c, equality)
+ else (i, e)
+ in
+ let e1 = EqualitySet.min_elt pos_set in
+ let initial =
+ let common, others =
+ TermMap.fold foldfun (symbols_of_equality e1) (0, 0)
+ in
+ (others + (abs (common - card))), e1
+ in
+ let _, current = EqualitySet.fold f pos_set initial in
+ let passive_table =
+ Indexing.remove_index passive_table current
+ in
+ (Positive, current),
+ (([], neg_set),
+ (remove current pos_list, EqualitySet.remove current pos_set),
+ passive_table)
+ )
+ | _ ->
+ symbols_counter := !symbols_ratio;
+ let set_selection set = EqualitySet.min_elt set in
+ if EqualitySet.is_empty neg_set then
+ let current = set_selection pos_set in
+ let passive =
+ (neg_list, neg_set),
+ (remove current pos_list, EqualitySet.remove current pos_set),
+ Indexing.remove_index passive_table current
+ in
+ (Positive, current), passive
+ else
+ let current = set_selection neg_set in
+ let passive =
+ (remove current neg_list, EqualitySet.remove current neg_set),
+ (pos_list, pos_set),
+ passive_table
+ in
+ (Negative, current), passive
+;;
+
+
+(* initializes the passive set of equalities *)
+let make_passive neg pos =
+ let set_of equalities =
+ List.fold_left (fun s e -> EqualitySet.add e s) EqualitySet.empty equalities
+ in
+ let table =
+ List.fold_left (fun tbl e -> Indexing.index tbl e) Indexing.empty pos
+ in
+ (neg, set_of neg),
+ (pos, set_of pos),
+ table
+;;
+
+
+let make_active () =
+ [], Indexing.empty
+;;
+
+
+(* adds to passive a list of equalities: new_neg is a list of negative
+ equalities, new_pos a list of positive equalities *)
+let add_to_passive passive (new_neg, new_pos) =
+ let (neg_list, neg_set), (pos_list, pos_set), table = passive in
+ let ok set equality = not (EqualitySet.mem equality set) in
+ let neg = List.filter (ok neg_set) new_neg
+ and pos = List.filter (ok pos_set) new_pos in
+ let table =
+ List.fold_left (fun tbl e -> Indexing.index tbl e) table pos
+ in
+ let add set equalities =
+ List.fold_left (fun s e -> EqualitySet.add e s) set equalities
+ in
+ (neg @ neg_list, add neg_set neg),
+ (pos_list @ pos, add pos_set pos),
+ table
+;;
+
+
+let passive_is_empty = function
+ | ([], _), ([], _), _ -> true
+ | _ -> false
+;;
+
+
+let size_of_passive ((_, ns), (_, ps), _) =
+ (EqualitySet.cardinal ns) + (EqualitySet.cardinal ps)
+;;
+
+
+let size_of_active (active_list, _) =
+ List.length active_list
+;;
+
+
+(* removes from passive equalities that are estimated impossible to activate
+ within the current time limit *)
+let prune_passive howmany (active, _) passive =
+ let (nl, ns), (pl, ps), tbl = passive in
+ let howmany = float_of_int howmany
+ and ratio = float_of_int !weight_age_ratio in
+ let round v =
+ let t = ceil v in
+ int_of_float (if t -. v < 0.5 then t else v)
+ in
+ let in_weight = round (howmany *. ratio /. (ratio +. 1.))
+ and in_age = round (howmany /. (ratio +. 1.)) in
+ debug_print
+ (lazy (Printf.sprintf "in_weight: %d, in_age: %d\n" in_weight in_age));
+ let symbols, card =
+ match active with
+ | (Negative, e)::_ ->
+ let symbols = symbols_of_equality e in
+ let card = TermMap.fold (fun k v res -> res + v) symbols 0 in
+ Some symbols, card
+ | _ -> None, 0
+ in
+ let counter = ref !symbols_ratio in
+ let rec pickw w ns ps =
+ if w > 0 then
+ if not (EqualitySet.is_empty ns) then
+ let e = EqualitySet.min_elt ns in
+ let ns', ps = pickw (w-1) (EqualitySet.remove e ns) ps in
+ EqualitySet.add e ns', ps
+ else if !counter > 0 then
+ let _ =
+ counter := !counter - 1;
+ if !counter = 0 then counter := !symbols_ratio
+ in
+ match symbols with
+ | None ->
+ let e = EqualitySet.min_elt ps in
+ let ns, ps' = pickw (w-1) ns (EqualitySet.remove e ps) in
+ ns, EqualitySet.add e ps'
+ | Some symbols ->
+ let foldfun k v (r1, r2) =
+ if TermMap.mem k symbols then
+ let c = TermMap.find k symbols in
+ let c1 = abs (c - v) in
+ let c2 = v - c1 in
+ r1 + c2, r2 + c1
+ else
+ r1, r2 + v
+ in
+ let f equality (i, e) =
+ let common, others =
+ TermMap.fold foldfun (symbols_of_equality equality) (0, 0)
+ in
+ let c = others + (abs (common - card)) in
+ if c < i then (c, equality)
+ else (i, e)
+ in
+ let e1 = EqualitySet.min_elt ps in
+ let initial =
+ let common, others =
+ TermMap.fold foldfun (symbols_of_equality e1) (0, 0)
+ in
+ (others + (abs (common - card))), e1
+ in
+ let _, e = EqualitySet.fold f ps initial in
+ let ns, ps' = pickw (w-1) ns (EqualitySet.remove e ps) in
+ ns, EqualitySet.add e ps'
+ else
+ let e = EqualitySet.min_elt ps in
+ let ns, ps' = pickw (w-1) ns (EqualitySet.remove e ps) in
+ ns, EqualitySet.add e ps'
+ else
+ EqualitySet.empty, EqualitySet.empty
+ in
+ let ns, ps = pickw in_weight ns ps in
+ let rec picka w s l =
+ if w > 0 then
+ match l with
+ | [] -> w, s, []
+ | hd::tl when not (EqualitySet.mem hd s) ->
+ let w, s, l = picka (w-1) s tl in
+ w, EqualitySet.add hd s, hd::l
+ | hd::tl ->
+ let w, s, l = picka w s tl in
+ w, s, hd::l
+ else
+ 0, s, l
+ in
+ let in_age, ns, nl = picka in_age ns nl in
+ let _, ps, pl = picka in_age ps pl in
+ if not (EqualitySet.is_empty ps) then
+ maximal_retained_equality := Some (EqualitySet.max_elt ps);
+ let tbl =
+ EqualitySet.fold
+ (fun e tbl -> Indexing.index tbl e) ps Indexing.empty
+ in
+ (nl, ns), (pl, ps), tbl
+;;
+
+
+(** inference of new equalities between current and some in active *)
+let infer env sign current (active_list, active_table) =
+ let new_neg, new_pos =
+ match sign with
+ | Negative ->
+ let maxm, res =
+ Indexing.superposition_left !maxmeta env active_table current in
+ maxmeta := maxm;
+ res, []
+ | Positive ->
+ let maxm, res =
+ Indexing.superposition_right !maxmeta env active_table current in
+ maxmeta := maxm;
+ let rec infer_positive table = function
+ | [] -> [], []
+ | (Negative, equality)::tl ->
+ let maxm, res =
+ Indexing.superposition_left !maxmeta env table equality in
+ maxmeta := maxm;
+ let neg, pos = infer_positive table tl in
+ res @ neg, pos
+ | (Positive, equality)::tl ->
+ let maxm, res =
+ Indexing.superposition_right !maxmeta env table equality in
+ maxmeta := maxm;
+ let neg, pos = infer_positive table tl in
+ neg, res @ pos
+ in
+ let curr_table = Indexing.index Indexing.empty current in
+ let neg, pos = infer_positive curr_table active_list in
+ neg, res @ pos
+ in
+ derived_clauses := !derived_clauses + (List.length new_neg) +
+ (List.length new_pos);
+ match !maximal_retained_equality with
+ | None -> new_neg, new_pos
+ | Some eq ->
+ (* if we have a maximal_retained_equality, we can discard all equalities
+ "greater" than it, as they will never be reached... An equality is
+ greater than maximal_retained_equality if it is bigger
+ wrt. OrderedEquality.compare and it is less similar than
+ maximal_retained_equality to the current goal *)
+ let symbols, card =
+ match active_list with
+ | (Negative, e)::_ ->
+ let symbols = symbols_of_equality e in
+ let card = TermMap.fold (fun k v res -> res + v) symbols 0 in
+ Some symbols, card
+ | _ -> None, 0
+ in
+ let new_pos =
+ match symbols with
+ | None ->
+ List.filter (fun e -> OrderedEquality.compare e eq <= 0) new_pos
+ | Some symbols ->
+ let filterfun e =
+ if OrderedEquality.compare e eq <= 0 then
+ true
+ else
+ let foldfun k v (r1, r2) =
+ if TermMap.mem k symbols then
+ let c = TermMap.find k symbols in
+ let c1 = abs (c - v) in
+ let c2 = v - c1 in
+ r1 + c2, r2 + c1
+ else
+ r1, r2 + v
+ in
+ let initial =
+ let common, others =
+ TermMap.fold foldfun (symbols_of_equality eq) (0, 0) in
+ others + (abs (common - card))
+ in
+ let common, others =
+ TermMap.fold foldfun (symbols_of_equality e) (0, 0) in
+ let c = others + (abs (common - card)) in
+ if c < initial then true else false
+ in
+ List.filter filterfun new_pos
+ in
+ new_neg, new_pos
+;;
+
+
+let contains_empty env (negative, positive) =
+ let metasenv, context, ugraph = env in
+ try
+ let found =
+ List.find
+ (fun (w, proof, (ty, left, right, ordering), m, a) ->
+ fst (CicReduction.are_convertible context left right ugraph))
+ negative
+ in
+ true, Some found
+ with Not_found ->
+ false, None
+;;
+
+
+(** simplifies current using active and passive *)
+let forward_simplify env (sign, current) ?passive (active_list, active_table) =
+ let pl, passive_table =
+ match passive with
+ | None -> [], None
+ | Some ((pn, _), (pp, _), pt) ->
+ let pn = List.map (fun e -> (Negative, e)) pn
+ and pp = List.map (fun e -> (Positive, e)) pp in
+ pn @ pp, Some pt
+ in
+ let all = if pl = [] then active_list else active_list @ pl in
+
+ let demodulate table current =
+ let newmeta, newcurrent =
+ Indexing.demodulation_equality !maxmeta env table sign current in
+ maxmeta := newmeta;
+ if is_identity env newcurrent then
+ if sign = Negative then Some (sign, newcurrent)
+ else (
+(* debug_print *)
+(* (lazy *)
+(* (Printf.sprintf "\ncurrent was: %s\nnewcurrent is: %s\n" *)
+(* (string_of_equality current) *)
+(* (string_of_equality newcurrent))); *)
+(* debug_print *)
+(* (lazy *)
+(* (Printf.sprintf "active is: %s" *)
+(* (String.concat "\n" *)
+(* (List.map (fun (_, e) -> (string_of_equality e)) active_list)))); *)
+ None
+ )
+ else
+ Some (sign, newcurrent)
+ in
+ let res =
+ let res = demodulate active_table current in
+ match res with
+ | None -> None
+ | Some (sign, newcurrent) ->
+ match passive_table with
+ | None -> res
+ | Some passive_table -> demodulate passive_table newcurrent
+ in
+ match res with
+ | None -> None
+ | Some (Negative, c) ->
+ let ok = not (
+ List.exists
+ (fun (s, eq) -> s = Negative && meta_convertibility_eq eq c)
+ all)
+ in
+ if ok then res else None
+ | Some (Positive, c) ->
+ if Indexing.in_index active_table c then
+ None
+ else
+ match passive_table with
+ | None ->
+ if fst (Indexing.subsumption env active_table c) then
+ None
+ else
+ res
+ | Some passive_table ->
+ if Indexing.in_index passive_table c then None
+ else
+ let r1, _ = Indexing.subsumption env active_table c in
+ if r1 then None else
+ let r2, _ = Indexing.subsumption env passive_table c in
+ if r2 then None else res
+;;
+
+type fs_time_info_t = {
+ mutable build_all: float;
+ mutable demodulate: float;
+ mutable subsumption: float;
+};;
+
+let fs_time_info = { build_all = 0.; demodulate = 0.; subsumption = 0. };;
+
+
+(** simplifies new using active and passive *)
+let forward_simplify_new env (new_neg, new_pos) ?passive active =
+ let t1 = Unix.gettimeofday () in
+
+ let active_list, active_table = active in
+ let pl, passive_table =
+ match passive with
+ | None -> [], None
+ | Some ((pn, _), (pp, _), pt) ->
+ let pn = List.map (fun e -> (Negative, e)) pn
+ and pp = List.map (fun e -> (Positive, e)) pp in
+ pn @ pp, Some pt
+ in
+ let all = active_list @ pl in
+
+ let t2 = Unix.gettimeofday () in
+ fs_time_info.build_all <- fs_time_info.build_all +. (t2 -. t1);
+
+ let demodulate sign table target =
+ let newmeta, newtarget =
+ Indexing.demodulation_equality !maxmeta env table sign target in
+ maxmeta := newmeta;
+ newtarget
+ in
+ let t1 = Unix.gettimeofday () in
+
+ let new_neg, new_pos =
+ let new_neg = List.map (demodulate Negative active_table) new_neg
+ and new_pos = List.map (demodulate Positive active_table) new_pos in
+ match passive_table with
+ | None -> new_neg, new_pos
+ | Some passive_table ->
+ List.map (demodulate Negative passive_table) new_neg,
+ List.map (demodulate Positive passive_table) new_pos
+ in
+
+ let t2 = Unix.gettimeofday () in
+ fs_time_info.demodulate <- fs_time_info.demodulate +. (t2 -. t1);
+
+ let new_pos_set =
+ List.fold_left
+ (fun s e ->
+ if not (Inference.is_identity env e) then
+ if EqualitySet.mem e s then s
+ else EqualitySet.add e s
+ else s)
+ EqualitySet.empty new_pos
+ in
+ let new_pos = EqualitySet.elements new_pos_set in
+
+ let subs =
+ match passive_table with
+ | None ->
+ (fun e -> not (fst (Indexing.subsumption env active_table e)))
+ | Some passive_table ->
+ (fun e -> not ((fst (Indexing.subsumption env active_table e)) ||
+ (fst (Indexing.subsumption env passive_table e))))
+ in
+(* let t1 = Unix.gettimeofday () in *)
+(* let t2 = Unix.gettimeofday () in *)
+(* fs_time_info.subsumption <- fs_time_info.subsumption +. (t2 -. t1); *)
+ let is_duplicate =
+ match passive_table with
+ | None ->
+ (fun e -> not (Indexing.in_index active_table e))
+ | Some passive_table ->
+ (fun e ->
+ not ((Indexing.in_index active_table e) ||
+ (Indexing.in_index passive_table e)))
+ in
+ new_neg, List.filter subs (List.filter is_duplicate new_pos)
+;;
+
+
+(** simplifies active usign new *)
+let backward_simplify_active env new_pos new_table min_weight active =
+ let active_list, active_table = active in
+ let active_list, newa =
+ List.fold_right
+ (fun (s, equality) (res, newn) ->
+ let ew, _, _, _, _ = equality in
+ if ew < min_weight then
+ (s, equality)::res, newn
+ else
+ match forward_simplify env (s, equality) (new_pos, new_table) with
+ | None -> res, newn
+ | Some (s, e) ->
+ if equality = e then
+ (s, e)::res, newn
+ else
+ res, (s, e)::newn)
+ active_list ([], [])
+ in
+ let find eq1 where =
+ List.exists (fun (s, e) -> meta_convertibility_eq eq1 e) where
+ in
+ let active, newa =
+ List.fold_right
+ (fun (s, eq) (res, tbl) ->
+ if List.mem (s, eq) res then
+ res, tbl
+ else if (is_identity env eq) || (find eq res) then (
+ res, tbl
+ )
+ else
+ (s, eq)::res, if s = Negative then tbl else Indexing.index tbl eq)
+ active_list ([], Indexing.empty),
+ List.fold_right
+ (fun (s, eq) (n, p) ->
+ if (s <> Negative) && (is_identity env eq) then (
+ (n, p)
+ ) else
+ if s = Negative then eq::n, p
+ else n, eq::p)
+ newa ([], [])
+ in
+ match newa with
+ | [], [] -> active, None
+ | _ -> active, Some newa
+;;
+
+
+(** simplifies passive using new *)
+let backward_simplify_passive env new_pos new_table min_weight passive =
+ let (nl, ns), (pl, ps), passive_table = passive in
+ let f sign equality (resl, ress, newn) =
+ let ew, _, _, _, _ = equality in
+ if ew < min_weight then
+ equality::resl, ress, newn
+ else
+ match forward_simplify env (sign, equality) (new_pos, new_table) with
+ | None -> resl, EqualitySet.remove equality ress, newn
+ | Some (s, e) ->
+ if equality = e then
+ equality::resl, ress, newn
+ else
+ let ress = EqualitySet.remove equality ress in
+ resl, ress, e::newn
+ in
+ let nl, ns, newn = List.fold_right (f Negative) nl ([], ns, [])
+ and pl, ps, newp = List.fold_right (f Positive) pl ([], ps, []) in
+ let passive_table =
+ List.fold_left
+ (fun tbl e -> Indexing.index tbl e) Indexing.empty pl
+ in
+ match newn, newp with
+ | [], [] -> ((nl, ns), (pl, ps), passive_table), None
+ | _, _ -> ((nl, ns), (pl, ps), passive_table), Some (newn, newp)
+;;
+
+
+let backward_simplify env new' ?passive active =
+ let new_pos, new_table, min_weight =
+ List.fold_left
+ (fun (l, t, w) e ->
+ let ew, _, _, _, _ = e in
+ (Positive, e)::l, Indexing.index t e, min ew w)
+ ([], Indexing.empty, 1000000) (snd new')
+ in
+ let active, newa =
+ backward_simplify_active env new_pos new_table min_weight active in
+ match passive with
+ | None ->
+ active, (make_passive [] []), newa, None
+ | Some passive ->
+ let passive, newp =
+ backward_simplify_passive env new_pos new_table min_weight passive in
+ active, passive, newa, newp
+;;
+
+
+(* returns an estimation of how many equalities in passive can be activated
+ within the current time limit *)
+let get_selection_estimate () =
+ elapsed_time := (Unix.gettimeofday ()) -. !start_time;
+ (* !processed_clauses * (int_of_float (!time_limit /. !elapsed_time)) *)
+ int_of_float (
+ ceil ((float_of_int !processed_clauses) *.
+ ((!time_limit (* *. 2. *)) /. !elapsed_time -. 1.)))
+;;
+
+
+(** initializes the set of goals *)
+let make_goals goal =
+ let active = []
+ and passive = [0, [goal]] in
+ active, passive
+;;
+
+
+(** initializes the set of theorems *)
+let make_theorems theorems =
+ theorems, []
+;;
+
+
+let activate_goal (active, passive) =
+ match passive with
+ | goal_conj::tl -> true, (goal_conj::active, tl)
+ | [] -> false, (active, passive)
+;;
+
+
+let activate_theorem (active, passive) =
+ match passive with
+ | theorem::tl -> true, (theorem::active, tl)
+ | [] -> false, (active, passive)
+;;
+
+
+(** simplifies a goal with equalities in active and passive *)
+let simplify_goal env goal ?passive (active_list, active_table) =
+ let pl, passive_table =
+ match passive with
+ | None -> [], None
+ | Some ((pn, _), (pp, _), pt) ->
+ let pn = List.map (fun e -> (Negative, e)) pn
+ and pp = List.map (fun e -> (Positive, e)) pp in
+ pn @ pp, Some pt
+ in
+ let all = if pl = [] then active_list else active_list @ pl in
+
+ let demodulate table goal =
+ let newmeta, newgoal =
+ Indexing.demodulation_goal !maxmeta env table goal in
+ maxmeta := newmeta;
+ goal != newgoal, newgoal
+ in
+ let changed, goal =
+ match passive_table with
+ | None -> demodulate active_table goal
+ | Some passive_table ->
+ let changed, goal = demodulate active_table goal in
+ let changed', goal = demodulate passive_table goal in
+ (changed || changed'), goal
+ in
+ changed, goal
+;;
+
+
+let simplify_goals env goals ?passive active =
+ let a_goals, p_goals = goals in
+ let p_goals =
+ List.map
+ (fun (d, gl) ->
+ let gl =
+ List.map (fun g -> snd (simplify_goal env g ?passive active)) gl in
+ d, gl)
+ p_goals
+ in
+ let goals =
+ List.fold_left
+ (fun (a, p) (d, gl) ->
+ let changed = ref false in
+ let gl =
+ List.map
+ (fun g ->
+ let c, g = simplify_goal env g ?passive active in
+ changed := !changed || c; g) gl in
+ if !changed then (a, (d, gl)::p) else ((d, gl)::a, p))
+ ([], p_goals) a_goals
+ in
+ goals
+;;
+
+
+let simplify_theorems env theorems ?passive (active_list, active_table) =
+ let pl, passive_table =
+ match passive with
+ | None -> [], None
+ | Some ((pn, _), (pp, _), pt) ->
+ let pn = List.map (fun e -> (Negative, e)) pn
+ and pp = List.map (fun e -> (Positive, e)) pp in
+ pn @ pp, Some pt
+ in
+ let all = if pl = [] then active_list else active_list @ pl in
+ let a_theorems, p_theorems = theorems in
+ let demodulate table theorem =
+ let newmeta, newthm =
+ Indexing.demodulation_theorem !maxmeta env table theorem in
+ maxmeta := newmeta;
+ theorem != newthm, newthm
+ in
+ let foldfun table (a, p) theorem =
+ let changed, theorem = demodulate table theorem in
+ if changed then (a, theorem::p) else (theorem::a, p)
+ in
+ let mapfun table theorem = snd (demodulate table theorem) in
+ match passive_table with
+ | None ->
+ let p_theorems = List.map (mapfun active_table) p_theorems in
+ List.fold_left (foldfun active_table) ([], p_theorems) a_theorems
+ | Some passive_table ->
+ let p_theorems = List.map (mapfun active_table) p_theorems in
+ let p_theorems, a_theorems =
+ List.fold_left (foldfun active_table) ([], p_theorems) a_theorems in
+ let p_theorems = List.map (mapfun passive_table) p_theorems in
+ List.fold_left (foldfun passive_table) ([], p_theorems) a_theorems
+;;
+
+
+(* applies equality to goal to see if the goal can be closed *)
+let apply_equality_to_goal env equality goal =
+ let module C = Cic in
+ let module HL = HelmLibraryObjects in
+ let module I = Inference in
+ let metasenv, context, ugraph = env in
+ let _, proof, (ty, left, right, _), metas, args = equality in
+ let eqterm =
+ C.Appl [C.MutInd (LibraryObjects.eq_URI (), 0, []); ty; left; right] in
+ let gproof, gmetas, gterm = goal in
+(* debug_print *)
+(* (lazy *)
+(* (Printf.sprintf "APPLY EQUALITY TO GOAL: %s, %s" *)
+(* (string_of_equality equality) (CicPp.ppterm gterm))); *)
+ try
+ let subst, metasenv', _ =
+ let menv = metasenv @ metas @ gmetas in
+ Inference.unification menv context eqterm gterm ugraph
+ in
+ let newproof =
+ match proof with
+ | I.BasicProof t -> I.BasicProof (CicMetaSubst.apply_subst subst t)
+ | I.ProofBlock (s, uri, nt, t, pe, p) ->
+ I.ProofBlock (subst @ s, uri, nt, t, pe, p)
+ | _ -> assert false
+ in
+ let newgproof =
+ let rec repl = function
+ | I.ProofGoalBlock (_, gp) -> I.ProofGoalBlock (newproof, gp)
+ | I.NoProof -> newproof
+ | I.BasicProof p -> newproof
+ | I.SubProof (t, i, p) -> I.SubProof (t, i, repl p)
+ | _ -> assert false
+ in
+ repl gproof
+ in
+ true, subst, newgproof
+ with CicUnification.UnificationFailure _ ->
+ false, [], I.NoProof
+;;
+
+
+
+let new_meta metasenv =
+ let m = CicMkImplicit.new_meta metasenv [] in
+ incr maxmeta;
+ while !maxmeta <= m do incr maxmeta done;
+ !maxmeta
+;;
+
+
+(* applies a theorem or an equality to goal, returning a list of subgoals or
+ an indication of failure *)
+let apply_to_goal env theorems ?passive active goal =
+ let metasenv, context, ugraph = env in
+ let proof, metas, term = goal in
+ (* debug_print *)
+ (* (lazy *)
+ (* (Printf.sprintf "apply_to_goal with goal: %s" *)
+ (* (\* (string_of_proof proof) *\)(CicPp.ppterm term))); *)
+ let status =
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context in
+ let proof', newmeta =
+ let rec get_meta = function
+ | SubProof (t, i, p) ->
+ let t', i' = get_meta p in
+ if i' = -1 then t, i else t', i'
+ | ProofGoalBlock (_, p) -> get_meta p
+ | _ -> Cic.Implicit None, -1
+ in
+ let p, m = get_meta proof in
+ if m = -1 then
+ let n = new_meta (metasenv @ metas) in
+ Cic.Meta (n, irl), n
+ else
+ p, m
+ in
+ let metasenv = (newmeta, context, term)::metasenv @ metas in
+ let bit = new_meta metasenv, context, term in
+ let metasenv' = bit::metasenv in
+ ((None, metasenv', Cic.Meta (newmeta, irl), term), newmeta)
+ in
+ let rec aux = function
+ | [] -> `No
+ | (theorem, thmty, _)::tl ->
+ try
+ let subst, (newproof, newgoals) =
+ PrimitiveTactics.apply_tac_verbose_with_subst ~term:theorem status
+ in
+ if newgoals = [] then
+ let _, _, p, _ = newproof in
+ let newp =
+ let rec repl = function
+ | Inference.ProofGoalBlock (_, gp) ->
+ Inference.ProofGoalBlock (Inference.BasicProof p, gp)
+ | Inference.NoProof -> Inference.BasicProof p
+ | Inference.BasicProof _ -> Inference.BasicProof p
+ | Inference.SubProof (t, i, p2) ->
+ Inference.SubProof (t, i, repl p2)
+ | _ -> assert false
+ in
+ repl proof
+ in
+ let _, m = status in
+ let subst = List.filter (fun (i, _) -> i = m) subst in
+ `Ok (subst, [newp, metas, term])
+ else
+ let _, menv, p, _ = newproof in
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context
+ in
+ let goals =
+ List.map
+ (fun i ->
+ let _, _, ty = CicUtil.lookup_meta i menv in
+ let p' =
+ let rec gp = function
+ | SubProof (t, i, p) ->
+ SubProof (t, i, gp p)
+ | ProofGoalBlock (sp1, sp2) ->
+ ProofGoalBlock (sp1, gp sp2)
+ | BasicProof _
+ | NoProof ->
+ SubProof (p, i, BasicProof (Cic.Meta (i, irl)))
+ | ProofSymBlock (s, sp) ->
+ ProofSymBlock (s, gp sp)
+ | ProofBlock (s, u, nt, t, pe, sp) ->
+ ProofBlock (s, u, nt, t, pe, gp sp)
+ in gp proof
+ in
+ (p', menv, ty))
+ newgoals
+ in
+ let goals =
+ let weight t =
+ let w, m = weight_of_term t in
+ w + 2 * (List.length m)
+ in
+ List.sort
+ (fun (_, _, t1) (_, _, t2) ->
+ Pervasives.compare (weight t1) (weight t2))
+ goals
+ in
+ let best = aux tl in
+ match best with
+ | `Ok (_, _) -> best
+ | `No -> `GoOn ([subst, goals])
+ | `GoOn sl -> `GoOn ((subst, goals)::sl)
+ with ProofEngineTypes.Fail msg ->
+ aux tl
+ in
+ let r, s, l =
+ if Inference.term_is_equality term then
+ let rec appleq_a = function
+ | [] -> false, [], []
+ | (Positive, equality)::tl ->
+ let ok, s, newproof = apply_equality_to_goal env equality goal in
+ if ok then true, s, [newproof, metas, term] else appleq_a tl
+ | _::tl -> appleq_a tl
+ in
+ let rec appleq_p = function
+ | [] -> false, [], []
+ | equality::tl ->
+ let ok, s, newproof = apply_equality_to_goal env equality goal in
+ if ok then true, s, [newproof, metas, term] else appleq_p tl
+ in
+ let al, _ = active in
+ match passive with
+ | None -> appleq_a al
+ | Some (_, (pl, _), _) ->
+ let r, s, l = appleq_a al in if r then r, s, l else appleq_p pl
+ else
+ false, [], []
+ in
+ if r = true then `Ok (s, l) else aux theorems
+;;
+
+
+(* sorts a conjunction of goals in order to detect earlier if it is
+ unsatisfiable. Non-predicate goals are placed at the end of the list *)
+let sort_goal_conj (metasenv, context, ugraph) (depth, gl) =
+ let gl =
+ List.stable_sort
+ (fun (_, e1, g1) (_, e2, g2) ->
+ let ty1, _ =
+ CicTypeChecker.type_of_aux' (e1 @ metasenv) context g1 ugraph
+ and ty2, _ =
+ CicTypeChecker.type_of_aux' (e2 @ metasenv) context g2 ugraph
+ in
+ let prop1 =
+ let b, _ =
+ CicReduction.are_convertible context (Cic.Sort Cic.Prop) ty1 ugraph
+ in
+ if b then 0 else 1
+ and prop2 =
+ let b, _ =
+ CicReduction.are_convertible context (Cic.Sort Cic.Prop) ty2 ugraph
+ in
+ if b then 0 else 1
+ in
+ if prop1 = 0 && prop2 = 0 then
+ let e1 = if Inference.term_is_equality g1 then 0 else 1
+ and e2 = if Inference.term_is_equality g2 then 0 else 1 in
+ e1 - e2
+ else
+ prop1 - prop2)
+ gl
+ in
+ (depth, gl)
+;;
+
+
+let is_meta_closed goals =
+ List.for_all (fun (_, _, g) -> CicUtil.is_meta_closed g) goals
+;;
+
+
+(* applies a series of theorems/equalities to a conjunction of goals *)
+let rec apply_to_goal_conj env theorems ?passive active (depth, goals) =
+ let aux (goal, r) tl =
+ let propagate_subst subst (proof, metas, term) =
+ let rec repl = function
+ | NoProof -> NoProof
+ | BasicProof t ->
+ BasicProof (CicMetaSubst.apply_subst subst t)
+ | ProofGoalBlock (p, pb) ->
+ let pb' = repl pb in
+ ProofGoalBlock (p, pb')
+ | SubProof (t, i, p) ->
+ let t' = CicMetaSubst.apply_subst subst t in
+ let p = repl p in
+ SubProof (t', i, p)
+ | ProofSymBlock (ens, p) -> ProofSymBlock (ens, repl p)
+ | ProofBlock (s, u, nty, t, pe, p) ->
+ ProofBlock (subst @ s, u, nty, t, pe, p)
+ in (repl proof, metas, term)
+ in
+ (* let r = apply_to_goal env theorems ?passive active goal in *) (
+ match r with
+ | `No -> `No (depth, goals)
+ | `GoOn sl ->
+ let l =
+ List.map
+ (fun (s, gl) ->
+ let tl = List.map (propagate_subst s) tl in
+ sort_goal_conj env (depth+1, gl @ tl)) sl
+ in
+ `GoOn l
+ | `Ok (subst, gl) ->
+ if tl = [] then
+ `Ok (depth, gl)
+ else
+ let p, _, _ = List.hd gl in
+ let subproof =
+ let rec repl = function
+ | SubProof (_, _, p) -> repl p
+ | ProofGoalBlock (p1, p2) ->
+ ProofGoalBlock (repl p1, repl p2)
+ | p -> p
+ in
+ build_proof_term (repl p)
+ in
+ let i =
+ let rec get_meta = function
+ | SubProof (_, i, p) ->
+ let i' = get_meta p in
+ if i' = -1 then i else i'
+(* max i (get_meta p) *)
+ | ProofGoalBlock (_, p) -> get_meta p
+ | _ -> -1
+ in
+ get_meta p
+ in
+ let subst =
+ let _, (context, _, _) = List.hd subst in
+ [i, (context, subproof, Cic.Implicit None)]
+ in
+ let tl = List.map (propagate_subst subst) tl in
+ let conj = sort_goal_conj env (depth(* +1 *), tl) in
+ `GoOn ([conj])
+ )
+ in
+ if depth > !maxdepth || (List.length goals) > !maxwidth then
+ `No (depth, goals)
+ else
+ let rec search_best res = function
+ | [] -> res
+ | goal::tl ->
+ let r = apply_to_goal env theorems ?passive active goal in
+ match r with
+ | `Ok _ -> (goal, r)
+ | `No -> search_best res tl
+ | `GoOn l ->
+ let newres =
+ match res with
+ | _, `Ok _ -> assert false
+ | _, `No -> goal, r
+ | _, `GoOn l2 ->
+ if (List.length l) < (List.length l2) then goal, r else res
+ in
+ search_best newres tl
+ in
+ let hd = List.hd goals in
+ let res = hd, (apply_to_goal env theorems ?passive active hd) in
+ let best =
+ match res with
+ | _, `Ok _ -> res
+ | _, _ -> search_best res (List.tl goals)
+ in
+ let res = aux best (List.filter (fun g -> g != (fst best)) goals) in
+ match res with
+ | `GoOn ([conj]) when is_meta_closed (snd conj) &&
+ (List.length (snd conj)) < (List.length goals)->
+ apply_to_goal_conj env theorems ?passive active conj
+ | _ -> res
+;;
+
+
+(*
+module OrderedGoals = struct
+ type t = int * (Inference.proof * Cic.metasenv * Cic.term) list
+
+ let compare g1 g2 =
+ let d1, l1 = g1
+ and d2, l2 = g2 in
+ let r = d2 - d1 in
+ if r <> 0 then r
+ else let r = (List.length l1) - (List.length l2) in
+ if r <> 0 then r
+ else
+ let res = ref 0 in
+ let _ =
+ List.exists2
+ (fun (_, _, t1) (_, _, t2) ->
+ let r = Pervasives.compare t1 t2 in
+ if r <> 0 then (
+ res := r;
+ true
+ ) else
+ false) l1 l2
+ in !res
+end
+
+module GoalsSet = Set.Make(OrderedGoals);;
+
+
+exception SearchSpaceOver;;
+*)
+
+
+(*
+let apply_to_goals env is_passive_empty theorems active goals =
+ debug_print (lazy "\n\n\tapply_to_goals\n\n");
+ let add_to set goals =
+ List.fold_left (fun s g -> GoalsSet.add g s) set goals
+ in
+ let rec aux set = function
+ | [] ->
+ debug_print (lazy "HERE!!!");
+ if is_passive_empty then raise SearchSpaceOver else false, set
+ | goals::tl ->
+ let res = apply_to_goal_conj env theorems active goals in
+ match res with
+ | `Ok newgoals ->
+ let _ =
+ let d, p, t =
+ match newgoals with
+ | (d, (p, _, t)::_) -> d, p, t
+ | _ -> assert false
+ in
+ debug_print
+ (lazy
+ (Printf.sprintf "\nOK!!!!\ndepth: %d\nProof: %s\ngoal: %s\n"
+ d (string_of_proof p) (CicPp.ppterm t)))
+ in
+ true, GoalsSet.singleton newgoals
+ | `GoOn newgoals ->
+ let set' = add_to set (goals::tl) in
+ let set' = add_to set' newgoals in
+ false, set'
+ | `No newgoals ->
+ aux set tl
+ in
+ let n = List.length goals in
+ let res, goals = aux (add_to GoalsSet.empty goals) goals in
+ let goals = GoalsSet.elements goals in
+ debug_print (lazy "\n\tapply_to_goals end\n");
+ let m = List.length goals in
+ if m = n && is_passive_empty then
+ raise SearchSpaceOver
+ else
+ res, goals
+;;
+*)
+
+
+(* sorts the list of passive goals to minimize the search for a proof (doesn't
+ work that well yet...) *)
+let sort_passive_goals goals =
+ List.stable_sort
+ (fun (d1, l1) (d2, l2) ->
+ let r1 = d2 - d1
+ and r2 = (List.length l1) - (List.length l2) in
+ let foldfun ht (_, _, t) =
+ let _ = List.map (fun i -> Hashtbl.replace ht i 1) (metas_of_term t)
+ in ht
+ in
+ let m1 = Hashtbl.length (List.fold_left foldfun (Hashtbl.create 3) l1)
+ and m2 = Hashtbl.length (List.fold_left foldfun (Hashtbl.create 3) l2)
+ in let r3 = m1 - m2 in
+ if r3 <> 0 then r3
+ else if r2 <> 0 then r2
+ else r1)
+ (* let _, _, g1 = List.hd l1 *)
+(* and _, _, g2 = List.hd l2 in *)
+(* let e1 = if Inference.term_is_equality g1 then 0 else 1 *)
+(* and e2 = if Inference.term_is_equality g2 then 0 else 1 *)
+(* in let r4 = e1 - e2 in *)
+(* if r4 <> 0 then r3 else r1) *)
+ goals
+;;
+
+
+let print_goals goals =
+ (String.concat "\n"
+ (List.map
+ (fun (d, gl) ->
+ let gl' =
+ List.map
+ (fun (p, _, t) ->
+ (* (string_of_proof p) ^ ", " ^ *) (CicPp.ppterm t)) gl
+ in
+ Printf.sprintf "%d: %s" d (String.concat "; " gl')) goals))
+;;
+
+
+(* tries to prove the first conjunction in goals with applications of
+ theorems/equalities, returning new sub-goals or an indication of success *)
+let apply_goal_to_theorems dbd env theorems ?passive active goals =
+ let theorems, _ = theorems in
+ let a_goals, p_goals = goals in
+ let goal = List.hd a_goals in
+ let not_in_active gl =
+ not
+ (List.exists
+ (fun (_, gl') ->
+ if (List.length gl) = (List.length gl') then
+ List.for_all2 (fun (_, _, g1) (_, _, g2) -> g1 = g2) gl gl'
+ else
+ false)
+ a_goals)
+ in
+ let aux theorems =
+ let res = apply_to_goal_conj env theorems ?passive active goal in
+ match res with
+ | `Ok newgoals ->
+ true, ([newgoals], [])
+ | `No _ ->
+ false, (a_goals, p_goals)
+ | `GoOn newgoals ->
+ let newgoals =
+ List.filter
+ (fun (d, gl) ->
+ (d <= !maxdepth) && (List.length gl) <= !maxwidth &&
+ not_in_active gl)
+ newgoals in
+ let p_goals = newgoals @ p_goals in
+ let p_goals = sort_passive_goals p_goals in
+ false, (a_goals, p_goals)
+ in
+ aux theorems
+;;
+
+
+let apply_theorem_to_goals env theorems active goals =
+ let a_goals, p_goals = goals in
+ let theorem = List.hd (fst theorems) in
+ let theorems = [theorem] in
+ let rec aux p = function
+ | [] -> false, ([], p)
+ | goal::tl ->
+ let res = apply_to_goal_conj env theorems active goal in
+ match res with
+ | `Ok newgoals -> true, ([newgoals], [])
+ | `No _ -> aux p tl
+ | `GoOn newgoals -> aux (newgoals @ p) tl
+ in
+ let ok, (a, p) = aux p_goals a_goals in
+ if ok then
+ ok, (a, p)
+ else
+ let p_goals =
+ List.stable_sort
+ (fun (d1, l1) (d2, l2) ->
+ let r = d2 - d1 in
+ if r <> 0 then r
+ else let r = (List.length l1) - (List.length l2) in
+ if r <> 0 then r
+ else
+ let res = ref 0 in
+ let _ =
+ List.exists2
+ (fun (_, _, t1) (_, _, t2) ->
+ let r = Pervasives.compare t1 t2 in
+ if r <> 0 then (res := r; true) else false) l1 l2
+ in !res)
+ p
+ in
+ ok, (a_goals, p_goals)
+;;
+
+
+(* given-clause algorithm with lazy reduction strategy *)
+let rec given_clause dbd env goals theorems passive active =
+ let goals = simplify_goals env goals active in
+ let ok, goals = activate_goal goals in
+ (* let theorems = simplify_theorems env theorems active in *)
+ if ok then
+ let ok, goals = apply_goal_to_theorems dbd env theorems active goals in
+ if ok then
+ let proof =
+ match (fst goals) with
+ | (_, [proof, _, _])::_ -> Some proof
+ | _ -> assert false
+ in
+ ParamodulationSuccess (proof, env)
+ else
+ given_clause_aux dbd env goals theorems passive active
+ else
+(* let ok', theorems = activate_theorem theorems in *)
+ let ok', theorems = false, theorems in
+ if ok' then
+ let ok, goals = apply_theorem_to_goals env theorems active goals in
+ if ok then
+ let proof =
+ match (fst goals) with
+ | (_, [proof, _, _])::_ -> Some proof
+ | _ -> assert false
+ in
+ ParamodulationSuccess (proof, env)
+ else
+ given_clause_aux dbd env goals theorems passive active
+ else
+ if (passive_is_empty passive) then ParamodulationFailure
+ else given_clause_aux dbd env goals theorems passive active
+
+and given_clause_aux dbd env goals theorems passive active =
+ let time1 = Unix.gettimeofday () in
+
+ let selection_estimate = get_selection_estimate () in
+ let kept = size_of_passive passive in
+ let passive =
+ if !time_limit = 0. || !processed_clauses = 0 then
+ passive
+ else if !elapsed_time > !time_limit then (
+ debug_print (lazy (Printf.sprintf "Time limit (%.2f) reached: %.2f\n"
+ !time_limit !elapsed_time));
+ make_passive [] []
+ ) else if kept > selection_estimate then (
+ debug_print
+ (lazy (Printf.sprintf ("Too many passive equalities: pruning..." ^^
+ "(kept: %d, selection_estimate: %d)\n")
+ kept selection_estimate));
+ prune_passive selection_estimate active passive
+ ) else
+ passive
+ in
+
+ let time2 = Unix.gettimeofday () in
+ passive_maintainance_time := !passive_maintainance_time +. (time2 -. time1);
+
+ kept_clauses := (size_of_passive passive) + (size_of_active active);
+ match passive_is_empty passive with
+ | true -> (* ParamodulationFailure *)
+ given_clause dbd env goals theorems passive active
+ | false ->
+ let (sign, current), passive = select env (fst goals) passive active in
+ let time1 = Unix.gettimeofday () in
+ let res = forward_simplify env (sign, current) ~passive active in
+ let time2 = Unix.gettimeofday () in
+ forward_simpl_time := !forward_simpl_time +. (time2 -. time1);
+ match res with
+ | None ->
+ given_clause dbd env goals theorems passive active
+ | Some (sign, current) ->
+ if (sign = Negative) && (is_identity env current) then (
+ debug_print
+ (lazy (Printf.sprintf "OK!!! %s %s" (string_of_sign sign)
+ (string_of_equality ~env current)));
+ let _, proof, _, _, _ = current in
+ ParamodulationSuccess (Some proof, env)
+ ) else (
+ debug_print
+ (lazy "\n================================================");
+ debug_print (lazy (Printf.sprintf "selected: %s %s"
+ (string_of_sign sign)
+ (string_of_equality ~env current)));
+
+ let t1 = Unix.gettimeofday () in
+ let new' = infer env sign current active in
+ let t2 = Unix.gettimeofday () in
+ infer_time := !infer_time +. (t2 -. t1);
+
+ let res, goal' = contains_empty env new' in
+ if res then
+ let proof =
+ match goal' with
+ | Some goal -> let _, proof, _, _, _ = goal in Some proof
+ | None -> None
+ in
+ ParamodulationSuccess (proof, env)
+ else
+ let t1 = Unix.gettimeofday () in
+ let new' = forward_simplify_new env new' active in
+ let t2 = Unix.gettimeofday () in
+ let _ =
+ forward_simpl_new_time :=
+ !forward_simpl_new_time +. (t2 -. t1)
+ in
+ let active =
+ match sign with
+ | Negative -> active
+ | Positive ->
+ let t1 = Unix.gettimeofday () in
+ let active, _, newa, _ =
+ backward_simplify env ([], [current]) active
+ in
+ let t2 = Unix.gettimeofday () in
+ backward_simpl_time :=
+ !backward_simpl_time +. (t2 -. t1);
+ match newa with
+ | None -> active
+ | Some (n, p) ->
+ let al, tbl = active in
+ let nn = List.map (fun e -> Negative, e) n in
+ let pp, tbl =
+ List.fold_right
+ (fun e (l, t) ->
+ (Positive, e)::l,
+ Indexing.index tbl e)
+ p ([], tbl)
+ in
+ nn @ al @ pp, tbl
+ in
+ match contains_empty env new' with
+ | false, _ ->
+ let active =
+ let al, tbl = active in
+ match sign with
+ | Negative -> (sign, current)::al, tbl
+ | Positive ->
+ al @ [(sign, current)], Indexing.index tbl current
+ in
+ let passive = add_to_passive passive new' in
+ let (_, ns), (_, ps), _ = passive in
+ given_clause dbd env goals theorems passive active
+ | true, goal ->
+ let proof =
+ match goal with
+ | Some goal ->
+ let _, proof, _, _, _ = goal in Some proof
+ | None -> None
+ in
+ ParamodulationSuccess (proof, env)
+ )
+;;
+
+
+(** given-clause algorithm with full reduction strategy *)
+let rec given_clause_fullred dbd env goals theorems passive active =
+ let goals = simplify_goals env goals ~passive active in
+ let ok, goals = activate_goal goals in
+(* let theorems = simplify_theorems env theorems ~passive active in *)
+ if ok then
+(* let _ = *)
+(* debug_print *)
+(* (lazy *)
+(* (Printf.sprintf "\ngoals = \nactive\n%s\npassive\n%s\n" *)
+(* (print_goals (fst goals)) (print_goals (snd goals)))); *)
+(* let current = List.hd (fst goals) in *)
+(* let p, _, t = List.hd (snd current) in *)
+(* debug_print *)
+(* (lazy *)
+(* (Printf.sprintf "goal activated:\n%s\n%s\n" *)
+(* (CicPp.ppterm t) (string_of_proof p))); *)
+(* in *)
+ let ok, goals =
+ apply_goal_to_theorems dbd env theorems ~passive active goals
+ in
+ if ok then
+ let proof =
+ match (fst goals) with
+ | (_, [proof, _, _])::_ -> Some proof
+ | _ -> assert false
+ in
+ ParamodulationSuccess (proof, env)
+ else
+ given_clause_fullred_aux dbd env goals theorems passive active
+ else
+(* let ok', theorems = activate_theorem theorems in *)
+(* if ok' then *)
+(* let ok, goals = apply_theorem_to_goals env theorems active goals in *)
+(* if ok then *)
+(* let proof = *)
+(* match (fst goals) with *)
+(* | (_, [proof, _, _])::_ -> Some proof *)
+(* | _ -> assert false *)
+(* in *)
+(* ParamodulationSuccess (proof, env) *)
+(* else *)
+(* given_clause_fullred_aux env goals theorems passive active *)
+(* else *)
+ if (passive_is_empty passive) then ParamodulationFailure
+ else given_clause_fullred_aux dbd env goals theorems passive active
+
+and given_clause_fullred_aux dbd env goals theorems passive active =
+ let time1 = Unix.gettimeofday () in
+
+ let selection_estimate = get_selection_estimate () in
+ let kept = size_of_passive passive in
+ let passive =
+ if !time_limit = 0. || !processed_clauses = 0 then
+ passive
+ else if !elapsed_time > !time_limit then (
+ debug_print (lazy (Printf.sprintf "Time limit (%.2f) reached: %.2f\n"
+ !time_limit !elapsed_time));
+ make_passive [] []
+ ) else if kept > selection_estimate then (
+ debug_print
+ (lazy (Printf.sprintf ("Too many passive equalities: pruning..." ^^
+ "(kept: %d, selection_estimate: %d)\n")
+ kept selection_estimate));
+ prune_passive selection_estimate active passive
+ ) else
+ passive
+ in
+
+ let time2 = Unix.gettimeofday () in
+ passive_maintainance_time := !passive_maintainance_time +. (time2 -. time1);
+
+ kept_clauses := (size_of_passive passive) + (size_of_active active);
+ match passive_is_empty passive with
+ | true -> (* ParamodulationFailure *)
+ given_clause_fullred dbd env goals theorems passive active
+ | false ->
+ let (sign, current), passive = select env (fst goals) passive active in
+ let time1 = Unix.gettimeofday () in
+ let res = forward_simplify env (sign, current) ~passive active in
+ let time2 = Unix.gettimeofday () in
+ forward_simpl_time := !forward_simpl_time +. (time2 -. time1);
+ match res with
+ | None ->
+ given_clause_fullred dbd env goals theorems passive active
+ | Some (sign, current) ->
+ if (sign = Negative) && (is_identity env current) then (
+ debug_print
+ (lazy (Printf.sprintf "OK!!! %s %s" (string_of_sign sign)
+ (string_of_equality ~env current)));
+ let _, proof, _, _, _ = current in
+ ParamodulationSuccess (Some proof, env)
+ ) else (
+ debug_print
+ (lazy "\n================================================");
+ debug_print (lazy (Printf.sprintf "selected: %s %s"
+ (string_of_sign sign)
+ (string_of_equality ~env current)));
+
+ let t1 = Unix.gettimeofday () in
+ let new' = infer env sign current active in
+ let t2 = Unix.gettimeofday () in
+ infer_time := !infer_time +. (t2 -. t1);
+
+ let active =
+ if is_identity env current then active
+ else
+ let al, tbl = active in
+ match sign with
+ | Negative -> (sign, current)::al, tbl
+ | Positive ->
+ al @ [(sign, current)], Indexing.index tbl current
+ in
+ let rec simplify new' active passive =
+ let t1 = Unix.gettimeofday () in
+ let new' = forward_simplify_new env new' ~passive active in
+ let t2 = Unix.gettimeofday () in
+ forward_simpl_new_time :=
+ !forward_simpl_new_time +. (t2 -. t1);
+ let t1 = Unix.gettimeofday () in
+ let active, passive, newa, retained =
+ backward_simplify env new' ~passive active in
+ let t2 = Unix.gettimeofday () in
+ backward_simpl_time := !backward_simpl_time +. (t2 -. t1);
+ match newa, retained with
+ | None, None -> active, passive, new'
+ | Some (n, p), None
+ | None, Some (n, p) ->
+ let nn, np = new' in
+ simplify (nn @ n, np @ p) active passive
+ | Some (n, p), Some (rn, rp) ->
+ let nn, np = new' in
+ simplify (nn @ n @ rn, np @ p @ rp) active passive
+ in
+ let active, passive, new' = simplify new' active passive in
+
+ let k = size_of_passive passive in
+ if k < (kept - 1) then
+ processed_clauses := !processed_clauses + (kept - 1 - k);
+
+ let _ =
+ debug_print
+ (lazy
+ (Printf.sprintf "active:\n%s\n"
+ (String.concat "\n"
+ ((List.map
+ (fun (s, e) -> (string_of_sign s) ^ " " ^
+ (string_of_equality ~env e))
+ (fst active))))))
+ in
+ let _ =
+ match new' with
+ | neg, pos ->
+ debug_print
+ (lazy
+ (Printf.sprintf "new':\n%s\n"
+ (String.concat "\n"
+ ((List.map
+ (fun e -> "Negative " ^
+ (string_of_equality ~env e)) neg) @
+ (List.map
+ (fun e -> "Positive " ^
+ (string_of_equality ~env e)) pos)))))
+ in
+ match contains_empty env new' with
+ | false, _ ->
+ let passive = add_to_passive passive new' in
+ given_clause_fullred dbd env goals theorems passive active
+ | true, goal ->
+ let proof =
+ match goal with
+ | Some goal -> let _, proof, _, _, _ = goal in Some proof
+ | None -> None
+ in
+ ParamodulationSuccess (proof, env)
+ )
+;;
+
+
+let rec saturate_equations env goal accept_fun passive active =
+ elapsed_time := Unix.gettimeofday () -. !start_time;
+ if !elapsed_time > !time_limit then
+ (active, passive)
+ else
+ let (sign, current), passive = select env [1, [goal]] passive active in
+ let res = forward_simplify env (sign, current) ~passive active in
+ match res with
+ | None ->
+ saturate_equations env goal accept_fun passive active
+ | Some (sign, current) ->
+ assert (sign = Positive);
+ debug_print
+ (lazy "\n================================================");
+ debug_print (lazy (Printf.sprintf "selected: %s %s"
+ (string_of_sign sign)
+ (string_of_equality ~env current)));
+ let new' = infer env sign current active in
+ let active =
+ if is_identity env current then active
+ else
+ let al, tbl = active in
+ al @ [(sign, current)], Indexing.index tbl current
+ in
+ let rec simplify new' active passive =
+ let new' = forward_simplify_new env new' ~passive active in
+ let active, passive, newa, retained =
+ backward_simplify env new' ~passive active in
+ match newa, retained with
+ | None, None -> active, passive, new'
+ | Some (n, p), None
+ | None, Some (n, p) ->
+ let nn, np = new' in
+ simplify (nn @ n, np @ p) active passive
+ | Some (n, p), Some (rn, rp) ->
+ let nn, np = new' in
+ simplify (nn @ n @ rn, np @ p @ rp) active passive
+ in
+ let active, passive, new' = simplify new' active passive in
+ let _ =
+ debug_print
+ (lazy
+ (Printf.sprintf "active:\n%s\n"
+ (String.concat "\n"
+ ((List.map
+ (fun (s, e) -> (string_of_sign s) ^ " " ^
+ (string_of_equality ~env e))
+ (fst active))))))
+ in
+ let _ =
+ match new' with
+ | neg, pos ->
+ debug_print
+ (lazy
+ (Printf.sprintf "new':\n%s\n"
+ (String.concat "\n"
+ ((List.map
+ (fun e -> "Negative " ^
+ (string_of_equality ~env e)) neg) @
+ (List.map
+ (fun e -> "Positive " ^
+ (string_of_equality ~env e)) pos)))))
+ in
+ let new' = match new' with _, pos -> [], List.filter accept_fun pos in
+ let passive = add_to_passive passive new' in
+ saturate_equations env goal accept_fun passive active
+;;
+
+
+
+
+let main dbd full term metasenv ugraph =
+ let module C = Cic in
+ let module T = CicTypeChecker in
+ let module PET = ProofEngineTypes in
+ let module PP = CicPp in
+ let proof = None, (1, [], term)::metasenv, C.Meta (1, []), term in
+ let status = PET.apply_tactic (PrimitiveTactics.intros_tac ()) (proof, 1) in
+ let proof, goals = status in
+ let goal' = List.nth goals 0 in
+ let _, metasenv, meta_proof, _ = proof in
+ let _, context, goal = CicUtil.lookup_meta goal' metasenv in
+ let eq_indexes, equalities, maxm = find_equalities context proof in
+ let lib_eq_uris, library_equalities, maxm =
+ find_library_equalities dbd context (proof, goal') (maxm+2)
+ in
+ let library_equalities = List.map snd library_equalities in
+ maxmeta := maxm+2; (* TODO ugly!! *)
+ let irl = CicMkImplicit.identity_relocation_list_for_metavariable context in
+ let new_meta_goal, metasenv, type_of_goal =
+ let _, context, ty = CicUtil.lookup_meta goal' metasenv in
+ debug_print
+ (lazy
+ (Printf.sprintf "\n\nTIPO DEL GOAL: %s\n\n" (CicPp.ppterm ty)));
+ Cic.Meta (maxm+1, irl),
+ (maxm+1, context, ty)::metasenv,
+ ty
+ in
+ let env = (metasenv, context, ugraph) in
+ let t1 = Unix.gettimeofday () in
+ let theorems =
+ if full then
+ let theorems = find_library_theorems dbd env (proof, goal') lib_eq_uris in
+ let context_hyp = find_context_hypotheses env eq_indexes in
+ context_hyp @ theorems, []
+ else
+ let refl_equal =
+ let us = UriManager.string_of_uri (LibraryObjects.eq_URI ()) in
+ UriManager.uri_of_string (us ^ "#xpointer(1/1/1)")
+ in
+ let t = CicUtil.term_of_uri refl_equal in
+ let ty, _ = CicTypeChecker.type_of_aux' [] [] t CicUniv.empty_ugraph in
+ [(t, ty, [])], []
+ in
+ let t2 = Unix.gettimeofday () in
+ debug_print
+ (lazy
+ (Printf.sprintf "Time to retrieve theorems: %.9f\n" (t2 -. t1)));
+ let _ =
+ debug_print
+ (lazy
+ (Printf.sprintf
+ "Theorems:\n-------------------------------------\n%s\n"
+ (String.concat "\n"
+ (List.map
+ (fun (t, ty, _) ->
+ Printf.sprintf
+ "Term: %s, type: %s" (CicPp.ppterm t) (CicPp.ppterm ty))
+ (fst theorems)))))
+ in
+ try
+ let goal = Inference.BasicProof new_meta_goal, [], goal in
+ let equalities =
+ let equalities = equalities @ library_equalities in
+ debug_print
+ (lazy
+ (Printf.sprintf "equalities:\n%s\n"
+ (String.concat "\n"
+ (List.map string_of_equality equalities))));
+ debug_print (lazy "SIMPLYFYING EQUALITIES...");
+ let rec simpl e others others_simpl =
+ let active = others @ others_simpl in
+ let tbl =
+ List.fold_left
+ (fun t (_, e) -> Indexing.index t e)
+ Indexing.empty active
+ in
+ let res = forward_simplify env e (active, tbl) in
+ match others with
+ | hd::tl -> (
+ match res with
+ | None -> simpl hd tl others_simpl
+ | Some e -> simpl hd tl (e::others_simpl)
+ )
+ | [] -> (
+ match res with
+ | None -> others_simpl
+ | Some e -> e::others_simpl
+ )
+ in
+ match equalities with
+ | [] -> []
+ | hd::tl ->
+ let others = List.map (fun e -> (Positive, e)) tl in
+ let res =
+ List.rev (List.map snd (simpl (Positive, hd) others []))
+ in
+ debug_print
+ (lazy
+ (Printf.sprintf "equalities AFTER:\n%s\n"
+ (String.concat "\n"
+ (List.map string_of_equality res))));
+ res
+ in
+ let active = make_active () in
+ let passive = make_passive [] equalities in
+ Printf.printf "\ncurrent goal: %s\n"
+ (let _, _, g = goal in CicPp.ppterm g);
+ Printf.printf "\ncontext:\n%s\n" (PP.ppcontext context);
+ Printf.printf "\nmetasenv:\n%s\n" (print_metasenv metasenv);
+ Printf.printf "\nequalities:\n%s\n"
+ (String.concat "\n"
+ (List.map
+ (string_of_equality ~env) equalities));
+(* (equalities @ library_equalities))); *)
+ print_endline "--------------------------------------------------";
+ let start = Unix.gettimeofday () in
+ print_endline "GO!";
+ start_time := Unix.gettimeofday ();
+ let res =
+ let goals = make_goals goal in
+ (if !use_fullred then given_clause_fullred else given_clause)
+ dbd env goals theorems passive active
+ in
+ let finish = Unix.gettimeofday () in
+ let _ =
+ match res with
+ | ParamodulationFailure ->
+ Printf.printf "NO proof found! :-(\n\n"
+ | ParamodulationSuccess (Some proof, env) ->
+ let proof = Inference.build_proof_term proof in
+ Printf.printf "OK, found a proof!\n";
+ (* REMEMBER: we have to instantiate meta_proof, we should use
+ apply the "apply" tactic to proof and status
+ *)
+ let names = names_of_context context in
+ print_endline (PP.pp proof names);
+ let newmetasenv =
+ List.fold_left
+ (fun m (_, _, _, menv, _) -> m @ menv) metasenv equalities
+ in
+ let _ =
+ try
+ let ty, ug =
+ CicTypeChecker.type_of_aux' newmetasenv context proof ugraph
+ in
+ print_endline (string_of_float (finish -. start));
+ Printf.printf
+ "\nGOAL was: %s\nPROOF has type: %s\nconvertible?: %s\n\n"
+ (CicPp.pp type_of_goal names) (CicPp.pp ty names)
+ (string_of_bool
+ (fst (CicReduction.are_convertible
+ context type_of_goal ty ug)));
+ with e ->
+ Printf.printf "\nEXCEPTION!!! %s\n" (Printexc.to_string e);
+ Printf.printf "MAXMETA USED: %d\n" !maxmeta;
+ print_endline (string_of_float (finish -. start));
+ in
+ ()
+
+ | ParamodulationSuccess (None, env) ->
+ Printf.printf "Success, but no proof?!?\n\n"
+ in
+ Printf.printf ("infer_time: %.9f\nforward_simpl_time: %.9f\n" ^^
+ "forward_simpl_new_time: %.9f\n" ^^
+ "backward_simpl_time: %.9f\n")
+ !infer_time !forward_simpl_time !forward_simpl_new_time
+ !backward_simpl_time;
+ Printf.printf "passive_maintainance_time: %.9f\n"
+ !passive_maintainance_time;
+ Printf.printf " successful unification/matching time: %.9f\n"
+ !Indexing.match_unif_time_ok;
+ Printf.printf " failed unification/matching time: %.9f\n"
+ !Indexing.match_unif_time_no;
+ Printf.printf " indexing retrieval time: %.9f\n"
+ !Indexing.indexing_retrieval_time;
+ Printf.printf " demodulate_term.build_newtarget_time: %.9f\n"
+ !Indexing.build_newtarget_time;
+ Printf.printf "derived %d clauses, kept %d clauses.\n"
+ !derived_clauses !kept_clauses;
+ with exc ->
+ print_endline ("EXCEPTION: " ^ (Printexc.to_string exc));
+ raise exc
+;;
+
+
+let default_depth = !maxdepth
+and default_width = !maxwidth;;
+
+let reset_refs () =
+ maxmeta := 0;
+ symbols_counter := 0;
+ weight_age_counter := !weight_age_ratio;
+ processed_clauses := 0;
+ start_time := 0.;
+ elapsed_time := 0.;
+ maximal_retained_equality := None;
+ infer_time := 0.;
+ forward_simpl_time := 0.;
+ forward_simpl_new_time := 0.;
+ backward_simpl_time := 0.;
+ passive_maintainance_time := 0.;
+ derived_clauses := 0;
+ kept_clauses := 0;
+;;
+
+let saturate
+ dbd ?(full=false) ?(depth=default_depth) ?(width=default_width) status =
+ let module C = Cic in
+ reset_refs ();
+ Indexing.init_index ();
+ maxdepth := depth;
+ maxwidth := width;
+ let proof, goal = status in
+ let goal' = goal in
+ let uri, metasenv, meta_proof, term_to_prove = proof in
+ let _, context, goal = CicUtil.lookup_meta goal' metasenv in
+ let eq_indexes, equalities, maxm = find_equalities context proof in
+ let new_meta_goal, metasenv, type_of_goal =
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context in
+ let _, context, ty = CicUtil.lookup_meta goal' metasenv in
+ debug_print
+ (lazy (Printf.sprintf "\n\nTIPO DEL GOAL: %s\n" (CicPp.ppterm ty)));
+ Cic.Meta (maxm+1, irl),
+ (maxm+1, context, ty)::metasenv,
+ ty
+ in
+ let ugraph = CicUniv.empty_ugraph in
+ let env = (metasenv, context, ugraph) in
+ let goal = Inference.BasicProof new_meta_goal, [], goal in
+ let res, time =
+ let t1 = Unix.gettimeofday () in
+ let lib_eq_uris, library_equalities, maxm =
+ find_library_equalities dbd context (proof, goal') (maxm+2)
+ in
+ let library_equalities = List.map snd library_equalities in
+ let t2 = Unix.gettimeofday () in
+ maxmeta := maxm+2;
+ let equalities =
+ let equalities = equalities @ library_equalities in
+ debug_print
+ (lazy
+ (Printf.sprintf "equalities:\n%s\n"
+ (String.concat "\n"
+ (List.map string_of_equality equalities))));
+ debug_print (lazy "SIMPLYFYING EQUALITIES...");
+ let rec simpl e others others_simpl =
+ let active = others @ others_simpl in
+ let tbl =
+ List.fold_left
+ (fun t (_, e) -> Indexing.index t e)
+ Indexing.empty active
+ in
+ let res = forward_simplify env e (active, tbl) in
+ match others with
+ | hd::tl -> (
+ match res with
+ | None -> simpl hd tl others_simpl
+ | Some e -> simpl hd tl (e::others_simpl)
+ )
+ | [] -> (
+ match res with
+ | None -> others_simpl
+ | Some e -> e::others_simpl
+ )
+ in
+ match equalities with
+ | [] -> []
+ | hd::tl ->
+ let others = List.map (fun e -> (Positive, e)) tl in
+ let res =
+ List.rev (List.map snd (simpl (Positive, hd) others []))
+ in
+ debug_print
+ (lazy
+ (Printf.sprintf "equalities AFTER:\n%s\n"
+ (String.concat "\n"
+ (List.map string_of_equality res))));
+ res
+ in
+ debug_print
+ (lazy
+ (Printf.sprintf "Time to retrieve equalities: %.9f\n" (t2 -. t1)));
+ let t1 = Unix.gettimeofday () in
+ let theorems =
+ if full then
+ let thms = find_library_theorems dbd env (proof, goal') lib_eq_uris in
+ let context_hyp = find_context_hypotheses env eq_indexes in
+ context_hyp @ thms, []
+ else
+ let refl_equal =
+ let us = UriManager.string_of_uri (LibraryObjects.eq_URI ()) in
+ UriManager.uri_of_string (us ^ "#xpointer(1/1/1)")
+ in
+ let t = CicUtil.term_of_uri refl_equal in
+ let ty, _ = CicTypeChecker.type_of_aux' [] [] t CicUniv.empty_ugraph in
+ [(t, ty, [])], []
+ in
+ let t2 = Unix.gettimeofday () in
+ let _ =
+ debug_print
+ (lazy
+ (Printf.sprintf
+ "Theorems:\n-------------------------------------\n%s\n"
+ (String.concat "\n"
+ (List.map
+ (fun (t, ty, _) ->
+ Printf.sprintf
+ "Term: %s, type: %s"
+ (CicPp.ppterm t) (CicPp.ppterm ty))
+ (fst theorems)))));
+ debug_print
+ (lazy
+ (Printf.sprintf "Time to retrieve theorems: %.9f\n" (t2 -. t1)));
+ in
+ let active = make_active () in
+ let passive = make_passive [] equalities in
+ let start = Unix.gettimeofday () in
+ let res =
+ let goals = make_goals goal in
+ given_clause_fullred dbd env goals theorems passive active
+ in
+ let finish = Unix.gettimeofday () in
+ (res, finish -. start)
+ in
+ match res with
+ | ParamodulationSuccess (Some proof, env) ->
+ debug_print (lazy "OK, found a proof!");
+ let proof = Inference.build_proof_term proof in
+ let names = names_of_context context in
+ let newmetasenv =
+ let i1 =
+ match new_meta_goal with
+ | C.Meta (i, _) -> i | _ -> assert false
+ in
+ List.filter (fun (i, _, _) -> i <> i1 && i <> goal') metasenv
+ in
+ let newstatus =
+ try
+ let ty, ug =
+ CicTypeChecker.type_of_aux' newmetasenv context proof ugraph
+ in
+ debug_print (lazy (CicPp.pp proof [](* names *)));
+ debug_print
+ (lazy
+ (Printf.sprintf
+ "\nGOAL was: %s\nPROOF has type: %s\nconvertible?: %s\n"
+ (CicPp.pp type_of_goal names) (CicPp.pp ty names)
+ (string_of_bool
+ (fst (CicReduction.are_convertible
+ context type_of_goal ty ug)))));
+ let equality_for_replace i t1 =
+ match t1 with
+ | C.Meta (n, _) -> n = i
+ | _ -> false
+ in
+ let real_proof =
+ ProofEngineReduction.replace
+ ~equality:equality_for_replace
+ ~what:[goal'] ~with_what:[proof]
+ ~where:meta_proof
+ in
+ debug_print
+ (lazy
+ (Printf.sprintf "status:\n%s\n%s\n%s\n%s\n"
+ (match uri with Some uri -> UriManager.string_of_uri uri
+ | None -> "")
+ (print_metasenv newmetasenv)
+ (CicPp.pp real_proof [](* names *))
+ (CicPp.pp term_to_prove names)));
+ ((uri, newmetasenv, real_proof, term_to_prove), [])
+ with CicTypeChecker.TypeCheckerFailure _ ->
+ debug_print (lazy "THE PROOF DOESN'T TYPECHECK!!!");
+ debug_print (lazy (CicPp.pp proof names));
+ raise (ProofEngineTypes.Fail
+ (lazy "Found a proof, but it doesn't typecheck"))
+ in
+ debug_print (lazy (Printf.sprintf "\nTIME NEEDED: %.9f" time));
+ newstatus
+ | _ ->
+ raise (ProofEngineTypes.Fail (lazy "NO proof found"))
+;;
+
+(* dummy function called within matita to trigger linkage *)
+let init () = ();;
+
+
+(* UGLY SIDE EFFECT... *)
+if connect_to_auto then (
+ AutoTactic.paramodulation_tactic := saturate;
+ AutoTactic.term_is_equality := Inference.term_is_equality;
+);;
+
+
+let retrieve_and_print dbd term metasenv ugraph =
+ let module C = Cic in
+ let module T = CicTypeChecker in
+ let module PET = ProofEngineTypes in
+ let module PP = CicPp in
+ let proof = None, (1, [], term)::metasenv, C.Meta (1, []), term in
+ let status = PET.apply_tactic (PrimitiveTactics.intros_tac ()) (proof, 1) in
+ let proof, goals = status in
+ let goal' = List.nth goals 0 in
+ let uri, metasenv, meta_proof, term_to_prove = proof in
+ let _, context, goal = CicUtil.lookup_meta goal' metasenv in
+ let eq_indexes, equalities, maxm = find_equalities context proof in
+ let new_meta_goal, metasenv, type_of_goal =
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context in
+ let _, context, ty = CicUtil.lookup_meta goal' metasenv in
+ debug_print
+ (lazy (Printf.sprintf "\n\nTIPO DEL GOAL: %s\n" (CicPp.ppterm ty)));
+ Cic.Meta (maxm+1, irl),
+ (maxm+1, context, ty)::metasenv,
+ ty
+ in
+ let ugraph = CicUniv.empty_ugraph in
+ let env = (metasenv, context, ugraph) in
+ let goal = Inference.BasicProof new_meta_goal, [], goal in
+ let t1 = Unix.gettimeofday () in
+ let lib_eq_uris, library_equalities, maxm =
+ find_library_equalities dbd context (proof, goal') (maxm+2)
+ in
+ let t2 = Unix.gettimeofday () in
+ maxmeta := maxm+2;
+ let equalities =
+ let equalities = (* equalities @ *) library_equalities in
+ debug_print
+ (lazy
+ (Printf.sprintf "\n\nequalities:\n%s\n"
+ (String.concat "\n"
+ (List.map
+ (fun (u, e) ->
+(* Printf.sprintf "%s: %s" *)
+ (UriManager.string_of_uri u)
+(* (string_of_equality e) *)
+ )
+ equalities))));
+ debug_print (lazy "SIMPLYFYING EQUALITIES...");
+ let rec simpl e others others_simpl =
+ let (u, e) = e in
+ let active = List.map (fun (u, e) -> (Positive, e))
+ (others @ others_simpl) in
+ let tbl =
+ List.fold_left
+ (fun t (_, e) -> Indexing.index t e)
+ Indexing.empty active
+ in
+ let res = forward_simplify env (Positive, e) (active, tbl) in
+ match others with
+ | hd::tl -> (
+ match res with
+ | None -> simpl hd tl others_simpl
+ | Some e -> simpl hd tl ((u, (snd e))::others_simpl)
+ )
+ | [] -> (
+ match res with
+ | None -> others_simpl
+ | Some e -> (u, (snd e))::others_simpl
+ )
+ in
+ match equalities with
+ | [] -> []
+ | hd::tl ->
+ let others = tl in (* List.map (fun e -> (Positive, e)) tl in *)
+ let res =
+ List.rev (simpl (*(Positive,*) hd others [])
+ in
+ debug_print
+ (lazy
+ (Printf.sprintf "\nequalities AFTER:\n%s\n"
+ (String.concat "\n"
+ (List.map
+ (fun (u, e) ->
+ Printf.sprintf "%s: %s"
+ (UriManager.string_of_uri u)
+ (string_of_equality e)
+ )
+ res))));
+ res
+ in
+ debug_print
+ (lazy
+ (Printf.sprintf "Time to retrieve equalities: %.9f\n" (t2 -. t1)))
+;;
+
+
+let main_demod_equalities dbd term metasenv ugraph =
+ let module C = Cic in
+ let module T = CicTypeChecker in
+ let module PET = ProofEngineTypes in
+ let module PP = CicPp in
+ let proof = None, (1, [], term)::metasenv, C.Meta (1, []), term in
+ let status = PET.apply_tactic (PrimitiveTactics.intros_tac ()) (proof, 1) in
+ let proof, goals = status in
+ let goal' = List.nth goals 0 in
+ let _, metasenv, meta_proof, _ = proof in
+ let _, context, goal = CicUtil.lookup_meta goal' metasenv in
+ let eq_indexes, equalities, maxm = find_equalities context proof in
+ let lib_eq_uris, library_equalities, maxm =
+ find_library_equalities dbd context (proof, goal') (maxm+2)
+ in
+ let library_equalities = List.map snd library_equalities in
+ maxmeta := maxm+2; (* TODO ugly!! *)
+ let irl = CicMkImplicit.identity_relocation_list_for_metavariable context in
+ let new_meta_goal, metasenv, type_of_goal =
+ let _, context, ty = CicUtil.lookup_meta goal' metasenv in
+ debug_print
+ (lazy
+ (Printf.sprintf "\n\nTRYING TO INFER EQUALITIES MATCHING: %s\n\n"
+ (CicPp.ppterm ty)));
+ Cic.Meta (maxm+1, irl),
+ (maxm+1, context, ty)::metasenv,
+ ty
+ in
+ let env = (metasenv, context, ugraph) in
+ let t1 = Unix.gettimeofday () in
+ try
+ let goal = Inference.BasicProof new_meta_goal, [], goal in
+ let equalities =
+ let equalities = equalities @ library_equalities in
+ debug_print
+ (lazy
+ (Printf.sprintf "equalities:\n%s\n"
+ (String.concat "\n"
+ (List.map string_of_equality equalities))));
+ debug_print (lazy "SIMPLYFYING EQUALITIES...");
+ let rec simpl e others others_simpl =
+ let active = others @ others_simpl in
+ let tbl =
+ List.fold_left
+ (fun t (_, e) -> Indexing.index t e)
+ Indexing.empty active
+ in
+ let res = forward_simplify env e (active, tbl) in
+ match others with
+ | hd::tl -> (
+ match res with
+ | None -> simpl hd tl others_simpl
+ | Some e -> simpl hd tl (e::others_simpl)
+ )
+ | [] -> (
+ match res with
+ | None -> others_simpl
+ | Some e -> e::others_simpl
+ )
+ in
+ match equalities with
+ | [] -> []
+ | hd::tl ->
+ let others = List.map (fun e -> (Positive, e)) tl in
+ let res =
+ List.rev (List.map snd (simpl (Positive, hd) others []))
+ in
+ debug_print
+ (lazy
+ (Printf.sprintf "equalities AFTER:\n%s\n"
+ (String.concat "\n"
+ (List.map string_of_equality res))));
+ res
+ in
+ let active = make_active () in
+ let passive = make_passive [] equalities in
+ Printf.printf "\ncontext:\n%s\n" (PP.ppcontext context);
+ Printf.printf "\nmetasenv:\n%s\n" (print_metasenv metasenv);
+ Printf.printf "\nequalities:\n%s\n"
+ (String.concat "\n"
+ (List.map
+ (string_of_equality ~env) equalities));
+ print_endline "--------------------------------------------------";
+ let start = Unix.gettimeofday () in
+ print_endline "GO!";
+ start_time := Unix.gettimeofday ();
+ if !time_limit < 1. then time_limit := 60.;
+ let ra, rp =
+ saturate_equations env goal (fun e -> true) passive active
+ in
+ let finish = Unix.gettimeofday () in
+
+ let initial =
+ List.fold_left (fun s e -> EqualitySet.add e s)
+ EqualitySet.empty equalities
+ in
+ let addfun s e =
+ if not (EqualitySet.mem e initial) then EqualitySet.add e s else s
+ in
+
+ let passive =
+ match rp with
+ | (n, _), (p, _), _ ->
+ EqualitySet.elements (List.fold_left addfun EqualitySet.empty p)
+ in
+ let active =
+ let l = List.map snd (fst ra) in
+ EqualitySet.elements (List.fold_left addfun EqualitySet.empty l)
+ in
+ Printf.printf "\n\nRESULTS:\nActive:\n%s\n\nPassive:\n%s\n"
+(* (String.concat "\n" (List.map (string_of_equality ~env) active)) *)
+ (String.concat "\n"
+ (List.map (fun e -> CicPp.ppterm (term_of_equality e)) active))
+(* (String.concat "\n" (List.map (string_of_equality ~env) passive)); *)
+ (String.concat "\n"
+ (List.map (fun e -> CicPp.ppterm (term_of_equality e)) passive));
+ print_newline ();
+ with e ->
+ debug_print (lazy ("EXCEPTION: " ^ (Printexc.to_string e)))
+;;
diff --git a/helm/ocaml/paramodulation/test_indexing.ml b/helm/ocaml/paramodulation/test_indexing.ml
new file mode 100644
index 000000000..ba6b2ebe0
--- /dev/null
+++ b/helm/ocaml/paramodulation/test_indexing.ml
@@ -0,0 +1,253 @@
+(* $Id$ *)
+
+open Path_indexing
+
+(*
+let build_equality term =
+ let module C = Cic in
+ C.Implicit None, (C.Implicit None, term, C.Rel 1, Utils.Gt), [], []
+;;
+
+
+(*
+ f = Rel 1
+ g = Rel 2
+ a = Rel 3
+ b = Rel 4
+ c = Rel 5
+*)
+let path_indexing_test () =
+ let module C = Cic in
+ let terms = [
+ C.Appl [C.Rel 1; C.Appl [C.Rel 2; C.Rel 3; C.Meta (1, [])]; C.Rel 5];
+ C.Appl [C.Rel 1; C.Appl [C.Rel 2; C.Meta (1, []); C.Rel 4]; C.Meta (1, [])];
+ C.Appl [C.Rel 1; C.Appl [C.Rel 2; C.Rel 3; C.Rel 4]; C.Rel 5];
+ C.Appl [C.Rel 1; C.Appl [C.Rel 2; C.Meta (1, []); C.Rel 5]; C.Rel 4];
+ C.Appl [C.Rel 1; C.Meta (1, []); C.Meta (1, [])]
+ ] in
+ let path_strings = List.map (path_strings_of_term 0) terms in
+ let table =
+ List.fold_left index PSTrie.empty (List.map build_equality terms) in
+ let query =
+ C.Appl [C.Rel 1; C.Appl [C.Rel 2; C.Meta (1, []); C.Rel 4]; C.Rel 5] in
+ let matches = retrieve_generalizations table query in
+ let unifications = retrieve_unifiables table query in
+ let eq1 = build_equality (C.Appl [C.Rel 1; C.Meta (1, []); C.Meta (1, [])])
+ and eq2 = build_equality (C.Appl [C.Rel 1; C.Meta (1, []); C.Meta (2, [])]) in
+ let res1 = in_index table eq1
+ and res2 = in_index table eq2 in
+ let print_results res =
+ String.concat "\n"
+ (PosEqSet.fold
+ (fun (p, e) l ->
+ let s =
+ "(" ^ (Utils.string_of_pos p) ^ ", " ^
+ (Inference.string_of_equality e) ^ ")"
+ in
+ s::l)
+ res [])
+ in
+ Printf.printf "path_strings:\n%s\n\n"
+ (String.concat "\n"
+ (List.map
+ (fun l ->
+ "{" ^ (String.concat "; " (List.map string_of_path_string l)) ^ "}"
+ ) path_strings));
+ Printf.printf "table:\n%s\n\n" (string_of_pstrie table);
+ Printf.printf "matches:\n%s\n\n" (print_results matches);
+ Printf.printf "unifications:\n%s\n\n" (print_results unifications);
+ Printf.printf "in_index %s: %s\n"
+ (Inference.string_of_equality eq1) (string_of_bool res1);
+ Printf.printf "in_index %s: %s\n"
+ (Inference.string_of_equality eq2) (string_of_bool res2);
+;;
+
+
+let differing () =
+ let module C = Cic in
+ let t1 =
+ C.Appl [C.Rel 1; C.Appl [C.Rel 2; C.Rel 3; C.Meta (1, [])]; C.Rel 5]
+ and t2 =
+ C.Appl [C.Rel 1; C.Appl [C.Rel 5; C.Rel 4; C.Meta (1, [])]; C.Rel 5]
+ in
+ let res = Inference.extract_differing_subterms t1 t2 in
+ match res with
+ | None -> print_endline "NO DIFFERING SUBTERMS???"
+ | Some (t1, t2) ->
+ Printf.printf "OK: %s, %s\n" (CicPp.ppterm t1) (CicPp.ppterm t2);
+;;
+
+
+let next_after () =
+ let module C = Cic in
+ let t =
+ C.Appl [C.Rel 1; C.Appl [C.Rel 2; C.Rel 3; C.Rel 4]; C.Rel 5]
+ in
+ let pos1 = Discrimination_tree.next_t [1] t in
+ let pos2 = Discrimination_tree.after_t [1] t in
+ Printf.printf "next_t 1: %s\nafter_t 1: %s\n"
+ (CicPp.ppterm (Discrimination_tree.subterm_at_pos pos1 t))
+ (CicPp.ppterm (Discrimination_tree.subterm_at_pos pos2 t));
+;;
+
+
+let discrimination_tree_test () =
+ let module C = Cic in
+ let terms = [
+ C.Appl [C.Rel 1; C.Appl [C.Rel 2; C.Rel 3; C.Meta (1, [])]; C.Rel 5];
+ C.Appl [C.Rel 1; C.Appl [C.Rel 2; C.Meta (1, []); C.Rel 4]; C.Meta (1, [])];
+ C.Appl [C.Rel 1; C.Appl [C.Rel 2; C.Rel 3; C.Rel 4]; C.Rel 5];
+ C.Appl [C.Rel 1; C.Appl [C.Rel 2; C.Meta (1, []); C.Rel 5]; C.Rel 4];
+ C.Appl [C.Rel 10; C.Meta (5, []); C.Rel 11]
+ ] in
+ let path_strings =
+ List.map Discrimination_tree.path_string_of_term terms in
+ let table =
+ List.fold_left
+ Discrimination_tree.index
+ Discrimination_tree.DiscriminationTree.empty
+ (List.map build_equality terms)
+ in
+(* let query = *)
+(* C.Appl [C.Rel 1; C.Appl [C.Rel 2; C.Meta (1, []); C.Rel 4]; C.Rel 5] in *)
+ let query = C.Appl [C.Rel 10; C.Meta (14, []); C.Meta (13, [])] in
+ let matches = Discrimination_tree.retrieve_generalizations table query in
+ let unifications = Discrimination_tree.retrieve_unifiables table query in
+ let eq1 = build_equality (C.Appl [C.Rel 1; C.Meta (1, []); C.Meta (1, [])])
+ and eq2 = build_equality (C.Appl [C.Rel 1; C.Meta (1, []); C.Meta (2, [])]) in
+ let res1 = Discrimination_tree.in_index table eq1
+ and res2 = Discrimination_tree.in_index table eq2 in
+ let print_results res =
+ String.concat "\n"
+ (Discrimination_tree.PosEqSet.fold
+ (fun (p, e) l ->
+ let s =
+ "(" ^ (Utils.string_of_pos p) ^ ", " ^
+ (Inference.string_of_equality e) ^ ")"
+ in
+ s::l)
+ res [])
+ in
+ Printf.printf "path_strings:\n%s\n\n"
+ (String.concat "\n"
+ (List.map Discrimination_tree.string_of_path_string path_strings));
+ Printf.printf "table:\n%s\n\n"
+ (Discrimination_tree.string_of_discrimination_tree table);
+ Printf.printf "matches:\n%s\n\n" (print_results matches);
+ Printf.printf "unifications:\n%s\n\n" (print_results unifications);
+ Printf.printf "in_index %s: %s\n"
+ (Inference.string_of_equality eq1) (string_of_bool res1);
+ Printf.printf "in_index %s: %s\n"
+ (Inference.string_of_equality eq2) (string_of_bool res2);
+;;
+
+
+let test_subst () =
+ let module C = Cic in
+ let module M = CicMetaSubst in
+ let term = C.Appl [
+ C.Rel 1;
+ C.Appl [C.Rel 11;
+ C.Meta (43, []);
+ C.Appl [C.Rel 15; C.Rel 12; C.Meta (41, [])]];
+ C.Appl [C.Rel 11;
+ C.Appl [C.Rel 15; C.Meta (10, []); C.Meta (11, [])];
+ C.Appl [C.Rel 15; C.Meta (10, []); C.Meta (12, [])]]
+ ] in
+ let subst1 = [
+ (43, ([], C.Appl [C.Rel 15; C.Meta (10, []); C.Meta (11, [])], C.Rel 16));
+ (10, ([], C.Rel 12, C.Rel 16));
+ (12, ([], C.Meta (41, []), C.Rel 16))
+ ]
+ and subst2 = [
+ (43, ([], C.Appl [C.Rel 15; C.Rel 12; C.Meta (11, [])], C.Rel 16));
+ (10, ([], C.Rel 12, C.Rel 16));
+ (12, ([], C.Meta (41, []), C.Rel 16))
+ ] in
+ let t1 = M.apply_subst subst1 term
+ and t2 = M.apply_subst subst2 term in
+ Printf.printf "t1 = %s\nt2 = %s\n" (CicPp.ppterm t1) (CicPp.ppterm t2);
+;;
+*)
+
+
+let test_refl () =
+ let module C = Cic in
+ let context = [
+ Some (C.Name "H", C.Decl (
+ C.Prod (C.Name "z", C.Rel 3,
+ C.Appl [
+ C.MutInd (HelmLibraryObjects.Logic.eq_URI, 0, []);
+ C.Rel 4; C.Rel 3; C.Rel 1])));
+ Some (C.Name "x", C.Decl (C.Rel 2));
+ Some (C.Name "y", C.Decl (C.Rel 1));
+ Some (C.Name "A", C.Decl (C.Sort C.Set))
+ ]
+ in
+ let term = C.Appl [
+ C.Const (HelmLibraryObjects.Logic.eq_ind_URI, []); C.Rel 4;
+ C.Rel 2;
+ C.Lambda (C.Name "z", C.Rel 4,
+ C.Appl [
+ C.MutInd (HelmLibraryObjects.Logic.eq_URI, 0, []);
+ C.Rel 5; C.Rel 1; C.Rel 3
+ ]);
+ C.Appl [C.MutConstruct
+ (HelmLibraryObjects.Logic.eq_URI, 0, 1, []); (* reflexivity *)
+ C.Rel 4; C.Rel 2];
+ C.Rel 3;
+(* C.Appl [C.Const (HelmLibraryObjects.Logic.sym_eq_URI, []); (\* symmetry *\) *)
+(* C.Rel 4; C.Appl [C.Rel 1; C.Rel 2]] *)
+ C.Appl [
+ C.Const (HelmLibraryObjects.Logic.eq_ind_URI, []);
+ C.Rel 4; C.Rel 3;
+ C.Lambda (C.Name "z", C.Rel 4,
+ C.Appl [
+ C.MutInd (HelmLibraryObjects.Logic.eq_URI, 0, []);
+ C.Rel 5; C.Rel 1; C.Rel 4
+ ]);
+ C.Appl [C.MutConstruct (HelmLibraryObjects.Logic.eq_URI, 0, 1, []);
+ C.Rel 4; C.Rel 3];
+ C.Rel 2; C.Appl [C.Rel 1; C.Rel 2]
+ ]
+ ] in
+ let ens = [
+ (UriManager.uri_of_string "cic:/Coq/Init/Logic/Logic_lemmas/equality/A.var",
+ C.Rel 4);
+ (UriManager.uri_of_string "cic:/Coq/Init/Logic/Logic_lemmas/equality/x.var",
+ C.Rel 3);
+ (UriManager.uri_of_string "cic:/Coq/Init/Logic/Logic_lemmas/equality/y.var",
+ C.Rel 2);
+ ] in
+ let term2 = C.Appl [
+ C.Const (HelmLibraryObjects.Logic.sym_eq_URI, ens);
+ C.Appl [C.Rel 1; C.Rel 2]
+ ] in
+ let ty, ug =
+ CicTypeChecker.type_of_aux' [] context term CicUniv.empty_ugraph
+ in
+ Printf.printf "OK, %s ha tipo %s\n" (CicPp.ppterm term) (CicPp.ppterm ty);
+ let ty, ug =
+ CicTypeChecker.type_of_aux' [] context term2 CicUniv.empty_ugraph
+ in
+ Printf.printf "OK, %s ha tipo %s\n" (CicPp.ppterm term2) (CicPp.ppterm ty);
+;;
+
+
+let test_lib () =
+ let uri = Sys.argv.(1) in
+ let t = CicUtil.term_of_uri (UriManager.uri_of_string uri) in
+ let ty, _ = CicTypeChecker.type_of_aux' [] [] t CicUniv.empty_ugraph in
+ Printf.printf "Term of %s: %s\n" uri (CicPp.ppterm t);
+ Printf.printf "type: %s\n" (CicPp.ppterm ty);
+;;
+
+
+(* differing ();; *)
+(* next_after ();; *)
+(* discrimination_tree_test ();; *)
+(* path_indexing_test ();; *)
+(* test_subst ();; *)
+Helm_registry.load_from "../../matita/matita.conf.xml";
+(* test_refl ();; *)
+test_lib ();;
diff --git a/helm/ocaml/paramodulation/utils.ml b/helm/ocaml/paramodulation/utils.ml
new file mode 100644
index 000000000..5eb591c0b
--- /dev/null
+++ b/helm/ocaml/paramodulation/utils.ml
@@ -0,0 +1,596 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+let debug = true;;
+
+let debug_print s = if debug then prerr_endline (Lazy.force s);;
+
+let print_metasenv metasenv =
+ String.concat "\n--------------------------\n"
+ (List.map (fun (i, context, term) ->
+ (string_of_int i) ^ " [\n" ^ (CicPp.ppcontext context) ^
+ "\n] " ^ (CicPp.ppterm term))
+ metasenv)
+;;
+
+
+let print_subst ?(prefix="\n") subst =
+ String.concat prefix
+ (List.map
+ (fun (i, (c, t, ty)) ->
+ Printf.sprintf "?%d -> %s : %s" i
+ (CicPp.ppterm t) (CicPp.ppterm ty))
+ subst)
+;;
+
+(* (weight of constants, [(meta, weight_of_meta)]) *)
+type weight = int * (int * int) list;;
+
+let string_of_weight (cw, mw) =
+ let s =
+ String.concat ", "
+ (List.map (function (m, w) -> Printf.sprintf "(%d,%d)" m w) mw)
+ in
+ Printf.sprintf "[%d; %s]" cw s
+
+
+let weight_of_term ?(consider_metas=true) term =
+ let module C = Cic in
+ let vars_dict = Hashtbl.create 5 in
+ let rec aux = function
+ | C.Meta (metano, _) when consider_metas ->
+ (try
+ let oldw = Hashtbl.find vars_dict metano in
+ Hashtbl.replace vars_dict metano (oldw+1)
+ with Not_found ->
+ Hashtbl.add vars_dict metano 1);
+ 0
+ | C.Meta _ -> 0 (* "variables" are lighter than constants and functions...*)
+
+ | C.Var (_, ens)
+ | C.Const (_, ens)
+ | C.MutInd (_, _, ens)
+ | C.MutConstruct (_, _, _, ens) ->
+ List.fold_left (fun w (u, t) -> (aux t) + w) 1 ens
+
+ | C.Cast (t1, t2)
+ | C.Lambda (_, t1, t2)
+ | C.Prod (_, t1, t2)
+ | C.LetIn (_, t1, t2) ->
+ let w1 = aux t1 in
+ let w2 = aux t2 in
+ w1 + w2 + 1
+
+ | C.Appl l -> List.fold_left (+) 0 (List.map aux l)
+
+ | C.MutCase (_, _, outt, t, pl) ->
+ let w1 = aux outt in
+ let w2 = aux t in
+ let w3 = List.fold_left (+) 0 (List.map aux pl) in
+ w1 + w2 + w3 + 1
+
+ | C.Fix (_, fl) ->
+ List.fold_left (fun w (n, i, t1, t2) -> (aux t1) + (aux t2) + w) 1 fl
+
+ | C.CoFix (_, fl) ->
+ List.fold_left (fun w (n, t1, t2) -> (aux t1) + (aux t2) + w) 1 fl
+
+ | _ -> 1
+ in
+ let w = aux term in
+ let l =
+ Hashtbl.fold (fun meta metaw resw -> (meta, metaw)::resw) vars_dict [] in
+ let compare w1 w2 =
+ match w1, w2 with
+ | (m1, _), (m2, _) -> m2 - m1
+ in
+ (w, List.sort compare l) (* from the biggest meta to the smallest (0) *)
+;;
+
+
+module OrderedInt = struct
+ type t = int
+
+ let compare = Pervasives.compare
+end
+
+module IntSet = Set.Make(OrderedInt)
+
+let compute_equality_weight ty left right =
+ let metasw = ref 0 in
+ let weight_of t =
+ let w, m = (weight_of_term ~consider_metas:true t) in
+ metasw := !metasw + (2 * (List.length m));
+ w
+ in
+ (* Warning: the following let cannot be expanded since it forces the
+ right evaluation order!!!! *)
+ let w = (weight_of ty) + (weight_of left) + (weight_of right) in
+ w + !metasw
+;;
+
+
+(* returns a "normalized" version of the polynomial weight wl (with type
+ * weight list), i.e. a list sorted ascending by meta number,
+ * from 0 to maxmeta. wl must be sorted descending by meta number. Example:
+ * normalize_weight 5 (3, [(3, 2); (1, 1)]) ->
+ * (3, [(1, 1); (2, 0); (3, 2); (4, 0); (5, 0)]) *)
+let normalize_weight maxmeta (cw, wl) =
+ let rec aux = function
+ | 0 -> []
+ | m -> (m, 0)::(aux (m-1))
+ in
+ let tmpl = aux maxmeta in
+ let wl =
+ List.sort
+ (fun (m, _) (n, _) -> Pervasives.compare m n)
+ (List.fold_left
+ (fun res (m, w) -> (m, w)::(List.remove_assoc m res)) tmpl wl)
+ in
+ (cw, wl)
+;;
+
+
+let normalize_weights (cw1, wl1) (cw2, wl2) =
+ let rec aux wl1 wl2 =
+ match wl1, wl2 with
+ | [], [] -> [], []
+ | (m, w)::tl1, (n, w')::tl2 when m = n ->
+ let res1, res2 = aux tl1 tl2 in
+ (m, w)::res1, (n, w')::res2
+ | (m, w)::tl1, ((n, w')::_ as wl2) when m < n ->
+ let res1, res2 = aux tl1 wl2 in
+ (m, w)::res1, (m, 0)::res2
+ | ((m, w)::_ as wl1), (n, w')::tl2 when m > n ->
+ let res1, res2 = aux wl1 tl2 in
+ (n, 0)::res1, (n, w')::res2
+ | [], (n, w)::tl2 ->
+ let res1, res2 = aux [] tl2 in
+ (n, 0)::res1, (n, w)::res2
+ | (m, w)::tl1, [] ->
+ let res1, res2 = aux tl1 [] in
+ (m, w)::res1, (m, 0)::res2
+ | _, _ -> assert false
+ in
+ let cmp (m, _) (n, _) = compare m n in
+ let wl1, wl2 = aux (List.sort cmp wl1) (List.sort cmp wl2) in
+ (cw1, wl1), (cw2, wl2)
+;;
+
+
+type comparison = Lt | Le | Eq | Ge | Gt | Incomparable;;
+
+let string_of_comparison = function
+ | Lt -> "<"
+ | Le -> "<="
+ | Gt -> ">"
+ | Ge -> ">="
+ | Eq -> "="
+ | Incomparable -> "I"
+
+
+let compare_weights ?(normalize=false)
+ ((h1, w1) as weight1) ((h2, w2) as weight2)=
+ let (h1, w1), (h2, w2) =
+ if normalize then
+ normalize_weights weight1 weight2
+ else
+ (h1, w1), (h2, w2)
+ in
+ let res, diffs =
+ try
+ List.fold_left2
+ (fun ((lt, eq, gt), diffs) w1 w2 ->
+ match w1, w2 with
+ | (meta1, w1), (meta2, w2) when meta1 = meta2 ->
+ let diffs = (w1 - w2) + diffs in
+ let r = compare w1 w2 in
+ if r < 0 then (lt+1, eq, gt), diffs
+ else if r = 0 then (lt, eq+1, gt), diffs
+ else (lt, eq, gt+1), diffs
+ | (meta1, w1), (meta2, w2) ->
+ debug_print
+ (lazy
+ (Printf.sprintf "HMMM!!!! %s, %s\n"
+ (string_of_weight weight1) (string_of_weight weight2)));
+ assert false)
+ ((0, 0, 0), 0) w1 w2
+ with Invalid_argument _ ->
+ debug_print
+ (lazy
+ (Printf.sprintf "Invalid_argument: %s{%s}, %s{%s}, normalize = %s\n"
+ (string_of_weight (h1, w1)) (string_of_weight weight1)
+ (string_of_weight (h2, w2)) (string_of_weight weight2)
+ (string_of_bool normalize)));
+ assert false
+ in
+ let hdiff = h1 - h2 in
+ match res with
+ | (0, _, 0) ->
+ if hdiff < 0 then Lt
+ else if hdiff > 0 then Gt
+ else Eq (* Incomparable *)
+ | (m, _, 0) ->
+ if diffs < (- hdiff) then Lt
+ else if diffs = (- hdiff) then Le else Incomparable
+(*
+ if hdiff <= 0 then
+ if m > 0 || hdiff < 0 then Lt
+ else if diffs >= (- hdiff) then Le else Incomparable
+ else
+ if diffs >= (- hdiff) then Le else Incomparable *)
+ | (0, _, m) ->
+ if (- hdiff) < diffs then Gt
+ else if (- hdiff) = diffs then Ge else Incomparable
+(*
+ if hdiff >= 0 then
+ if m > 0 || hdiff > 0 then Gt
+ else if (- diffs) >= hdiff then Ge else Incomparable
+ else
+ if (- diffs) >= hdiff then Ge else Incomparable *)
+ | (m, _, n) when m > 0 && n > 0 ->
+ Incomparable
+ | _ -> assert false
+;;
+
+
+let rec aux_ordering ?(recursion=true) t1 t2 =
+ let module C = Cic in
+ let compare_uris u1 u2 =
+ let res =
+ compare (UriManager.string_of_uri u1) (UriManager.string_of_uri u2) in
+ if res < 0 then Lt
+ else if res = 0 then Eq
+ else Gt
+ in
+ match t1, t2 with
+ | C.Meta _, _
+ | _, C.Meta _ -> Incomparable
+
+ | t1, t2 when t1 = t2 -> Eq
+
+ | C.Rel n, C.Rel m -> if n > m then Lt else Gt
+ | C.Rel _, _ -> Lt
+ | _, C.Rel _ -> Gt
+
+ | C.Const (u1, _), C.Const (u2, _) -> compare_uris u1 u2
+ | C.Const _, _ -> Lt
+ | _, C.Const _ -> Gt
+
+ | C.MutInd (u1, _, _), C.MutInd (u2, _, _) -> compare_uris u1 u2
+ | C.MutInd _, _ -> Lt
+ | _, C.MutInd _ -> Gt
+
+ | C.MutConstruct (u1, _, _, _), C.MutConstruct (u2, _, _, _) ->
+ compare_uris u1 u2
+ | C.MutConstruct _, _ -> Lt
+ | _, C.MutConstruct _ -> Gt
+
+ | C.Appl l1, C.Appl l2 when recursion ->
+ let rec cmp t1 t2 =
+ match t1, t2 with
+ | [], [] -> Eq
+ | _, [] -> Gt
+ | [], _ -> Lt
+ | hd1::tl1, hd2::tl2 ->
+ let o = aux_ordering hd1 hd2 in
+ if o = Eq then cmp tl1 tl2
+ else o
+ in
+ cmp l1 l2
+ | C.Appl (h1::t1), C.Appl (h2::t2) when not recursion ->
+ aux_ordering h1 h2
+
+ | t1, t2 ->
+ debug_print
+ (lazy
+ (Printf.sprintf "These two terms are not comparable:\n%s\n%s\n\n"
+ (CicPp.ppterm t1) (CicPp.ppterm t2)));
+ Incomparable
+;;
+
+
+(* w1, w2 are the weights, they should already be normalized... *)
+let nonrec_kbo_w (t1, w1) (t2, w2) =
+ match compare_weights w1 w2 with
+ | Le -> if aux_ordering t1 t2 = Lt then Lt else Incomparable
+ | Ge -> if aux_ordering t1 t2 = Gt then Gt else Incomparable
+ | Eq -> aux_ordering t1 t2
+ | res -> res
+;;
+
+
+let nonrec_kbo t1 t2 =
+ let w1 = weight_of_term t1 in
+ let w2 = weight_of_term t2 in
+ (*
+ prerr_endline ("weight1 :"^(string_of_weight w1));
+ prerr_endline ("weight2 :"^(string_of_weight w2));
+ *)
+ match compare_weights ~normalize:true w1 w2 with
+ | Le -> if aux_ordering t1 t2 = Lt then Lt else Incomparable
+ | Ge -> if aux_ordering t1 t2 = Gt then Gt else Incomparable
+ | Eq -> aux_ordering t1 t2
+ | res -> res
+;;
+
+
+let rec kbo t1 t2 =
+ let aux = aux_ordering ~recursion:false in
+ let w1 = weight_of_term t1
+ and w2 = weight_of_term t2 in
+ let rec cmp t1 t2 =
+ match t1, t2 with
+ | [], [] -> Eq
+ | _, [] -> Gt
+ | [], _ -> Lt
+ | hd1::tl1, hd2::tl2 ->
+ let o =
+ kbo hd1 hd2
+ in
+ if o = Eq then cmp tl1 tl2
+ else o
+ in
+ let comparison = compare_weights ~normalize:true w1 w2 in
+ match comparison with
+ | Le ->
+ let r = aux t1 t2 in
+ if r = Lt then Lt
+ else if r = Eq then (
+ match t1, t2 with
+ | Cic.Appl (h1::tl1), Cic.Appl (h2::tl2) when h1 = h2 ->
+ if cmp tl1 tl2 = Lt then Lt else Incomparable
+ | _, _ -> Incomparable
+ ) else Incomparable
+ | Ge ->
+ let r = aux t1 t2 in
+ if r = Gt then Gt
+ else if r = Eq then (
+ match t1, t2 with
+ | Cic.Appl (h1::tl1), Cic.Appl (h2::tl2) when h1 = h2 ->
+ if cmp tl1 tl2 = Gt then Gt else Incomparable
+ | _, _ -> Incomparable
+ ) else Incomparable
+ | Eq ->
+ let r = aux t1 t2 in
+ if r = Eq then (
+ match t1, t2 with
+ | Cic.Appl (h1::tl1), Cic.Appl (h2::tl2) when h1 = h2 ->
+ cmp tl1 tl2
+ | _, _ -> Incomparable
+ ) else r
+ | res -> res
+;;
+
+let rec ao t1 t2 =
+ let get_hd t =
+ match t with
+ Cic.MutConstruct(uri,tyno,cno,_) -> Some(uri,tyno,cno)
+ | Cic.Appl(Cic.MutConstruct(uri,tyno,cno,_)::_) ->
+ Some(uri,tyno,cno)
+ | _ -> None in
+ let aux = aux_ordering ~recursion:false in
+ let w1 = weight_of_term t1
+ and w2 = weight_of_term t2 in
+ let rec cmp t1 t2 =
+ match t1, t2 with
+ | [], [] -> Eq
+ | _, [] -> Gt
+ | [], _ -> Lt
+ | hd1::tl1, hd2::tl2 ->
+ let o =
+ ao hd1 hd2
+ in
+ if o = Eq then cmp tl1 tl2
+ else o
+ in
+ match get_hd t1, get_hd t2 with
+ Some(_),None -> Lt
+ | None,Some(_) -> Gt
+ | _ ->
+ let comparison = compare_weights ~normalize:true w1 w2 in
+ match comparison with
+ | Le ->
+ let r = aux t1 t2 in
+ if r = Lt then Lt
+ else if r = Eq then (
+ match t1, t2 with
+ | Cic.Appl (h1::tl1), Cic.Appl (h2::tl2) when h1 = h2 ->
+ if cmp tl1 tl2 = Lt then Lt else Incomparable
+ | _, _ -> Incomparable
+ ) else Incomparable
+ | Ge ->
+ let r = aux t1 t2 in
+ if r = Gt then Gt
+ else if r = Eq then (
+ match t1, t2 with
+ | Cic.Appl (h1::tl1), Cic.Appl (h2::tl2) when h1 = h2 ->
+ if cmp tl1 tl2 = Gt then Gt else Incomparable
+ | _, _ -> Incomparable
+ ) else Incomparable
+ | Eq ->
+ let r = aux t1 t2 in
+ if r = Eq then (
+ match t1, t2 with
+ | Cic.Appl (h1::tl1), Cic.Appl (h2::tl2) when h1 = h2 ->
+ cmp tl1 tl2
+ | _, _ -> Incomparable
+ ) else r
+ | res -> res
+;;
+
+let names_of_context context =
+ List.map
+ (function
+ | None -> None
+ | Some (n, e) -> Some n)
+ context
+;;
+
+
+module OrderedTerm =
+struct
+ type t = Cic.term
+
+ let compare = Pervasives.compare
+end
+
+module TermSet = Set.Make(OrderedTerm);;
+module TermMap = Map.Make(OrderedTerm);;
+
+let symbols_of_term term =
+ let module C = Cic in
+ let rec aux map = function
+ | C.Meta _ -> map
+ | C.Appl l ->
+ List.fold_left (fun res t -> (aux res t)) map l
+ | t ->
+ let map =
+ try
+ let c = TermMap.find t map in
+ TermMap.add t (c+1) map
+ with Not_found ->
+ TermMap.add t 1 map
+ in
+ map
+ in
+ aux TermMap.empty term
+;;
+
+
+let metas_of_term term =
+ let module C = Cic in
+ let rec aux = function
+ | C.Meta _ as t -> TermSet.singleton t
+ | C.Appl l ->
+ List.fold_left (fun res t -> TermSet.union res (aux t)) TermSet.empty l
+ | t -> TermSet.empty (* TODO: maybe add other cases? *)
+ in
+ aux term
+;;
+
+
+let rec lpo t1 t2 =
+ let module C = Cic in
+ match t1, t2 with
+ | t1, t2 when t1 = t2 -> Eq
+ | t1, (C.Meta _ as m) ->
+ if TermSet.mem m (metas_of_term t1) then Gt else Incomparable
+ | (C.Meta _ as m), t2 ->
+ if TermSet.mem m (metas_of_term t2) then Lt else Incomparable
+ | C.Appl (hd1::tl1), C.Appl (hd2::tl2) -> (
+ let res =
+ let f o r t =
+ if r then true else
+ match lpo t o with
+ | Gt | Eq -> true
+ | _ -> false
+ in
+ let res1 = List.fold_left (f t2) false tl1 in
+ if res1 then Gt
+ else let res2 = List.fold_left (f t1) false tl2 in
+ if res2 then Lt
+ else Incomparable
+ in
+ if res <> Incomparable then
+ res
+ else
+ let f o r t =
+ if not r then false else
+ match lpo o t with
+ | Gt -> true
+ | _ -> false
+ in
+ match aux_ordering hd1 hd2 with
+ | Gt ->
+ let res = List.fold_left (f t1) false tl2 in
+ if res then Gt
+ else Incomparable
+ | Lt ->
+ let res = List.fold_left (f t2) false tl1 in
+ if res then Lt
+ else Incomparable
+ | Eq -> (
+ let lex_res =
+ try
+ List.fold_left2
+ (fun r t1 t2 -> if r <> Eq then r else lpo t1 t2)
+ Eq tl1 tl2
+ with Invalid_argument _ ->
+ Incomparable
+ in
+ match lex_res with
+ | Gt ->
+ if List.fold_left (f t1) false tl2 then Gt
+ else Incomparable
+ | Lt ->
+ if List.fold_left (f t2) false tl1 then Lt
+ else Incomparable
+ | _ -> Incomparable
+ )
+ | _ -> Incomparable
+ )
+ | t1, t2 -> aux_ordering t1 t2
+;;
+
+
+(* settable by the user... *)
+let compare_terms = ref nonrec_kbo;;
+(* let compare_terms = ref ao;; *)
+
+let guarded_simpl context t =
+ let t' = ProofEngineReduction.simpl context t in
+ let simpl_order = !compare_terms t t' in
+ if simpl_order = Gt then
+ (* prerr_endline ("reduce: "^(CicPp.ppterm t)^(CicPp.ppterm t')); *)
+ t'
+ else t
+;;
+
+type equality_sign = Negative | Positive;;
+
+let string_of_sign = function
+ | Negative -> "Negative"
+ | Positive -> "Positive"
+;;
+
+
+type pos = Left | Right
+
+let string_of_pos = function
+ | Left -> "Left"
+ | Right -> "Right"
+;;
+
+
+let eq_ind_URI () = LibraryObjects.eq_ind_URI ~eq:(LibraryObjects.eq_URI ())
+let eq_ind_r_URI () = LibraryObjects.eq_ind_r_URI ~eq:(LibraryObjects.eq_URI ())
+let sym_eq_URI () = LibraryObjects.sym_eq_URI ~eq:(LibraryObjects.eq_URI ())
+let eq_XURI () =
+ let s = UriManager.string_of_uri (LibraryObjects.eq_URI ()) in
+ UriManager.uri_of_string (s ^ "#xpointer(1/1/1)")
+let trans_eq_URI () = LibraryObjects.trans_eq_URI ~eq:(LibraryObjects.eq_URI ())
diff --git a/helm/ocaml/paramodulation/utils.mli b/helm/ocaml/paramodulation/utils.mli
new file mode 100644
index 000000000..d52483ddb
--- /dev/null
+++ b/helm/ocaml/paramodulation/utils.mli
@@ -0,0 +1,82 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* (weight of constants, [(meta, weight_of_meta)]) *)
+type weight = int * (int * int) list;;
+
+type comparison = Lt | Le | Eq | Ge | Gt | Incomparable;;
+
+val print_metasenv: Cic.metasenv -> string
+
+val print_subst: ?prefix:string -> Cic.substitution -> string
+
+val string_of_weight: weight -> string
+
+val weight_of_term: ?consider_metas:bool -> Cic.term -> weight
+
+val normalize_weight: int -> weight -> weight
+
+val string_of_comparison: comparison -> string
+
+val compare_weights: ?normalize:bool -> weight -> weight -> comparison
+
+val nonrec_kbo: Cic.term -> Cic.term -> comparison
+
+val nonrec_kbo_w: (Cic.term * weight) -> (Cic.term * weight) -> comparison
+
+val names_of_context: Cic.context -> (Cic.name option) list
+
+module TermMap: Map.S with type key = Cic.term
+
+val symbols_of_term: Cic.term -> int TermMap.t
+
+val lpo: Cic.term -> Cic.term -> comparison
+
+val kbo: Cic.term -> Cic.term -> comparison
+
+val ao: Cic.term -> Cic.term -> comparison
+
+(** term-ordering function settable by the user *)
+val compare_terms: (Cic.term -> Cic.term -> comparison) ref
+
+val guarded_simpl: Cic.context -> Cic.term -> Cic.term
+
+type equality_sign = Negative | Positive
+
+val string_of_sign: equality_sign -> string
+
+type pos = Left | Right
+
+val string_of_pos: pos -> string
+
+val compute_equality_weight: Cic.term -> Cic.term -> Cic.term -> int
+
+val debug_print: string Lazy.t -> unit
+
+val eq_ind_URI: unit -> UriManager.uri
+val eq_ind_r_URI: unit -> UriManager.uri
+val sym_eq_URI: unit -> UriManager.uri
+val eq_XURI: unit -> UriManager.uri
+val trans_eq_URI: unit -> UriManager.uri
diff --git a/helm/ocaml/patch_deps.sh b/helm/ocaml/patch_deps.sh
new file mode 100755
index 000000000..cd9f09c89
--- /dev/null
+++ b/helm/ocaml/patch_deps.sh
@@ -0,0 +1,32 @@
+#!/bin/sh
+# script args: source_file target_file
+
+use_clusters='no'
+if [ ! -z "$USE_CLUSTERS" ]; then
+ use_clusters=$USE_CLUSTERS
+fi
+
+# args: file snippet
+# file will be modified in place
+include_dot_snippet ()
+{
+ echo "Adding to $1 graphviz snipet $2 ..."
+ sed -i "/digraph/r $2" $1
+}
+
+# args: file patch
+apply_patch ()
+{
+ if [ -f "$2" ]; then
+ echo "Applying to $1 patch $2 ..."
+ patch $1 $2
+ fi
+}
+
+cp $1 $2
+apply_patch $2 deps.patch
+include_dot_snippet $2 daemons.dot
+if [ "$use_clusters" = "yes" ]; then
+ include_dot_snippet $2 clusters.dot
+fi
+
diff --git a/helm/ocaml/registry/.depend b/helm/ocaml/registry/.depend
new file mode 100644
index 000000000..cf4f36b68
--- /dev/null
+++ b/helm/ocaml/registry/.depend
@@ -0,0 +1,2 @@
+helm_registry.cmo: helm_registry.cmi
+helm_registry.cmx: helm_registry.cmi
diff --git a/helm/ocaml/registry/.ocamlinit b/helm/ocaml/registry/.ocamlinit
new file mode 100644
index 000000000..9aee6008e
--- /dev/null
+++ b/helm/ocaml/registry/.ocamlinit
@@ -0,0 +1,4 @@
+#use "topfind";;
+#require "helm-registry";;
+open Helm_registry;;
+load_from "sample.xml";;
diff --git a/helm/ocaml/registry/Makefile b/helm/ocaml/registry/Makefile
new file mode 100644
index 000000000..4d3e0a52c
--- /dev/null
+++ b/helm/ocaml/registry/Makefile
@@ -0,0 +1,7 @@
+
+PACKAGE = registry
+INTERFACE_FILES = helm_registry.mli
+IMPLEMENTATION_FILES = helm_registry.ml
+
+include ../Makefile.common
+
diff --git a/helm/ocaml/registry/helm_registry.ml b/helm/ocaml/registry/helm_registry.ml
new file mode 100644
index 000000000..42316a27f
--- /dev/null
+++ b/helm/ocaml/registry/helm_registry.ml
@@ -0,0 +1,422 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+let debug = false
+let debug_print s =
+ if debug then prerr_endline ("Helm_registry debugging: " ^ (Lazy.force s))
+
+ (** <helpers> *)
+
+let list_uniq l =
+ let rec aux last_element = function
+ | [] -> []
+ | hd :: tl ->
+ (match last_element with
+ | Some elt when elt = hd -> aux last_element tl
+ | _ -> hd :: aux (Some hd) tl)
+ in
+ aux None l
+
+let starts_with prefix =
+(*
+ let rex = Str.regexp (Str.quote prefix) in
+ fun s -> Str.string_match rex s 0
+*)
+ let prefix_len = String.length prefix in
+ fun s ->
+ try
+ String.sub s 0 prefix_len = prefix
+ with Invalid_argument _ -> false
+
+let hashtbl_keys tbl = Hashtbl.fold (fun k _ acc -> k :: acc) tbl []
+let hashtbl_pairs tbl = Hashtbl.fold (fun k v acc -> (k,v) :: acc) tbl []
+
+ (** </helpers> *)
+
+exception Malformed_key of string
+exception Key_not_found of string
+exception Cyclic_definition of string
+exception Type_error of string (* expected type, value, msg *)
+exception Parse_error of string * int * int * string (* file, line, col, msg *)
+
+ (* root XML tag: used by save_to, ignored by load_from *)
+let root_tag = "helm_registry"
+
+let magic_size = 127
+
+let backup_registry registry = Hashtbl.copy registry
+let restore_registry backup registry =
+ Hashtbl.clear registry;
+ Hashtbl.iter (fun key value -> Hashtbl.add registry key value) backup
+
+ (* as \\w but:
+ * - no sequences of '_' longer than 1 are permitted
+ *)
+let valid_step_rex_raw = "[a-zA-Z0-9]+\\(_[a-z0A-Z-9]+\\)*"
+let valid_key_rex_raw =
+ sprintf "%s\\(\\.%s\\)*" valid_step_rex_raw valid_step_rex_raw
+let valid_key_rex = Str.regexp ("^" ^ valid_key_rex_raw ^ "$")
+let interpolated_key_rex = Str.regexp ("\\$(" ^ valid_key_rex_raw ^ ")")
+let dot_rex = Str.regexp "\\."
+let spaces_rex = Str.regexp "[ \t\n\r]+"
+let heading_spaces_rex = Str.regexp "^[ \t\n\r]+"
+let margin_blanks_rex =
+ Str.regexp "^\\([ \t\n\r]*\\)\\([^ \t\n\r]*\\)\\([ \t\n\r]*\\)$"
+
+let strip_blanks s = Str.global_replace margin_blanks_rex "\\2" s
+
+let split s =
+ (* trailing blanks are removed per default by split *)
+ Str.split spaces_rex (Str.global_replace heading_spaces_rex "" s)
+let merge l = String.concat " " l
+
+let handle_type_error f x =
+ try f x with exn -> raise (Type_error (Printexc.to_string exn))
+
+ (** marshallers/unmarshallers *)
+let string x = x
+let int = handle_type_error int_of_string
+let float = handle_type_error float_of_string
+let bool = handle_type_error bool_of_string
+let of_string x = x
+let of_int = handle_type_error string_of_int
+let of_float = handle_type_error string_of_float
+let of_bool = handle_type_error string_of_bool
+
+ (* escapes for xml configuration file *)
+let (escape, unescape) =
+ let (in_enc, out_enc) = (`Enc_utf8, `Enc_utf8) in
+ (Netencoding.Html.encode ~in_enc ~out_enc (),
+ Netencoding.Html.decode ~in_enc ~out_enc ~entity_base:`Xml ())
+
+let key_is_valid key =
+ if not (Str.string_match valid_key_rex key 0) then
+ raise (Malformed_key key)
+
+let set' ?(replace=false) registry ~key ~value =
+ debug_print (lazy(sprintf "Setting (replace: %b) %s = %s" replace key value));
+ key_is_valid key;
+ let add_fun = if replace then Hashtbl.replace else Hashtbl.add in
+ add_fun registry key value
+
+let unset registry = Hashtbl.remove registry
+
+let env_var_of_key = Str.global_replace dot_rex "__"
+
+let singleton = function
+ | [] ->
+ raise (Type_error ("empty list value found where singleton was expected"))
+ | hd :: _ -> hd
+
+let get registry key =
+ let rec aux stack key =
+ key_is_valid key;
+ if List.mem key stack then begin
+ let msg = (String.concat " -> " (List.rev stack)) ^ " -> " ^ key in
+ raise (Cyclic_definition msg)
+ end;
+ (* internal value *)
+ let registry_values = List.rev (Hashtbl.find_all registry key) in
+ let env_value = (* environment value *)
+ try
+ Some (Sys.getenv (env_var_of_key key))
+ with Not_found -> None
+ in
+ let values = (* resulting value *)
+ match registry_values, env_value with
+ | _, Some env -> [env]
+ | [], None -> raise (Key_not_found key)
+ | values, None -> values
+ in
+ List.map (interpolate (key :: stack)) values
+ and interpolate stack value =
+ Str.global_substitute interpolated_key_rex
+ (fun s ->
+ let matched = Str.matched_string s in
+ (* "$(var)" -> "var" *)
+ let key = String.sub matched 2 (String.length matched - 3) in
+ singleton (aux stack key))
+ value
+ in
+ List.map strip_blanks (aux [] key)
+
+let has registry key = Hashtbl.mem registry key
+
+let get_typed registry unmarshaller key =
+ let value = singleton (get registry key) in
+ unmarshaller value
+
+let set_typed registry marshaller ~key ~value =
+ set' ~replace:true registry ~key ~value:(marshaller value)
+
+let get_opt registry unmarshaller key =
+ try
+ Some (unmarshaller (singleton (get registry key)))
+ with Key_not_found _ -> None
+
+let get_opt_default registry unmarshaller ~default key =
+ match get_opt registry unmarshaller key with
+ | None -> default
+ | Some v -> v
+
+let set_opt registry marshaller ~key ~value =
+ match value with
+ | None -> unset registry key
+ | Some value -> set' ~replace:true registry ~key ~value:(marshaller value)
+
+let get_list registry unmarshaller key =
+ try
+ List.map unmarshaller (get registry key)
+ with Key_not_found _ -> []
+
+let get_pair registry fst_unmarshaller snd_unmarshaller key =
+ let v = singleton (get registry key) in
+ match Str.split spaces_rex v with
+ | [fst; snd] -> fst_unmarshaller fst, snd_unmarshaller snd
+ | _ -> raise (Type_error "not a pair")
+
+let set_list registry marshaller ~key ~value =
+ Hashtbl.remove registry key;
+ List.iter
+ (fun v -> set' ~replace:false registry ~key ~value:(marshaller v))
+ value
+
+type xml_tree =
+ | Cdata of string
+ | Element of string * (string * string) list * xml_tree list
+
+let dot_RE = Str.regexp "\\."
+
+let xml_tree_of_registry registry =
+ let has_child name elements =
+ List.exists
+ (function
+ | Element (_, ["name", name'], _) when name = name' -> true
+ | _ -> false)
+ elements
+ in
+ let rec get_child name = function
+ | [] -> assert false
+ | (Element (_, ["name", name'], _) as child) :: tl when name = name' ->
+ child, tl
+ | hd :: tl ->
+ let child, rest = get_child name tl in
+ child, hd :: rest
+ in
+ let rec add_key path value tree =
+ match path, tree with
+ | [key], Element (name, attrs, children) ->
+ Element (name, attrs,
+ Element ("key", ["name", key],
+ [Cdata (strip_blanks value)]) :: children)
+ | dir :: path, Element (name, attrs, children) ->
+ if has_child dir children then
+ let child, rest = get_child dir children in
+ Element (name, attrs, add_key path value child :: rest)
+ else
+ Element (name, attrs,
+ ((add_key path value (Element ("section", ["name", dir], [])))
+ :: children))
+ | _ -> assert false
+ in
+ Hashtbl.fold
+ (fun k v tree -> add_key ((Str.split dot_RE k)) v tree)
+ registry
+ (Element (root_tag, [], []))
+
+let rec stream_of_xml_tree = function
+ | Cdata s -> Xml.xml_cdata s
+ | Element (name, attrs, children) ->
+ Xml.xml_nempty name
+ (List.map (fun (n, v) -> (None, n, v)) attrs)
+ (stream_of_xml_trees children)
+and stream_of_xml_trees = function
+ | [] -> [< >]
+ | hd :: tl -> [< stream_of_xml_tree hd; stream_of_xml_trees tl >]
+
+let save_to registry fname =
+ let token_stream = stream_of_xml_tree (xml_tree_of_registry registry) in
+ let oc = open_out fname in
+ Xml.pp_to_outchan token_stream oc;
+ close_out oc
+
+let rec load_from_absolute ?path registry fname =
+ let _path = ref (match path with None -> [] | Some p -> p)in
+ (* <section> elements entered so far *)
+ let in_key = ref false in (* have we entered a <key> element? *)
+ let cdata = ref "" in (* collected cdata (inside <key> *)
+ let push_path name = _path := name :: !_path in
+ let pop_path () = _path := List.tl !_path in
+ let start_element tag attrs =
+ match tag, attrs with
+ | "section", ["name", name] -> push_path name
+ | "key", ["name", name] -> in_key := true; push_path name
+ | "helm_registry", _ -> ()
+ | "include", ["href", fname] ->
+ debug_print (lazy ("including file " ^ fname));
+ load_from_absolute ~path:!_path registry fname
+ | tag, _ ->
+ raise (Parse_error (fname, ~-1, ~-1,
+ (sprintf "unexpected element <%s> or wrong attribute set" tag)))
+ in
+ let end_element tag =
+ match tag with
+ | "section" -> pop_path ()
+ | "key" ->
+ let key = String.concat "." (List.rev !_path) in
+ set' registry ~key ~value:!cdata;
+ cdata := "";
+ in_key := false;
+ pop_path ()
+ | "include" | "helm_registry" -> ()
+ | _ -> assert false
+ in
+ let character_data text =
+ if !in_key then cdata := !cdata ^ text
+ in
+ let callbacks = {
+ XmlPushParser.default_callbacks with
+ XmlPushParser.start_element = Some start_element;
+ XmlPushParser.end_element = Some end_element;
+ XmlPushParser.character_data = Some character_data;
+ } in
+ let xml_parser = XmlPushParser.create_parser callbacks in
+ let backup = backup_registry registry in
+(* if path = None then Hashtbl.clear registry; *)
+ try
+ XmlPushParser.parse xml_parser (`File fname)
+ with exn ->
+ restore_registry backup registry;
+ raise exn
+
+let load_from registry ?path fname =
+ if Filename.is_relative fname then begin
+ let no_file_found = ref true in
+ let path =
+ match path with
+ | Some path -> path (* path given as argument *)
+ | None -> [ Sys.getcwd () ] (* no path given, try with cwd *)
+ in
+ List.iter
+ (fun dir ->
+ let conffile = dir ^ "/" ^ fname in
+ if Sys.file_exists conffile then begin
+ no_file_found := false;
+ load_from_absolute registry conffile
+ end)
+ path;
+ if !no_file_found then
+ failwith (sprintf
+ "Helm_registry.init: no configuration file named %s in [ %s ]"
+ fname (String.concat "; " path))
+ end else
+ load_from_absolute registry fname
+
+let fold registry ?prefix ?(interpolate = true) f init =
+ let value_of k v =
+ if interpolate then singleton (get registry k) else strip_blanks v
+ in
+ match prefix with
+ | None -> Hashtbl.fold (fun k v acc -> f acc k (value_of k v)) registry init
+ | Some s ->
+ let key_matches = starts_with (s ^ ".") in
+ let rec fold_filter acc = function
+ | [] -> acc
+ | (k,v) :: tl when key_matches k ->
+ fold_filter (f acc k (value_of k v)) tl
+ | _ :: tl -> fold_filter acc tl
+ in
+ fold_filter init (hashtbl_pairs registry)
+
+let iter registry ?prefix ?interpolate f =
+ fold registry ?prefix ?interpolate (fun _ k v -> f k v) ()
+let to_list registry ?prefix ?interpolate () =
+ fold registry ?prefix ?interpolate (fun acc k v -> (k, v) :: acc) []
+
+let ls registry prefix =
+ let prefix = prefix ^ "." in
+ let prefix_len = String.length prefix in
+ let key_matches = starts_with prefix in
+ let matching_keys = (* collect matching keys' _postfixes_ *)
+ fold registry
+ (fun acc key _ ->
+ if key_matches key then
+ String.sub key prefix_len (String.length key - prefix_len) :: acc
+ else
+ acc)
+ []
+ in
+ let (sections, keys) =
+ List.fold_left
+ (fun (sections, keys) postfix ->
+ match Str.split dot_rex postfix with
+ | [key] -> (sections, key :: keys)
+ | hd_key :: _ -> (* length > 1 => nested section found *)
+ (hd_key :: sections, keys)
+ | _ -> assert false)
+ ([], []) matching_keys
+ in
+ (list_uniq (List.sort Pervasives.compare sections), keys)
+
+(** {2 API implementation}
+ * functional methods above are wrapped so that they work on a default
+ * (imperative) registry*)
+
+let default_registry = Hashtbl.create magic_size
+
+let get key = singleton (get default_registry key)
+let set = set' ~replace:true default_registry
+let has = has default_registry
+let fold ?prefix ?interpolate f init =
+ fold default_registry ?prefix ?interpolate f init
+let iter = iter default_registry
+let to_list = to_list default_registry
+let ls = ls default_registry
+let get_typed unmarshaller = get_typed default_registry unmarshaller
+let get_opt unmarshaller = get_opt default_registry unmarshaller
+let get_opt_default unmarshaller = get_opt_default default_registry unmarshaller
+let get_list unmarshaller = get_list default_registry unmarshaller
+let get_pair unmarshaller = get_pair default_registry unmarshaller
+let set_typed marshaller = set_typed default_registry marshaller
+let set_opt unmarshaller = set_opt default_registry unmarshaller
+let set_list marshaller = set_list default_registry marshaller
+let unset = unset default_registry
+let save_to = save_to default_registry
+let load_from = load_from default_registry
+let clear () = Hashtbl.clear default_registry
+
+let get_string = get_typed string
+let get_int = get_typed int
+let get_float = get_typed float
+let get_bool = get_typed bool
+let set_string = set_typed of_string
+let set_int = set_typed of_int
+let set_float = set_typed of_float
+let set_bool = set_typed of_bool
+
diff --git a/helm/ocaml/registry/helm_registry.mli b/helm/ocaml/registry/helm_registry.mli
new file mode 100644
index 000000000..1ef1aa3b7
--- /dev/null
+++ b/helm/ocaml/registry/helm_registry.mli
@@ -0,0 +1,199 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** Configuration repository for HELM applications.
+ *
+ * ++ Keys format ++
+ *
+ * key ::= path
+ * path ::= component ( '.' component )*
+ * component ::= ( alpha | num | '_' )+
+ * # with the only exception that sequences of '_' longer than 1 aren't valid
+ * # components
+ *
+ * Suggested usage <application>.<setting>:
+ * e.g. gTopLevel.prooffile, http_getter.port, ...
+ *
+ * ++ Configuration file example ++
+ *
+ * gTopLevel.prooffile = "/home/zack/prooffile"
+ * http_getter.port = "58080"
+ *
+ * ++ Environment variable override ++
+ *
+ * each key has an associated environment variable name. At runtime (i.e. when
+ * "get" requests are performed) a variable with this name will be looked for,
+ * if it's defined it will override the value present (or absent) in the
+ * registry.
+ * Environment variables are _not_ considered when saving the configuration to
+ * a configuration file (via "save_to" function below) .
+ *
+ * Mapping between keys and environment variables is as follows:
+ * - each "." is converted to "__"
+ * E.g.: my.Foo_iSH.Application -> my__Foo_iSH__Application
+ *
+ * ++ Variable interpolation ++
+ *
+ * Interpolation is supported with the following syntax:
+ *
+ * foo.bar = "quux"
+ * foo.baz = $(foo.bar)/baz
+ *)
+
+ (** raised when a looked up key can't be found
+ * @param key looked up key *)
+exception Key_not_found of string
+
+ (** raised when a cyclic definitions is found, e.g. after
+ * Helm_registry.set "a" "$b"
+ * Helm_registry.set "b" "$a"
+ * @param msg brief description of the definition cycle *)
+exception Cyclic_definition of string
+
+ (** raised when a looked up key doesn't have the required type, parameter is
+ * an error message *)
+exception Type_error of string
+
+ (** raised when a malformed key is encountered
+ * @param key malformed key *)
+exception Malformed_key of string
+
+ (** raised when an error is encountered while parsing a configuration file
+ * @param fname file name
+ * @param line line number
+ * @param col column number
+ * @param msg error description
+ *)
+exception Parse_error of string * int * int * string
+
+(** {2 Generic untyped interface}
+ * Using the functions below this module could be used as a repository of
+ * key/value pairs *)
+
+ (** lookup key in registry with environment variable override *)
+val get: string -> string
+val set: key:string -> value:string -> unit
+val has: string -> bool
+
+ (** remove a key from the current environment, next get over this key will
+ * raise Key_not_found until the key will be redefined *)
+val unset: string -> unit
+
+ (** @param interpolate defaults to true *)
+val fold:
+ ?prefix:string -> ?interpolate:bool ->
+ ('a -> string -> string -> 'a) -> 'a -> 'a
+
+ (** @param interpolate defaults to true *)
+val iter:
+ ?prefix:string -> ?interpolate:bool ->
+ (string -> string -> unit) -> unit
+
+ (** @param interpolate defaults to true *)
+val to_list:
+ ?prefix:string -> ?interpolate:bool ->
+ unit -> (string * string) list
+
+ (** @param prefix key representing the section whose contents should be listed
+ * @return section list * key list *)
+val ls: string -> string list * string list
+
+(** {2 Typed interface}
+ * Three basic types are supported: strings, int and strings list. Strings
+ * correspond literally to what is written inside double quotes; int to the
+ * parsing of an integer number from ; strings list to the splitting at blanks
+ * of it (heading and trailing blanks are removed before splitting) *)
+
+(** {3 Unmarshallers} *)
+
+val string: string -> string
+val int: string -> int
+val float: string -> float
+val bool: string -> bool
+
+(** {3 Typed getters} *)
+
+ (** like get, with an additional unmarshaller
+ * @param unmarshaller conversion function from string to the desired type.
+ * Use one of the above unmarshallers *)
+val get_typed: (string -> 'a) -> string -> 'a
+
+val get_opt: (string -> 'a) -> string -> 'a option
+val get_opt_default: (string -> 'a) -> default:'a -> string -> 'a
+
+ (** never fails with Key_not_found, instead return the empty list *)
+val get_list: (string -> 'a) -> string -> 'a list
+
+ (** decode values which are blank separated list of values, of length 2 *)
+val get_pair: (string -> 'a) -> (string -> 'b) -> string -> 'a * 'b
+
+(** {4 Shorthands} *)
+
+val get_string: string -> string
+val get_int: string -> int
+val get_float: string -> float
+val get_bool: string -> bool
+
+(** {3 Marshallers} *)
+
+val of_string: string -> string
+val of_int: int -> string
+val of_float: float -> string
+val of_bool: bool -> string
+
+(** {3 Typed setters} *)
+
+ (** like set, with an additional marshaller
+ * @param marshaller conversion function to string.
+ * Use one of the above marshallers *)
+val set_typed: ('a -> string) -> key:string -> value:'a -> unit
+
+val set_opt: ('a -> string) -> key:string -> value:'a option -> unit
+val set_list: ('a -> string) -> key:string -> value:'a list -> unit
+
+(** {4 Shorthands} *)
+
+val set_string: key:string -> value:string -> unit
+val set_int: key:string -> value:int -> unit
+val set_float: key:string -> value:float -> unit
+val set_bool: key:string -> value:bool -> unit
+
+(** {2 Persistent configuration} *)
+
+ (** @param fname file to which save current configuration *)
+val save_to: string -> unit
+
+ (** @param fname file from which load new configuration. If it's an absolute
+ * file name "path" argument is ignored.
+ * Otherwise given file name is looked up in each directory member of the
+ * given path. Each matching file is loaded overriding previous settings. If
+ * no path is given a default path composed of just the current working
+ * directory is used.
+ *)
+val load_from: ?path:string list -> string -> unit
+
+ (** removes all keys *)
+val clear: unit -> unit
+
diff --git a/helm/ocaml/registry/test.ml b/helm/ocaml/registry/test.ml
new file mode 100644
index 000000000..d0b91a28c
--- /dev/null
+++ b/helm/ocaml/registry/test.ml
@@ -0,0 +1,32 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf;;
+Helm_registry.load_from Sys.argv.(1);
+Helm_registry.iter ~interpolate:false (fun k v -> printf "%s = %s\n" k v);
+Helm_registry.save_to Sys.argv.(2)
+
diff --git a/helm/ocaml/registry/tests/sample.xml b/helm/ocaml/registry/tests/sample.xml
new file mode 100644
index 000000000..b0f91f30b
--- /dev/null
+++ b/helm/ocaml/registry/tests/sample.xml
@@ -0,0 +1,34 @@
+<?xml version="1.0" encoding="utf-8"?>
+<helm_registry>
+ <section name="annotations">
+ <key name="dir">file:///home/zack/miohelm/objects</key>
+ <key name="url">file:///home/zack/miohelm/objects</key>
+ </section>
+ <section name="getter">
+ <key name="mode">remote</key>
+ <key name="url">http://localhost:58081</key>
+ </section>
+ <section name="triciclo">
+ <key name="merge1">yes</key>
+ </section>
+ <section name="triciclo">
+ <include href="sample_include.xml" />
+ </section>
+ <section name="triciclo">
+ <key name="merge2">yes</key>
+ </section>
+ <section name="types">
+ <key name="string">debian</key>
+ <key name="int">1</key>
+ <key name="bool">false</key>
+ <key name="float">2.5</key>
+ <key name="int_list">11</key>
+ <key name="int_list">13</key>
+ <key name="int_list">17</key>
+ <key name="int_list">19</key>
+ <key name="int_float_pair">19 23.2</key>
+ </section>
+ <section name="uwobo">
+ <key name="url">http://localhost:58080/</key>
+ </section>
+</helm_registry>
diff --git a/helm/ocaml/registry/tests/sample_include.xml b/helm/ocaml/registry/tests/sample_include.xml
new file mode 100644
index 000000000..8a6851998
--- /dev/null
+++ b/helm/ocaml/registry/tests/sample_include.xml
@@ -0,0 +1,15 @@
+<helm_registry>
+ <section name="foo1">
+ <key name="bar2">aaa</key>
+ <key name="bar3">bbb</key>
+ </section>
+ <section name="foo2">
+ <key name="bar1">quux</key>
+ </section>
+ <key name="basedir">/public/helm_library</key>
+ <key name="constant_type_file">$(triciclo.basedir)/constanttype</key>
+ <key name="environment_file">$(triciclo.basedir)/environment</key>
+ <key name="inner_types_file">$(triciclo.basedir)/innertypes</key>
+ <key name="proof_file">$(triciclo.basedir)/currentproof</key>
+ <key name="proof_file_type">$(triciclo.basedir)/currentprooftype</key>
+</helm_registry>
diff --git a/helm/ocaml/tactics/.depend b/helm/ocaml/tactics/.depend
new file mode 100644
index 000000000..95131ecf4
--- /dev/null
+++ b/helm/ocaml/tactics/.depend
@@ -0,0 +1,128 @@
+proofEngineHelpers.cmi: proofEngineTypes.cmi
+continuationals.cmi: proofEngineTypes.cmi
+tacticals.cmi: proofEngineTypes.cmi continuationals.cmi
+reductionTactics.cmi: proofEngineTypes.cmi
+proofEngineStructuralRules.cmi: proofEngineTypes.cmi
+primitiveTactics.cmi: proofEngineTypes.cmi
+metadataQuery.cmi: proofEngineTypes.cmi
+variousTactics.cmi: proofEngineTypes.cmi
+autoTactic.cmi: proofEngineTypes.cmi
+introductionTactics.cmi: proofEngineTypes.cmi
+eliminationTactics.cmi: proofEngineTypes.cmi
+negationTactics.cmi: proofEngineTypes.cmi
+equalityTactics.cmi: proofEngineTypes.cmi
+discriminationTactics.cmi: proofEngineTypes.cmi
+inversion.cmi: proofEngineTypes.cmi
+ring.cmi: proofEngineTypes.cmi
+fourierR.cmi: proofEngineTypes.cmi
+fwdSimplTactic.cmi: proofEngineTypes.cmi
+statefulProofEngine.cmi: proofEngineTypes.cmi
+tactics.cmi: proofEngineTypes.cmi
+proofEngineTypes.cmo: proofEngineTypes.cmi
+proofEngineTypes.cmx: proofEngineTypes.cmi
+proofEngineHelpers.cmo: proofEngineTypes.cmi proofEngineHelpers.cmi
+proofEngineHelpers.cmx: proofEngineTypes.cmx proofEngineHelpers.cmi
+proofEngineReduction.cmo: proofEngineTypes.cmi proofEngineHelpers.cmi \
+ proofEngineReduction.cmi
+proofEngineReduction.cmx: proofEngineTypes.cmx proofEngineHelpers.cmx \
+ proofEngineReduction.cmi
+continuationals.cmo: proofEngineTypes.cmi continuationals.cmi
+continuationals.cmx: proofEngineTypes.cmx continuationals.cmi
+tacticals.cmo: proofEngineTypes.cmi continuationals.cmi tacticals.cmi
+tacticals.cmx: proofEngineTypes.cmx continuationals.cmx tacticals.cmi
+reductionTactics.cmo: proofEngineTypes.cmi proofEngineReduction.cmi \
+ proofEngineHelpers.cmi reductionTactics.cmi
+reductionTactics.cmx: proofEngineTypes.cmx proofEngineReduction.cmx \
+ proofEngineHelpers.cmx reductionTactics.cmi
+proofEngineStructuralRules.cmo: proofEngineTypes.cmi \
+ proofEngineStructuralRules.cmi
+proofEngineStructuralRules.cmx: proofEngineTypes.cmx \
+ proofEngineStructuralRules.cmi
+primitiveTactics.cmo: tacticals.cmi reductionTactics.cmi proofEngineTypes.cmi \
+ proofEngineHelpers.cmi primitiveTactics.cmi
+primitiveTactics.cmx: tacticals.cmx reductionTactics.cmx proofEngineTypes.cmx \
+ proofEngineHelpers.cmx primitiveTactics.cmi
+hashtbl_equiv.cmo: hashtbl_equiv.cmi
+hashtbl_equiv.cmx: hashtbl_equiv.cmi
+metadataQuery.cmo: proofEngineTypes.cmi primitiveTactics.cmi \
+ hashtbl_equiv.cmi metadataQuery.cmi
+metadataQuery.cmx: proofEngineTypes.cmx primitiveTactics.cmx \
+ hashtbl_equiv.cmx metadataQuery.cmi
+variousTactics.cmo: tacticals.cmi proofEngineTypes.cmi \
+ proofEngineReduction.cmi proofEngineHelpers.cmi primitiveTactics.cmi \
+ variousTactics.cmi
+variousTactics.cmx: tacticals.cmx proofEngineTypes.cmx \
+ proofEngineReduction.cmx proofEngineHelpers.cmx primitiveTactics.cmx \
+ variousTactics.cmi
+autoTactic.cmo: proofEngineTypes.cmi proofEngineHelpers.cmi \
+ primitiveTactics.cmi metadataQuery.cmi autoTactic.cmi
+autoTactic.cmx: proofEngineTypes.cmx proofEngineHelpers.cmx \
+ primitiveTactics.cmx metadataQuery.cmx autoTactic.cmi
+introductionTactics.cmo: proofEngineTypes.cmi primitiveTactics.cmi \
+ introductionTactics.cmi
+introductionTactics.cmx: proofEngineTypes.cmx primitiveTactics.cmx \
+ introductionTactics.cmi
+eliminationTactics.cmo: tacticals.cmi proofEngineTypes.cmi \
+ proofEngineStructuralRules.cmi proofEngineHelpers.cmi \
+ primitiveTactics.cmi eliminationTactics.cmi
+eliminationTactics.cmx: tacticals.cmx proofEngineTypes.cmx \
+ proofEngineStructuralRules.cmx proofEngineHelpers.cmx \
+ primitiveTactics.cmx eliminationTactics.cmi
+negationTactics.cmo: variousTactics.cmi tacticals.cmi proofEngineTypes.cmi \
+ primitiveTactics.cmi eliminationTactics.cmi negationTactics.cmi
+negationTactics.cmx: variousTactics.cmx tacticals.cmx proofEngineTypes.cmx \
+ primitiveTactics.cmx eliminationTactics.cmx negationTactics.cmi
+equalityTactics.cmo: tacticals.cmi reductionTactics.cmi proofEngineTypes.cmi \
+ proofEngineStructuralRules.cmi proofEngineReduction.cmi \
+ proofEngineHelpers.cmi primitiveTactics.cmi introductionTactics.cmi \
+ equalityTactics.cmi
+equalityTactics.cmx: tacticals.cmx reductionTactics.cmx proofEngineTypes.cmx \
+ proofEngineStructuralRules.cmx proofEngineReduction.cmx \
+ proofEngineHelpers.cmx primitiveTactics.cmx introductionTactics.cmx \
+ equalityTactics.cmi
+discriminationTactics.cmo: tacticals.cmi reductionTactics.cmi \
+ proofEngineTypes.cmi primitiveTactics.cmi introductionTactics.cmi \
+ equalityTactics.cmi eliminationTactics.cmi discriminationTactics.cmi
+discriminationTactics.cmx: tacticals.cmx reductionTactics.cmx \
+ proofEngineTypes.cmx primitiveTactics.cmx introductionTactics.cmx \
+ equalityTactics.cmx eliminationTactics.cmx discriminationTactics.cmi
+inversion.cmo: tacticals.cmi proofEngineTypes.cmi proofEngineReduction.cmi \
+ proofEngineHelpers.cmi primitiveTactics.cmi equalityTactics.cmi \
+ inversion.cmi
+inversion.cmx: tacticals.cmx proofEngineTypes.cmx proofEngineReduction.cmx \
+ proofEngineHelpers.cmx primitiveTactics.cmx equalityTactics.cmx \
+ inversion.cmi
+ring.cmo: tacticals.cmi proofEngineTypes.cmi proofEngineStructuralRules.cmi \
+ primitiveTactics.cmi equalityTactics.cmi eliminationTactics.cmi ring.cmi
+ring.cmx: tacticals.cmx proofEngineTypes.cmx proofEngineStructuralRules.cmx \
+ primitiveTactics.cmx equalityTactics.cmx eliminationTactics.cmx ring.cmi
+fourier.cmo: fourier.cmi
+fourier.cmx: fourier.cmi
+fourierR.cmo: tacticals.cmi ring.cmi reductionTactics.cmi \
+ proofEngineTypes.cmi proofEngineHelpers.cmi primitiveTactics.cmi \
+ fourier.cmi equalityTactics.cmi fourierR.cmi
+fourierR.cmx: tacticals.cmx ring.cmx reductionTactics.cmx \
+ proofEngineTypes.cmx proofEngineHelpers.cmx primitiveTactics.cmx \
+ fourier.cmx equalityTactics.cmx fourierR.cmi
+fwdSimplTactic.cmo: tacticals.cmi proofEngineTypes.cmi \
+ proofEngineStructuralRules.cmi proofEngineHelpers.cmi \
+ primitiveTactics.cmi fwdSimplTactic.cmi
+fwdSimplTactic.cmx: tacticals.cmx proofEngineTypes.cmx \
+ proofEngineStructuralRules.cmx proofEngineHelpers.cmx \
+ primitiveTactics.cmx fwdSimplTactic.cmi
+history.cmo: history.cmi
+history.cmx: history.cmi
+statefulProofEngine.cmo: proofEngineTypes.cmi history.cmi \
+ statefulProofEngine.cmi
+statefulProofEngine.cmx: proofEngineTypes.cmx history.cmx \
+ statefulProofEngine.cmi
+tactics.cmo: variousTactics.cmi tacticals.cmi ring.cmi reductionTactics.cmi \
+ proofEngineStructuralRules.cmi primitiveTactics.cmi negationTactics.cmi \
+ inversion.cmi introductionTactics.cmi fwdSimplTactic.cmi fourierR.cmi \
+ equalityTactics.cmi eliminationTactics.cmi discriminationTactics.cmi \
+ autoTactic.cmi tactics.cmi
+tactics.cmx: variousTactics.cmx tacticals.cmx ring.cmx reductionTactics.cmx \
+ proofEngineStructuralRules.cmx primitiveTactics.cmx negationTactics.cmx \
+ inversion.cmx introductionTactics.cmx fwdSimplTactic.cmx fourierR.cmx \
+ equalityTactics.cmx eliminationTactics.cmx discriminationTactics.cmx \
+ autoTactic.cmx tactics.cmi
diff --git a/helm/ocaml/tactics/Makefile b/helm/ocaml/tactics/Makefile
new file mode 100644
index 000000000..1595fb337
--- /dev/null
+++ b/helm/ocaml/tactics/Makefile
@@ -0,0 +1,23 @@
+PACKAGE = tactics
+
+INTERFACE_FILES = \
+ proofEngineTypes.mli \
+ proofEngineHelpers.mli proofEngineReduction.mli \
+ continuationals.mli \
+ tacticals.mli reductionTactics.mli proofEngineStructuralRules.mli \
+ primitiveTactics.mli hashtbl_equiv.mli metadataQuery.mli \
+ variousTactics.mli autoTactic.mli \
+ introductionTactics.mli eliminationTactics.mli negationTactics.mli \
+ equalityTactics.mli discriminationTactics.mli inversion.mli ring.mli \
+ fourier.mli fourierR.mli fwdSimplTactic.mli history.mli \
+ statefulProofEngine.mli tactics.mli
+IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml)
+
+all:
+
+tactics.mli: tactics.ml *Tactics.mli *Tactic.mli fourierR.mli ring.mli
+ echo "(* GENERATED FILE, DO NOT EDIT *)" > $@
+ $(OCAMLC) -i $< >> $@
+
+include ../Makefile.common
+
diff --git a/helm/ocaml/tactics/autoTactic.ml b/helm/ocaml/tactics/autoTactic.ml
new file mode 100644
index 000000000..dc5b8324c
--- /dev/null
+++ b/helm/ocaml/tactics/autoTactic.ml
@@ -0,0 +1,348 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+ let debug = false
+ let debug_print s = if debug then prerr_endline (Lazy.force s)
+
+(* let debug_print = fun _ -> () *)
+
+(* Profiling code
+let new_experimental_hint =
+ let profile = CicUtil.profile "new_experimental_hint" in
+ fun ~dbd ~facts ?signature ~universe status ->
+ profile.profile (MetadataQuery.new_experimental_hint ~dbd ~facts ?signature ~universe) status
+*) let new_experimental_hint = MetadataQuery.new_experimental_hint
+
+(* In this versions of auto_tac we maintain an hash table of all inspected
+ goals. We assume that the context is invariant for application.
+ To this aim, it is essential to sall hint_verbose, that in turns calls
+ apply_verbose. *)
+
+type exitus =
+ No of int
+ | Yes of Cic.term * int
+ | NotYetInspected
+
+let inspected_goals = Hashtbl.create 503;;
+
+let search_theorems_in_context status =
+ let (proof, goal) = status in
+ let module C = Cic in
+ let module R = CicReduction in
+ let module S = CicSubstitution in
+ let module PET = ProofEngineTypes in
+ let module PT = PrimitiveTactics in
+ let _,metasenv,_,_ = proof in
+ let _,context,ty = CicUtil.lookup_meta goal metasenv in
+ let rec find n = function
+ | [] -> []
+ | hd::tl ->
+ let res =
+ (* we should check that the hypothesys has not been cleared *)
+ if List.nth context (n-1) = None then
+ None
+ else
+ try
+ let (subst,(proof, goal_list)) =
+ PT.apply_tac_verbose ~term:(C.Rel n) status
+ in
+ (*
+ let goal_list =
+ List.stable_sort (compare_goal_list proof) goal_list in
+ *)
+ Some (subst,(proof, goal_list))
+ with
+ PET.Fail _ -> None
+ in
+ (match res with
+ | Some res -> res::(find (n+1) tl)
+ | None -> find (n+1) tl)
+ in
+ try
+ find 1 context
+ with Failure s -> []
+;;
+
+
+let compare_goals proof goal1 goal2 =
+ let _,metasenv,_,_ = proof in
+ let (_, ey1, ty1) = CicUtil.lookup_meta goal1 metasenv in
+ let (_, ey2, ty2) = CicUtil.lookup_meta goal2 metasenv in
+ let ty_sort1,_ = CicTypeChecker.type_of_aux' metasenv ey1 ty1
+ CicUniv.empty_ugraph in
+ let ty_sort2,_ = CicTypeChecker.type_of_aux' metasenv ey2 ty2
+ CicUniv.empty_ugraph in
+ let prop1 =
+ let b,_ = CicReduction.are_convertible ey1 (Cic.Sort Cic.Prop) ty_sort1
+ CicUniv.empty_ugraph in
+ if b then 0 else 1
+ in
+ let prop2 =
+ let b,_ = CicReduction.are_convertible ey2 (Cic.Sort Cic.Prop) ty_sort2
+ CicUniv.empty_ugraph in
+ if b then 0 else 1
+ in
+ prop1 - prop2
+
+
+let new_search_theorems f dbd proof goal depth sign =
+ let choices = f (proof,goal)
+ in
+ List.map
+ (function (subst,(proof, goallist)) ->
+ (* let goallist = reorder_goals dbd sign proof goallist in *)
+ let goallist = List.sort (compare_goals proof) goallist in
+ (subst,(proof,(List.map (function g -> (g,depth)) goallist), sign)))
+ choices
+;;
+
+exception NoOtherChoices;;
+
+let rec auto_single dbd proof goal ey ty depth width sign already_seen_goals
+ universe
+ =
+ if depth = 0 then [] else
+ if List.mem ty already_seen_goals then [] else
+ let already_seen_goals = ty::already_seen_goals in
+ let facts = (depth = 1) in
+ let _,metasenv,p,_ = proof in
+ (* first of all we check if the goal has been already
+ inspected *)
+ assert (CicUtil.exists_meta goal metasenv);
+ let exitus =
+ try Hashtbl.find inspected_goals ty
+ with Not_found -> NotYetInspected in
+ let is_meta_closed = CicUtil.is_meta_closed ty in
+ begin
+ match exitus with
+ Yes (bo,_) ->
+ (*
+ debug_print (lazy "ALREADY PROVED!!!!!!!!!!!!!!!!!!!!!!!!!!!!");
+ debug_print (lazy (CicPp.ppterm ty));
+ *)
+ let subst_in =
+ (* if we just apply the subtitution, the type
+ is irrelevant: we may use Implicit, since it will
+ be dropped *)
+ CicMetaSubst.apply_subst
+ [(goal,(ey, bo, Cic.Implicit None))] in
+ let (proof,_) =
+ ProofEngineHelpers.subst_meta_and_metasenv_in_proof
+ proof goal subst_in metasenv in
+ [(subst_in,(proof,[],sign))]
+ | No d when (d >= depth) ->
+ (* debug_print (lazy "PRUNED!!!!!!!!!!!!!!!!!!!!!!!!!!!!"); *)
+ [] (* the empty list means no choices, i.e. failure *)
+ | No _
+ | NotYetInspected ->
+ debug_print (lazy ("CURRENT GOAL = " ^ CicPp.ppterm ty));
+ debug_print (lazy ("CURRENT PROOF = " ^ CicPp.ppterm p));
+ debug_print (lazy ("CURRENT HYP = " ^ CicPp.ppcontext ey));
+ let sign, new_sign =
+ if is_meta_closed then
+ None, Some (MetadataConstraints.signature_of ty)
+ else sign,sign in (* maybe the union ? *)
+ let local_choices =
+ new_search_theorems
+ search_theorems_in_context dbd
+ proof goal (depth-1) new_sign in
+ let global_choices =
+ new_search_theorems
+ (fun status ->
+ List.map snd
+ (new_experimental_hint
+ ~dbd ~facts:facts ?signature:sign ~universe status))
+ dbd proof goal (depth-1) new_sign in
+ let all_choices =
+ local_choices@global_choices in
+ let sorted_choices =
+ List.stable_sort
+ (fun (_, (_, goals1, _)) (_, (_, goals2, _)) ->
+ Pervasives.compare
+ (List.length goals1) (List.length goals2))
+ all_choices in
+ (match (auto_new dbd width already_seen_goals universe sorted_choices)
+ with
+ [] ->
+ (* no proof has been found; we update the
+ hastable *)
+ (* if is_meta_closed then *)
+ Hashtbl.add inspected_goals ty (No depth);
+ []
+ | (subst,(proof,[],sign))::tl1 ->
+ (* a proof for goal has been found:
+ in order to get the proof we apply subst to
+ Meta[goal] *)
+ if is_meta_closed then
+ begin
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable ey in
+ let meta_proof =
+ subst (Cic.Meta(goal,irl)) in
+ Hashtbl.add inspected_goals
+ ty (Yes (meta_proof,depth));
+(*
+ begin
+ let cty,_ =
+ CicTypeChecker.type_of_aux' metasenv ey meta_proof CicUniv.empty_ugraph
+ in
+ if not (cty = ty) then
+ begin
+ debug_print (lazy ("ty = "^CicPp.ppterm ty));
+ debug_print (lazy ("cty = "^CicPp.ppterm cty));
+ assert false
+ end
+ Hashtbl.add inspected_goals
+ ty (Yes (meta_proof,depth));
+ end;
+*)
+ end;
+ (subst,(proof,[],sign))::tl1
+ | _ -> assert false)
+ end
+
+and auto_new dbd width already_seen_goals universe = function
+ | [] -> []
+ | (subst,(proof, goals, sign))::tl ->
+ let _,metasenv,_,_ = proof in
+ let goals'=
+ List.filter (fun (goal, _) -> CicUtil.exists_meta goal metasenv) goals
+ in
+ auto_new_aux dbd
+ width already_seen_goals universe ((subst,(proof, goals', sign))::tl)
+
+and auto_new_aux dbd width already_seen_goals universe = function
+ | [] -> []
+ | (subst,(proof, [], sign))::tl -> (subst,(proof, [], sign))::tl
+ | (subst,(proof, (goal,0)::_, _))::tl ->
+ auto_new dbd width already_seen_goals universe tl
+ | (subst,(proof, goals, _))::tl when
+ (List.length goals) > width ->
+ auto_new dbd width already_seen_goals universe tl
+ | (subst,(proof, (goal,depth)::gtl, sign))::tl ->
+ let _,metasenv,p,_ = proof in
+ let (_, ey ,ty) = CicUtil.lookup_meta goal metasenv in
+ match (auto_single dbd proof goal ey ty depth
+ (width - (List.length gtl)) sign already_seen_goals) universe
+ with
+ [] -> auto_new dbd width already_seen_goals universe tl
+ | (local_subst,(proof,[],sign))::tl1 ->
+ let new_subst f t = f (subst t) in
+ let is_meta_closed = CicUtil.is_meta_closed ty in
+ let all_choices =
+ if is_meta_closed then
+ (new_subst local_subst,(proof,gtl,sign))::tl
+ else
+ let tl2 =
+ (List.map
+ (function (f,(p,l,s)) -> (new_subst f,(p,l@gtl,s))) tl1)
+ in
+ (new_subst local_subst,(proof,gtl,sign))::tl2@tl in
+ auto_new dbd width already_seen_goals universe all_choices
+ | _ -> assert false
+ ;;
+
+let default_depth = 5
+let default_width = 3
+
+(*
+let auto_tac ?(depth=default_depth) ?(width=default_width) ~(dbd:HMysql.dbd)
+ ()
+=
+ let auto_tac dbd (proof,goal) =
+ let universe = MetadataQuery.signature_of_goal ~dbd (proof,goal) in
+ Hashtbl.clear inspected_goals;
+ debug_print (lazy "Entro in Auto");
+ let id t = t in
+ let t1 = Unix.gettimeofday () in
+ match auto_new dbd width [] universe [id,(proof, [(goal,depth)],None)] with
+ [] -> debug_print (lazy "Auto failed");
+ raise (ProofEngineTypes.Fail "No Applicable theorem")
+ | (_,(proof,[],_))::_ ->
+ let t2 = Unix.gettimeofday () in
+ debug_print (lazy "AUTO_TAC HA FINITO");
+ let _,_,p,_ = proof in
+ debug_print (lazy (CicPp.ppterm p));
+ Printf.printf "tempo: %.9f\n" (t2 -. t1);
+ (proof,[])
+ | _ -> assert false
+ in
+ ProofEngineTypes.mk_tactic (auto_tac dbd)
+;;
+*)
+
+let paramodulation_tactic = ref
+ (fun dbd ?full ?depth ?width status ->
+ raise (ProofEngineTypes.Fail (lazy "Not Ready yet...")));;
+
+let term_is_equality = ref
+ (fun term -> debug_print (lazy "term_is_equality E` DUMMY!!!!"); false);;
+
+
+let auto_tac ?(depth=default_depth) ?(width=default_width) ?paramodulation
+ ?full ~(dbd:HMysql.dbd) () =
+ let auto_tac dbd (proof, goal) =
+ let normal_auto () =
+ let universe = MetadataQuery.signature_of_goal ~dbd (proof, goal) in
+ Hashtbl.clear inspected_goals;
+ debug_print (lazy "Entro in Auto");
+ let id t = t in
+ let t1 = Unix.gettimeofday () in
+ match
+ auto_new dbd width [] universe [id, (proof, [(goal, depth)], None)]
+ with
+ [] -> debug_print(lazy "Auto failed");
+ raise (ProofEngineTypes.Fail (lazy "No Applicable theorem"))
+ | (_,(proof,[],_))::_ ->
+ let t2 = Unix.gettimeofday () in
+ debug_print (lazy "AUTO_TAC HA FINITO");
+ let _,_,p,_ = proof in
+ debug_print (lazy (CicPp.ppterm p));
+ debug_print (lazy (Printf.sprintf "tempo: %.9f\n" (t2 -. t1)));
+ (proof,[])
+ | _ -> assert false
+ in
+ let full = match full with None -> false | Some _ -> true in
+ let paramodulation_ok =
+ match paramodulation with
+ | None -> false
+ | Some _ ->
+ let _, metasenv, _, _ = proof in
+ let _, _, meta_goal = CicUtil.lookup_meta goal metasenv in
+ full || (!term_is_equality meta_goal)
+ in
+ if paramodulation_ok then (
+ debug_print (lazy "USO PARAMODULATION...");
+(* try *)
+ !paramodulation_tactic dbd ~depth ~width ~full (proof, goal)
+(* with ProofEngineTypes.Fail _ -> *)
+(* normal_auto () *)
+ ) else
+ normal_auto ()
+ in
+ ProofEngineTypes.mk_tactic (auto_tac dbd)
+;;
diff --git a/helm/ocaml/tactics/autoTactic.mli b/helm/ocaml/tactics/autoTactic.mli
new file mode 100644
index 000000000..696c97007
--- /dev/null
+++ b/helm/ocaml/tactics/autoTactic.mli
@@ -0,0 +1,38 @@
+
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val auto_tac:
+ ?depth:int -> ?width:int -> ?paramodulation:string -> ?full:string ->
+ dbd:HMysql.dbd -> unit ->
+ ProofEngineTypes.tactic
+
+val paramodulation_tactic:
+ (HMysql.dbd -> ?full:bool -> ?depth:int -> ?width:int ->
+ ProofEngineTypes.status ->
+ ProofEngineTypes.proof * ProofEngineTypes.goal list) ref
+
+val term_is_equality:
+ (Cic.term -> bool) ref
diff --git a/helm/ocaml/tactics/continuationals.ml b/helm/ocaml/tactics/continuationals.ml
new file mode 100644
index 000000000..3ed167a71
--- /dev/null
+++ b/helm/ocaml/tactics/continuationals.ml
@@ -0,0 +1,357 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+let debug = false
+let debug_print s = if debug then prerr_endline (Lazy.force s) else ()
+
+exception Error of string lazy_t
+let fail msg = raise (Error msg)
+
+type goal = ProofEngineTypes.goal
+
+module Stack =
+struct
+ type switch = Open of goal | Closed of goal
+ type locator = int * switch
+ type tag = [ `BranchTag | `FocusTag | `NoTag ]
+ type entry = locator list * locator list * locator list * tag
+ type t = entry list
+
+ let empty = [ [], [], [], `NoTag ]
+
+ let fold ~env ~cont ~todo init stack =
+ let rec aux acc depth =
+ function
+ | [] -> acc
+ | (locs, todos, conts, tag) :: tl ->
+ let acc = List.fold_left (fun acc -> env acc depth tag) acc locs in
+ let acc = List.fold_left (fun acc -> cont acc depth tag) acc conts in
+ let acc = List.fold_left (fun acc -> todo acc depth tag) acc todos in
+ aux acc (depth + 1) tl
+ in
+ assert (stack <> []);
+ aux init 0 stack
+
+ let iter ~env ~cont ~todo =
+ fold ~env:(fun _ -> env) ~cont:(fun _ -> cont) ~todo:(fun _ -> todo) ()
+
+ let map ~env ~cont ~todo =
+ let depth = ref ~-1 in
+ List.map
+ (fun (s, t, c, tag) ->
+ incr depth;
+ let d = !depth in
+ env d tag s, todo d tag t, cont d tag c, tag)
+
+ let is_open = function _, Open _ -> true | _ -> false
+ let close = function n, Open g -> n, Closed g | l -> l
+ let filter_open = List.filter is_open
+ let is_fresh = function n, Open _ when n > 0 -> true | _ -> false
+ let goal_of_loc = function _, Open g | _, Closed g -> g
+ let goal_of_switch = function Open g | Closed g -> g
+ let switch_of_loc = snd
+
+ let zero_pos = List.map (fun g -> 0, Open g)
+
+ let init_pos locs =
+ let pos = ref 0 in (* positions are 1-based *)
+ List.map (function _, sw -> incr pos; !pos, sw) locs
+
+ let extract_pos i =
+ let rec aux acc =
+ function
+ | [] -> fail (lazy (sprintf "relative position %d not found" i))
+ | (i', _) as loc :: tl when i = i' -> loc, (List.rev acc) @ tl
+ | hd :: tl -> aux (hd :: acc) tl
+ in
+ aux []
+
+ let deep_close gs =
+ let close _ _ =
+ List.map (fun l -> if List.mem (goal_of_loc l) gs then close l else l)
+ in
+ let rm _ _ = List.filter (fun l -> not (List.mem (goal_of_loc l) gs)) in
+ map ~env:close ~cont:rm ~todo:rm
+
+ let rec find_goal =
+ function
+ | [] -> raise (Failure "Continuationals.find_goal")
+ | (l :: _, _ , _ , _) :: _ -> goal_of_loc l
+ | ( _ , _ , l :: _, _) :: _ -> goal_of_loc l
+ | ( _ , l :: _, _ , _) :: _ -> goal_of_loc l
+ | _ :: tl -> find_goal tl
+
+ let is_empty =
+ function
+ | [] -> assert false
+ | [ [], [], [], `NoTag ] -> true
+ | _ -> false
+
+ let of_metasenv metasenv =
+ let goals = List.map (fun (g, _, _) -> g) metasenv in
+ [ zero_pos goals, [], [], `NoTag ]
+
+ let head_switches =
+ function
+ | (locs, _, _, _) :: _ -> List.map switch_of_loc locs
+ | [] -> assert false
+
+ let head_goals =
+ function
+ | (locs, _, _, _) :: _ -> List.map goal_of_loc locs
+ | [] -> assert false
+
+ let head_tag =
+ function
+ | (_, _, _, tag) :: _ -> tag
+ | [] -> assert false
+
+ let shift_goals =
+ function
+ | _ :: (locs, _, _, _) :: _ -> List.map goal_of_loc locs
+ | [] -> assert false
+ | _ -> []
+
+ let open_goals stack =
+ let add_open acc _ _ l = if is_open l then goal_of_loc l :: acc else acc in
+ List.rev (fold ~env:add_open ~cont:add_open ~todo:add_open [] stack)
+
+ let (@+) = (@) (* union *)
+
+ let (@-) s1 s2 = (* difference *)
+ List.fold_right
+ (fun e acc -> if List.mem e s2 then acc else e :: acc)
+ s1 []
+
+ let (@~-) locs gs = (* remove some goals from a locators list *)
+ List.fold_right
+ (fun loc acc -> if List.mem (goal_of_loc loc) gs then acc else loc :: acc)
+ locs []
+
+ let pp stack =
+ let pp_goal = string_of_int in
+ let pp_switch =
+ function Open g -> "o" ^ pp_goal g | Closed g -> "c" ^ pp_goal g
+ in
+ let pp_loc (i, s) = string_of_int i ^ pp_switch s in
+ let pp_env env = sprintf "[%s]" (String.concat ";" (List.map pp_loc env)) in
+ let pp_tag = function `BranchTag -> "B" | `FocusTag -> "F" | `NoTag -> "N" in
+ let pp_stack_entry (env, todo, cont, tag) =
+ sprintf "(%s, %s, %s, %s)" (pp_env env) (pp_env todo) (pp_env cont)
+ (pp_tag tag)
+ in
+ String.concat " :: " (List.map pp_stack_entry stack)
+end
+
+module type Status =
+sig
+ type input_status
+ type output_status
+
+ type tactic
+
+ val id_tactic : tactic
+ val mk_tactic : (input_status -> output_status) -> tactic
+ val apply_tactic : tactic -> input_status -> output_status
+
+ val goals : output_status -> goal list * goal list (** opened, closed goals *)
+ val set_goals: goal list * goal list -> output_status -> output_status
+ val get_stack : input_status -> Stack.t
+ val set_stack : Stack.t -> output_status -> output_status
+
+ val inject : input_status -> output_status
+ val focus : goal -> output_status -> input_status
+end
+
+module type C =
+sig
+ type input_status
+ type output_status
+ type tactic
+
+ type tactical =
+ | Tactic of tactic
+ | Skip
+
+ type t =
+ | Dot
+ | Semicolon
+
+ | Branch
+ | Shift
+ | Pos of int
+ | Merge
+
+ | Focus of goal list
+ | Unfocus
+
+ | Tactical of tactical
+
+ val eval: t -> input_status -> output_status
+end
+
+module Make (S: Status) =
+struct
+ open Stack
+
+ type input_status = S.input_status
+ type output_status = S.output_status
+ type tactic = S.tactic
+
+ type tactical =
+ | Tactic of tactic
+ | Skip
+
+ type t =
+ | Dot
+ | Semicolon
+ | Branch
+ | Shift
+ | Pos of int
+ | Merge
+ | Focus of goal list
+ | Unfocus
+ | Tactical of tactical
+
+ let pp_t =
+ function
+ | Dot -> "Dot"
+ | Semicolon -> "Semicolon"
+ | Branch -> "Branch"
+ | Shift -> "Shift"
+ | Pos i -> "Pos " ^ string_of_int i
+ | Merge -> "Merge"
+ | Focus gs ->
+ sprintf "Focus [%s]" (String.concat "; " (List.map string_of_int gs))
+ | Unfocus -> "Unfocus"
+ | Tactical _ -> "Tactical <abs>"
+
+ let eval_tactical tactical ostatus switch =
+ match tactical, switch with
+ | Tactic tac, Open n ->
+ let ostatus = S.apply_tactic tac (S.focus n ostatus) in
+ let opened, closed = S.goals ostatus in
+ ostatus, opened, closed
+ | Skip, Closed n -> ostatus, [], [n]
+ | Tactic _, Closed _ -> fail (lazy "can't apply tactic to a closed goal")
+ | Skip, Open _ -> fail (lazy "can't skip an open goal")
+
+ let eval cmd istatus =
+ let stack = S.get_stack istatus in
+ debug_print (lazy (sprintf "EVAL CONT %s <- %s" (pp_t cmd) (pp stack)));
+ let new_stack stack = S.inject istatus, stack in
+ let ostatus, stack =
+ match cmd, stack with
+ | _, [] -> assert false
+ | Tactical tac, (g, t, k, tag) :: s ->
+ if g = [] then fail (lazy "can't apply a tactic to zero goals");
+ debug_print (lazy ("context length " ^string_of_int (List.length g)));
+ let rec aux s go gc =
+ function
+ | [] -> s, go, gc
+ | loc :: loc_tl ->
+ debug_print (lazy "inner eval tactical");
+ let s, go, gc =
+ if List.exists ((=) (goal_of_loc loc)) gc then
+ s, go, gc
+ else
+ let s, go', gc' = eval_tactical tac s (switch_of_loc loc) in
+ s, (go @- gc') @+ go', gc @+ gc'
+ in
+ aux s go gc loc_tl
+ in
+ let s0, go0, gc0 = S.inject istatus, [], [] in
+ let sn, gon, gcn = aux s0 go0 gc0 g in
+ debug_print (lazy ("opened: "
+ ^ String.concat " " (List.map string_of_int gon)));
+ debug_print (lazy ("closed: "
+ ^ String.concat " " (List.map string_of_int gcn)));
+ let stack =
+ (zero_pos gon, t @~- gcn, k @~- gon, tag) :: deep_close gcn s
+ in
+ sn, stack
+ | Dot, ([], _, [], _) :: _ ->
+ (* backward compatibility: do-nothing-dot *)
+ new_stack stack
+ | Dot, (g, t, k, tag) :: s ->
+ (match filter_open g, k with
+ | loc :: loc_tl, _ -> new_stack (([ loc ], t, loc_tl @+ k, tag) :: s)
+ | [], loc :: k ->
+ assert (is_open loc);
+ new_stack (([ loc ], t, k, tag) :: s)
+ | _ -> fail (lazy "can't use \".\" here"))
+ | Semicolon, _ -> new_stack stack
+ | Branch, (g, t, k, tag) :: s ->
+ (match init_pos g with
+ | [] | [ _ ] -> fail (lazy "too few goals to branch");
+ | loc :: loc_tl ->
+ new_stack
+ (([ loc ], [], [], `BranchTag) :: (loc_tl, t, k, tag) :: s))
+ | Shift, (g, t, k, `BranchTag) :: (g', t', k', tag) :: s ->
+ (match g' with
+ | [] -> fail (lazy "no more goals to shift")
+ | loc :: loc_tl ->
+ new_stack
+ (([ loc ], t @+ filter_open g, [],`BranchTag)
+ :: (loc_tl, t', k', tag) :: s))
+ | Shift, _ -> fail (lazy "can't shift goals here")
+ | Pos i, ([ loc ], [], [],`BranchTag) :: (g', t', k', tag) :: s
+ when is_fresh loc ->
+ let loc_i, g' = extract_pos i g' in
+ new_stack
+ (([ loc_i ], [], [],`BranchTag)
+ :: ([ loc ] @+ g', t', k', tag) :: s)
+ | Pos i, (g, t, k,`BranchTag) :: (g', t', k', tag) :: s ->
+ let loc_i, g' = extract_pos i g' in
+ new_stack
+ (([ loc_i ], [], [],`BranchTag)
+ :: (g', t' @+ filter_open g, k', tag) :: s)
+ | Pos _, _ -> fail (lazy "can't use relative positioning here")
+ | Merge, (g, t, k,`BranchTag) :: (g', t', k', tag) :: s ->
+ new_stack ((t @+ filter_open g @+ g' @+ k, t', k', tag) :: s)
+ | Merge, _ -> fail (lazy "can't merge goals here")
+ | Focus [], _ -> assert false
+ | Focus gs, s ->
+ let stack_locs =
+ let add_l acc _ _ l = if is_open l then l :: acc else acc in
+ Stack.fold ~env:add_l ~cont:add_l ~todo:add_l [] s
+ in
+ List.iter
+ (fun g ->
+ if not (List.exists (fun l -> goal_of_loc l = g) stack_locs) then
+ fail (lazy (sprintf "goal %d not found (or closed)" g)))
+ gs;
+ new_stack ((zero_pos gs, [], [], `FocusTag) :: deep_close gs s)
+ | Unfocus, ([], [], [], `FocusTag) :: s -> new_stack s
+ | Unfocus, _ -> fail (lazy "can't unfocus, some goals are still open")
+ in
+ debug_print (lazy (sprintf "EVAL CONT %s -> %s" (pp_t cmd) (pp stack)));
+ S.set_stack stack ostatus
+end
+
diff --git a/helm/ocaml/tactics/continuationals.mli b/helm/ocaml/tactics/continuationals.mli
new file mode 100644
index 000000000..d40202d4b
--- /dev/null
+++ b/helm/ocaml/tactics/continuationals.mli
@@ -0,0 +1,126 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+exception Error of string Lazy.t
+
+type goal = ProofEngineTypes.goal
+
+(** {2 Goal stack} *)
+
+module Stack:
+sig
+ type switch = Open of goal | Closed of goal
+ type locator = int * switch
+ type tag = [ `BranchTag | `FocusTag | `NoTag ]
+ type entry = locator list * locator list * locator list * tag
+ type t = entry list
+
+ val empty: t
+
+ val find_goal: t -> goal (** find "next" goal *)
+ val is_empty: t -> bool (** a singleton empty level *)
+ val of_metasenv: Cic.metasenv -> t
+ val head_switches: t -> switch list (** top level switches *)
+ val head_goals: t -> goal list (** top level goals *)
+ val head_tag: t -> tag (** top level tag *)
+ val shift_goals: t -> goal list (** second level goals *)
+ val open_goals: t -> goal list (** all (Open) goals *)
+ val goal_of_switch: switch -> goal
+
+ (** @param int depth, depth 0 is the top of the stack *)
+ val fold:
+ env: ('a -> int -> tag -> locator -> 'a) ->
+ cont:('a -> int -> tag -> locator -> 'a) ->
+ todo:('a -> int -> tag -> locator -> 'a) ->
+ 'a -> t -> 'a
+
+ val iter: (** @param depth as above *)
+ env: (int -> tag -> locator -> unit) ->
+ cont:(int -> tag -> locator -> unit) ->
+ todo:(int -> tag -> locator -> unit) ->
+ t -> unit
+
+ val map: (** @param depth as above *)
+ env: (int -> tag -> locator list -> locator list) ->
+ cont:(int -> tag -> locator list -> locator list) ->
+ todo:(int -> tag -> locator list -> locator list) ->
+ t -> t
+
+ val pp: t -> string
+end
+
+(** {2 Functorial interface} *)
+
+module type Status =
+sig
+ type input_status
+ type output_status
+
+ type tactic
+
+ val id_tactic : tactic
+ val mk_tactic : (input_status -> output_status) -> tactic
+ val apply_tactic : tactic -> input_status -> output_status
+
+ val goals : output_status -> goal list * goal list (** opened, closed goals *)
+ val set_goals: goal list * goal list -> output_status -> output_status
+ val get_stack : input_status -> Stack.t
+ val set_stack : Stack.t -> output_status -> output_status
+
+ val inject : input_status -> output_status
+ val focus : goal -> output_status -> input_status
+end
+
+module type C =
+sig
+ type input_status
+ type output_status
+ type tactic
+
+ type tactical =
+ | Tactic of tactic
+ | Skip
+
+ type t =
+ | Dot
+ | Semicolon
+
+ | Branch
+ | Shift
+ | Pos of int
+ | Merge
+ | Focus of goal list
+ | Unfocus
+
+ | Tactical of tactical
+
+ val eval: t -> input_status -> output_status
+end
+
+module Make (S: Status) : C
+ with type tactic = S.tactic
+ and type input_status = S.input_status
+ and type output_status = S.output_status
+
diff --git a/helm/ocaml/tactics/discriminationTactics.ml b/helm/ocaml/tactics/discriminationTactics.ml
new file mode 100644
index 000000000..9e5bc7f43
--- /dev/null
+++ b/helm/ocaml/tactics/discriminationTactics.ml
@@ -0,0 +1,554 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+let debug_print = fun _ -> ()
+
+let rec injection_tac ~term =
+ let injection_tac ~term status =
+ let (proof, goal) = status in
+ let module C = Cic in
+ let module U = UriManager in
+ let module P = PrimitiveTactics in
+ let module T = Tacticals in
+ let _,metasenv,_,_ = proof in
+ let _,context,_ = CicUtil.lookup_meta goal metasenv in
+ let termty,_ = (* TASSI: FIXME *)
+ CicTypeChecker.type_of_aux' metasenv context term CicUniv.empty_ugraph in
+ ProofEngineTypes.apply_tactic
+ (match termty with
+ (C.Appl [(C.MutInd (equri, 0, [])) ; tty ; t1 ; t2])
+ when LibraryObjects.is_eq_URI equri -> (
+ match tty with
+ (C.MutInd (turi,typeno,exp_named_subst))
+ | (C.Appl (C.MutInd (turi,typeno,exp_named_subst)::_)) -> (
+ match t1,t2 with
+ ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1)),
+ (C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2)))
+ when (uri1 = uri2) && (typeno1 = typeno2) &&
+ (consno1 = consno2) && (exp_named_subst1 = exp_named_subst2) ->
+ (* raise (ProofEngineTypes.Fail "Injection: nothing to do") ; *) T.id_tac
+ | ((C.Appl ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1))::applist1)),
+ (C.Appl ((C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2))::applist2)))
+ when (uri1 = uri2) && (typeno1 = typeno2) && (consno1 = consno2) && (exp_named_subst1 = exp_named_subst2) ->
+ let rec traverse_list i l1 l2 =
+ match l1,l2 with
+ [],[] -> T.id_tac
+ | hd1::tl1,hd2::tl2 ->
+ T.then_
+ ~start:(injection1_tac ~i ~term)
+ ~continuation:(traverse_list (i+1) tl1 tl2)
+ | _ -> raise (ProofEngineTypes.Fail (lazy "Discriminate: i 2 termini hanno in testa lo stesso costruttore, ma applicato a un numero diverso di termini. possibile???"))
+ in traverse_list 1 applist1 applist2
+ | ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1)),
+ (C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2)))
+ | ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1)),
+ (C.Appl ((C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2))::_)))
+ | ((C.Appl ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1))::_)),
+ (C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2)))
+ | ((C.Appl ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1))::_)),
+ (C.Appl ((C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2))::_)))
+ when (consno1 <> consno2) || (exp_named_subst1 <> exp_named_subst2) ->
+ (* raise (ProofEngineTypes.Fail "Injection: not a projectable equality but a discriminable one") ; *) T.id_tac
+ | _ -> (* raise (ProofEngineTypes.Fail "Injection: not a projectable equality") ; *) T.id_tac
+ )
+ | _ -> raise (ProofEngineTypes.Fail (lazy "Injection: not a projectable equality"))
+ )
+ | _ -> raise (ProofEngineTypes.Fail (lazy "Injection: not an equation"))
+ ) status
+ in
+ ProofEngineTypes.mk_tactic (injection_tac ~term)
+
+and injection1_tac ~term ~i =
+ let injection1_tac ~term ~i status =
+ let (proof, goal) = status in
+ (* precondizione: t1 e t2 hanno in testa lo stesso costruttore ma differiscono (o potrebbero differire?) nell'i-esimo parametro del costruttore *)
+ let module C = Cic in
+ let module S = CicSubstitution in
+ let module U = UriManager in
+ let module P = PrimitiveTactics in
+ let module T = Tacticals in
+ let _,metasenv,_,_ = proof in
+ let _,context,_ = CicUtil.lookup_meta goal metasenv in
+ let termty,_ = (* TASSI: FIXME *)
+ CicTypeChecker.type_of_aux' metasenv context term CicUniv.empty_ugraph in
+ match termty with (* an equality *)
+ (C.Appl [(C.MutInd (equri, 0, [])) ; tty ; t1 ; t2])
+ when LibraryObjects.is_eq_URI equri -> (
+ match tty with (* some inductive type *)
+ (C.MutInd (turi,typeno,exp_named_subst))
+ | (C.Appl (C.MutInd (turi,typeno,exp_named_subst)::_)) ->
+ let t1',t2',consno = (* sono i due sottotermini che differiscono *)
+ match t1,t2 with
+ ((C.Appl ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1))::applist1)),
+ (C.Appl ((C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2))::applist2)))
+ when (uri1 = uri2) && (typeno1 = typeno2) && (consno1 = consno2) && (exp_named_subst1 = exp_named_subst2) -> (* controllo ridondante *)
+ (List.nth applist1 (i-1)),(List.nth applist2 (i-1)),consno2
+ | _ -> assert false
+ in
+ let tty',_ =
+ CicTypeChecker.type_of_aux' metasenv context t1'
+ CicUniv.empty_ugraph in
+ let pattern =
+ match fst(CicEnvironment.get_obj
+ CicUniv.empty_ugraph turi ) with
+ C.InductiveDefinition (ind_type_list,_,nr_ind_params_dx,_) ->
+ let _,_,_,constructor_list = (List.nth ind_type_list typeno) in
+ let i_constr_id,_ = List.nth constructor_list (consno - 1) in
+ List.map
+ (function (id,cty) ->
+ let reduced_cty = CicReduction.whd context cty in
+ let rec aux t k =
+ match t with
+ C.Prod (_,_,target) when (k <= nr_ind_params_dx) ->
+ aux target (k+1)
+ | C.Prod (binder,source,target) when (k > nr_ind_params_dx) ->
+ let binder' =
+ match binder with
+ C.Name b -> C.Name b
+ | C.Anonymous -> C.Name "y"
+ in
+ C.Lambda (binder',source,(aux target (k+1)))
+ | _ ->
+ let nr_param_constr = k - 1 - nr_ind_params_dx in
+ if (id = i_constr_id)
+ then C.Rel (nr_param_constr - i + 1)
+ else S.lift (nr_param_constr + 1) t1' (* + 1 per liftare anche il lambda agguinto esternamente al case *)
+ in aux reduced_cty 1
+ )
+ constructor_list
+ | _ -> raise (ProofEngineTypes.Fail (lazy "Discriminate: object is not an Inductive Definition: it's imposible"))
+ in
+ ProofEngineTypes.apply_tactic
+ (T.thens
+ ~start:(P.cut_tac (C.Appl [(C.MutInd (equri,0,[])) ; tty' ; t1' ; t2']))
+ ~continuations:[
+ T.then_
+ ~start:(injection_tac ~term:(C.Rel 1))
+ ~continuation:T.id_tac (* !!! qui devo anche fare clear di term tranne al primo passaggio *)
+ ;
+ T.then_
+ ~start:(ProofEngineTypes.mk_tactic
+ (fun status ->
+ let (proof, goal) = status in
+ let _,metasenv,_,_ = proof in
+ let _,context,gty = CicUtil.lookup_meta goal metasenv in
+ let new_t1' =
+ match gty with
+ (C.Appl (C.MutInd (_,_,_)::arglist)) ->
+ List.nth arglist 1
+ | _ -> raise (ProofEngineTypes.Fail (lazy "Injection: goal after cut is not correct"))
+ in
+ ProofEngineTypes.apply_tactic
+ (ReductionTactics.change_tac
+ ~pattern:(ProofEngineTypes.conclusion_pattern
+ (Some new_t1'))
+ (fun _ m u ->
+ C.Appl [ C.Lambda (C.Name "x", tty,
+ C.MutCase (turi, typeno,
+ (C.Lambda ((C.Name "x"),
+ (S.lift 1 tty),
+ (S.lift 2 tty'))),
+ (C.Rel 1), pattern
+ )
+ );
+ t1], m, u))
+ status
+ ))
+ ~continuation:
+ (T.then_
+ ~start:
+ (EqualityTactics.rewrite_simpl_tac
+ ~direction:`LeftToRight
+ ~pattern:(ProofEngineTypes.conclusion_pattern None)
+ term)
+ ~continuation:EqualityTactics.reflexivity_tac
+ )
+ ])
+ status
+ | _ -> raise (ProofEngineTypes.Fail (lazy "Discriminate: not a discriminable equality"))
+ )
+ | _ -> raise (ProofEngineTypes.Fail (lazy "Discriminate: not an equality"))
+ in
+ ProofEngineTypes.mk_tactic (injection1_tac ~term ~i)
+;;
+
+exception TwoDifferentSubtermsFound of int
+
+(* term ha tipo t1=t2; funziona solo se t1 e t2 hanno in testa costruttori
+diversi *)
+
+let discriminate'_tac ~term =
+ let module C = Cic in
+ let module U = UriManager in
+ let module P = PrimitiveTactics in
+ let module T = Tacticals in
+ let fail msg = raise (ProofEngineTypes.Fail (lazy ("Discriminate: " ^ msg))) in
+ let find_discriminating_consno t1 t2 =
+ let rec aux t1 t2 =
+ match t1, t2 with
+ | C.MutConstruct _, C.MutConstruct _ when t1 = t2 -> None
+ | C.Appl ((C.MutConstruct _ as constr1) :: args1),
+ C.Appl ((C.MutConstruct _ as constr2) :: args2)
+ when constr1 = constr2 ->
+ let rec aux_list l1 l2 =
+ match l1, l2 with
+ | [], [] -> None
+ | hd1 :: tl1, hd2 :: tl2 ->
+ (match aux hd1 hd2 with
+ | None -> aux_list tl1 tl2
+ | Some _ as res -> res)
+ | _ -> (* same constructor applied to a different number of args *)
+ assert false
+ in
+ aux_list args1 args2
+ | ((C.MutConstruct (_,_,consno1,subst1)),
+ (C.MutConstruct (_,_,consno2,subst2)))
+ | ((C.MutConstruct (_,_,consno1,subst1)),
+ (C.Appl ((C.MutConstruct (_,_,consno2,subst2)) :: _)))
+ | ((C.Appl ((C.MutConstruct (_,_,consno1,subst1)) :: _)),
+ (C.MutConstruct (_,_,consno2,subst2)))
+ | ((C.Appl ((C.MutConstruct (_,_,consno1,subst1)) :: _)),
+ (C.Appl ((C.MutConstruct (_,_,consno2,subst2)) :: _)))
+ when (consno1 <> consno2) || (subst1 <> subst2) ->
+ Some consno2
+ | _ -> fail "not a discriminable equality"
+ in
+ aux t1 t2
+ in
+ let mk_pattern turi typeno consno context left_args =
+ (* a list of "True" except for the element in position consno which
+ * is "False" *)
+ match fst (CicEnvironment.get_obj CicUniv.empty_ugraph turi) with
+ | C.InductiveDefinition (ind_type_list,_,nr_ind_params,_) ->
+ let _,_,_,constructor_list = List.nth ind_type_list typeno in
+ let false_constr_id,_ = List.nth constructor_list (consno - 1) in
+ List.map
+ (fun (id,cty) ->
+ (* dubbio: e' corretto ridurre in questo context ??? *)
+ let red_ty = CicReduction.whd context cty in
+ let rec aux t k =
+ match t with
+ | C.Prod (_,_,target) when (k <= nr_ind_params) ->
+ CicSubstitution.subst (List.nth left_args (k-1))
+ (aux target (k+1))
+ | C.Prod (binder,source,target) when (k > nr_ind_params) ->
+ C.Lambda (binder, source, (aux target (k+1)))
+ | _ ->
+ if (id = false_constr_id)
+ then (C.MutInd(LibraryObjects.false_URI (),0,[]))
+ else (C.MutInd(LibraryObjects.true_URI (),0,[]))
+ in
+ (CicSubstitution.lift 1 (aux red_ty 1)))
+ constructor_list
+ | _ -> (* object is not an inductive definition *)
+ assert false
+ in
+ let discriminate'_tac ~term status =
+ let (proof, goal) = status in
+ let _,metasenv,_,_ = proof in
+ let _,context,_ = CicUtil.lookup_meta goal metasenv in
+ let termty,_ =
+ CicTypeChecker.type_of_aux' metasenv context term CicUniv.empty_ugraph
+ in
+ match termty with
+ | (C.Appl [(C.MutInd (equri, 0, [])) ; tty ; t1 ; t2])
+ when LibraryObjects.is_eq_URI equri ->
+ let turi,typeno,exp_named_subst,left_args =
+ match tty with
+ | (C.MutInd (turi,typeno,exp_named_subst)) ->
+ turi,typeno,exp_named_subst,[]
+ | (C.Appl (C.MutInd (turi,typeno,exp_named_subst)::left_args)) ->
+ turi,typeno,exp_named_subst,left_args
+ | _ -> fail "not a discriminable equality"
+ in
+ let consno =
+ match find_discriminating_consno t1 t2 with
+ | Some consno -> consno
+ | None -> fail "discriminating terms are structurally equal"
+ in
+ let pattern = mk_pattern turi typeno consno context left_args in
+ let (proof',goals') =
+ ProofEngineTypes.apply_tactic
+ (EliminationTactics.elim_type_tac
+ (C.MutInd (LibraryObjects.false_URI (), 0, [])))
+ status
+ in
+ (match goals' with
+ | [goal'] ->
+ let _,metasenv',_,_ = proof' in
+ let _,context',gty' = CicUtil.lookup_meta goal' metasenv' in
+ ProofEngineTypes.apply_tactic
+ (T.then_
+ ~start:
+ (ReductionTactics.change_tac
+ ~pattern:(ProofEngineTypes.conclusion_pattern (Some gty'))
+ (fun _ m u ->
+ C.Appl [
+ C.Lambda ( C.Name "x", tty,
+ C.MutCase (turi, typeno,
+ (C.Lambda ((C.Name "x"),
+ (CicSubstitution.lift 1 tty),
+ (C.Sort C.Prop))),
+ (C.Rel 1), pattern));
+ t2 ], m, u))
+ ~continuation:
+ (T.then_
+ ~start:
+ (EqualityTactics.rewrite_simpl_tac
+ ~direction:`RightToLeft
+ ~pattern:(ProofEngineTypes.conclusion_pattern None)
+ term)
+ ~continuation:
+ (IntroductionTactics.constructor_tac ~n:1)))
+ (proof',goal')
+ | [] -> fail "ElimType False left no goals"
+ | _ -> fail "ElimType False left more than one goal")
+ | _ -> fail "not an equality"
+ in
+ ProofEngineTypes.mk_tactic (discriminate'_tac ~term)
+
+let discriminate_tac ~term =
+ let discriminate_tac ~term status =
+ ProofEngineTypes.apply_tactic
+ (Tacticals.then_
+ ~start:(* (injection_tac ~term) *) Tacticals.id_tac
+ ~continuation:(discriminate'_tac ~term)) (* NOOO!!! non term ma una (qualunque) delle nuove hyp introdotte da inject *)
+ status
+ in
+ ProofEngineTypes.mk_tactic (discriminate_tac ~term)
+
+let decide_equality_tac =
+(* il goal e' un termine della forma t1=t2\/~t1=t2; la tattica decide se l'uguaglianza
+e' vera o no e lo risolve *)
+ Tacticals.id_tac
+
+let compare_tac ~term = Tacticals.id_tac
+ (*
+(* term is in the form t1=t2; the tactic leaves two goals: in the first you have to *)
+(* demonstrate the goal with the additional hyp that t1=t2, in the second the hyp is ~t1=t2 *)
+ let module C = Cic in
+ let module U = UriManager in
+ let module P = PrimitiveTactics in
+ let module T = Tacticals in
+ let _,metasenv,_,_ = proof in
+ let _,context,gty = CicUtil.lookup_meta goal metasenv in
+ let termty = (CicTypeChecker.type_of_aux' metasenv context term) in
+ match termty with
+ (C.Appl [(C.MutInd (uri, 0, [])); _; t1; t2]) when (uri = (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind")) ->
+
+ let term' = (* (t1=t2)\/~(t1=t2) *)
+ C.Appl [
+ (C.MutInd ((U.uri_of_string "cic:/Coq/Init/Logic/or.ind"), 0, [])) ;
+ term ;
+ C.Appl [
+ (C.MutInd ((U.uri_of_string "cic:/Coq/Init/Logic/eq.ind"), 1, [])) ;
+ t1 ;
+ C.Appl [C.Const ((U.uri_of_string "cic:/Coq/Init/Logic/not.con"), []) ; t2]
+ ]
+ ]
+ in
+ T.thens
+ ~start:(P.cut_tac ~term:term')
+ ~continuations:[
+ T.then_ ~start:(P.intros_tac) ~continuation:(P.elim_intros_simpl_tac ~term:(C.Rel 1)) ;
+ decide_equality_tac]
+ status
+ | (C.Appl [(C.MutInd (uri, 0, [])); _; t1; t2]) when (uri = (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind")) ->
+ let term' = (* (t1=t2) \/ ~(t1=t2) *)
+ C.Appl [
+ (C.MutInd ((U.uri_of_string "cic:/Coq/Init/Logic/or.ind"), 0, [])) ;
+ term ;
+ C.Appl [
+ (C.MutInd ((U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind"), 1, [])) ;
+ t1 ;
+ C.Appl [C.Const ((U.uri_of_string "cic:/Coq/Init/Logic/not.con"), []) ; t2]
+ ]
+ ]
+ in
+ T.thens
+ ~start:(P.cut_tac ~term:term')
+ ~continuations:[
+ T.then_ ~start:(P.intros_tac) ~continuation:(P.elim_intros_simpl_tac ~term:(C.Rel 1)) ;
+ decide_equality_tac]
+ status
+ | _ -> raise (ProofEngineTypes.Fail "Compare: Not an equality")
+*)
+;;
+
+
+
+(* DISCRIMINTATE SENZA INJECTION
+
+exception TwoDifferentSubtermsFound of (Cic.term * Cic.term * int)
+
+let discriminate_tac ~term status =
+ let module C = Cic in
+ let module U = UriManager in
+ let module P = PrimitiveTactics in
+ let module T = Tacticals in
+ let (proof, goal) = status in
+ let _,metasenv,_,_ = proof in
+ let _,context,_ = CicUtil.lookup_meta goal metasenv in
+ let termty = (CicTypeChecker.type_of_aux' metasenv context term) in
+ match termty with
+ (C.Appl [(C.MutInd (equri, 0, [])) ; tty ; t1 ; t2])
+ when (U.eq equri (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind"))
+ or (U.eq equri (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind")) -> (
+ match tty with
+ (C.MutInd (turi,typeno,exp_named_subst))
+ | (C.Appl (C.MutInd (turi,typeno,exp_named_subst)::_)) ->
+
+ let (t1',t2',consno2') = (* bruuutto: uso un eccezione per terminare con successo! buuu!! :-/ *)
+ try
+ let rec traverse t1 t2 =
+debug_print (lazy ("XXXX t1 " ^ CicPp.ppterm t1)) ;
+debug_print (lazy ("XXXX t2 " ^ CicPp.ppterm t2)) ;
+ match t1,t2 with
+ ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1)),
+ (C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2)))
+ when (uri1 = uri2) && (typeno1 = typeno2) && (consno1 = consno2) && (exp_named_subst1 = exp_named_subst2) ->
+ t1,t2,0
+ | ((C.Appl ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1))::applist1)),
+ (C.Appl ((C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2))::applist2)))
+ when (uri1 = uri2) && (typeno1 = typeno2) && (consno1 = consno2) && (exp_named_subst1 = exp_named_subst2) ->
+ let rec traverse_list l1 l2 =
+ match l1,l2 with
+ [],[] -> t1,t2,0
+ | hd1::tl1,hd2::tl2 -> traverse hd1 hd2; traverse_list tl1 tl2
+ | _ -> raise (ProofEngineTypes.Fail "Discriminate: i 2 termini hanno in testa lo stesso costruttore, ma applicato a un numero diverso di termini. possibile???")
+ in traverse_list applist1 applist2
+
+ | ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1)),
+ (C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2)))
+ | ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1)),
+ (C.Appl ((C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2))::_)))
+ | ((C.Appl ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1))::_)),
+ (C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2)))
+ | ((C.Appl ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1))::_)),
+ (C.Appl ((C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2))::_)))
+ when (consno1 <> consno2) || (exp_named_subst1 <> exp_named_subst2) ->
+ raise (TwoDifferentSubtermsFound (t1,t2,consno2))
+ | _ -> raise (ProofEngineTypes.Fail "Discriminate: not a discriminable equality")
+ in traverse t1 t2
+ with (TwoDifferentSubtermsFound (t1,t2,consno2)) -> (t1,t2,consno2)
+ in
+debug_print (lazy ("XXXX consno2' " ^ (string_of_int consno2'))) ;
+ if consno2' = 0
+ then raise (ProofEngineTypes.Fail "Discriminate: Discriminating terms are structurally equal")
+ else
+
+ let pattern =
+ (* a list of "True" except for the element in position consno2' which is "False" *)
+ match fst(CicEnvironment.get_obj turi
+ CicUniv.empty_ugraph) with
+ C.InductiveDefinition (ind_type_list,_,nr_ind_params) ->
+debug_print (lazy ("XXXX nth " ^ (string_of_int (List.length ind_type_list)) ^ " " ^ (string_of_int typeno))) ;
+ let _,_,_,constructor_list = (List.nth ind_type_list typeno) in
+debug_print (lazy ("XXXX nth " ^ (string_of_int (List.length constructor_list)) ^ " " ^ (string_of_int consno2'))) ;
+ let false_constr_id,_ = List.nth constructor_list (consno2' - 1) in
+debug_print (lazy "XXXX nth funzionano ") ;
+ List.map
+ (function (id,cty) ->
+ let red_ty = CicReduction.whd context cty in (* dubbio: e' corretto ridurre in questo context ??? *)
+ let rec aux t k =
+ match t with
+ C.Prod (_,_,target) when (k <= nr_ind_params) ->
+ aux target (k+1)
+ | C.Prod (binder,source,target) when (k > nr_ind_params) ->
+ C.Lambda (binder,source,(aux target (k+1)))
+ | _ ->
+ if (id = false_constr_id)
+ then (C.MutInd (U.uri_of_string "cic:/Coq/Init/Logic/False.ind") 0 [])
+ else (C.MutInd (U.uri_of_string "cic:/Coq/Init/Logic/True.ind") 0 [])
+ in aux red_ty 1
+ )
+ constructor_list
+ | _ -> raise (ProofEngineTypes.Fail "Discriminate: object is not an Inductive Definition: it's imposible")
+ in
+
+ let (proof',goals') =
+ EliminationTactics.elim_type_tac
+ ~term:(C.MutInd (U.uri_of_string "cic:/Coq/Init/Logic/False.ind") 0 [] )
+ status
+ in
+ (match goals' with
+ [goal'] ->
+ let _,metasenv',_,_ = proof' in
+ let _,context',gty' =
+ CicUtil.lookup_meta goal' metasenv'
+ in
+ T.then_
+ ~start:
+ (P.change_tac
+ ~what:gty'
+ ~with_what:
+ (C.Appl [
+ C.Lambda (
+ C.Name "x", tty,
+ C.MutCase (
+ turi, typeno,
+ (C.Lambda ((C.Name "x"),tty,(C.Sort C.Prop))),
+ (C.Rel 1), pattern
+ )
+ );
+ t2']
+ )
+ )
+ ~continuation:
+ (
+debug_print (lazy ("XXXX rewrite<-: " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' (C.Appl [(C.MutInd (equri,0,[])) ; tty ; t1' ; t2']))));
+debug_print (lazy ("XXXX rewrite<-: " ^ CicPp.ppterm (C.Appl [(C.MutInd (equri,0,[])) ; tty ; t1' ; t2']))) ;
+debug_print (lazy ("XXXX equri: " ^ U.string_of_uri equri)) ;
+debug_print (lazy ("XXXX tty : " ^ CicPp.ppterm tty)) ;
+debug_print (lazy ("XXXX tt1': " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' t1'))) ;
+debug_print (lazy ("XXXX tt2': " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' t2'))) ;
+if (CicTypeChecker.type_of_aux' metasenv' context' t1') <> tty then debug_print (lazy ("XXXX tt1': " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' t1'))) ;
+if (CicTypeChecker.type_of_aux' metasenv' context' t2') <> tty then debug_print (lazy ("XXXX tt2': " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' t2'))) ;
+if (CicTypeChecker.type_of_aux' metasenv' context' t1') <> (CicTypeChecker.type_of_aux' metasenv' context' t2')
+ then debug_print (lazy ("XXXX tt1': " ^ CicPp.ppterm (CicTypeChecker.type_of_aux'
+ metasenv' context' t1'))) ; debug_print (lazy ("XXXX tt2': " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' t2'))) ;
+
+ let termty' = ProofEngineReduction.replace_lifting ~equality:(==) ~what:t1 ~with_what:t1' ~where:termty in
+ let termty'' = ProofEngineReduction.replace_lifting ~equality:(==) ~what:t2 ~with_what:t2' ~where:termty' in
+
+debug_print (lazy ("XXXX rewrite<- " ^ CicPp.ppterm term ^ " : " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' term)));
+ T.then_
+ ~start:(EqualityTactics.rewrite_back_simpl_tac ~term:term)
+ ~continuation:(IntroductionTactics.constructor_tac ~n:1)
+ )
+ (proof',goal')
+ | _ -> raise (ProofEngineTypes.Fail "Discriminate: ElimType False left more (or less) than one goal")
+ )
+ | _ -> raise (ProofEngineTypes.Fail "Discriminate: not a discriminable equality")
+ )
+ | _ -> raise (ProofEngineTypes.Fail "Discriminate: not an equality")
+;;
+
+*)
+
+
+
diff --git a/helm/ocaml/tactics/discriminationTactics.mli b/helm/ocaml/tactics/discriminationTactics.mli
new file mode 100644
index 000000000..f1153256f
--- /dev/null
+++ b/helm/ocaml/tactics/discriminationTactics.mli
@@ -0,0 +1,30 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val injection_tac: term:Cic.term -> ProofEngineTypes.tactic
+val discriminate_tac: term:Cic.term -> ProofEngineTypes.tactic
+val decide_equality_tac: ProofEngineTypes.tactic
+val compare_tac: term:Cic.term -> ProofEngineTypes.tactic
+
diff --git a/helm/ocaml/tactics/doc/Makefile b/helm/ocaml/tactics/doc/Makefile
new file mode 100644
index 000000000..b7d8fb45c
--- /dev/null
+++ b/helm/ocaml/tactics/doc/Makefile
@@ -0,0 +1,124 @@
+
+#
+# Generic makefile for latex
+#
+# Author: Stefano Zacchiroli <zack@bononia.it>
+#
+# Created: Sun, 29 Jun 2003 12:00:55 +0200 zack
+# Last-Modified: Mon, 10 Oct 2005 15:37:12 +0200 zack
+#
+
+########################################################################
+
+# list of .tex _main_ files
+TEXS = main.tex
+
+# number of runs of latex (for table of contents, list of figures, ...)
+RUNS = 1
+
+# do you need bibtex?
+BIBTEX = no
+
+# would you like to use pdflatex?
+PDF_VIA_PDFLATEX = yes
+
+# which formats generated by default ("all" target)?
+# (others will be generated by "world" target)
+# see AVAILABLE_FORMATS below
+BUILD_FORMATS = dvi
+
+# which format to be shown on "make show"
+SHOW_FORMAT = dvi
+
+########################################################################
+
+AVAILABLE_FORMATS = dvi ps ps.gz pdf html
+
+ADVI = advi
+BIBTEX = bibtex
+BROWSER = galeon
+DVIPDF = dvipdf
+DVIPS = dvips
+GV = gv
+GZIP = gzip
+HEVEA = hevea
+ISPELL = ispell
+LATEX = latex
+PDFLATEX = pdflatex
+PRINT = lpr
+XDVI = xdvi
+XPDF = xpdf
+
+ALL_FORMATS = $(BUILD_FORMATS)
+WORLD_FORMATS = $(AVAILABLE_FORMATS)
+
+all: $(ALL_FORMATS)
+world: $(WORLD_FORMATS)
+
+DVIS = $(TEXS:.tex=.dvi)
+PSS = $(TEXS:.tex=.ps)
+PSGZS = $(TEXS:.tex=.ps.gz)
+PDFS = $(TEXS:.tex=.pdf)
+HTMLS = $(TEXS:.tex=.html)
+
+dvi: $(DVIS)
+ps: $(PSS)
+ps.gz: $(PSGZS)
+pdf: $(PDFS)
+html: $(HTMLS)
+
+show: show$(SHOW_FORMAT)
+showdvi: $(DVIS)
+ $(XDVI) $<
+showps: $(PSS)
+ $(GV) $<
+showpdf: $(PDFS)
+ $(XPDF) $<
+showpsgz: $(PSGZS)
+ $(GV) $<
+showps.gz: showpsgz
+showhtml: $(HTMLS)
+ $(BROWSER) $<
+
+print: $(PSS)
+ $(PRINT) $^
+
+clean:
+ rm -f \
+ $(TEXS:.tex=.dvi) $(TEXS:.tex=.ps) $(TEXS:.tex=.ps.gz) \
+ $(TEXS:.tex=.pdf) $(TEXS:.tex=.aux) $(TEXS:.tex=.log) \
+ $(TEXS:.tex=.html) $(TEXS:.tex=.out) $(TEXS:.tex=.haux) \
+ $(TEXS:.tex=.htoc) $(TEXS:.tex=.tmp)
+
+%.dvi: %.tex
+ $(LATEX) $<
+ if [ "$(BIBTEX)" = "yes" ]; then $(BIBTEX) $*; fi
+ if [ "$(RUNS)" -gt 1 ]; then \
+ for i in seq 1 `expr $(RUNS) - 1`; do \
+ $(LATEX) $<; \
+ done; \
+ fi
+ifeq ($(PDF_VIA_PDFLATEX),yes)
+%.pdf: %.tex
+ $(PDFLATEX) $<
+ if [ "$(BIBTEX)" = "yes" ]; then $(BIBTEX) $*; fi
+ if [ "$(RUNS)" -gt 1 ]; then \
+ for i in seq 1 `expr $(RUNS) - 1`; do \
+ $(PDFLATEX) $<; \
+ done; \
+ fi
+else
+%.pdf: %.dvi
+ $(DVIPDF) $< $@
+endif
+%.ps: %.dvi
+ $(DVIPS) $<
+%.ps.gz: %.ps
+ $(GZIP) -c $< > $@
+%.html: %.tex
+ $(HEVEA) -fix $<
+
+.PHONY: all ps pdf html clean
+
+########################################################################
+
diff --git a/helm/ocaml/tactics/doc/body.tex b/helm/ocaml/tactics/doc/body.tex
new file mode 100644
index 000000000..8b7bbc9b0
--- /dev/null
+++ b/helm/ocaml/tactics/doc/body.tex
@@ -0,0 +1,474 @@
+
+\section{Tinycals: \MATITA{} tacticals}
+
+\subsection{Introduction}
+
+% outline:
+% - script
+
+Most of modern mainstream proof assistants enable input of proofs of
+propositions using a textual language. Compilation units written in such
+languages are sequence of textual \emph{statements} and are usually called
+\emph{scripts} as a whole. Scripts are so entangled with proof assistants that
+they drived the design of state of the art of their Graphical User Interfaces
+(GUIs). Fig.~\ref{fig:proofgeneral} is a screenshot of Proof General, a generic
+proof assistant interface based on Emacs widely used and compatible with systems
+like Coq, Isabelle, PhoX, LEGO, and many more. Other system specific GUIs exist
+but share the same design, understanding it and they way such GUIs are operated
+is relevant to our discussion.
+
+%\begin{figure}[ht]
+% \begin{center}
+% \includegraphic{pics/pg-coq-screenshot}
+% \caption{Proof General: a generic interface for proof assistants}
+% \label{fig:proofgeneral}
+% \end{center}
+%\end{figure}
+
+% - modo di lavorare
+
+The paradigm behind such GUIs is quite simple. The window on the left is an
+editable text area containing the script and split in two by an \emph{execution
+point} (the point where background color changes). The part starting at the
+beginning of the script and ending at the marker (distinguishable for having a
+light blue background in the picture) contains the sequence of statements which
+have already been fed into the system. We will call this former part
+\emph{locked area} since the user is not free to change it as her willing. The
+remaining part, which extends until the end of the script, is named
+\emph{scratch area} and can be freely modified. The window on the right is
+read-only for the user and includes at the top the current proof status, when
+some proof is ongoing, and at the bottom a message area used for error messages
+or other feedback from the system to the user. The user usually proceed
+alternating editing of the scratch area and execution point movements (forward
+to evaluate statements and backward to retract statements if she need to change
+something in the locked area).
+
+Execution point movements are not free, but constrained by the structure of the
+script language used. The granularity is that of statements. In systems like Coq
+or \MATITA{} examples of statements are: inductive definitions, theorems, and
+tactics. \emph{Tactics} are the building blocks of proofs. For example, the
+following script snippet contains a theorem about a relationship of natural
+minus with natural plus, along with its proof (line numbers have been added for
+the sake of presentation) as it can be found in the standard library of the
+\MATITA{} proof assistant:
+
+%\begin{example}
+%\begin{Verbatim}
+%theorem eq_minus_minus_minus_plus: \forall n,m,p:nat. (n-m)-p = n-(m+p).
+% intros.
+% cut (m+p \le n \or m+p \nleq n).
+% elim Hcut.
+% symmetry.
+% apply plus_to_minus.
+% rewrite > assoc_plus.
+% rewrite > (sym_plus p).
+% rewrite < plus_minus_m_m.
+% rewrite > sym_plus.
+% rewrite < plus_minus_m_m.
+% reflexivity.
+% apply (trans_le ? (m+p)).
+% rewrite < sym_plus.
+% apply le_plus_n.
+% assumption.
+% apply le_plus_to_minus_r.
+% rewrite > sym_plus.
+% assumption.
+% rewrite > (eq_minus_n_m_O n (m+p)).
+% rewrite > (eq_minus_n_m_O (n-m) p).
+% reflexivity.
+% apply le_plus_to_minus.
+% apply lt_to_le.
+% rewrite < sym_plus.
+% apply not_le_to_lt.
+% assumption.
+% apply lt_to_le.
+% apply not_le_to_lt.
+% assumption.
+% apply (decidable_le (m+p) n).
+%qed.
+%\end{Verbatim}
+%\end{example}
+
+The script snippet is made of 32 statements, one per line (but this is not a
+requirement of the \MATITA{} script language, namely \emph{Grafite}). The first
+statement is the assertion that the user want to prove a proposition with a
+given type, specified after the ``\texttt{:}'', its execution will cause
+\MATITA{} to enter the proof state showing to the user the list of goals that
+still need to be proved to conclude the proof. The last statement (\texttt{Qed})
+is an assertion that the proof is completed. All intertwining statements are
+tactic applications.
+
+Given the constraint we mentioned about execution point, while inserting (or
+replaying) the above script, the user may position it at the end of any line,
+having feedback about the status of the proof in that point. See for example
+Fig.~\ref{fig:matita} where an intermediate proof status is shown.
+
+%\begin{figure}[ht]
+% \begin{center}
+% \includegraphic{matita_screenshot}
+% \caption{Matita: ongoing proof}
+% \label{fig:matita}
+% \end{center}
+%\end{figure}
+
+% - script: sorgenti di un linguaggio imperativo, oggetti la loro semantica
+% - script = sequenza di comandi
+
+You can create an analogy among scripts and sources written in an imperative
+programming language, seeing proofs as the denotational semantics of that
+language. In such analogy the language used in the script of
+Fig.~\ref{fig:matita} is rather poor offering as the only programming construct
+the sequential composition of tactic application. What enables step by step
+execution is the operational semantics of each tactic application (i.e. how it
+changes the current proof status).
+
+% - pro: concisi
+
+This kind of scripts have both advantages and drawbacks. Among advantages we can
+for sure list the effectiveness of the language. In spite of being longer than
+the corresponding informal text version of the proof (a gap hardly fillable with
+proof assistants~\cite{debrujinfactor}), the script is fast to write in
+interactive use, enable cut and paste approaches, and gives a lot of flexibility
+(once the syntax is known of course) in tactic application via additional flags
+that can be easily passed to them.
+
+% - cons: non strutturati, hanno senso solo via reply
+
+Unfortunately, drawbacks are non negligible. Scripts like those of
+Fig.~\ref{fig:matita} are completely unstructured and hardly can be assigned a
+meaning simply looking at them. Even experienced users, that knows the details
+of all involved tactics, can hardly figure what a script mean without replaying
+the proof in their heads. This indeed is a key aspect of scripts: they are
+meaningful via \emph{reply}. People interested in understanding a formal proof
+written as a script usually start the preferred tool and execute it step by
+step. A contrasting approach compared to what happens with high level
+programming languages where looking at the code is usually enough to understand
+its details.
+
+% - cons: poco robusti (wrt cambiamenti nelle tattiche, nello statement, ...)
+
+Additionally, scripts are usually not robust against changes, intending with
+that term both changes in the statement that need to be proved (e.g.
+strenghtening of an inductive hypothesis) and changes in the implementation of
+involved tactics. This drawback can force backward compatibility and slow down
+systems development. A real-life example in the history of \MATITA{} was the
+reordering of goals after tactic application; the total time needed to port the
+(tiny at the time) standard library of no more that 30 scripts was 2 days work.
+Having the scripts being structured the task could have been done in much less
+time and even automated.
+
+Tacticals are an attempt at solving this drawbacks.
+
+\subsection{Tacticals}
+
+% - script = sequenza di comandi + tatticali
+
+\ldots descrizione dei tatticali \ldots
+
+% - pro: fattorizzazione
+
+Tacticals as described above have several advantages with respect to plain
+sequential application of tactics. First of all they enable a great amount of
+factorization of proofs using the sequential composition ``;'' operator. Think
+for example at proofs by induction on inductive types with several constructors,
+which are so frequent when formalizing properties from the computer science
+field. It is often the case that several, or even all, cases can be dealt with
+uniform strategies, which can in turn by coded in a single script snipped which
+can appear only once, at the right hand side of a ``;''.
+
+% - pro: robustezza
+
+Scripts properly written using the tacticals above are even more robust with
+respect to changes. The additional amount of flexibility is given by
+``conditional'' constructs like \texttt{try}, \texttt{solve}, and
+\texttt{first}. Using them the scripts no longer contain a single way of
+proceeding from one status of the proof to another, they can list more. The wise
+proof coder may exploit this mechanism providing fallbacks in order to be more
+robust to future changes in tactics implementation. Of course she is not
+required to!
+
+% - pro: strutturazione delle prove (via branching)
+
+Finally, the branching constructs \texttt{[}, \texttt{|}, and \texttt{]} enable
+proof structuring. Consider for example an alternative, branching based, version
+of the example above:
+
+%\begin{example}
+%\begin{Verbatim}
+%...
+%\end{Verbatim}
+%\end{example}
+
+Tactic applications are the same of the previous version of the script, but
+branching tacticals are used. The above version is highly more readable and
+without executing it key points of the proofs like induction cases can be
+observed.
+
+% - tradeoff: utilizzo dei tatticali vs granularita' dell'esecuzione
+% (impossibile eseguire passo passo)
+
+One can now wonder why thus all scripts are not written in a robust, concise and
+structured fashion. The reason is the existence of an unfortunate tradeoff
+between the need of using tacticals and the impossibility of executing step by
+step \emph{inside} them. Indeed, trying to mimic the structured version of the
+proof above in GUIs like Proof General or CoqIDE will result in a single macro
+step that will bring you from the beginning of the proof directly at the end of
+it!
+
+Tinycals as implemented in \MATITA{} are a solution to this problem, preserving
+the usual tacticals semantics, giving meaning to intermediate execution point
+inside complex tacticals.
+
+\subsection{Tinycals}
+
+\subsection{Tinycals semantics}
+
+\subsubsection{Language}
+
+\[
+\begin{array}{rcll}
+ S & ::= & & \mbox{(\textbf{continuationals})}\\
+ & & \TACTIC{T} & \mbox{(tactic)}\\[2ex]
+ & | & \DOT & \mbox{(dot)} \\
+ & | & \SEMICOLON & \mbox{(semicolon)} \\
+ & | & \BRANCH & \mbox{(branch)} \\
+ & | & \SHIFT & \mbox{(shift)} \\
+ & | & \POS{i} & \mbox{(relative positioning)} \\
+ & | & \MERGE & \mbox{(merge)} \\[2ex]
+ & | & \FOCUS{g_1,\dots,g_n} & \mbox{(absolute positioning)} \\
+ & | & \UNFOCUS & \mbox{(unfocus)} \\[2ex]
+ & | & S ~ S & \mbox{(sequential composition)} \\[2ex]
+ T & : := & & \mbox{(\textbf{tactics})}\\
+ & & \SKIP & \mbox{(skip)} \\
+ & | & \mathtt{reflexivity} & \\
+ & | & \mathtt{apply}~t & \\
+ & | & \dots &
+\end{array}
+\]
+
+\subsubsection{Status}
+
+\[
+\begin{array}{rcll}
+ \xi & & & \mbox{(proof status)} \\
+ \mathit{goal} & & & \mbox{(proof goal)} \\[2ex]
+
+ \SWITCH & = & \OPEN~\mathit{goal} ~ | ~ \CLOSED~\mathit{goal} & \\
+ \mathit{locator} & = & \INT\times\SWITCH & \\
+ \mathit{tag} & = & \BRANCHTAG ~ | ~ \FOCUSTAG \\[2ex]
+
+ \Gamma & = & \mathit{locator}~\LIST & \mbox{(context)} \\
+ \tau & = & \mathit{locator}~\LIST & \mbox{(todo)} \\
+ \kappa & = & \mathit{locator}~\LIST & \mbox{(dot's future)} \\[2ex]
+
+ \mathit{stack} & = & (\Gamma\times\tau\times\kappa\times\mathit{tag})~\LIST
+ \\[2ex]
+
+ \mathit{status} & = & \xi\times\mathit{stack} \\
+\end{array}
+\]
+
+\paragraph{Utilities}
+\begin{itemize}
+ \item $\ZEROPOS([g_1;\cdots;g_n]) =
+ [\langle 0,\OPEN~g_1\rangle;\cdots;\langle 0,\OPEN~g_n\rangle]$
+ \item $\INITPOS([\langle i_1,s_1\rangle;\cdots;\langle i_n,s_n\rangle]) =
+ [\langle 1,s_1\rangle;\cdots;\langle n,s_n\rangle]$
+ \item $\ISFRESH(s) =
+ \left\{
+ \begin{array}{ll}
+ \mathit{true} & \mathrm{if} ~ s = \langle n, \OPEN~g\rangle\land n > 0 \\
+ \mathit{false} & \mathrm{otherwise} \\
+ \end{array}
+ \right.$
+ \item $\FILTEROPEN(\mathit{locs})=
+ \left\{
+ \begin{array}{ll}
+ [] & \mathrm{if}~\mathit{locs} = [] \\
+ \langle i,\OPEN~g\rangle :: \FILTEROPEN(\mathit{tl})
+ & \mathrm{if}~\mathit{locs} = \langle i,\OPEN~g\rangle :: \mathit{tl} \\
+ \FILTEROPEN(\mathit{tl})
+ & \mathrm{if}~\mathit{locs} = \mathit{hd} :: \mathit{tl} \\
+ \end{array}
+ \right.$
+ \item $\REMOVEGOALS(G,\mathit{locs}) =
+ \left\{
+ \begin{array}{ll}
+ [] & \mathrm{if}~\mathit{locs} = [] \\
+ \REMOVEGOALS(G,\mathit{tl})
+ & \mathrm{if}~\mathit{locs} = \langle i,\OPEN~g\rangle :: \mathit{tl}
+ \land g\in G\\
+ hd :: \REMOVEGOALS(G,\mathit{tl})
+ & \mathrm{if}~\mathit{locs} = \mathit{hd} :: \mathit{tl} \\
+ \end{array}
+ \right.$
+ \item $\DEEPCLOSE(G,S)$: (intuition) given a set of goals $G$ and a stack $S$
+ it returns a new stack $S'$ identical to the given one with the exceptions
+ that each locator whose goal is in $G$ is marked as closed in $\Gamma$ stack
+ components and removed from $\tau$ and $\kappa$ components.
+ \item $\GOALS(S)$: (inutition) return all goals appearing in whatever position
+ on a given stack $S$, appearing in an \OPEN{} switch.
+\end{itemize}
+
+\paragraph{Invariants}
+\begin{itemize}
+ \item $\forall~\mathrm{entry}~\ENTRY{\Gamma}{\tau}{\kappa}{t}, \forall s
+ \in\tau\cup\kappa, \exists g, s = \OPEN~g$ (each locator on the stack in
+ $\tau$ and $\kappa$ components has an \OPEN~switch).
+ \item Unless \FOCUS{} is used the stack contains no duplicate goals.
+ \item $\forall~\mathrm{locator}~l\in\Gamma \mbox{(with the exception of the
+ top-level $\Gamma$)}, \ISFRESH(l)$.
+\end{itemize}
+
+\subsubsection{Semantics}
+
+\[
+\begin{array}{rcll}
+ \SEMOP{\cdot} & : & C -> \mathit{status} -> \mathit{status} &
+ \mbox{(continuationals semantics)} \\
+ \TSEMOP{\cdot} & : & T -> \xi -> \SWITCH ->
+ \xi\times\GOAL~\LIST\times\GOAL~\LIST & \mbox{(tactics semantics)} \\
+\end{array}
+\]
+
+\[
+\begin{array}{rcl}
+ \mathit{apply\_tac} & : & T -> \xi -> \GOAL ->
+ \xi\times\GOAL~\LIST\times\GOAL~\LIST
+\end{array}
+\]
+
+\[
+\begin{array}{rlcc}
+ \TSEM{T}{\xi}{\OPEN~g} & = & \mathit{apply\_tac}(T,\xi,n) & T\neq\SKIP\\
+ \TSEM{\SKIP}{\xi}{\CLOSED~g} & = & \langle \xi, [], [g]\rangle &
+\end{array}
+\]
+
+\[
+\begin{array}{rcl}
+
+ \SEM{\TACTIC{T}}{\ENTRY{\GIN}{\tau}{\kappa}{t}::S}
+ & =
+ & \langle
+ \xi_n,
+ \ENTRY{\Gamma'}{\tau'}{\kappa'}{t}
+% \ENTRY{\ZEROPOS(G^o_n)}{\tau\setminus G^c_n}{\kappa\setminus G^o_n}{t}
+ :: \DEEPCLOSE(G^c_n,S)
+ \rangle
+ \\[1ex]
+ \multicolumn{3}{l}{\hspace{\sidecondlen}\mathit{where} ~ n\geq 1}
+ \\[1ex]
+ \multicolumn{3}{l}{\hspace{\sidecondlen}\mathit{and} ~
+ \Gamma' = \ZEROPOS(G^o_n)
+ \land \tau' = \REMOVEGOALS(G^c_n,\tau)
+ \land \kappa' = \REMOVEGOALS(G^o_n,\kappa)
+ }
+ \\[1ex]
+ \multicolumn{3}{l}{\hspace{\sidecondlen}\mathit{and} ~
+ \left\{
+ \begin{array}{rcll}
+ \langle\xi_0, G^o_0, G^c_0\rangle & = & \langle\xi, [], []\rangle \\
+ \langle\xi_{i+1}, G^o_{i+1}, G^c_{i+1}\rangle
+ & =
+ & \langle\xi_i, G^o_i, G^c_i\rangle
+ & l_{i+1}\in G^c_i \\
+ \langle\xi_{i+1}, G^o_{i+1}, G^c_{i+1}\rangle
+ & =
+ & \langle\xi, (G^o_i\setminus G^c)\cup G^o, G^c_i\cup G^c\rangle
+ & l_{i+1}\not\in G^c_i \\[1ex]
+ & & \mathit{where} ~ \langle\xi,G^o,G^c\rangle=\TSEM{T}{\xi_i}{l_{i+1}} \\
+ \end{array}
+ \right.
+ }
+ \\[6ex]
+
+ \SEM{~\DOT~}{\ENTRY{\Gamma}{\tau}{\kappa}{t}::S}
+ & =
+ & \langle \xi, \ENTRY{l_1}{\tau}{\GIN[2]\cup\kappa}{t}::S \rangle
+ \\[1ex]
+ & & \mathrm{where} ~ \FILTEROPEN(\Gamma)=\GIN \land n\geq 1
+ \\[2ex]
+
+ \SEM{~\DOT~}{\ENTRY{\Gamma}{\tau}{l::\kappa}{t}::S}
+ & =
+ & \langle \xi, \ENTRY{[l]}{\tau}{\kappa}{t}::S \rangle
+ \\[1ex]
+ & & \mathrm{where} ~ \FILTEROPEN(\Gamma)=[]
+ \\[2ex]
+
+ \SEM{~\SEMICOLON~}{S} & = & \langle \xi, S \rangle \\[1ex]
+
+ \SEM{~\BRANCH~}{\ENTRY{\GIN}{\tau}{\kappa}{t}::S}
+ \quad
+ & =
+ & \langle\xi, \ENTRY{[l_1']}{[]}{[]}{\BRANCHTAG}
+ ::\ENTRY{[l_2';\cdots;l_n']}{\tau}{\kappa}{t}::S
+ \\[1ex]
+ & & \mathrm{where} ~ n\geq 2 ~ \land ~ \INITPOS(\GIN)=[l_1';\cdots;l_n']
+ \\[2ex]
+
+ \SEM{~\SHIFT~}
+ {\ENTRY{\Gamma}{\tau}{\kappa}{\BRANCHTAG}::\ENTRY{\GIN}{\tau'}{\kappa'}{t'}
+ ::S}
+ & =
+ & \langle
+ \xi, \ENTRY{[l_1]}{\tau\cup\FILTEROPEN(\Gamma)}{[]}{\BRANCHTAG}
+ ::\ENTRY{\GIN[2]}{\tau'}{\kappa'}{t'}::S
+ \rangle
+ \\[1ex]
+ & & \mathrm{where} ~ n\geq 1
+ \\[2ex]
+
+ \SEM{~\POS{i}~}
+ {\ENTRY{[l]}{[]}{[]}{\BRANCHTAG}::\ENTRY{\Gamma'}{\tau'}{\kappa'}{t'}::S}
+ & =
+ & \langle \xi, \ENTRY{[l_i]}{[]}{[]}{\BRANCHTAG}
+ ::\ENTRY{l :: (\Gamma'\setminus [l_i])}{\tau'}{\kappa'}{t'}::S \rangle
+ \\[1ex]
+ & & \mathrm{where} ~ \langle i,l'\rangle = l_i\in \Gamma'~\land~\ISFRESH(l)
+ \\[2ex]
+
+ \SEM{~\POS{i}~}
+ {\ENTRY{\Gamma}{\tau}{\kappa}{\BRANCHTAG}
+ ::\ENTRY{\Gamma'}{\tau'}{\kappa'}{t'}::S}
+ & =
+ & \langle \xi, \ENTRY{[l_i]}{[]}{[]}{\BRANCHTAG}
+ ::\ENTRY{\Gamma'\setminus [l_i]}{\tau'\cup\FILTEROPEN(\Gamma)}{\kappa'}{t'}::S
+ \rangle
+ \\[1ex]
+ & & \mathrm{where} ~ \langle i, l'\rangle = l_i\in \Gamma'
+ \\[2ex]
+
+ \SEM{~\MERGE~}
+ {\ENTRY{\Gamma}{\tau}{\kappa}{\BRANCHTAG}::\ENTRY{\Gamma'}{\tau'}{\kappa'}{t'}
+ ::S}
+ & =
+ & \langle \xi,
+ \ENTRY{\tau\cup\FILTEROPEN(\Gamma)\cup\Gamma'\cup\kappa}{\tau'}{\kappa'}{t'}
+ :: S
+ \rangle
+ \\[2ex]
+
+ \SEM{\FOCUS{g_1,\dots,g_n}}{S}
+ & =
+ & \langle \xi, \ENTRY{\ZEROPOS([g_1;\cdots;g_n])}{[]}{[]}{\FOCUSTAG}
+ ::\DEEPCLOSE(S)
+ \rangle
+ \\[1ex]
+ & & \mathrm{where} ~
+ \forall i=1,\dots,n,~g_i\in\GOALS(S)
+ \\[2ex]
+
+ \SEM{\UNFOCUS}{\ENTRY{[]}{[]}{[]}{\FOCUSTAG}::S}
+ & =
+ & \langle \xi, S\rangle \\[2ex]
+
+\end{array}
+\]
+
+\subsection{Related works}
+
+In~\cite{fk:strata2003}, Kirchner described a small step semantics for Coq
+tacticals and PVS strategies.
+
diff --git a/helm/ocaml/tactics/doc/infernce.sty b/helm/ocaml/tactics/doc/infernce.sty
new file mode 100644
index 000000000..fc4afeaaf
--- /dev/null
+++ b/helm/ocaml/tactics/doc/infernce.sty
@@ -0,0 +1,217 @@
+%%
+%% This is file `infernce.sty',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% semantic.dtx (with options: `allOptions,inference')
+%%
+%% IMPORTANT NOTICE:
+%%
+%% For the copyright see the source file.
+%%
+%% Any modified versions of this file must be renamed
+%% with new filenames distinct from infernce.sty.
+%%
+%% For distribution of the original source see the terms
+%% for copying and modification in the file semantic.dtx.
+%%
+%% This generated file may be distributed as long as the
+%% original source files, as listed above, are part of the
+%% same distribution. (The sources need not necessarily be
+%% in the same archive or directory.)
+%%
+%% semantic.dtx (c)1995--2002 Peter M^^f8ller Neergaard and
+%% Arne John Glenstrup
+%%
+\expandafter\ifx\csname sem@nticsLoader\endcsname\relax
+ \PackageError{semantic}{%
+ This file should not be loaded directly}
+ {%
+ This file is an option of the semantic package. It should not be
+ loaded directly\MessageBreak
+ but by using \protect\usepackage{semantic} in your document
+ preamble.\MessageBreak
+ No commands are defined.\MessageBreak
+ Type <return> to proceed.
+ }%
+\else
+\TestForConflict{\@@tempa,\@@tempb,\@adjustPremises,\@inference}
+\TestForConflict{\@inferenceBack,\@inferenceFront,\@inferenceOrPremis}
+\TestForConflict{\@premises,\@processInference,\@processPremiseLine}
+\TestForConflict{\@setLengths,\inference,\predicate,\predicatebegin}
+\TestForConflict{\predicateend,\setnamespace,\setpremisesend}
+\TestForConflict{\setpremisesspace,\@makeLength,\@@space}
+\TestForConflict{\@@aLineBox,\if@@shortDivider}
+\newtoks\@@tempa
+\newtoks\@@tempb
+\newcommand{\@makeLength}[4]{
+ \@@tempa=\expandafter{\csname @@#2\endcsname}
+ \@@tempb=\expandafter{\csname @set#2\endcsname} %
+ \expandafter \newlength \the\@@tempa
+ \expandafter \newcommand \the\@@tempb {}
+ \expandafter \newcommand \csname set#1\endcsname[1]{}
+ \expandafter \xdef \csname set#1\endcsname##1%
+ {{\dimen0=##1}%
+ \noexpand\renewcommand{\the\@@tempb}{%
+ \noexpand\setlength{\the \@@tempa}{##1 #4}}%
+ }%
+ \csname set#1\endcsname{#3}
+ \@@tempa=\expandafter{\@setLengths} %
+ \edef\@setLengths{\the\@@tempa \the\@@tempb} %
+ }
+
+\newcommand{\@setLengths}{%
+ \setlength{\baselineskip}{1.166em}%
+ \setlength{\lineskip}{1pt}%
+ \setlength{\lineskiplimit}{1pt}}
+\@makeLength{premisesspace}{pSpace}{1.5em}{plus 1fil}
+\@makeLength{premisesend}{pEnd}{.75em}{plus 0.5fil}
+\@makeLength{namespace}{nSpace}{.5em}{}
+\newbox\@@aLineBox
+\newif\if@@shortDivider
+\newcommand{\@@space}{ }
+\newcommand{\predicate}[1]{\predicatebegin #1\predicateend}
+\newcommand{\predicatebegin}{$}
+\newcommand{\predicateend}{$}
+\def\inference{%
+ \@@shortDividerfalse
+ \expandafter\hbox\bgroup
+ \@ifstar{\@@shortDividertrue\@inferenceFront}%
+ \@inferenceFront
+}
+\def\@inferenceFront{%
+ \@ifnextchar[%
+ {\@inferenceFrontName}%
+ {\@inferenceMiddle}%
+}
+\def\@inferenceFrontName[#1]{%
+ \setbox3=\hbox{\footnotesize #1}%
+ \ifdim \wd3 > \z@
+ \unhbox3%
+ \hskip\@@nSpace
+ \fi
+ \@inferenceMiddle
+}
+\long\def\@inferenceMiddle#1{%
+ \@setLengths%
+ \setbox\@@pBox=
+ \vbox{%
+ \@premises{#1}%
+ \unvbox\@@pBox
+ }%
+ \@inferenceBack
+}
+\long\def\@inferenceBack#1{%
+ \setbox\@@cBox=%
+ \hbox{\hskip\@@pEnd \predicate{\ignorespaces#1}\unskip\hskip\@@pEnd}%
+ \setbox1=\hbox{$ $}%
+ \setbox\@@pBox=\vtop{\unvbox\@@pBox
+ \vskip 4\fontdimen8\textfont3}%
+ \setbox\@@cBox=\vbox{\vskip 4\fontdimen8\textfont3%
+ \box\@@cBox}%
+ \if@@shortDivider
+ \ifdim\wd\@@pBox >\wd\@@cBox%
+ \dimen1=\wd\@@pBox%
+ \else%
+ \dimen1=\wd\@@cBox%
+ \fi%
+ \dimen0=\wd\@@cBox%
+ \hbox to \dimen1{%
+ \hss
+ $\frac{\hbox to \dimen0{\hss\box\@@pBox\hss}}%
+ {\box\@@cBox}$%
+ \hss
+ }%
+ \else
+ $\frac{\box\@@pBox}%
+ {\box\@@cBox}$%
+ \fi
+ \@ifnextchar[%
+ {\@inferenceBackName}%{}%
+ {\egroup}
+}
+\def\@inferenceBackName[#1]{%
+ \setbox3=\hbox{\footnotesize #1}%
+ \ifdim \wd3 > \z@
+ \hskip\@@nSpace
+ \unhbox3%
+ \fi
+ \egroup
+}
+\newcommand{\@premises}[1]{%
+ \setbox\@@pBox=\vbox{}%
+ \dimen\@@maxwidth=\wd\@@cBox%
+ \@processPremises #1\\\end%
+ \@adjustPremises%
+}
+\newcommand{\@adjustPremises}{%
+ \setbox\@@pBox=\vbox{%
+ \@@moreLinestrue %
+ \loop %
+ \setbox\@@pBox=\vbox{%
+ \unvbox\@@pBox %
+ \global\setbox\@@aLineBox=\lastbox %
+ }%
+ \ifvoid\@@aLineBox %
+ \@@moreLinesfalse %
+ \else %
+ \hbox to \dimen\@@maxwidth{\unhbox\@@aLineBox}%
+ \fi %
+ \if@@moreLines\repeat%
+ }%
+}
+\def\@processPremises#1\\#2\end{%
+ \setbox\@@pLineBox=\hbox{}%
+ \@processPremiseLine #1&\end%
+ \setbox\@@pLineBox=\hbox{\unhbox\@@pLineBox \unskip}%
+ \ifdim \wd\@@pLineBox > \z@ %
+ \setbox\@@pLineBox=%
+ \hbox{\hskip\@@pEnd \unhbox\@@pLineBox \hskip\@@pEnd}%
+ \ifdim \wd\@@pLineBox > \dimen\@@maxwidth %
+ \dimen\@@maxwidth=\wd\@@pLineBox %
+ \fi %
+ \setbox\@@pBox=\vbox{\box\@@pLineBox\unvbox\@@pBox}%
+ \fi %
+ \def\sem@tmp{#2}%
+ \ifx \sem@tmp\empty \else %
+ \@ReturnAfterFi{%
+ \@processPremises #2\end %
+ }%
+ \fi%
+}
+\def\@processPremiseLine#1\end{%
+ \def\sem@tmp{#1}%
+ \ifx \sem@tmp\empty \else%
+ \ifx \sem@tmp\@@space \else%
+ \setbox\@@pLineBox=%
+ \hbox{\unhbox\@@pLineBox%
+ \@inferenceOrPremis #1\inference\end%
+ \hskip\@@pSpace}%
+ \fi%
+ \fi%
+ \def\sem@tmp{#2}%
+ \ifx \sem@tmp\empty \else%
+ \@ReturnAfterFi{%
+ \@processPremiseLine#2\end%
+ }%
+ \fi%
+}
+\def\@inferenceOrPremis#1\inference{%
+ \@ifnext \end
+ {\@dropnext{\predicate{\ignorespaces #1}\unskip}}%
+ {\@processInference #1\inference}%
+}
+\def\@processInference#1\inference\end{%
+ \ignorespaces #1%
+ \setbox3=\lastbox
+ \dimen3=\dp3
+ \advance\dimen3 by -\fontdimen22\textfont2
+ \advance\dimen3 by \fontdimen8\textfont3
+ \expandafter\raise\dimen3\box3%
+}
+\long\def\@ReturnAfterFi#1\fi{\fi#1}
+\fi
+\endinput
+%%
+%% End of file `infernce.sty'.
diff --git a/helm/ocaml/tactics/doc/ligature.sty b/helm/ocaml/tactics/doc/ligature.sty
new file mode 100644
index 000000000..a914d91d1
--- /dev/null
+++ b/helm/ocaml/tactics/doc/ligature.sty
@@ -0,0 +1,169 @@
+%%
+%% This is file `ligature.sty',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% semantic.dtx (with options: `allOptions,ligature')
+%%
+%% IMPORTANT NOTICE:
+%%
+%% For the copyright see the source file.
+%%
+%% Any modified versions of this file must be renamed
+%% with new filenames distinct from ligature.sty.
+%%
+%% For distribution of the original source see the terms
+%% for copying and modification in the file semantic.dtx.
+%%
+%% This generated file may be distributed as long as the
+%% original source files, as listed above, are part of the
+%% same distribution. (The sources need not necessarily be
+%% in the same archive or directory.)
+%%
+%% semantic.dtx (c)1995--2002 Peter M^^f8ller Neergaard and
+%% Arne John Glenstrup
+%%
+\expandafter\ifx\csname sem@nticsLoader\endcsname\relax
+ \PackageError{semantic}{%
+ This file should not be loaded directly}
+ {%
+ This file is an option of the semantic package. It should not be
+ loaded directly\MessageBreak
+ but by using \protect\usepackage{semantic} in your document
+ preamble.\MessageBreak
+ No commands are defined.\MessageBreak
+ Type <return> to proceed.
+ }%
+\else
+\TestForConflict{\@addligto,\@addligtofollowlist,\@def@ligstep}
+\TestForConflict{\@@trymathlig,\@defactive,\@defligstep}
+\TestForConflict{\@definemathlig,\@domathligfirsts,\@domathligfollows}
+\TestForConflict{\@exitmathlig,\@firstmathligs,\@ifactive,\@ifcharacter}
+\TestForConflict{\@ifinlist,\@lastvalidmathlig,\@mathliglink}
+\TestForConflict{\@mathligredefactive,\@mathligsoff,\@mathligson}
+\TestForConflict{\@seentoks,\@setupfirstligchar,\@try@mathlig}
+\TestForConflict{\@trymathlig,\if@mathligon,\mathlig,\mathligprotect}
+\TestForConflict{\mathligsoff,\mathligson,\@startmathlig,\@pushedtoks}
+\newif\if@mathligon
+\DeclareRobustCommand\mathlig[1]{\@addligtolists#1\@@
+ \if@mathligon\mathligson\fi
+ \@setupfirstligchar#1\@@
+ \@defligstep{}#1\@@}
+\def\@mathligson{\if@mathligon\mathligson\fi}
+\def\@mathligsoff{\if@mathligon\mathligsoff\@mathligontrue\fi}
+\DeclareRobustCommand\mathligprotect[1]{\expandafter
+ \def\expandafter#1\expandafter{%
+ \expandafter\@mathligsoff#1\@mathligson}}
+\DeclareRobustCommand\mathligson{\def\do##1##2##3{\mathcode`##1="8000}%
+ \@domathligfirsts\@mathligontrue}
+\AtBeginDocument{\mathligson}
+\DeclareRobustCommand\mathligsoff{\def\do##1##2##3{\mathcode`##1=##2}%
+ \@domathligfirsts\@mathligonfalse}
+\edef\@mathliglink{Error: \noexpand\verb|\string\@mathliglink| expanded}
+{\catcode`\A=11\catcode`\1=12\catcode`\~=13 % Letter, Other and Active
+\gdef\@ifcharacter#1{\ifcat A\noexpand#1\let\next\@firstoftwo
+ \else\ifcat 1\noexpand#1\let\next\@firstoftwo
+ \else\ifcat \noexpand~\noexpand#1\let\next\@firstoftwo
+ \else\let\next\@secondoftwo\fi\fi\fi\next}%
+\gdef\@ifactive#1{\ifcat \noexpand~\noexpand#1\let\next\@firstoftwo
+ \else\let\next\@secondoftwo\fi\next}}
+\def\@domathligfollows{}\def\@domathligfirsts{}
+\def\@makemathligsactive{\mathligson
+ \def\do##1##2##3{\catcode`##1=12}\@domathligfollows}
+\def\@makemathligsnormal{\mathligsoff
+ \def\do##1##2##3{\catcode`##1=##3}\@domathligfollows}
+\def\@ifinlist#1#2{\@tempswafalse
+ \def\do##1##2##3{\ifnum`##1=`#2\relax\@tempswatrue\fi}#1%
+ \if@tempswa\let\next\@firstoftwo\else\let\next\@secondoftwo\fi\next}
+\def\@addligto#1#2{%
+ \@ifinlist#1#2{\def\do##1##2##3{\noexpand\do\noexpand##1%
+ \ifnum`##1=`#2 {\the\mathcode`#2}{\the\catcode`#2}%
+ \else{##2}{##3}\fi}%
+ \edef#1{#1}}%
+ {\def\do##1##2##3{\noexpand\do\noexpand##1%
+ \ifnum`##1=`#2 {\the\mathcode`#2}{\the\catcode`#2}%
+ \else{##2}{##3}\fi}%
+ \edef#1{#1\do#2{\the\mathcode`#2}{\the\catcode`#2}}}}
+\def\@addligtolists#1{\expandafter\@addligto
+ \expandafter\@domathligfirsts
+ \csname\string#1\endcsname\@addligtofollowlist}
+\def\@addligtofollowlist#1{\ifx#1\@@\let\next\relax\else
+ \def\next{\expandafter\@addligto
+ \expandafter\@domathligfollows
+ \csname\string#1\endcsname
+ \@addligtofollowlist}\fi\next}
+\def\@defligstep#1#2{\def\@tempa##1{\ifx##1\endcsname
+ \expandafter\endcsname\else
+ \string##1\expandafter\@tempa\fi}%
+ \expandafter\@def@ligstep\csname @mathlig\@tempa#1#2\endcsname{#1#2}}
+\def\@def@ligstep#1#2#3{%
+ \ifx#3\@@
+ \def\next{\def#1}%
+ \else
+ \ifx#1\relax
+ \def\next{\let#1\@mathliglink\@defligstep{#2}#3}%
+ \else
+ \def\next{\@defligstep{#2}#3}%
+ \fi
+ \fi\next}
+\def\@setupfirstligchar#1#2\@@{%
+ \@ifactive{#1}{%
+ \expandafter\expandafter\expandafter\@mathligredefactive
+ \expandafter\string\expandafter#1\expandafter{#1}{#1}}%
+ {\@defactive#1{\@startmathlig #1}\@namedef{@mathlig#1}{#1}}}
+\def\@mathligredefactive#1#2#3{%
+ \def#3{{}\ifmmode\def\next{\@startmathlig#1}\else
+ \def\next{#2}\fi\next}%
+ \@namedef{@mathlig#1}{#2}}
+\def\@defactive#1{\@ifundefined{@definemathlig\string#1}%
+ {\@latex@error{Illegal first character in math ligature}
+ {You can only use \@firstmathligs\space as the first^^J
+ character of a math ligature}}%
+ {\csname @definemathlig\string#1\endcsname}}
+
+{\def\@firstmathligs{}\def\do#1{\catcode`#1=\active
+ \expandafter\gdef\expandafter\@firstmathligs
+ \expandafter{\@firstmathligs\space\string#1}\next}
+ \def\next#1{\expandafter\gdef\csname
+ @definemathlig\string#1\endcsname{\def#1}}
+ \do{"}"\do{@}@\do{/}/\do{(}(\do{)})\do{[}[\do{]}]\do{=}=
+ \do{?}?\do{!}!\do{`}`\do{'}'\do{|}|\do{~}~\do{<}<\do{>}>
+ \do{+}+\do{-}-\do{*}*\do{.}.\do{,},\do{:}:\do{;};}
+\newtoks\@pushedtoks
+\newtoks\@seentoks
+\def\@startmathlig{\def\@lastvalidmathlig{}\@pushedtoks{}%
+ \@seentoks{}\@trymathlig}
+\def\@trymathlig{\futurelet\next\@@trymathlig}
+\def\@@trymathlig{\@ifcharacter\next{\@try@mathlig}{\@exitmathlig{}}}
+\def\@exitmathlig#1{%
+ \expandafter\@makemathligsnormal\@lastvalidmathlig\mathligson
+ \the\@pushedtoks#1}
+\def\@try@mathlig#1{%\typeout{char: #1 catcode: \the\catcode`#1
+ \@ifundefined{@mathlig\the\@seentoks#1}{\@exitmathlig{#1}}%
+ {\expandafter\ifx
+ \csname @mathlig\the\@seentoks#1\endcsname
+ \@mathliglink
+ \expandafter\@pushedtoks
+ \expandafter=\expandafter{\the\@pushedtoks#1}%
+ \else
+ \expandafter\let\expandafter\@lastvalidmathlig
+ \csname @mathlig\the\@seentoks#1\endcsname
+ \@pushedtoks={}%
+ \fi
+ \expandafter\@seentoks\expandafter=\expandafter%
+ {\the\@seentoks#1}\@makemathligsactive\obeyspaces\@trymathlig}}
+\edef\patch@newmcodes@{%
+ \mathcode\number`\'=39
+ \mathcode\number`\*=42
+ \mathcode\number`\.=\string "613A
+ \mathchardef\noexpand\std@minus=\the\mathcode`\-\relax
+ \mathcode\number`\-=45
+ \mathcode\number`\/=47
+ \mathcode\number`\:=\string "603A\relax
+}
+\AtBeginDocument{\let\newmcodes@=\patch@newmcodes@}
+\fi
+\endinput
+%%
+%% End of file `ligature.sty'.
diff --git a/helm/ocaml/tactics/doc/main.tex b/helm/ocaml/tactics/doc/main.tex
new file mode 100644
index 000000000..06952d61c
--- /dev/null
+++ b/helm/ocaml/tactics/doc/main.tex
@@ -0,0 +1,70 @@
+\documentclass[a4paper]{article}
+
+\usepackage{a4wide}
+\usepackage{pifont}
+\usepackage{semantic}
+\usepackage{stmaryrd}
+\usepackage{graphicx}
+
+\newcommand{\MATITA}{\ding{46}\textsf{\textbf{Matita}}}
+
+\title{Continuationals semantics for \MATITA}
+\author{Claudio Sacerdoti Coen \quad Enrico Tassi \quad Stefano Zacchiroli \\
+\small Department of Computer Science, University of Bologna \\
+\small Mura Anteo Zamboni, 7 -- 40127 Bologna, ITALY \\
+\small \{\texttt{sacerdot}, \texttt{tassi}, \texttt{zacchiro}\}\texttt{@cs.unibo.it}}
+
+\newcommand{\MATHIT}[1]{\ensuremath{\mathit{#1}}}
+\newcommand{\MATHTT}[1]{\ensuremath{\mathtt{#1}}}
+
+\newcommand{\DOT}{\ensuremath{\mbox{\textbf{.}}}}
+\newcommand{\SEMICOLON}{\ensuremath{\mbox{\textbf{;}}}}
+\newcommand{\BRANCH}{\ensuremath{\mbox{\textbf{[}}}}
+\newcommand{\SHIFT}{\ensuremath{\mbox{\textbf{\textbar}}}}
+\newcommand{\POS}[1]{\ensuremath{#1\mbox{\textbf{:}}}}
+\newcommand{\MERGE}{\ensuremath{\mbox{\textbf{]}}}}
+\newcommand{\FOCUS}[1]{\ensuremath{\mathtt{focus}~#1}}
+\newcommand{\UNFOCUS}{\ensuremath{\mathtt{unfocus}}}
+\newcommand{\SKIP}{\MATHTT{skip}}
+\newcommand{\TACTIC}[1]{\ensuremath{\mathtt{tactic}~#1}}
+
+\newcommand{\APPLY}[1]{\ensuremath{\mathtt{apply}~\mathit{#1}}}
+
+\newcommand{\GOAL}{\MATHIT{goal}}
+\newcommand{\SWITCH}{\MATHIT{switch}}
+\newcommand{\LIST}{\MATHTT{list}}
+\newcommand{\INT}{\MATHTT{int}}
+\newcommand{\OPEN}{\MATHTT{Open}}
+\newcommand{\CLOSED}{\MATHTT{Closed}}
+
+\newcommand{\SEMOP}[1]{|[#1|]}
+\newcommand{\TSEMOP}[1]{{}_t|[#1|]}
+\newcommand{\SEM}[3][\xi]{\SEMOP{#2}_{{#1},{#3}}}
+\newcommand{\ENTRY}[4]{\langle#1,#2,#3,#4\rangle}
+\newcommand{\TSEM}[3]{\TSEMOP{#1}_{#2,#3}}
+
+\newcommand{\GIN}[1][1]{\ensuremath{[l_{#1};\cdots;l_n]}}
+
+\newcommand{\ZEROPOS}{\MATHIT{zero\_pos}}
+\newcommand{\INITPOS}{\MATHIT{init\_pos}}
+\newcommand{\ISFRESH}{\MATHIT{is\_fresh}}
+\newcommand{\FILTER}{\MATHIT{filter}}
+\newcommand{\FILTEROPEN}{\MATHIT{filter\_open}}
+\newcommand{\ISOPEN}{\MATHIT{is\_open}}
+\newcommand{\DEEPCLOSE}{\MATHIT{deep\_close}}
+\newcommand{\REMOVEGOALS}{\MATHIT{remove\_goals}}
+\newcommand{\GOALS}{\MATHIT{open\_goals}}
+
+\newcommand{\BRANCHTAG}{\ensuremath{\mathtt{B}}}
+\newcommand{\FOCUSTAG}{\ensuremath{\mathtt{F}}}
+
+\newlength{\sidecondlen}
+\setlength{\sidecondlen}{2cm}
+
+\begin{document}
+\maketitle
+
+\input{body.tex}
+
+\end{document}
+
diff --git a/helm/ocaml/tactics/doc/reserved.sty b/helm/ocaml/tactics/doc/reserved.sty
new file mode 100644
index 000000000..c0d56b8aa
--- /dev/null
+++ b/helm/ocaml/tactics/doc/reserved.sty
@@ -0,0 +1,80 @@
+%%
+%% This is file `reserved.sty',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% semantic.dtx (with options: `allOptions,reservedWords')
+%%
+%% IMPORTANT NOTICE:
+%%
+%% For the copyright see the source file.
+%%
+%% Any modified versions of this file must be renamed
+%% with new filenames distinct from reserved.sty.
+%%
+%% For distribution of the original source see the terms
+%% for copying and modification in the file semantic.dtx.
+%%
+%% This generated file may be distributed as long as the
+%% original source files, as listed above, are part of the
+%% same distribution. (The sources need not necessarily be
+%% in the same archive or directory.)
+%%
+%% semantic.dtx (c)1995--2002 Peter M^^f8ller Neergaard and
+%% Arne John Glenstrup
+%%
+\expandafter\ifx\csname sem@nticsLoader\endcsname\relax
+ \PackageError{semantic}{%
+ This file should not be loaded directly}
+ {%
+ This file is an option of the semantic package. It should not be
+ loaded directly\MessageBreak
+ but by using \protect\usepackage{semantic} in your document
+ preamble.\MessageBreak
+ No commands are defined.\MessageBreak
+ Type <return> to proceed.
+ }%
+\else
+\TestForConflict{\reservestyle,\@reservestyle,\setreserved,\<}
+\TestForConflict{\@parseDefineReserved,\@xparseDefineReserved}
+\TestForConflict{\@defineReserved,\@xdefineReserved}
+\newcommand{\reservestyle}[3][]{
+ \newcommand{#2}{\@parseDefineReserved{#1}{#3}}
+ \expandafter\expandafter\expandafter\def
+ \expandafter\csname set\expandafter\@gobble\string#2\endcsname##1%
+ {#1{#3{##1}}}}
+\newtoks\@@spacing
+\newtoks\@@formating
+\def\@parseDefineReserved#1#2{%
+ \@ifnextchar[{\@xparseDefineReserved{#2}}%
+ {\@xparseDefineReserved{#2}[#1]}}
+\def\@xparseDefineReserved#1[#2]#3{%
+ \@@formating{#1}%
+ \@@spacing{#2}%
+ \expandafter\@defineReserved#3,\end
+}
+\def\@defineReserved#1,{%
+ \@ifnextchar\end
+ {\@xdefineReserved #1[]\END\@gobble}%
+ {\@xdefineReserved#1[]\END\@defineReserved}}
+\def\@xdefineReserved#1[#2]#3\END{%
+ \def\reserved@a{#2}%
+ \ifx \reserved@a\empty \toks0{#1}\else \toks0{#2} \fi
+ \expandafter\edef\csname\expandafter<#1>\endcsname
+ {\the\@@formating{\the\@@spacing{\the\toks0}}}}
+\def\setreserved#1>{%
+ \expandafter\let\expandafter\reserved@a\csname<#1>\endcsname
+ \@ifundefined{reserved@a}{\PackageError{Semantic}
+ {``#1'' is not defined as a reserved word}%
+ {Before referring to a name as a reserved word, it %
+ should be defined\MessageBreak using an appropriate style
+ definer. A style definer is defined \MessageBreak
+ using \protect\reservestyle.\MessageBreak%
+ Type <return> to proceed --- nothing will be set.}}%
+ {\reserved@a}}
+\let\<=\setreserved
+\fi
+\endinput
+%%
+%% End of file `reserved.sty'.
diff --git a/helm/ocaml/tactics/doc/semantic.sty b/helm/ocaml/tactics/doc/semantic.sty
new file mode 100644
index 000000000..98257cab8
--- /dev/null
+++ b/helm/ocaml/tactics/doc/semantic.sty
@@ -0,0 +1,137 @@
+%%
+%% This is file `semantic.sty',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% semantic.dtx (with options: `general')
+%%
+%% IMPORTANT NOTICE:
+%%
+%% For the copyright see the source file.
+%%
+%% Any modified versions of this file must be renamed
+%% with new filenames distinct from semantic.sty.
+%%
+%% For distribution of the original source see the terms
+%% for copying and modification in the file semantic.dtx.
+%%
+%% This generated file may be distributed as long as the
+%% original source files, as listed above, are part of the
+%% same distribution. (The sources need not necessarily be
+%% in the same archive or directory.)
+%%
+%% semantic.dtx (c)1995--2002 Peter M^^f8ller Neergaard and
+%% Arne John Glenstrup
+%%
+\NeedsTeXFormat{LaTeX2e}
+\newcommand{\semanticVersion}{2.0(epsilon)}
+\newcommand{\semanticDate}{2003/10/28}
+\ProvidesPackage{semantic}
+ [\semanticDate\space v\semanticVersion\space]
+\typeout{Semantic Package v\semanticVersion\space [\semanticDate]}
+\typeout{CVSId: $Id$}
+\newcounter{@@conflict}
+\newcommand{\@semanticNotDefinable}{%
+ \typeout{Command \@backslashchar\reserved@a\space already defined}
+ \stepcounter{@@conflict}}
+\newcommand{\@oldNotDefinable}{}
+\let\@oldNotDefinable=\@notdefinable
+\let\@notdefinable=\@semanticNotDefinable
+\newcommand{\TestForConflict}{}
+\def\TestForConflict#1{\sem@test #1,,}
+\newcommand{\sem@test}{}
+\newcommand{\sem@tmp}{}
+\newcommand{\@@next}{}
+\def\sem@test#1,{%
+ \def\sem@tmp{#1}%
+ \ifx \sem@tmp\empty \let\@@next=\relax \else
+ \@ifdefinable{#1}{} \let\@@next=\sem@test \fi
+ \@@next}
+\TestForConflict{\@inputLigature,\@inputInference,\@inputTdiagram}
+\TestForConflict{\@inputReservedWords,\@inputShorthand}
+\TestForConflict{\@ddInput,\sem@nticsLoader,\lo@d}
+\def\@inputLigature{\input{ligature.sty}\message{ math mode ligatures,}%
+ \let\@inputLigature\relax}
+\def\@inputInference{\input{infernce.sty}\message{ inference rules,}%
+ \let\@inputInference\relax}
+\def\@inputTdiagram{\input{tdiagram.sty}\message{ T diagrams,}%
+ \let\@inputTdiagram\relax}
+\def\@inputReservedWords{\input{reserved.sty}\message{ reserved words,}%
+ \let\@inputReservedWords\relax}
+\def\@inputShorthand{\input{shrthand.sty}\message{ short hands,}%
+ \let\@inputShorthand\relax}
+\toks1={}
+\newcommand{\@ddInput}[1]{%
+ \toks1=\expandafter{\the\toks1\noexpand#1}}
+\DeclareOption{ligature}{\@ddInput\@inputLigature}
+\DeclareOption{inference}{\@ddInput\@inputInference}
+\DeclareOption{tdiagram}{\@ddInput\@inputTdiagram}
+\DeclareOption{reserved}{\@ddInput\@inputReservedWords}
+\DeclareOption{shorthand}{\@ddInput\@inputLigature
+ \@ddInput\@inputShorthand}
+\ProcessOptions*
+\typeout{Loading features: }
+\def\sem@nticsLoader{}
+\edef\lo@d{\the\toks1}
+\ifx\lo@d\empty
+ \@inputLigature
+ \@inputInference
+ \@inputTdiagram
+ \@inputReservedWords
+ \@inputShorthand
+\else
+ \lo@d
+\fi
+\typeout{and general definitions.^^J}
+\let\@ddInput\relax
+\let\@inputInference\relax
+\let\@inputLigature\relax
+\let\@inputTdiagram\relax
+\let\@inputReservedWords\relax
+\let\@inputShorthand\relax
+\let\sem@nticsLoader\realx
+\let\lo@d\relax
+\TestForConflict{\@dropnext,\@ifnext,\@ifn,\@ifNextMacro,\@ifnMacro}
+\TestForConflict{\@@maxwidth,\@@pLineBox,\if@@Nested,\@@cBox}
+\TestForConflict{\if@@moreLines,\@@pBox}
+\def\@ifnext#1#2#3{%
+ \let\reserved@e=#1\def\reserved@a{#2}\def\reserved@b{#3}\futurelet%
+ \reserved@c\@ifn}
+\def\@ifn{%
+ \ifx \reserved@c \reserved@e\let\reserved@d\reserved@a\else%
+ \let\reserved@d\reserved@b\fi \reserved@d}
+\def\@ifNextMacro#1#2{%
+ \def\reserved@a{#1}\def\reserved@b{#2}%
+ \futurelet\reserved@c\@ifnMacro}
+\def\@ifnMacro{%
+ \ifcat\noexpand\reserved@c\noexpand\@ifnMacro
+ \let\reserved@d\reserved@a
+ \else \let\reserved@d\reserved@b\fi \reserved@d}
+\newcommand{\@dropnext}[2]{#1}
+\ifnum \value{@@conflict} > 0
+ \PackageError{Semantic}
+ {The \the@@conflict\space command(s) listed above have been
+ redefined.\MessageBreak
+ Please report this to turtle@bu.edu}
+ {Some of the commands defined in semantic was already defined %
+ and has\MessageBreak now be redefined. There is a risk that %
+ these commands will be used\MessageBreak by other packages %
+ leading to spurious errors.\MessageBreak
+ \space\space Type <return> and cross your fingers%
+}\fi
+\let\@notdefinable=\@oldNotDefinable
+\let\@semanticNotDefinable=\relax
+\let\@oldNotDefinable=\relax
+\let\TestForConflict=\relax
+\let\@endmark=\relax
+\let\sem@test=\relax
+\newdimen\@@maxwidth
+\newbox\@@pLineBox
+\newbox\@@cBox
+\newbox\@@pBox
+\newif\if@@moreLines
+\newif\if@@Nested \@@Nestedfalse
+\endinput
+%%
+%% End of file `semantic.sty'.
diff --git a/helm/ocaml/tactics/doc/shrthand.sty b/helm/ocaml/tactics/doc/shrthand.sty
new file mode 100644
index 000000000..b73af4470
--- /dev/null
+++ b/helm/ocaml/tactics/doc/shrthand.sty
@@ -0,0 +1,96 @@
+%%
+%% This is file `shrthand.sty',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% semantic.dtx (with options: `allOptions,shorthand')
+%%
+%% IMPORTANT NOTICE:
+%%
+%% For the copyright see the source file.
+%%
+%% Any modified versions of this file must be renamed
+%% with new filenames distinct from shrthand.sty.
+%%
+%% For distribution of the original source see the terms
+%% for copying and modification in the file semantic.dtx.
+%%
+%% This generated file may be distributed as long as the
+%% original source files, as listed above, are part of the
+%% same distribution. (The sources need not necessarily be
+%% in the same archive or directory.)
+%%
+%% semantic.dtx (c)1995--2002 Peter M^^f8ller Neergaard and
+%% Arne John Glenstrup
+%%
+\expandafter\ifx\csname sem@nticsLoader\endcsname\relax
+ \PackageError{semantic}{%
+ This file should not be loaded directly}
+ {%
+ This file is an option of the semantic package. It should not be
+ loaded directly\MessageBreak
+ but by using \protect\usepackage{semantic} in your document
+ preamble.\MessageBreak
+ No commands are defined.\MessageBreak
+ Type <return> to proceed.
+ }%
+\else
+\IfFileExists{DONOTUSEmathbbol.sty}{%
+ \RequirePackage{mathbbol}
+ \newcommand{\@bblb}{\textbb{[}}
+ \newcommand{\@bbrb}{\textbb{]}}
+ \newcommand{\@mbblb}{\mathopen{\mbox{\textbb{[}}}}
+ \newcommand{\@mbbrb}{\mathclose{\mbox{\textbb{]}}}}
+}
+{ \newcommand{\@bblb}{\textnormal{[\kern-.15em[}}
+ \newcommand{\@bbrb}{\textnormal{]\kern-.15em]}}
+ \newcommand{\@mbblb}{\mathopen{[\mkern-2.67mu[}}
+ \newcommand{\@mbbrb}{\mathclose{]\mkern-2.67mu]}}
+}
+\mathlig{|-}{\vdash}
+\mathlig{|=}{\models}
+\mathlig{->}{\rightarrow}
+\mathlig{->*}{\mathrel{\rightarrow^*}}
+\mathlig{->+}{\mathrel{\rightarrow^+}}
+\mathlig{-->}{\longrightarrow}
+\mathlig{-->*}{\mathrel{\longrightarrow^*}}
+\mathlig{-->+}{\mathrel{\longrightarrow^+}}
+\mathlig{=>}{\Rightarrow}
+\mathlig{=>*}{\mathrel{\Rightarrow^*}}
+\mathlig{=>+}{\mathrel{\Rightarrow^+}}
+\mathlig{==>}{\Longrightarrow}
+\mathlig{==>*}{\mathrel{\Longrightarrow^*}}
+\mathlig{==>+}{\mathrel{\Longrightarrow^+}}
+\mathlig{<-}{\leftarrow}
+\mathlig{*<-}{\mathrel{{}^*\mkern-1mu\mathord\leftarrow}}
+\mathlig{+<-}{\mathrel{{}^+\mkern-1mu\mathord\leftarrow}}
+\mathlig{<--}{\longleftarrow}
+\mathlig{*<--}{\mathrel{{}^*\mkern-1mu\mathord{\longleftarrow}}}
+\mathlig{+<--}{\mathrel{{}^+\mkern-1mu\mathord{\longleftarrow}}}
+\mathlig{<=}{\Leftarrow}
+\mathlig{*<=}{\mathrel{{}^*\mkern-1mu\mathord\Leftarrow}}
+\mathlig{+<=}{\mathrel{{}^+\mkern-1mu\mathord\Leftarrow}}
+\mathlig{<==}{\Longleftarrow}
+\mathlig{*<==}{\mathrel{{}^*\mkern-1mu\mathord{\Longleftarrow}}}
+\mathlig{+<==}{\mathrel{{}^+\mkern-1mu\mathord{\Longleftarrow}}}
+\mathlig{<->}{\longleftrightarrow}
+\mathlig{<=>}{\Longleftrightarrow}
+\mathlig{|[}{\@mbblb}
+\mathlig{|]}{\@mbbrb}
+\newcommand{\evalsymbol}[1][]{\ensuremath{\mathcal{E}^{#1}}}
+\newcommand{\compsymbol}[1][]{\ensuremath{\mathcal{C}^{#1}}}
+\newcommand{\eval}[3][]%
+ {\mbox{$\mathcal{E}^{#1}$\@bblb \texttt{#2}\@bbrb}%
+ \ensuremath{\mathtt{#3}}}
+\newcommand{\comp}[3][]%
+ {\mbox{$\mathcal{C}^{#1}$\@bblb \texttt{#2}\@bbrb}%
+ \ensuremath{\mathtt{#3}}}
+\newcommand{\@exe}[3]{}
+\newcommand{\exe}[1]{\@ifnextchar[{\@exe{#1}}{\@exe{#1}[]}}
+\def\@exe#1[#2]#3{%
+ \mbox{\@bblb\texttt{#1}\@bbrb$^\mathtt{#2}\mathtt{(#3)}$}}
+\fi
+\endinput
+%%
+%% End of file `shrthand.sty'.
diff --git a/helm/ocaml/tactics/doc/tdiagram.sty b/helm/ocaml/tactics/doc/tdiagram.sty
new file mode 100644
index 000000000..02202b34a
--- /dev/null
+++ b/helm/ocaml/tactics/doc/tdiagram.sty
@@ -0,0 +1,166 @@
+%%
+%% This is file `tdiagram.sty',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% semantic.dtx (with options: `allOptions,Tdiagram')
+%%
+%% IMPORTANT NOTICE:
+%%
+%% For the copyright see the source file.
+%%
+%% Any modified versions of this file must be renamed
+%% with new filenames distinct from tdiagram.sty.
+%%
+%% For distribution of the original source see the terms
+%% for copying and modification in the file semantic.dtx.
+%%
+%% This generated file may be distributed as long as the
+%% original source files, as listed above, are part of the
+%% same distribution. (The sources need not necessarily be
+%% in the same archive or directory.)
+%%
+%% semantic.dtx (c)1995--2002 Peter M^^f8ller Neergaard and
+%% Arne John Glenstrup
+%%
+\expandafter\ifx\csname sem@nticsLoader\endcsname\relax
+ \PackageError{semantic}{%
+ This file should not be loaded directly}
+ {%
+ This file is an option of the semantic package. It should not be
+ loaded directly\MessageBreak
+ but by using \protect\usepackage{semantic} in your document
+ preamble.\MessageBreak
+ No commands are defined.\MessageBreak
+ Type <return> to proceed.
+ }%
+\else
+\TestForConflict{\@getSymbol,\@interpreter,\@parseArg,\@program}
+\TestForConflict{\@putSymbol,\@saveBeforeSymbolMacro,\compiler}
+\TestForConflict{\interpreter,\machine,\program,\@compiler}
+\newif\if@@Left
+\newif\if@@Up
+\newcount\@@xShift
+\newcount\@@yShift
+\newtoks\@@symbol
+\newtoks\@@tempSymbol
+\newcommand{\compiler}[1]{\@compiler#1\end}
+\def\@compiler#1,#2,#3\end{%
+ \if@@Nested %
+ \if@@Up %
+ \@@yShift=40 \if@@Left \@@xShift=-50 \else \@@xShift=-30 \fi
+ \else%
+ \@@yShift=20 \@@xShift =0 %
+ \fi%
+ \else%
+ \@@yShift=40 \@@xShift=-40%
+ \fi
+ \hskip\@@xShift\unitlength\raise \@@yShift\unitlength\hbox{%
+ \put(0,0){\line(1,0){80}}%
+ \put(0,-20){\line(1,0){30}}%
+ \put(50,-20){\line(1,0){30}}%
+ \put(30,-40){\line(1,0){20}}%
+ \put(0,0){\line(0,-1){20}}%
+ \put(80,0){\line(0,-1){20}}%
+ \put(30,-20){\line(0,-1){20}}%
+ \put(50,-20){\line(0,-1){20}}%
+ \put(30,-20){\makebox(20,20){$\rightarrow$}} %
+ {\@@Uptrue \@@Lefttrue \@parseArg(0,-20)(5,-20)#1\end}%
+ \if@@Up \else \@@tempSymbol=\expandafter{\the\@@symbol}\fi
+ {\@@Uptrue \@@Leftfalse \@parseArg(80,-20)(55,-20)#3\end}%
+ {\@@Upfalse \@@Lefttrue \@parseArg(50,-40)(30,-40)#2\end}%
+ \if@@Up \@@tempSymbol=\expandafter{\the\@@symbol}\fi
+ \if@@Nested \global\@@symbol=\expandafter{\the\@@tempSymbol} \fi%
+ }%
+}
+\newcommand{\interpreter}[1]{\@interpreter#1\end}
+\def\@interpreter#1,#2\end{%
+ \if@@Nested %
+ \if@@Up %
+ \@@yShift=40 \if@@Left \@@xShift=0 \else \@@xShift=20 \fi
+ \else%
+ \@@yShift=0 \@@xShift =0 %
+ \fi%
+ \else%
+ \@@yShift=40 \@@xShift=10%
+ \fi
+ \hskip\@@xShift\unitlength\raise \@@yShift\unitlength\hbox{%
+ \put(0,0){\line(-1,0){20}}%
+ \put(0,-40){\line(-1,0){20}}%
+ \put(0,0){\line(0,-1){40}}%
+ \put(-20,0){\line(0,-1){40}}%
+ {\@@Uptrue \@@Lefttrue \@parseArg(0,0)(-20,-20)#1\end}%
+ \if@@Up \else \@@tempSymbol=\expandafter{\the\@@symbol}\fi
+ {\@@Upfalse \@@Lefttrue \@parseArg(0,-40)(-20,-40)#2\end}%
+ \if@@Up \@@tempSymbol=\expandafter{\the\@@symbol}\fi
+ \if@@Nested \global\@@symbol=\expandafter{\the\@@tempSymbol} \fi%
+ }%
+}
+\newcommand{\program}[1]{\@program#1\end}
+\def\@program#1,#2\end{%
+ \if@@Nested %
+ \if@@Up %
+ \@@yShift=0 \if@@Left \@@xShift=0 \else \@@xShift=20 \fi
+ \else%
+ \PackageError{semantic}{%
+ A program cannot be at the bottom}
+ {%
+ You have tried to use a \protect\program\space as the
+ bottom\MessageBreak parameter to \protect\compiler,
+ \protect\interpreter\space or \protect\program.\MessageBreak
+ Type <return> to proceed --- Output can be distorted.}%
+ \fi%
+ \else%
+ \@@yShift=0 \@@xShift=10%
+ \fi
+ \hskip\@@xShift\unitlength\raise \@@yShift\unitlength\hbox{%
+ \put(0,0){\line(-1,0){20}}%
+ \put(0,0){\line(0,1){30}}%
+ \put(-20,0){\line(0,1){30}}%
+ \put(-10,30){\oval(20,20)[t]}%
+ \@putSymbol[#1]{-20,20}%
+ {\@@Upfalse \@@Lefttrue \@parseArg(0,0)(-20,0)#2\end}%
+ }%
+}
+\newcommand{\machine}[1]{%
+ \if@@Nested %
+ \if@@Up %
+ \PackageError{semantic}{%
+ A machine cannot be at the top}
+ {%
+ You have tried to use a \protect\machine\space as a
+ top\MessageBreak parameter to \protect\compiler or
+ \protect\interpreter.\MessageBreak
+ Type <return> to proceed --- Output can be distorted.}%
+ \else \@@yShift=0 \@@xShift=0
+ \fi%
+ \else%
+ \@@yShift=20 \@@xShift=10%
+ \fi
+ \hskip\@@xShift\unitlength\raise \@@yShift\unitlength\hbox{%
+ \put(0,0){\line(-1,0){20}} \put(-20,0){\line(3,-5){10}}
+ \put(0,0){\line(-3,-5){10}}%
+ {\@@Uptrue \@@Lefttrue \@parseArg(0,0)(-20,-15)#1\end}%
+ }%
+}
+\def\@parseArg(#1)(#2){%
+ \@ifNextMacro{\@doSymbolMacro(#1)(#2)}{\@getSymbol(#2)}}
+\def\@getSymbol(#1)#2\end{\@putSymbol[#2]{#1}}
+\def\@doSymbolMacro(#1)(#2)#3{%
+ \@ifnextchar[{\@saveBeforeSymbolMacro(#1)(#2)#3}%
+ {\@symbolMacro(#1)(#2)#3}}
+\def\@saveBeforeSymbolMacro(#1)(#2)#3[#4]#5\end{%
+ \@@tempSymbol={#4}%
+ \@@Nestedtrue\put(#1){#3#5}%
+ \@putSymbol[\the\@@tempSymbol]{#2}}
+\def\@symbolMacro(#1)(#2)#3\end{%
+ \@@Nestedtrue\put(#1){#3}%
+ \@putSymbol{#2}}
+\newcommand{\@putSymbol}[2][\the\@@symbol]{%
+ \global\@@symbol=\expandafter{#1}%
+ \put(#2){\makebox(20,20){\texttt{\the\@@symbol}}}}
+\fi
+\endinput
+%%
+%% End of file `tdiagram.sty'.
diff --git a/helm/ocaml/tactics/eliminationTactics.ml b/helm/ocaml/tactics/eliminationTactics.ml
new file mode 100644
index 000000000..e98bcd3c8
--- /dev/null
+++ b/helm/ocaml/tactics/eliminationTactics.ml
@@ -0,0 +1,217 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+module C = Cic
+module P = PrimitiveTactics
+module T = Tacticals
+module S = ProofEngineStructuralRules
+module F = FreshNamesGenerator
+module E = ProofEngineTypes
+module H = ProofEngineHelpers
+
+(*
+let induction_tac ~term status =
+ let (proof, goal) = status in
+ let module C = Cic in
+ let module R = CicReduction in
+ let module P = PrimitiveTactics in
+ let module T = Tacticals in
+ let module S = ProofEngineStructuralRules in
+ let module U = UriManager in
+ let (_,metasenv,_,_) = proof in
+ let _,context,ty = CicUtil.lookup_meta goal metasenv in
+ let termty = CicTypeChecker.type_of_aux' metasenv context term in (* per ora non serve *)
+
+ T.then_ ~start:(T.repeat_tactic
+ ~tactic:(T.then_ ~start:(VariousTactics.generalize_tac ~term) (* chissa' se cosi' funziona? *)
+ ~continuation:(P.intros))
+ ~continuation:(P.elim_intros_simpl ~term)
+ status
+;;
+*)
+
+(* unexported tactics *******************************************************)
+
+let get_name context index =
+ try match List.nth context (pred index) with
+ | Some (Cic.Name name, _) -> Some name
+ | _ -> None
+ with Invalid_argument "List.nth" -> None
+
+let rec scan_tac ~old_context_length ~index ~tactic =
+ let scan_tac status =
+ let (proof, goal) = status in
+ let _, metasenv, _, _ = proof in
+ let _, context, _ = CicUtil.lookup_meta goal metasenv in
+ let context_length = List.length context in
+ let rec aux index =
+ match get_name context index with
+ | _ when index <= 0 -> (proof, [goal])
+ | None -> aux (pred index)
+ | Some what ->
+ let tac = T.then_ ~start:(tactic ~what)
+ ~continuation:(scan_tac ~old_context_length:context_length ~index ~tactic)
+ in
+ try E.apply_tactic tac status
+ with E.Fail _ -> aux (pred index)
+ in aux (index + context_length - old_context_length - 1)
+ in
+ E.mk_tactic scan_tac
+
+let rec check_inductive_types types = function
+ | C.MutInd (uri, typeno, _) -> List.mem (uri, typeno) types
+ | C.Appl (hd :: tl) -> check_inductive_types types hd
+ | _ -> false
+
+let elim_clear_tac ~mk_fresh_name_callback ~types ~what =
+ let elim_clear_tac status =
+ let (proof, goal) = status in
+ let _, metasenv, _, _ = proof in
+ let _, context, _ = CicUtil.lookup_meta goal metasenv in
+ let index, ty = H.lookup_type metasenv context what in
+ if check_inductive_types types ty then
+ let tac = T.then_ ~start:(P.elim_intros_tac ~mk_fresh_name_callback (C.Rel index))
+ ~continuation:(S.clear what)
+ in
+ E.apply_tactic tac status
+ else raise (E.Fail (lazy "unexported elim_clear: not an eliminable type"))
+ in
+ E.mk_tactic elim_clear_tac
+
+(* elim type ****************************************************************)
+
+let elim_type_tac ?(mk_fresh_name_callback = F.mk_fresh_name ~subst:[]) ?depth
+ ?using what
+=
+ let elim what =
+ P.elim_intros_simpl_tac ?using ?depth ~mk_fresh_name_callback what
+ in
+ let elim_type_tac status =
+ let tac =
+ T.thens ~start: (P.cut_tac what) ~continuations:[elim (C.Rel 1); T.id_tac]
+ in
+ E.apply_tactic tac status
+ in
+ E.mk_tactic elim_type_tac
+
+(* decompose ****************************************************************)
+
+(* robaglia --------------------------------------------------------------- *)
+
+ (** perform debugging output? *)
+let debug = false
+let debug_print = fun _ -> ()
+
+ (** debugging print *)
+let warn s = debug_print (lazy ("DECOMPOSE: " ^ (Lazy.force s)))
+
+(* search in term the Inductive Types and return a list of uris as triples like this: (uri,typeno,exp_named_subst) *)
+let search_inductive_types ty =
+ let rec aux types = function
+ | C.MutInd (uri, typeno, _) when (not (List.mem (uri, typeno) types)) ->
+ (uri, typeno) :: types
+ | C.Appl applist -> List.fold_left aux types applist
+ | _ -> types
+ in
+ aux [] ty
+(* N.B: in un caso tipo (and A forall C:Prop.(or B C)) l'or *non* viene selezionato! *)
+
+(* roba seria ------------------------------------------------------------- *)
+
+let decompose_tac ?(mk_fresh_name_callback = F.mk_fresh_name ~subst:[])
+ ?(user_types=[]) ~dbd what =
+ let decompose_tac status =
+ let (proof, goal) = status in
+ let _, metasenv,_,_ = proof in
+ let _, context, _ = CicUtil.lookup_meta goal metasenv in
+ let types = List.rev_append user_types (FwdQueries.decomposables dbd) in
+ let tactic = elim_clear_tac ~mk_fresh_name_callback ~types in
+ let old_context_length = List.length context in
+ let tac = T.then_ ~start:(tactic ~what)
+ ~continuation:(scan_tac ~old_context_length ~index:1 ~tactic)
+ in
+ E.apply_tactic tac status
+ in
+ E.mk_tactic decompose_tac
+
+(*
+module R = CicReduction
+
+ let rec elim_clear_tac ~term' ~nr_of_hyp_still_to_elim status =
+ let (proof, goal) = status in
+ warn (lazy ("nr_of_hyp_still_to_elim=" ^ (string_of_int nr_of_hyp_still_to_elim)));
+ if nr_of_hyp_still_to_elim <> 0 then
+ let _,metasenv,_,_ = proof in
+ let _,context,_ = CicUtil.lookup_meta goal metasenv in
+ let old_context_len = List.length context in
+ let termty,_ =
+ CicTypeChecker.type_of_aux' metasenv context term'
+ CicUniv.empty_ugraph in
+ warn (lazy ("elim_clear termty= " ^ CicPp.ppterm termty));
+ match termty with
+ C.MutInd (uri,typeno,exp_named_subst)
+ | C.Appl((C.MutInd (uri,typeno,exp_named_subst))::_)
+ when (List.mem (uri,typeno,exp_named_subst) urilist) ->
+ warn (lazy ("elim " ^ CicPp.ppterm termty));
+ ProofEngineTypes.apply_tactic
+ (T.then_
+ ~start:(P.elim_intros_simpl_tac term')
+ ~continuation:(
+ (* clear the hyp that has just been eliminated *)
+ ProofEngineTypes.mk_tactic (fun status ->
+ let (proof, goal) = status in
+ let _,metasenv,_,_ = proof in
+ let _,context,_ = CicUtil.lookup_meta goal metasenv in
+ let new_context_len = List.length context in
+ warn (lazy ("newcon=" ^ (string_of_int new_context_len) ^ " & oldcon=" ^ (string_of_int old_context_len) ^ " & old_nr_of_hyp=" ^ (string_of_int nr_of_hyp_still_to_elim)));
+ let new_nr_of_hyp_still_to_elim = nr_of_hyp_still_to_elim + (new_context_len - old_context_len) - 1 in
+ let hyp_name =
+ match List.nth context new_nr_of_hyp_still_to_elim with
+ None
+ | Some (Cic.Anonymous,_) -> assert false
+ | Some (Cic.Name name,_) -> name
+ in
+ ProofEngineTypes.apply_tactic
+ (T.then_
+ ~start:(
+ if (term'==term) (* if it's the first application of elim, there's no need to clear the hyp *)
+ then begin debug_print (lazy ("%%%%%%% no clear")); T.id_tac end
+ else begin debug_print (lazy ("%%%%%%% clear " ^ (string_of_int (new_nr_of_hyp_still_to_elim)))); (S.clear ~hyp:hyp_name) end)
+ ~continuation:(ProofEngineTypes.mk_tactic (elim_clear_tac ~term':(C.Rel new_nr_of_hyp_still_to_elim) ~nr_of_hyp_still_to_elim:new_nr_of_hyp_still_to_elim)))
+ status
+ )))
+ status
+ | _ ->
+ let new_nr_of_hyp_still_to_elim = nr_of_hyp_still_to_elim - 1 in
+ warn (lazy ("fail; hyp=" ^ (string_of_int new_nr_of_hyp_still_to_elim)));
+ elim_clear_tac ~term':(C.Rel new_nr_of_hyp_still_to_elim) ~nr_of_hyp_still_to_elim:new_nr_of_hyp_still_to_elim status
+ else (* no hyp to elim left in this goal *)
+ ProofEngineTypes.apply_tactic T.id_tac status
+
+ in
+ elim_clear_tac ~term':term ~nr_of_hyp_still_to_elim:1 status
+*)
diff --git a/helm/ocaml/tactics/eliminationTactics.mli b/helm/ocaml/tactics/eliminationTactics.mli
new file mode 100644
index 000000000..cf6589f9a
--- /dev/null
+++ b/helm/ocaml/tactics/eliminationTactics.mli
@@ -0,0 +1,33 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val elim_type_tac:
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ ?depth:int -> ?using:Cic.term -> Cic.term -> ProofEngineTypes.tactic
+
+val decompose_tac:
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ ?user_types:((UriManager.uri * int) list) ->
+ dbd:HMysql.dbd -> string -> ProofEngineTypes.tactic
diff --git a/helm/ocaml/tactics/equalityTactics.ml b/helm/ocaml/tactics/equalityTactics.ml
new file mode 100644
index 000000000..8304d7bb1
--- /dev/null
+++ b/helm/ocaml/tactics/equalityTactics.ml
@@ -0,0 +1,363 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+let rec rewrite_tac ~direction ~(pattern: ProofEngineTypes.lazy_pattern) equality =
+ let _rewrite_tac ~direction ~pattern:(wanted,hyps_pat,concl_pat) equality status
+ =
+ let module C = Cic in
+ let module U = UriManager in
+ let module PET = ProofEngineTypes in
+ let module PER = ProofEngineReduction in
+ let module PEH = ProofEngineHelpers in
+ let module PT = PrimitiveTactics in
+ assert (wanted = None); (* this should be checked syntactically *)
+ let proof,goal = status in
+ let curi, metasenv, pbo, pty = proof in
+ let (metano,context,gty) = CicUtil.lookup_meta goal metasenv in
+ match hyps_pat with
+ he::(_::_ as tl) ->
+ PET.apply_tactic
+ (Tacticals.then_
+ (rewrite_tac ~direction
+ ~pattern:(None,[he],None) equality)
+ (rewrite_tac ~direction ~pattern:(None,tl,concl_pat) equality)
+ ) status
+ | [_] as hyps_pat when concl_pat <> None ->
+ PET.apply_tactic
+ (Tacticals.then_
+ (rewrite_tac ~direction
+ ~pattern:(None,hyps_pat,None) equality)
+ (rewrite_tac ~direction ~pattern:(None,[],concl_pat) equality)
+ ) status
+ | _ ->
+ let arg,dir2,tac,concl_pat,gty =
+ match hyps_pat with
+ [] -> None,true,(fun ~term _ -> PT.exact_tac term),concl_pat,gty
+ | [name,pat] ->
+ let rec find_hyp n =
+ function
+ [] -> assert false
+ | Some (Cic.Name s,Cic.Decl ty)::_ when name = s ->
+ Cic.Rel n, CicSubstitution.lift n ty
+ | Some (Cic.Name s,Cic.Def _)::_ -> assert false (*CSC: not implemented yet! But does this make any sense?*)
+ | _::tl -> find_hyp (n+1) tl
+ in
+ let arg,gty = find_hyp 1 context in
+ let last_hyp_name_of_status (proof,goal) =
+ let curi, metasenv, pbo, pty = proof in
+ let metano,context,gty = CicUtil.lookup_meta goal metasenv in
+ match context with
+ (Some (Cic.Name s,_))::_ -> s
+ | _ -> assert false
+ in
+ let dummy = "dummy" in
+ Some arg,false,
+ (fun ~term typ ->
+ Tacticals.seq
+ ~tactics:
+ [ProofEngineStructuralRules.rename name dummy;
+ PT.letin_tac
+ ~mk_fresh_name_callback:(fun _ _ _ ~typ -> Cic.Name name) term;
+ ProofEngineStructuralRules.clearbody name;
+ ReductionTactics.change_tac
+ ~pattern:
+ (None,[name,Cic.Implicit (Some `Hole)], None)
+ (ProofEngineTypes.const_lazy_term typ);
+ ProofEngineStructuralRules.clear dummy
+ ]),
+ Some pat,gty
+ | _::_ -> assert false
+ in
+ let if_right_to_left do_not_change a b =
+ match direction with
+ | `RightToLeft -> if do_not_change then a else b
+ | `LeftToRight -> if do_not_change then b else a
+ in
+ let ty_eq,ugraph =
+ CicTypeChecker.type_of_aux' metasenv context equality
+ CicUniv.empty_ugraph in
+ let (ty_eq,metasenv',arguments,fresh_meta) =
+ ProofEngineHelpers.saturate_term
+ (ProofEngineHelpers.new_meta_of_proof proof) metasenv context ty_eq 0 in
+ let equality =
+ if List.length arguments = 0 then
+ equality
+ else
+ C.Appl (equality :: arguments) in
+ (* t1x is t2 if we are rewriting in an hypothesis *)
+ let eq_ind, ty, t1, t2, t1x =
+ match ty_eq with
+ | C.Appl [C.MutInd (uri, 0, []); ty; t1; t2]
+ when LibraryObjects.is_eq_URI uri ->
+ let ind_uri =
+ if_right_to_left dir2
+ LibraryObjects.eq_ind_URI LibraryObjects.eq_ind_r_URI
+ in
+ let eq_ind = C.Const (ind_uri uri,[]) in
+ if dir2 then
+ if_right_to_left true (eq_ind,ty,t2,t1,t2) (eq_ind,ty,t1,t2,t1)
+ else
+ if_right_to_left true (eq_ind,ty,t1,t2,t2) (eq_ind,ty,t2,t1,t1)
+ | _ -> raise (PET.Fail (lazy "Rewrite: argument is not a proof of an equality")) in
+ (* now we always do as if direction was `LeftToRight *)
+ let fresh_name =
+ FreshNamesGenerator.mk_fresh_name
+ ~subst:[] metasenv' context C.Anonymous ~typ:ty in
+ let lifted_t1 = CicSubstitution.lift 1 t1x in
+ let lifted_gty = CicSubstitution.lift 1 gty in
+ let lifted_conjecture =
+ metano,(Some (fresh_name,Cic.Decl ty))::context,lifted_gty in
+ let lifted_pattern =
+ let lifted_concl_pat =
+ match concl_pat with
+ | None -> None
+ | Some term -> Some (CicSubstitution.lift 1 term) in
+ Some (fun _ m u -> lifted_t1, m, u),[],lifted_concl_pat
+ in
+ let subst,metasenv',ugraph,_,selected_terms_with_context =
+ ProofEngineHelpers.select
+ ~metasenv:metasenv' ~ugraph ~conjecture:lifted_conjecture
+ ~pattern:lifted_pattern in
+ let metasenv' = CicMetaSubst.apply_subst_metasenv subst metasenv' in
+ let what,with_what =
+ (* Note: Rel 1 does not live in the context context_of_t *)
+ (* The replace_lifting_csc 0 function will take care of lifting it *)
+ (* to context_of_t *)
+ List.fold_right
+ (fun (context_of_t,t) (l1,l2) -> t::l1, Cic.Rel 1::l2)
+ selected_terms_with_context ([],[]) in
+ let t1 = CicMetaSubst.apply_subst subst t1 in
+ let t2 = CicMetaSubst.apply_subst subst t2 in
+ let equality = CicMetaSubst.apply_subst subst equality in
+ let abstr_gty =
+ ProofEngineReduction.replace_lifting_csc 0
+ ~equality:(==) ~what ~with_what:with_what ~where:lifted_gty in
+ let abstr_gty = CicMetaSubst.apply_subst subst abstr_gty in
+ let pred = C.Lambda (fresh_name, ty, abstr_gty) in
+ (* The argument is either a meta if we are rewriting in the conclusion
+ or the hypothesis if we are rewriting in an hypothesis *)
+ let metasenv',arg,newtyp =
+ match arg with
+ None ->
+ let gty' = CicSubstitution.subst t2 abstr_gty in
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context in
+ let metasenv' = (fresh_meta,context,gty')::metasenv' in
+ metasenv', C.Meta (fresh_meta,irl), Cic.Rel (-1) (* dummy term, never used *)
+ | Some arg ->
+ let gty' = CicSubstitution.subst t1 abstr_gty in
+ metasenv,arg,gty'
+ in
+ let exact_proof =
+ C.Appl [eq_ind ; ty ; t2 ; pred ; arg ; t1 ;equality]
+ in
+ let (proof',goals) =
+ PET.apply_tactic
+ (tac ~term:exact_proof newtyp) ((curi,metasenv',pbo,pty),goal)
+ in
+ let goals =
+ goals@(ProofEngineHelpers.compare_metasenvs ~oldmetasenv:metasenv
+ ~newmetasenv:metasenv')
+ in
+ (proof',goals)
+ in
+ ProofEngineTypes.mk_tactic (_rewrite_tac ~direction ~pattern equality)
+
+
+let rewrite_simpl_tac ~direction ~pattern equality =
+ let rewrite_simpl_tac ~direction ~pattern equality status =
+ ProofEngineTypes.apply_tactic
+ (Tacticals.then_
+ ~start:(rewrite_tac ~direction ~pattern equality)
+ ~continuation:
+ (ReductionTactics.simpl_tac
+ ~pattern:(ProofEngineTypes.conclusion_pattern None)))
+ status
+ in
+ ProofEngineTypes.mk_tactic (rewrite_simpl_tac ~direction ~pattern equality)
+;;
+
+let replace_tac ~(pattern: ProofEngineTypes.lazy_pattern) ~with_what =
+ let replace_tac ~(pattern: ProofEngineTypes.lazy_pattern) ~with_what status =
+ let _wanted, hyps_pat, concl_pat = pattern in
+ let (proof, goal) = status in
+ let module C = Cic in
+ let module U = UriManager in
+ let module P = PrimitiveTactics in
+ let module T = Tacticals in
+ let uri,metasenv,pbo,pty = proof in
+ let (_,context,ty) as conjecture = CicUtil.lookup_meta goal metasenv in
+ assert (hyps_pat = []); (*CSC: not implemented yet *)
+ let context_len = List.length context in
+ let subst,metasenv,u,_,selected_terms_with_context =
+ ProofEngineHelpers.select ~metasenv ~ugraph:CicUniv.empty_ugraph
+ ~conjecture ~pattern in
+ let metasenv = CicMetaSubst.apply_subst_metasenv subst metasenv in
+ let with_what, metasenv, u = with_what context metasenv u in
+ let with_what = CicMetaSubst.apply_subst subst with_what in
+ let pbo = CicMetaSubst.apply_subst subst pbo in
+ let pty = CicMetaSubst.apply_subst subst pty in
+ let status = (uri,metasenv,pbo,pty),goal in
+ let ty_of_with_what,u =
+ CicTypeChecker.type_of_aux'
+ metasenv context with_what CicUniv.empty_ugraph in
+ let whats =
+ match selected_terms_with_context with
+ [] -> raise (ProofEngineTypes.Fail (lazy "Replace: no term selected"))
+ | l ->
+ List.map
+ (fun (context_of_t,t) ->
+ let t_in_context =
+ try
+ let context_of_t_len = List.length context_of_t in
+ if context_of_t_len = context_len then t
+ else
+ (let t_in_context,subst,metasenv' =
+ CicMetaSubst.delift_rels [] metasenv
+ (context_of_t_len - context_len) t
+ in
+ assert (subst = []);
+ assert (metasenv = metasenv');
+ t_in_context)
+ with
+ CicMetaSubst.DeliftingARelWouldCaptureAFreeVariable ->
+ (*CSC: we could implement something stronger by completely changing
+ the semantics of the tactic *)
+ raise (ProofEngineTypes.Fail
+ (lazy "Replace: one of the selected terms is not closed")) in
+ let ty_of_t_in_context,u = (* TASSI: FIXME *)
+ CicTypeChecker.type_of_aux' metasenv context t_in_context
+ CicUniv.empty_ugraph in
+ let b,u = CicReduction.are_convertible ~metasenv context
+ ty_of_with_what ty_of_t_in_context u in
+ if b then
+ let concl_pat_for_t = ProofEngineHelpers.pattern_of ~term:ty [t] in
+ let pattern_for_t = None,[],Some concl_pat_for_t in
+ t_in_context,pattern_for_t
+ else
+ raise
+ (ProofEngineTypes.Fail
+ (lazy "Replace: one of the selected terms and the term to be replaced with have not convertible types"))
+ ) l in
+ let rec aux n whats status =
+ match whats with
+ [] -> ProofEngineTypes.apply_tactic T.id_tac status
+ | (what,lazy_pattern)::tl ->
+ let what = CicSubstitution.lift n what in
+ let with_what = CicSubstitution.lift n with_what in
+ let ty_of_with_what = CicSubstitution.lift n ty_of_with_what in
+ ProofEngineTypes.apply_tactic
+ (T.thens
+ ~start:(
+ P.cut_tac
+ (C.Appl [
+ (C.MutInd (LibraryObjects.eq_URI (), 0, [])) ;
+ ty_of_with_what ;
+ what ;
+ with_what]))
+ ~continuations:[
+ T.then_
+ ~start:(
+ rewrite_tac ~direction:`LeftToRight ~pattern:lazy_pattern (C.Rel 1))
+ ~continuation:(
+ T.then_
+ ~start:(
+ ProofEngineTypes.mk_tactic
+ (function ((proof,goal) as status) ->
+ let _,metasenv,_,_ = proof in
+ let _,context,_ = CicUtil.lookup_meta goal metasenv in
+ let hyp =
+ try
+ match List.hd context with
+ Some (Cic.Name name,_) -> name
+ | _ -> assert false
+ with (Failure "hd") -> assert false
+ in
+ ProofEngineTypes.apply_tactic
+ (ProofEngineStructuralRules.clear ~hyp) status))
+ ~continuation:(aux_tac (n + 1) tl));
+ T.id_tac])
+ status
+ and aux_tac n tl = ProofEngineTypes.mk_tactic (aux n tl) in
+ aux 0 whats status
+ in
+ ProofEngineTypes.mk_tactic (replace_tac ~pattern ~with_what)
+;;
+
+
+(* All these tacs do is applying the right constructor/theorem *)
+
+let reflexivity_tac =
+ IntroductionTactics.constructor_tac ~n:1
+;;
+
+let symmetry_tac =
+ let symmetry_tac (proof, goal) =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+ let (_,metasenv,_,_) = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ match (R.whd context ty) with
+ (C.Appl [(C.MutInd (uri, 0, [])); _; _; _])
+ when LibraryObjects.is_eq_URI uri ->
+ ProofEngineTypes.apply_tactic
+ (PrimitiveTactics.apply_tac
+ ~term: (C.Const (LibraryObjects.sym_eq_URI uri, [])))
+ (proof,goal)
+
+ | _ -> raise (ProofEngineTypes.Fail (lazy "Symmetry failed"))
+ in
+ ProofEngineTypes.mk_tactic symmetry_tac
+;;
+
+let transitivity_tac ~term =
+ let transitivity_tac ~term status =
+ let (proof, goal) = status in
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+ let module T = Tacticals in
+ let (_,metasenv,_,_) = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ match (R.whd context ty) with
+ (C.Appl [(C.MutInd (uri, 0, [])); _; _; _])
+ when LibraryObjects.is_eq_URI uri ->
+ ProofEngineTypes.apply_tactic
+ (T.thens
+ ~start:(PrimitiveTactics.apply_tac
+ ~term: (C.Const (LibraryObjects.trans_eq_URI uri, [])))
+ ~continuations:
+ [PrimitiveTactics.exact_tac ~term ; T.id_tac ; T.id_tac])
+ status
+
+ | _ -> raise (ProofEngineTypes.Fail (lazy "Transitivity failed"))
+ in
+ ProofEngineTypes.mk_tactic (transitivity_tac ~term)
+;;
+
+
diff --git a/helm/ocaml/tactics/equalityTactics.mli b/helm/ocaml/tactics/equalityTactics.mli
new file mode 100644
index 000000000..1d60ae149
--- /dev/null
+++ b/helm/ocaml/tactics/equalityTactics.mli
@@ -0,0 +1,41 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val rewrite_tac:
+ direction:[`LeftToRight | `RightToLeft] ->
+ pattern:ProofEngineTypes.lazy_pattern -> Cic.term -> ProofEngineTypes.tactic
+
+val rewrite_simpl_tac:
+ direction:[`LeftToRight | `RightToLeft] ->
+ pattern:ProofEngineTypes.lazy_pattern -> Cic.term -> ProofEngineTypes.tactic
+
+val replace_tac:
+ pattern:ProofEngineTypes.lazy_pattern ->
+ with_what:Cic.lazy_term -> ProofEngineTypes.tactic
+
+val reflexivity_tac: ProofEngineTypes.tactic
+val symmetry_tac: ProofEngineTypes.tactic
+val transitivity_tac: term:Cic.term -> ProofEngineTypes.tactic
+
diff --git a/helm/ocaml/tactics/fourier.ml b/helm/ocaml/tactics/fourier.ml
new file mode 100644
index 000000000..d7728c0b3
--- /dev/null
+++ b/helm/ocaml/tactics/fourier.ml
@@ -0,0 +1,244 @@
+(***********************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *)
+(* \VV/ *************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(* Méthode d'élimination de Fourier *)
+(* Référence:
+Auteur(s) : Fourier, Jean-Baptiste-Joseph
+
+Titre(s) : Oeuvres de Fourier [Document électronique]. Tome second. Mémoires publiés dans divers recueils / publ. par les soins de M. Gaston Darboux,...
+
+Publication : Numérisation BnF de l'édition de Paris : Gauthier-Villars, 1890
+
+Pages: 326-327
+
+http://gallica.bnf.fr/
+*)
+
+(** @author The Coq Development Team *)
+
+
+(* Un peu de calcul sur les rationnels...
+Les opérations rendent des rationnels normalisés,
+i.e. le numérateur et le dénominateur sont premiers entre eux.
+*)
+
+
+(** Type for coefficents *)
+type rational = {
+num:int; (** Numerator *)
+den:int; (** Denumerator *)
+};;
+
+(** Debug function.
+ @param x the rational to print*)
+let print_rational x =
+ print_int x.num;
+ print_string "/";
+ print_int x.den
+;;
+
+let rec pgcd x y = if y = 0 then x else pgcd y (x mod y);;
+
+(** The constant 0*)
+let r0 = {num=0;den=1};;
+(** The constant 1*)
+let r1 = {num=1;den=1};;
+
+let rnorm x = let x = (if x.den<0 then {num=(-x.num);den=(-x.den)} else x) in
+ if x.num=0 then r0
+ else (let d=pgcd x.num x.den in
+ let d= (if d<0 then -d else d) in
+ {num=(x.num)/d;den=(x.den)/d});;
+
+(** Calculates the opposite of a rational.
+ @param x The rational
+ @return -x*)
+let rop x = rnorm {num=(-x.num);den=x.den};;
+
+(** Sums two rationals.
+ @param x A rational
+ @param y Another rational
+ @return x+y*)
+let rplus x y = rnorm {num=x.num*y.den + y.num*x.den;den=x.den*y.den};;
+(** Substracts two rationals.
+ @param x A rational
+ @param y Another rational
+ @return x-y*)
+let rminus x y = rnorm {num=x.num*y.den - y.num*x.den;den=x.den*y.den};;
+(** Multiplyes two rationals.
+ @param x A rational
+ @param y Another rational
+ @return x*y*)
+let rmult x y = rnorm {num=x.num*y.num;den=x.den*y.den};;
+(** Inverts arational.
+ @param x A rational
+ @return x{^ -1} *)
+let rinv x = rnorm {num=x.den;den=x.num};;
+(** Divides two rationals.
+ @param x A rational
+ @param y Another rational
+ @return x/y*)
+let rdiv x y = rnorm {num=x.num*y.den;den=x.den*y.num};;
+
+let rinf x y = x.num*y.den < y.num*x.den;;
+let rinfeq x y = x.num*y.den <= y.num*x.den;;
+
+
+(* {coef;hist;strict}, où coef=[c1; ...; cn; d], représente l'inéquation
+c1x1+...+cnxn < d si strict=true, <= sinon,
+hist donnant les coefficients (positifs) d'une combinaison linéaire qui permet d'obtenir l'inéquation à partir de celles du départ.
+*)
+
+type ineq = {coef:rational list;
+ hist:rational list;
+ strict:bool};;
+
+let pop x l = l:=x::(!l);;
+
+(* sépare la liste d'inéquations s selon que leur premier coefficient est
+négatif, nul ou positif. *)
+let partitionne s =
+ let lpos=ref [] in
+ let lneg=ref [] in
+ let lnul=ref [] in
+ List.iter (fun ie -> match ie.coef with
+ [] -> raise (Failure "empty ineq")
+ |(c::r) -> if rinf c r0
+ then pop ie lneg
+ else if rinf r0 c then pop ie lpos
+ else pop ie lnul)
+ s;
+ [!lneg;!lnul;!lpos]
+;;
+(* initialise les histoires d'une liste d'inéquations données par leurs listes de coefficients et leurs strictitudes (!):
+(add_hist [(equation 1, s1);...;(équation n, sn)])
+=
+[{équation 1, [1;0;...;0], s1};
+ {équation 2, [0;1;...;0], s2};
+ ...
+ {équation n, [0;0;...;1], sn}]
+*)
+let add_hist le =
+ let n = List.length le in
+ let i=ref 0 in
+ List.map (fun (ie,s) ->
+ let h =ref [] in
+ for k=1 to (n-(!i)-1) do pop r0 h; done;
+ pop r1 h;
+ for k=1 to !i do pop r0 h; done;
+ i:=!i+1;
+ {coef=ie;hist=(!h);strict=s})
+ le
+;;
+(* additionne deux inéquations *)
+let ie_add ie1 ie2 = {coef=List.map2 rplus ie1.coef ie2.coef;
+ hist=List.map2 rplus ie1.hist ie2.hist;
+ strict=ie1.strict || ie2.strict}
+;;
+(* multiplication d'une inéquation par un rationnel (positif) *)
+let ie_emult a ie = {coef=List.map (fun x -> rmult a x) ie.coef;
+ hist=List.map (fun x -> rmult a x) ie.hist;
+ strict= ie.strict}
+;;
+(* on enlève le premier coefficient *)
+let ie_tl ie = {coef=List.tl ie.coef;hist=ie.hist;strict=ie.strict}
+;;
+(* le premier coefficient: "tête" de l'inéquation *)
+let hd_coef ie = List.hd ie.coef
+;;
+
+(* calcule toutes les combinaisons entre inéquations de tête négative et inéquations de tête positive qui annulent le premier coefficient.
+*)
+let deduce_add lneg lpos =
+ let res=ref [] in
+ List.iter (fun i1 ->
+ List.iter (fun i2 ->
+ let a = rop (hd_coef i1) in
+ let b = hd_coef i2 in
+ pop (ie_tl (ie_add (ie_emult b i1)
+ (ie_emult a i2))) res)
+ lpos)
+ lneg;
+ !res
+;;
+(* élimination de la première variable à partir d'une liste d'inéquations:
+opération qu'on itère dans l'algorithme de Fourier.
+*)
+let deduce1 s i=
+ match (partitionne s) with
+ [lneg;lnul;lpos] ->
+ let lnew = deduce_add lneg lpos in
+ (match lneg with [] -> print_string("non posso ridurre "^string_of_int i^"\n")|_->();
+ match lpos with [] -> print_string("non posso ridurre "^string_of_int i^"\n")|_->());
+ (List.map ie_tl lnul)@lnew
+ |_->assert false
+;;
+(* algorithme de Fourier: on élimine successivement toutes les variables.
+*)
+let deduce lie =
+ let n = List.length (fst (List.hd lie)) in
+ let lie=ref (add_hist lie) in
+ for i=1 to n-1 do
+ lie:= deduce1 !lie i;
+ done;
+ !lie
+;;
+
+(* donne [] si le système a des find solutions,
+sinon donne [c,s,lc]
+où lc est la combinaison linéaire des inéquations de départ
+qui donne 0 < c si s=true
+ ou 0 <= c sinon
+cette inéquation étant absurde.
+*)
+(** Tryes to find if the system admits solutions.
+ @param lie the list of inequations
+ @return a list that can be empty if the system has solutions. Otherwise it returns a
+ one elements list [\[(c,s,lc)\]]. {b c} is the rational that can be obtained solving the system,
+ {b s} is true if the inequation that proves that the system is absurd is of type [c < 0], false if
+ [c <= 0], {b lc} is a list of rational that represents the liear combination to obtain the
+ absurd inequation *)
+let unsolvable lie =
+ let lr = deduce lie in
+ let res = ref [] in
+ (try (List.iter (fun e ->
+ match e with
+ {coef=[c];hist=lc;strict=s} ->
+ if (rinf c r0 && (not s)) || (rinfeq c r0 && s)
+ then (res := [c,s,lc];
+ raise (Failure "contradiction found"))
+ |_->assert false)
+ lr)
+ with _ -> ());
+ !res
+;;
+
+(* Exemples:
+
+let test1=[[r1;r1;r0],true;[rop r1;r1;r1],false;[r0;rop r1;rop r1],false];;
+deduce test1;;
+unsolvable test1;;
+
+let test2=[
+[r1;r1;r0;r0;r0],false;
+[r0;r1;r1;r0;r0],false;
+[r0;r0;r1;r1;r0],false;
+[r0;r0;r0;r1;r1],false;
+[r1;r0;r0;r0;r1],false;
+[rop r1;rop r1;r0;r0;r0],false;
+[r0;rop r1;rop r1;r0;r0],false;
+[r0;r0;rop r1;rop r1;r0],false;
+[r0;r0;r0;rop r1;rop r1],false;
+[rop r1;r0;r0;r0;rop r1],false
+];;
+deduce test2;;
+unsolvable test2;;
+
+*)
diff --git a/helm/ocaml/tactics/fourier.mli b/helm/ocaml/tactics/fourier.mli
new file mode 100644
index 000000000..8b26bc21a
--- /dev/null
+++ b/helm/ocaml/tactics/fourier.mli
@@ -0,0 +1,27 @@
+type rational = { num : int; den : int; }
+val print_rational : rational -> unit
+val pgcd : int -> int -> int
+val r0 : rational
+val r1 : rational
+val rnorm : rational -> rational
+val rop : rational -> rational
+val rplus : rational -> rational -> rational
+val rminus : rational -> rational -> rational
+val rmult : rational -> rational -> rational
+val rinv : rational -> rational
+val rdiv : rational -> rational -> rational
+val rinf : rational -> rational -> bool
+val rinfeq : rational -> rational -> bool
+type ineq = { coef : rational list; hist : rational list; strict : bool; }
+val pop : 'a -> 'a list ref -> unit
+val partitionne : ineq list -> ineq list list
+val add_hist : (rational list * bool) list -> ineq list
+val ie_add : ineq -> ineq -> ineq
+val ie_emult : rational -> ineq -> ineq
+val ie_tl : ineq -> ineq
+val hd_coef : ineq -> rational
+val deduce_add : ineq list -> ineq list -> ineq list
+val deduce1 : ineq list -> int -> ineq list
+val deduce : (rational list * bool) list -> ineq list
+val unsolvable :
+ (rational list * bool) list -> (rational * bool * rational list) list
diff --git a/helm/ocaml/tactics/fourierR.ml b/helm/ocaml/tactics/fourierR.ml
new file mode 100644
index 000000000..5418e1149
--- /dev/null
+++ b/helm/ocaml/tactics/fourierR.ml
@@ -0,0 +1,1205 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+
+(******************** THE FOURIER TACTIC ***********************)
+
+(* La tactique Fourier ne fonctionne de manière sûre que si les coefficients
+des inéquations et équations sont entiers. En attendant la tactique Field.
+*)
+
+open Fourier
+open ProofEngineTypes
+
+
+let debug x = print_string ("____ "^x) ; flush stdout;;
+
+let debug_pcontext x =
+ let str = ref "" in
+ List.iter (fun y -> match y with Some(Cic.Name(a),_) -> str := !str ^
+ a ^ " " | _ ->()) x ;
+ debug ("contesto : "^ (!str) ^ "\n")
+;;
+
+(******************************************************************************
+Operations on linear combinations.
+
+Opérations sur les combinaisons linéaires affines.
+La partie homogène d'une combinaison linéaire est en fait une table de hash
+qui donne le coefficient d'un terme du calcul des constructions,
+qui est zéro si le terme n'y est pas.
+*)
+
+
+
+(**
+ The type for linear combinations
+*)
+type flin = {fhom:(Cic.term , rational)Hashtbl.t;fcste:rational}
+;;
+
+(**
+ @return an empty flin
+*)
+let flin_zero () = {fhom = Hashtbl.create 50;fcste=r0}
+;;
+
+(**
+ @param f a flin
+ @param x a Cic.term
+ @return the rational associated with x (coefficient)
+*)
+let flin_coef f x =
+ try
+ (Hashtbl.find f.fhom x)
+ with
+ _ -> r0
+;;
+
+(**
+ Adds c to the coefficient of x
+ @param f a flin
+ @param x a Cic.term
+ @param c a rational
+ @return the new flin
+*)
+let flin_add f x c =
+ match x with
+ Cic.Rel(n) ->(
+ let cx = flin_coef f x in
+ Hashtbl.remove f.fhom x;
+ Hashtbl.add f.fhom x (rplus cx c);
+ f)
+ |_->debug ("Internal error in Fourier! this is not a Rel "^CicPp.ppterm x^"\n");
+ let cx = flin_coef f x in
+ Hashtbl.remove f.fhom x;
+ Hashtbl.add f.fhom x (rplus cx c);
+ f
+;;
+(**
+ Adds c to f.fcste
+ @param f a flin
+ @param c a rational
+ @return the new flin
+*)
+let flin_add_cste f c =
+ {fhom=f.fhom;
+ fcste=rplus f.fcste c}
+;;
+
+(**
+ @return a empty flin with r1 in fcste
+*)
+let flin_one () = flin_add_cste (flin_zero()) r1;;
+
+(**
+ Adds two flin
+*)
+let flin_plus f1 f2 =
+ let f3 = flin_zero() in
+ Hashtbl.iter (fun x c -> let _=flin_add f3 x c in ()) f1.fhom;
+ Hashtbl.iter (fun x c -> let _=flin_add f3 x c in ()) f2.fhom;
+ flin_add_cste (flin_add_cste f3 f1.fcste) f2.fcste;
+;;
+
+(**
+ Substracts two flin
+*)
+let flin_minus f1 f2 =
+ let f3 = flin_zero() in
+ Hashtbl.iter (fun x c -> let _=flin_add f3 x c in ()) f1.fhom;
+ Hashtbl.iter (fun x c -> let _=flin_add f3 x (rop c) in ()) f2.fhom;
+ flin_add_cste (flin_add_cste f3 f1.fcste) (rop f2.fcste);
+;;
+
+(**
+ @return a times f
+*)
+let flin_emult a f =
+ let f2 = flin_zero() in
+ Hashtbl.iter (fun x c -> let _=flin_add f2 x (rmult a c) in ()) f.fhom;
+ flin_add_cste f2 (rmult a f.fcste);
+;;
+
+
+(*****************************************************************************)
+
+
+(**
+ @param t a term
+ @raise Failure if conversion is impossible
+ @return rational proiection of t
+*)
+let rec rational_of_term t =
+ (* fun to apply f to the first and second rational-term of l *)
+ let rat_of_binop f l =
+ let a = List.hd l and
+ b = List.hd(List.tl l) in
+ f (rational_of_term a) (rational_of_term b)
+ in
+ (* as before, but f is unary *)
+ let rat_of_unop f l =
+ f (rational_of_term (List.hd l))
+ in
+ match t with
+ | Cic.Cast (t1,t2) -> (rational_of_term t1)
+ | Cic.Appl (t1::next) ->
+ (match t1 with
+ Cic.Const (u,boh) ->
+ if UriManager.eq u HelmLibraryObjects.Reals.ropp_URI then
+ rat_of_unop rop next
+ else if UriManager.eq u HelmLibraryObjects.Reals.rinv_URI then
+ rat_of_unop rinv next
+ else if UriManager.eq u HelmLibraryObjects.Reals.rmult_URI then
+ rat_of_binop rmult next
+ else if UriManager.eq u HelmLibraryObjects.Reals.rdiv_URI then
+ rat_of_binop rdiv next
+ else if UriManager.eq u HelmLibraryObjects.Reals.rplus_URI then
+ rat_of_binop rplus next
+ else if UriManager.eq u HelmLibraryObjects.Reals.rminus_URI then
+ rat_of_binop rminus next
+ else failwith "not a rational"
+ | _ -> failwith "not a rational")
+ | Cic.Const (u,boh) ->
+ if UriManager.eq u HelmLibraryObjects.Reals.r1_URI then r1
+ else if UriManager.eq u HelmLibraryObjects.Reals.r0_URI then r0
+ else failwith "not a rational"
+ | _ -> failwith "not a rational"
+;;
+
+(* coq wrapper
+let rational_of_const = rational_of_term;;
+*)
+let fails f a =
+ try
+ let tmp = (f a) in
+ false
+ with
+ _-> true
+ ;;
+
+let rec flin_of_term t =
+ let fl_of_binop f l =
+ let a = List.hd l and
+ b = List.hd(List.tl l) in
+ f (flin_of_term a) (flin_of_term b)
+ in
+ try(
+ match t with
+ | Cic.Cast (t1,t2) -> (flin_of_term t1)
+ | Cic.Appl (t1::next) ->
+ begin
+ match t1 with
+ Cic.Const (u,boh) ->
+ begin
+ if UriManager.eq u HelmLibraryObjects.Reals.ropp_URI then
+ flin_emult (rop r1) (flin_of_term (List.hd next))
+ else if UriManager.eq u HelmLibraryObjects.Reals.rplus_URI then
+ fl_of_binop flin_plus next
+ else if UriManager.eq u HelmLibraryObjects.Reals.rminus_URI then
+ fl_of_binop flin_minus next
+ else if UriManager.eq u HelmLibraryObjects.Reals.rmult_URI then
+ begin
+ let arg1 = (List.hd next) and
+ arg2 = (List.hd(List.tl next))
+ in
+ if fails rational_of_term arg1
+ then
+ if fails rational_of_term arg2
+ then
+ ( (* prodotto tra 2 incognite ????? impossibile*)
+ failwith "Sistemi lineari!!!!\n"
+ )
+ else
+ (
+ match arg1 with
+ Cic.Rel(n) -> (*trasformo al volo*)
+ (flin_add (flin_zero()) arg1 (rational_of_term arg2))
+ |_-> (* test this *)
+ let tmp = flin_of_term arg1 in
+ flin_emult (rational_of_term arg2) (tmp)
+ )
+ else
+ if fails rational_of_term arg2
+ then
+ (
+ match arg2 with
+ Cic.Rel(n) -> (*trasformo al volo*)
+ (flin_add (flin_zero()) arg2 (rational_of_term arg1))
+ |_-> (* test this *)
+ let tmp = flin_of_term arg2 in
+ flin_emult (rational_of_term arg1) (tmp)
+
+ )
+ else
+ ( (*prodotto tra razionali*)
+ (flin_add_cste (flin_zero()) (rmult (rational_of_term arg1) (rational_of_term arg2)))
+ )
+ (*try
+ begin
+ (*let a = rational_of_term arg1 in
+ debug("ho fatto rational of term di "^CicPp.ppterm arg1^
+ " e ho ottenuto "^string_of_int a.num^"/"^string_of_int a.den^"\n");*)
+ let a = flin_of_term arg1
+ try
+ begin
+ let b = (rational_of_term arg2) in
+ debug("ho fatto rational of term di "^CicPp.ppterm arg2^
+ " e ho ottenuto "^string_of_int b.num^"/"^string_of_int b.den^"\n");
+ (flin_add_cste (flin_zero()) (rmult a b))
+ end
+ with
+ _ -> debug ("ho fallito2 su "^CicPp.ppterm arg2^"\n");
+ (flin_add (flin_zero()) arg2 a)
+ end
+ with
+ _-> debug ("ho fallito1 su "^CicPp.ppterm arg1^"\n");
+ (flin_add(flin_zero()) arg1 (rational_of_term arg2))
+ *)
+ end
+ else if UriManager.eq u HelmLibraryObjects.Reals.rinv_URI then
+ let a=(rational_of_term (List.hd next)) in
+ flin_add_cste (flin_zero()) (rinv a)
+ else if UriManager.eq u HelmLibraryObjects.Reals.rdiv_URI then
+ begin
+ let b=(rational_of_term (List.hd(List.tl next))) in
+ try
+ begin
+ let a = (rational_of_term (List.hd next)) in
+ (flin_add_cste (flin_zero()) (rdiv a b))
+ end
+ with
+ _-> (flin_add (flin_zero()) (List.hd next) (rinv b))
+ end
+ else assert false
+ end
+ |_ -> assert false
+ end
+ | Cic.Const (u,boh) ->
+ begin
+ if UriManager.eq u HelmLibraryObjects.Reals.r1_URI then flin_one ()
+ else if UriManager.eq u HelmLibraryObjects.Reals.r0_URI then flin_zero ()
+ else assert false
+ end
+ |_-> assert false)
+ with _ -> debug("eccezione = "^CicPp.ppterm t^"\n");flin_add (flin_zero()) t r1
+;;
+
+(* coq wrapper
+let flin_of_constr = flin_of_term;;
+*)
+
+(**
+ Translates a flin to (c,x) list
+ @param f a flin
+ @return something like (c1,x1)::(c2,x2)::...::(cn,xn)
+*)
+let flin_to_alist f =
+ let res=ref [] in
+ Hashtbl.iter (fun x c -> res:=(c,x)::(!res)) f;
+ !res
+;;
+
+(* Représentation des hypothèses qui sont des inéquations ou des équations.
+*)
+
+(**
+ The structure for ineq
+*)
+type hineq={hname:Cic.term; (* le nom de l'hypothèse *)
+ htype:string; (* Rlt, Rgt, Rle, Rge, eqTLR ou eqTRL *)
+ hleft:Cic.term;
+ hright:Cic.term;
+ hflin:flin;
+ hstrict:bool}
+;;
+
+(* Transforme une hypothese h:t en inéquation flin<0 ou flin<=0
+*)
+
+let ineq1_of_term (h,t) =
+ match t with (* match t *)
+ Cic.Appl (t1::next) ->
+ let arg1= List.hd next in
+ let arg2= List.hd(List.tl next) in
+ (match t1 with (* match t1 *)
+ Cic.Const (u,boh) ->
+ if UriManager.eq u HelmLibraryObjects.Reals.rlt_URI then
+ [{hname=h;
+ htype="Rlt";
+ hleft=arg1;
+ hright=arg2;
+ hflin= flin_minus (flin_of_term arg1)
+ (flin_of_term arg2);
+ hstrict=true}]
+ else if UriManager.eq u HelmLibraryObjects.Reals.rgt_URI then
+ [{hname=h;
+ htype="Rgt";
+ hleft=arg2;
+ hright=arg1;
+ hflin= flin_minus (flin_of_term arg2)
+ (flin_of_term arg1);
+ hstrict=true}]
+ else if UriManager.eq u HelmLibraryObjects.Reals.rle_URI then
+ [{hname=h;
+ htype="Rle";
+ hleft=arg1;
+ hright=arg2;
+ hflin= flin_minus (flin_of_term arg1)
+ (flin_of_term arg2);
+ hstrict=false}]
+ else if UriManager.eq u HelmLibraryObjects.Reals.rge_URI then
+ [{hname=h;
+ htype="Rge";
+ hleft=arg2;
+ hright=arg1;
+ hflin= flin_minus (flin_of_term arg2)
+ (flin_of_term arg1);
+ hstrict=false}]
+ else assert false
+ | Cic.MutInd (u,i,o) ->
+ if UriManager.eq u HelmLibraryObjects.Logic.eq_URI then
+ let t0= arg1 in
+ let arg1= arg2 in
+ let arg2= List.hd(List.tl (List.tl next)) in
+ (match t0 with
+ Cic.Const (u,boh) ->
+ if UriManager.eq u HelmLibraryObjects.Reals.r_URI then
+ [{hname=h;
+ htype="eqTLR";
+ hleft=arg1;
+ hright=arg2;
+ hflin= flin_minus (flin_of_term arg1)
+ (flin_of_term arg2);
+ hstrict=false};
+ {hname=h;
+ htype="eqTRL";
+ hleft=arg2;
+ hright=arg1;
+ hflin= flin_minus (flin_of_term arg2)
+ (flin_of_term arg1);
+ hstrict=false}]
+ else assert false
+ |_-> assert false)
+ else assert false
+ |_-> assert false)(* match t1 *)
+ |_-> assert false (* match t *)
+;;
+(* coq wrapper
+let ineq1_of_constr = ineq1_of_term;;
+*)
+
+(* Applique la méthode de Fourier à une liste d'hypothèses (type hineq)
+*)
+
+let rec print_rl l =
+ match l with
+ []-> ()
+ | a::next -> Fourier.print_rational a ; print_string " " ; print_rl next
+;;
+
+let rec print_sys l =
+ match l with
+ [] -> ()
+ | (a,b)::next -> (print_rl a;
+ print_string (if b=true then "strict\n"else"\n");
+ print_sys next)
+ ;;
+
+(*let print_hash h =
+ Hashtbl.iter (fun x y -> print_string ("("^"-"^","^"-"^")")) h
+;;*)
+
+let fourier_lineq lineq1 =
+ let nvar=ref (-1) in
+ let hvar=Hashtbl.create 50 in (* la table des variables des inéquations *)
+ List.iter (fun f ->
+ Hashtbl.iter (fun x c ->
+ try (Hashtbl.find hvar x;())
+ with _-> nvar:=(!nvar)+1;
+ Hashtbl.add hvar x (!nvar);
+ debug("aggiungo una var "^
+ string_of_int !nvar^" per "^
+ CicPp.ppterm x^"\n"))
+ f.hflin.fhom)
+ lineq1;
+ (*print_hash hvar;*)
+ debug("Il numero di incognite e' "^string_of_int (!nvar+1)^"\n");
+ let sys= List.map (fun h->
+ let v=Array.create ((!nvar)+1) r0 in
+ Hashtbl.iter (fun x c -> v.(Hashtbl.find hvar x) <- c)
+ h.hflin.fhom;
+ ((Array.to_list v)@[rop h.hflin.fcste],h.hstrict))
+ lineq1 in
+ debug ("chiamo unsolvable sul sistema di "^
+ string_of_int (List.length sys) ^"\n");
+ print_sys sys;
+ unsolvable sys
+;;
+
+(*****************************************************************************
+Construction de la preuve en cas de succès de la méthode de Fourier,
+i.e. on obtient une contradiction.
+*)
+
+
+let _eqT = Cic.MutInd(HelmLibraryObjects.Logic.eq_URI, 0, []) ;;
+let _False = Cic.MutInd (HelmLibraryObjects.Logic.false_URI, 0, []) ;;
+let _not = Cic.Const (HelmLibraryObjects.Logic.not_URI,[]);;
+let _R0 = Cic.Const (HelmLibraryObjects.Reals.r0_URI,[]);;
+let _R1 = Cic.Const (HelmLibraryObjects.Reals.r1_URI,[]);;
+let _R = Cic.Const (HelmLibraryObjects.Reals.r_URI,[]);;
+let _Rfourier_eqLR_to_le=Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rfourier_eqLR_to_le.con"), []) ;;
+let _Rfourier_eqRL_to_le=Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rfourier_eqRL_to_le.con"), []) ;;
+let _Rfourier_ge_to_le =Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rfourier_ge_to_le.con"), []) ;;
+let _Rfourier_gt_to_lt =Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rfourier_gt_to_lt.con"), []) ;;
+let _Rfourier_le=Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rfourier_le.con"), []) ;;
+let _Rfourier_le_le =Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rfourier_le_le.con"), []) ;;
+let _Rfourier_le_lt =Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rfourier_le_lt.con"), []) ;;
+let _Rfourier_lt=Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rfourier_lt.con"), []) ;;
+let _Rfourier_lt_le =Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rfourier_lt_le.con"), []) ;;
+let _Rfourier_lt_lt =Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rfourier_lt_lt.con"), []) ;;
+let _Rfourier_not_ge_lt = Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rfourier_not_ge_lt.con"), []) ;;
+let _Rfourier_not_gt_le = Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rfourier_not_gt_le.con"), []) ;;
+let _Rfourier_not_le_gt = Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rfourier_not_le_gt.con"), []) ;;
+let _Rfourier_not_lt_ge = Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rfourier_not_lt_ge.con"), []) ;;
+let _Rinv = Cic.Const (HelmLibraryObjects.Reals.rinv_URI, []);;
+let _Rinv_R1 = Cic.Const(HelmLibraryObjects.Reals.rinv_r1_URI, []);;
+let _Rle = Cic.Const (HelmLibraryObjects.Reals.rle_URI, []);;
+let _Rle_mult_inv_pos = Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rle_mult_inv_pos.con"), []) ;;
+let _Rle_not_lt = Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rle_not_lt.con"), []) ;;
+let _Rle_zero_1 = Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rle_zero_1.con"), []) ;;
+let _Rle_zero_pos_plus1 = Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rle_zero_pos_plus1.con"), []) ;;
+let _Rlt = Cic.Const (HelmLibraryObjects.Reals.rlt_URI, []);;
+let _Rlt_mult_inv_pos = Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rlt_mult_inv_pos.con"), []) ;;
+let _Rlt_not_le = Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rlt_not_le.con"), []) ;;
+let _Rlt_zero_1 = Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rlt_zero_1.con"), []) ;;
+let _Rlt_zero_pos_plus1 = Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rlt_zero_pos_plus1.con"), []) ;;
+let _Rminus = Cic.Const (HelmLibraryObjects.Reals.rminus_URI, []);;
+let _Rmult = Cic.Const (HelmLibraryObjects.Reals.rmult_URI, []);;
+let _Rnot_le_le =Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rnot_le_le.con"), []) ;;
+let _Rnot_lt0 = Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rnot_lt0.con"), []) ;;
+let _Rnot_lt_lt =Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/fourier/Fourier_util/Rnot_lt_lt.con"), []) ;;
+let _Ropp = Cic.Const (HelmLibraryObjects.Reals.ropp_URI, []);;
+let _Rplus = Cic.Const (HelmLibraryObjects.Reals.rplus_URI, []);;
+
+(******************************************************************************)
+
+let is_int x = (x.den)=1
+;;
+
+(* fraction = couple (num,den) *)
+let rec rational_to_fraction x= (x.num,x.den)
+;;
+
+(* traduction -3 -> (Ropp (Rplus R1 (Rplus R1 R1)))
+*)
+
+let rec int_to_real_aux n =
+ match n with
+ 0 -> _R0 (* o forse R0 + R0 ????? *)
+ | 1 -> _R1
+ | _ -> Cic.Appl [ _Rplus ; _R1 ; int_to_real_aux (n-1) ]
+;;
+
+
+let int_to_real n =
+ let x = int_to_real_aux (abs n) in
+ if n < 0 then
+ Cic.Appl [ _Ropp ; x ]
+ else
+ x
+;;
+
+
+(* -1/2 -> (Rmult (Ropp R1) (Rinv (Rplus R1 R1)))
+*)
+
+let rational_to_real x =
+ let (n,d)=rational_to_fraction x in
+ Cic.Appl [ _Rmult ; int_to_real n ; Cic.Appl [ _Rinv ; int_to_real d ] ]
+;;
+
+(* preuve que 0<n*1/d
+*)
+
+let tac_zero_inf_pos (n,d) =
+ let tac_zero_inf_pos (n,d) status =
+ (*let cste = pf_parse_constr gl in*)
+ let pall str (proof,goal) t =
+ debug ("tac "^str^" :\n" );
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ debug ("th = "^ CicPp.ppterm t ^"\n");
+ debug ("ty = "^ CicPp.ppterm ty^"\n");
+ in
+ let tacn=ref (mk_tactic (fun status ->
+ pall "n0" status _Rlt_zero_1 ;
+ apply_tactic (PrimitiveTactics.apply_tac ~term:_Rlt_zero_1) status )) in
+ let tacd=ref (mk_tactic (fun status ->
+ pall "d0" status _Rlt_zero_1 ;
+ apply_tactic (PrimitiveTactics.apply_tac ~term:_Rlt_zero_1) status )) in
+
+
+ for i=1 to n-1 do
+ tacn:=(Tacticals.then_
+ ~start:(mk_tactic (fun status ->
+ pall ("n"^string_of_int i) status _Rlt_zero_pos_plus1;
+ apply_tactic
+ (PrimitiveTactics.apply_tac ~term:_Rlt_zero_pos_plus1)
+ status))
+ ~continuation:!tacn);
+ done;
+ for i=1 to d-1 do
+ tacd:=(Tacticals.then_
+ ~start:(mk_tactic (fun status ->
+ pall "d" status _Rlt_zero_pos_plus1 ;
+ apply_tactic
+ (PrimitiveTactics.apply_tac ~term:_Rlt_zero_pos_plus1) status))
+ ~continuation:!tacd);
+ done;
+
+debug("TAC ZERO INF POS\n");
+ apply_tactic
+ (Tacticals.thens
+ ~start:(PrimitiveTactics.apply_tac ~term:_Rlt_mult_inv_pos)
+ ~continuations:[!tacn ;!tacd ] )
+ status
+ in
+ mk_tactic (tac_zero_inf_pos (n,d))
+;;
+
+
+
+(* preuve que 0<=n*1/d
+*)
+
+let tac_zero_infeq_pos gl (n,d) =
+ let tac_zero_infeq_pos gl (n,d) status =
+ (*let cste = pf_parse_constr gl in*)
+ debug("inizio tac_zero_infeq_pos\n");
+ let tacn = ref
+ (*(if n=0 then
+ (PrimitiveTactics.apply_tac ~term:_Rle_zero_zero )
+ else*)
+ (PrimitiveTactics.apply_tac ~term:_Rle_zero_1 )
+ (* ) *)
+ in
+ let tacd=ref (PrimitiveTactics.apply_tac ~term:_Rlt_zero_1 ) in
+ for i=1 to n-1 do
+ tacn:=(Tacticals.then_ ~start:(PrimitiveTactics.apply_tac
+ ~term:_Rle_zero_pos_plus1) ~continuation:!tacn);
+ done;
+ for i=1 to d-1 do
+ tacd:=(Tacticals.then_ ~start:(PrimitiveTactics.apply_tac
+ ~term:_Rlt_zero_pos_plus1) ~continuation:!tacd);
+ done;
+ apply_tactic
+ (Tacticals.thens
+ ~start:(PrimitiveTactics.apply_tac ~term:_Rle_mult_inv_pos)
+ ~continuations:[!tacn;!tacd]) status
+ in
+ mk_tactic (tac_zero_infeq_pos gl (n,d))
+;;
+
+
+
+(* preuve que 0<(-n)*(1/d) => False
+*)
+
+let tac_zero_inf_false gl (n,d) =
+ let tac_zero_inf_false gl (n,d) status =
+ if n=0 then
+ apply_tactic (PrimitiveTactics.apply_tac ~term:_Rnot_lt0) status
+ else
+ apply_tactic (Tacticals.then_
+ ~start:( mk_tactic (fun status ->
+ let (proof, goal) = status in
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ apply_tactic (PrimitiveTactics.apply_tac ~term:_Rle_not_lt) status))
+ ~continuation:(tac_zero_infeq_pos gl (-n,d)))
+ status
+ in
+ mk_tactic (tac_zero_inf_false gl (n,d))
+;;
+
+(* preuve que 0<=n*(1/d) => False ; n est negatif
+*)
+
+let tac_zero_infeq_false gl (n,d) =
+ let tac_zero_infeq_false gl (n,d) status =
+ let (proof, goal) = status in
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+
+ debug("faccio fold di " ^ CicPp.ppterm
+ (Cic.Appl
+ [_Rle ; _R0 ;
+ Cic.Appl
+ [_Rmult ; int_to_real n ; Cic.Appl [_Rinv ; int_to_real d]]
+ ]
+ ) ^ "\n") ;
+ debug("apply di _Rlt_not_le a "^ CicPp.ppterm ty ^"\n");
+ (*CSC: Patch to undo the over-simplification of RewriteSimpl *)
+ apply_tactic
+ (Tacticals.then_
+ ~start:
+ (ReductionTactics.fold_tac
+ ~reduction:(const_lazy_reduction CicReduction.whd)
+ ~pattern:(ProofEngineTypes.conclusion_pattern None)
+ ~term:
+ (const_lazy_term
+ (Cic.Appl
+ [_Rle ; _R0 ;
+ Cic.Appl
+ [_Rmult ; int_to_real n ; Cic.Appl [_Rinv ; int_to_real d]]])))
+ ~continuation:
+ (Tacticals.then_
+ ~start:(PrimitiveTactics.apply_tac ~term:_Rlt_not_le)
+ ~continuation:(tac_zero_inf_pos (-n,d))))
+ status
+ in
+ mk_tactic (tac_zero_infeq_false gl (n,d))
+;;
+
+
+(* *********** ********** ******** ??????????????? *********** **************)
+
+let apply_type_tac ~cast:t ~applist:al =
+ let apply_type_tac ~cast:t ~applist:al (proof,goal) =
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ let fresh_meta = ProofEngineHelpers.new_meta_of_proof proof in
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context in
+ let metasenv' = (fresh_meta,context,t)::metasenv in
+ let proof' = curi,metasenv',pbo,pty in
+ let proof'',goals =
+ apply_tactic
+ (PrimitiveTactics.apply_tac
+ (*~term:(Cic.Appl ((Cic.Cast (Cic.Meta (fresh_meta,irl),t))::al)) *)
+ ~term:(Cic.Appl ((Cic.Meta (fresh_meta,irl))::al))) (* ??? *)
+ (proof',goal)
+ in
+ proof'',fresh_meta::goals
+ in
+ mk_tactic (apply_type_tac ~cast:t ~applist:al)
+;;
+
+let my_cut ~term:c =
+ let my_cut ~term:c (proof,goal) =
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ let fresh_meta = ProofEngineHelpers.new_meta_of_proof proof in
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context in
+ let metasenv' = (fresh_meta,context,c)::metasenv in
+ let proof' = curi,metasenv',pbo,pty in
+ let proof'',goals =
+ apply_tactic
+ (apply_type_tac
+ ~cast:(Cic.Prod(Cic.Name "Anonymous",c,CicSubstitution.lift 1 ty))
+ ~applist:[Cic.Meta(fresh_meta,irl)])
+ (proof',goal)
+ in
+ (* We permute the generated goals to be consistent with Coq *)
+ match goals with
+ [] -> assert false
+ | he::tl -> proof'',he::fresh_meta::tl
+ in
+ mk_tactic (my_cut ~term:c)
+;;
+
+let exact = PrimitiveTactics.exact_tac;;
+
+let tac_use h =
+ let tac_use h status =
+ let (proof, goal) = status in
+ debug("Inizio TC_USE\n");
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ debug ("hname = "^ CicPp.ppterm h.hname ^"\n");
+ debug ("ty = "^ CicPp.ppterm ty^"\n");
+ apply_tactic
+ (match h.htype with
+ "Rlt" -> exact ~term:h.hname
+ | "Rle" -> exact ~term:h.hname
+ | "Rgt" -> (Tacticals.then_
+ ~start:(PrimitiveTactics.apply_tac ~term:_Rfourier_gt_to_lt)
+ ~continuation:(exact ~term:h.hname))
+ | "Rge" -> (Tacticals.then_
+ ~start:(PrimitiveTactics.apply_tac ~term:_Rfourier_ge_to_le)
+ ~continuation:(exact ~term:h.hname))
+ | "eqTLR" -> (Tacticals.then_
+ ~start:(PrimitiveTactics.apply_tac ~term:_Rfourier_eqLR_to_le)
+ ~continuation:(exact ~term:h.hname))
+ | "eqTRL" -> (Tacticals.then_
+ ~start:(PrimitiveTactics.apply_tac ~term:_Rfourier_eqRL_to_le)
+ ~continuation:(exact ~term:h.hname))
+ | _->assert false)
+ status
+ in
+ mk_tactic (tac_use h)
+;;
+
+let is_ineq (h,t) =
+ match t with
+ Cic.Appl ( Cic.Const(u,boh)::next) ->
+ (if UriManager.eq u HelmLibraryObjects.Reals.rlt_URI or
+ UriManager.eq u HelmLibraryObjects.Reals.rgt_URI or
+ UriManager.eq u HelmLibraryObjects.Reals.rle_URI or
+ UriManager.eq u HelmLibraryObjects.Reals.rge_URI then true
+ else if UriManager.eq u HelmLibraryObjects.Logic.eq_URI then
+ (match (List.hd next) with
+ Cic.Const (uri,_) when
+ UriManager.eq uri HelmLibraryObjects.Reals.r_URI
+ -> true
+ | _ -> false)
+ else false)
+ |_->false
+;;
+
+let list_of_sign s = List.map (fun (x,_,z)->(x,z)) s;;
+
+let mkAppL a =
+ Cic.Appl(Array.to_list a)
+;;
+
+(* Résolution d'inéquations linéaires dans R *)
+let rec strip_outer_cast c = match c with
+ | Cic.Cast (c,_) -> strip_outer_cast c
+ | _ -> c
+;;
+
+(*let find_in_context id context =
+ let rec find_in_context_aux c n =
+ match c with
+ [] -> failwith (id^" not found in context")
+ | a::next -> (match a with
+ Some (Cic.Name(name),_) when name = id -> n
+ (*? magari al posto di _ qualcosaltro?*)
+ | _ -> find_in_context_aux next (n+1))
+ in
+ find_in_context_aux context 1
+;;
+
+(* mi sembra quadratico *)
+let rec filter_real_hyp context cont =
+ match context with
+ [] -> []
+ | Some(Cic.Name(h),Cic.Decl(t))::next -> (
+ let n = find_in_context h cont in
+ debug("assegno "^string_of_int n^" a "^CicPp.ppterm t^"\n");
+ [(Cic.Rel(n),t)] @ filter_real_hyp next cont)
+ | a::next -> debug(" no\n"); filter_real_hyp next cont
+;;*)
+
+let filter_real_hyp context _ =
+ let rec filter_aux context num =
+ match context with
+ [] -> []
+ | Some(Cic.Name(h),Cic.Decl(t))::next ->
+ [(Cic.Rel(num),t)] @ filter_aux next (num+1)
+ | a::next -> filter_aux next (num+1)
+ in
+ filter_aux context 1
+;;
+
+
+(* lifts everithing at the conclusion level *)
+let rec superlift c n=
+ match c with
+ [] -> []
+ | Some(name,Cic.Decl(a))::next ->
+ [Some(name,Cic.Decl(CicSubstitution.lift n a))]@ superlift next (n+1)
+ | Some(name,Cic.Def(a,None))::next ->
+ [Some(name,Cic.Def((CicSubstitution.lift n a),None))]@ superlift next (n+1)
+ | Some(name,Cic.Def(a,Some ty))::next ->
+ [Some(name,
+ Cic.Def((CicSubstitution.lift n a),Some (CicSubstitution.lift n ty)))
+ ] @ superlift next (n+1)
+ | _::next -> superlift next (n+1) (*?? ??*)
+
+;;
+
+let equality_replace a b =
+ let equality_replace a b status =
+ debug("inizio EQ\n");
+ let module C = Cic in
+ let proof,goal = status in
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ let a_eq_b = C.Appl [ _eqT ; _R ; a ; b ] in
+ let fresh_meta = ProofEngineHelpers.new_meta_of_proof proof in
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context in
+ let metasenv' = (fresh_meta,context,a_eq_b)::metasenv in
+ debug("chamo rewrite tac su"^CicPp.ppterm (C.Meta (fresh_meta,irl)));
+ let (proof,goals) = apply_tactic
+ (EqualityTactics.rewrite_simpl_tac
+ ~direction:`LeftToRight
+ ~pattern:(ProofEngineTypes.conclusion_pattern None)
+ (C.Meta (fresh_meta,irl)))
+ ((curi,metasenv',pbo,pty),goal)
+ in
+ let new_goals = fresh_meta::goals in
+ debug("fine EQ -> goals : "^string_of_int( List.length new_goals) ^" = "
+ ^string_of_int( List.length goals)^"+ meta\n");
+ (proof,new_goals)
+ in
+ mk_tactic (equality_replace a b)
+;;
+
+let tcl_fail a (proof,goal) =
+ match a with
+ 1 -> raise (ProofEngineTypes.Fail (lazy "fail-tactical"))
+ | _ -> (proof,[goal])
+;;
+
+(* Galla: moved in variousTactics.ml
+let assumption_tac (proof,goal)=
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ let num = ref 0 in
+ let tac_list = List.map
+ ( fun x -> num := !num + 1;
+ match x with
+ Some(Cic.Name(nm),t) -> (nm,exact ~term:(Cic.Rel(!num)))
+ | _ -> ("fake",tcl_fail 1)
+ )
+ context
+ in
+ Tacticals.first ~tactics:tac_list (proof,goal)
+;;
+*)
+(* Galla: moved in negationTactics.ml
+(* !!!!! fix !!!!!!!!!! *)
+let contradiction_tac (proof,goal)=
+ Tacticals.then_
+ (*inutile sia questo che quello prima della chiamata*)
+ ~start:PrimitiveTactics.intros_tac
+ ~continuation:(Tacticals.then_
+ ~start:(VariousTactics.elim_type_tac ~term:_False)
+ ~continuation:(assumption_tac))
+ (proof,goal)
+;;
+*)
+
+(* ********************* TATTICA ******************************** *)
+
+let rec fourier (s_proof,s_goal)=
+ let s_curi,s_metasenv,s_pbo,s_pty = s_proof in
+ let s_metano,s_context,s_ty = CicUtil.lookup_meta s_goal s_metasenv in
+ debug ("invoco fourier_tac sul goal "^string_of_int(s_goal)^" e contesto:\n");
+ debug_pcontext s_context;
+
+(* here we need to negate the thesis, but to do this we need to apply the
+ right theoreme,so let's parse our thesis *)
+
+ let th_to_appl = ref _Rfourier_not_le_gt in
+ (match s_ty with
+ Cic.Appl ( Cic.Const(u,boh)::args) ->
+ th_to_appl :=
+ (if UriManager.eq u HelmLibraryObjects.Reals.rlt_URI then
+ _Rfourier_not_ge_lt
+ else if UriManager.eq u HelmLibraryObjects.Reals.rle_URI then
+ _Rfourier_not_gt_le
+ else if UriManager.eq u HelmLibraryObjects.Reals.rgt_URI then
+ _Rfourier_not_le_gt
+ else if UriManager.eq u HelmLibraryObjects.Reals.rge_URI then
+ _Rfourier_not_lt_ge
+ else failwith "fourier can't be applyed")
+ |_-> failwith "fourier can't be applyed");
+ (* fix maybe strip_outer_cast goes here?? *)
+
+ (* now let's change our thesis applying the th and put it with hp *)
+
+ let proof,gl = apply_tactic
+ (Tacticals.then_
+ ~start:(PrimitiveTactics.apply_tac ~term:!th_to_appl)
+ ~continuation:(PrimitiveTactics.intros_tac ()))
+ (s_proof,s_goal)
+ in
+ let goal = if List.length gl = 1 then List.hd gl
+ else failwith "a new goal" in
+
+ debug ("port la tesi sopra e la nego. contesto :\n");
+ debug_pcontext s_context;
+
+ (* now we have all the right environment *)
+
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+
+ (* now we want to convert hp to inequations, but first we must lift
+ everyting to thesis level, so that a variable has the save Rel(n)
+ in each hp ( needed by ineq1_of_term ) *)
+
+ (* ? fix if None ?????*)
+ (* fix change superlift with a real name *)
+
+ let l_context = superlift context 1 in
+ let hyps = filter_real_hyp l_context l_context in
+
+ debug ("trasformo in diseq. "^ string_of_int (List.length hyps)^" ipotesi\n");
+
+ let lineq =ref [] in
+
+ (* transform hyps into inequations *)
+
+ List.iter (fun h -> try (lineq:=(ineq1_of_term h)@(!lineq))
+ with _-> ())
+ hyps;
+
+ debug ("applico fourier a "^ string_of_int (List.length !lineq)^
+ " disequazioni\n");
+
+ let res=fourier_lineq (!lineq) in
+ let tac=ref Tacticals.id_tac in
+ if res=[] then
+ (print_string "Tactic Fourier fails.\n";flush stdout;
+ failwith "fourier_tac fails")
+ else
+ (
+ match res with (*match res*)
+ [(cres,sres,lc)]->
+
+ (* in lc we have the coefficient to "reduce" the system *)
+
+ print_string "Fourier's method can prove the goal...\n";flush stdout;
+
+ debug "I coeff di moltiplicazione rit sono: ";
+
+ let lutil=ref [] in
+ List.iter
+ (fun (h,c) -> if c<>r0 then (lutil:=(h,c)::(!lutil);
+ (* DBG *)Fourier.print_rational(c);print_string " "(* DBG *))
+ )
+ (List.combine (!lineq) lc);
+
+ print_string (" quindi lutil e' lunga "^
+ string_of_int (List.length (!lutil))^"\n");
+
+ (* on construit la combinaison linéaire des inéquation *)
+
+ (match (!lutil) with (*match (!lutil) *)
+ (h1,c1)::lutil ->
+ debug ("elem di lutil ");Fourier.print_rational c1;print_string "\n";
+
+ let s=ref (h1.hstrict) in
+
+
+ let t1 = ref (Cic.Appl [_Rmult;rational_to_real c1;h1.hleft] ) in
+ let t2 = ref (Cic.Appl [_Rmult;rational_to_real c1;h1.hright]) in
+
+ List.iter (fun (h,c) ->
+ s:=(!s)||(h.hstrict);
+ t1:=(Cic.Appl [_Rplus;!t1;Cic.Appl
+ [_Rmult;rational_to_real c;h.hleft ] ]);
+ t2:=(Cic.Appl [_Rplus;!t2;Cic.Appl
+ [_Rmult;rational_to_real c;h.hright] ]))
+ lutil;
+
+ let ineq=Cic.Appl [(if (!s) then _Rlt else _Rle);!t1;!t2 ] in
+ let tc=rational_to_real cres in
+
+
+(* ora ho i termini che descrivono i passi di fourier per risolvere il sistema *)
+
+ debug "inizio a costruire tac1\n";
+ Fourier.print_rational(c1);
+
+ let tac1=ref ( mk_tactic (fun status ->
+ apply_tactic
+ (if h1.hstrict then
+ (Tacticals.thens
+ ~start:(mk_tactic (fun status ->
+ debug ("inizio t1 strict\n");
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ debug ("th = "^ CicPp.ppterm _Rfourier_lt ^"\n");
+ debug ("ty = "^ CicPp.ppterm ty^"\n");
+ apply_tactic
+ (PrimitiveTactics.apply_tac ~term:_Rfourier_lt) status))
+ ~continuations:[tac_use h1;
+ tac_zero_inf_pos (rational_to_fraction c1)])
+ else
+ (Tacticals.thens
+ ~start:(PrimitiveTactics.apply_tac ~term:_Rfourier_le)
+ ~continuations:[tac_use h1;tac_zero_inf_pos
+ (rational_to_fraction c1)]))
+ status))
+
+ in
+ s:=h1.hstrict;
+ List.iter (fun (h,c) ->
+ (if (!s) then
+ (if h.hstrict then
+ (debug("tac1 1\n");
+ tac1:=(Tacticals.thens
+ ~start:(PrimitiveTactics.apply_tac ~term:_Rfourier_lt_lt)
+ ~continuations:[!tac1;tac_use h;tac_zero_inf_pos
+ (rational_to_fraction c)]))
+ else
+ (debug("tac1 2\n");
+ Fourier.print_rational(c1);
+ tac1:=(Tacticals.thens
+ ~start:(mk_tactic (fun status ->
+ debug("INIZIO TAC 1 2\n");
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ debug ("th = "^ CicPp.ppterm _Rfourier_lt_le ^"\n");
+ debug ("ty = "^ CicPp.ppterm ty^"\n");
+ apply_tactic
+ (PrimitiveTactics.apply_tac ~term:_Rfourier_lt_le)
+ status))
+ ~continuations:[!tac1;tac_use h;tac_zero_inf_pos
+ (rational_to_fraction c)])))
+ else
+ (if h.hstrict then
+ (debug("tac1 3\n");
+ tac1:=(Tacticals.thens
+ ~start:(PrimitiveTactics.apply_tac ~term:_Rfourier_le_lt)
+ ~continuations:[!tac1;tac_use h;tac_zero_inf_pos
+ (rational_to_fraction c)]))
+ else
+ (debug("tac1 4\n");
+ tac1:=(Tacticals.thens
+ ~start:(PrimitiveTactics.apply_tac ~term:_Rfourier_le_le)
+ ~continuations:[!tac1;tac_use h;tac_zero_inf_pos
+ (rational_to_fraction c)]))));
+ s:=(!s)||(h.hstrict)) (* end fun -> *)
+ lutil;(*end List.iter*)
+
+ let tac2 =
+ if sres then
+ tac_zero_inf_false goal (rational_to_fraction cres)
+ else
+ tac_zero_infeq_false goal (rational_to_fraction cres)
+ in
+ tac:=(Tacticals.thens
+ ~start:(my_cut ~term:ineq)
+ ~continuations:[Tacticals.then_
+ ~start:( mk_tactic (fun status ->
+ let (proof, goal) = status in
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ apply_tactic
+ (ReductionTactics.change_tac
+ ~pattern:(ProofEngineTypes.conclusion_pattern (Some ty))
+ (const_lazy_term (Cic.Appl [ _not; ineq])))
+ status))
+ ~continuation:(Tacticals.then_
+ ~start:(PrimitiveTactics.apply_tac ~term:
+ (if sres then _Rnot_lt_lt else _Rnot_le_le))
+ ~continuation:(Tacticals.thens
+ ~start:(mk_tactic (fun status ->
+ debug("t1 ="^CicPp.ppterm !t1 ^"t2 ="^
+ CicPp.ppterm !t2 ^"tc="^ CicPp.ppterm tc^"\n");
+ let r = apply_tactic
+ (equality_replace (Cic.Appl [_Rminus;!t2;!t1] ) tc)
+ status
+ in
+ (match r with (p,gl) ->
+ debug("eq1 ritorna "^string_of_int(List.length gl)^"\n" ));
+ r))
+ ~continuations:[(Tacticals.thens
+ ~start:(mk_tactic (fun status ->
+ let r = apply_tactic
+ (equality_replace (Cic.Appl[_Rinv;_R1]) _R1)
+ status
+ in
+ (match r with (p,gl) ->
+ debug("eq2 ritorna "^string_of_int(List.length gl)^"\n" ));
+ r))
+ ~continuations:
+ [PrimitiveTactics.apply_tac ~term:_Rinv_R1;
+ Tacticals.first
+ ~tactics:[ "ring",Ring.ring_tac; "id", Tacticals.id_tac]
+ ])
+ ;(*Tacticals.id_tac*)
+ Tacticals.then_
+ ~start:(mk_tactic (fun status ->
+ let (proof, goal) = status in
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ (* check if ty is of type *)
+ let w1 =
+ debug("qui c'e' gia' l'or "^CicPp.ppterm ty^"\n");
+ (match ty with
+ Cic.Prod (Cic.Anonymous,a,b) -> (Cic.Appl [_not;a])
+ |_ -> assert false)
+ in
+ let r = apply_tactic
+ (ReductionTactics.change_tac
+ ~pattern:(ProofEngineTypes.conclusion_pattern (Some ty))
+ (const_lazy_term w1)) status
+ in
+ debug("fine MY_CHNGE\n");
+ r))
+ ~continuation:(*PORTINGTacticals.id_tac*)tac2]))
+ ;(*Tacticals.id_tac*)!tac1]);(*end tac:=*)
+
+ |_-> assert false)(*match (!lutil) *)
+ |_-> assert false); (*match res*)
+ debug ("finalmente applico tac\n");
+ (
+ let r = apply_tactic !tac (proof,goal) in
+ debug("\n\n]]]]]]]]]]]]]]]]]) That's all folks ([[[[[[[[[[[[[[[[[[[\n\n");r
+
+ )
+;;
+
+let fourier_tac = mk_tactic fourier
+
+
diff --git a/helm/ocaml/tactics/fourierR.mli b/helm/ocaml/tactics/fourierR.mli
new file mode 100644
index 000000000..e5790ec0f
--- /dev/null
+++ b/helm/ocaml/tactics/fourierR.mli
@@ -0,0 +1,5 @@
+(*
+val rewrite_tac: term:Cic.term -> ProofEngineTypes.tactic
+val rewrite_simpl_tac: term:Cic.term -> ProofEngineTypes.tactic
+*)
+val fourier_tac: ProofEngineTypes.tactic
diff --git a/helm/ocaml/tactics/fwdSimplTactic.ml b/helm/ocaml/tactics/fwdSimplTactic.ml
new file mode 100644
index 000000000..0bae64f6c
--- /dev/null
+++ b/helm/ocaml/tactics/fwdSimplTactic.ml
@@ -0,0 +1,144 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+module PEH = ProofEngineHelpers
+module U = CicUniv
+module TC = CicTypeChecker
+module PET = ProofEngineTypes
+module S = CicSubstitution
+module PT = PrimitiveTactics
+module T = Tacticals
+module FNG = FreshNamesGenerator
+module MI = CicMkImplicit
+module PESR = ProofEngineStructuralRules
+
+let fail_msg0 = "unexported clearbody: invalid argument"
+let fail_msg2 = "fwd: no applicable simplification"
+
+let error msg = raise (PET.Fail (lazy msg))
+
+(* unexported tactics *******************************************************)
+
+let id_tac =
+ let id_tac (proof,goal) =
+ try
+ let _, metasenv, _, _ = proof in
+ let _, _, _ = CicUtil.lookup_meta goal metasenv in
+ (proof,[goal])
+ with CicUtil.Meta_not_found _ -> (proof, [])
+ in
+ PET.mk_tactic id_tac
+
+let clearbody ~index =
+ let rec find_name index = function
+ | Some (Cic.Name name, _) :: _ when index = 1 -> name
+ | _ :: tail when index > 1 -> find_name (pred index) tail
+ | _ -> error fail_msg0
+ in
+ let clearbody status =
+ let (proof, goal) = status in
+ let _, metasenv, _, _ = proof in
+ let _, context, _ = CicUtil.lookup_meta goal metasenv in
+ PET.apply_tactic (PESR.clearbody ~hyp:(find_name index context)) status
+ in
+ PET.mk_tactic clearbody
+
+(* lapply *******************************************************************)
+
+let strip_prods metasenv context ?how_many to_what term =
+ let irl = MI.identity_relocation_list_for_metavariable context in
+ let mk_meta metasenv its_type =
+ let index = MI.new_meta metasenv [] in
+ let metasenv = [index, context, its_type] @ metasenv in
+ metasenv, Cic.Meta (index, irl), index
+ in
+ let update_counters = function
+ | None, [] -> None, false, id_tac, []
+ | None, to_what :: tail -> None, true, PT.apply_tac ~term:to_what, tail
+ | Some hm, [] -> Some (pred hm), false, id_tac, []
+ | Some hm, to_what :: tail -> Some (pred hm), true, PT.apply_tac ~term:to_what, tail
+ in
+ let rec aux metasenv metas conts tw = function
+ | Some hm, _ when hm <= 0 -> metasenv, metas, conts
+ | xhm, Cic.Prod (Cic.Name _, t1, t2) ->
+ let metasenv, meta, index = mk_meta metasenv t1 in
+ aux metasenv (meta :: metas) (conts @ [id_tac, index]) tw (xhm, (S.subst meta t2))
+ | xhm, Cic.Prod (Cic.Anonymous, t1, t2) ->
+ let xhm, pos, tac, tw = update_counters (xhm, tw) in
+ let metasenv, meta, index = mk_meta metasenv t1 in
+ let conts = if pos then (tac, index) :: conts else conts @ [tac, index] in
+ aux metasenv (meta :: metas) conts tw (xhm, (S.subst meta t2))
+ | _, t -> metasenv, metas, conts
+ in
+ aux metasenv [] [] to_what (how_many, term)
+
+let lapply_tac ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[])
+ (* ?(substs = []) *) ?how_many ?(to_what = []) what =
+ let letin_tac term = PT.letin_tac ~mk_fresh_name_callback term in
+ let lapply_tac (proof, goal) =
+ let xuri, metasenv, u, t = proof in
+ let _, context, _ = CicUtil.lookup_meta goal metasenv in
+ let lemma, _ = TC.type_of_aux' metasenv context what U.empty_ugraph in
+ let lemma = FNG.clean_dummy_dependent_types lemma in
+ let metasenv, metas, conts = strip_prods metasenv context ?how_many to_what lemma in
+ let conclusion =
+ match metas with [] -> what | _ -> Cic.Appl (what :: List.rev metas)
+ in
+ let tac = T.then_ ~start:(letin_tac conclusion)
+ ~continuation:(clearbody ~index:1)
+ in
+ let proof = (xuri, metasenv, u, t) in
+ let aux (proof, goals) (tac, goal) =
+ let proof, new_goals = PET.apply_tactic tac (proof, goal) in
+ proof, goals @ new_goals
+ in
+ List.fold_left aux (proof, []) ((tac, goal) :: conts)
+ in
+ PET.mk_tactic lapply_tac
+
+(* fwd **********************************************************************)
+
+let fwd_simpl_tac
+ ?(mk_fresh_name_callback = FNG.mk_fresh_name ~subst:[])
+ ~dbd hyp =
+ let lapply_tac to_what lemma =
+ lapply_tac ~mk_fresh_name_callback ~how_many:1 ~to_what:[to_what] lemma
+ in
+ let fwd_simpl_tac status =
+ let (proof, goal) = status in
+ let _, metasenv, _, _ = proof in
+ let _, context, ty = CicUtil.lookup_meta goal metasenv in
+ let index, major = PEH.lookup_type metasenv context hyp in
+ match FwdQueries.fwd_simpl ~dbd major with
+ | [] -> error fail_msg2
+ | uri :: _ ->
+ Printf.eprintf "fwd: %s\n" (UriManager.string_of_uri uri); flush stderr;
+ let start = lapply_tac (Cic.Rel index) (Cic.Const (uri, [])) in
+ let tac = T.then_ ~start ~continuation:(PESR.clear hyp) in
+ PET.apply_tactic tac status
+ in
+ PET.mk_tactic fwd_simpl_tac
diff --git a/helm/ocaml/tactics/fwdSimplTactic.mli b/helm/ocaml/tactics/fwdSimplTactic.mli
new file mode 100644
index 000000000..d75b83320
--- /dev/null
+++ b/helm/ocaml/tactics/fwdSimplTactic.mli
@@ -0,0 +1,32 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val lapply_tac:
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ ?how_many:int -> ?to_what:Cic.term list -> Cic.term -> ProofEngineTypes.tactic
+
+val fwd_simpl_tac:
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ dbd:HMysql.dbd -> string -> ProofEngineTypes.tactic
diff --git a/helm/ocaml/tactics/hashtbl_equiv.ml b/helm/ocaml/tactics/hashtbl_equiv.ml
new file mode 100644
index 000000000..86448268c
--- /dev/null
+++ b/helm/ocaml/tactics/hashtbl_equiv.ml
@@ -0,0 +1,190 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(*********************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Andrea Asperti *)
+(* 8/09/2004 *)
+(* *)
+(* *)
+(*********************************************************************)
+
+(* $Id$ *)
+
+(* the file contains an hash table of objects of the library
+ equivalent to some object in the standard subset; it is
+ mostly used to filter useless cases in auto *)
+
+
+let equivalent_objects =
+(* finte costanti; i.e. costanti senza corpo *)
+[UriManager.uri_of_string "cic:/Rocq/DEMOS/Demo_AutoRewrite/Ack0.con"(*,"finte costanti"*);
+ UriManager.uri_of_string "cic:/Rocq/DEMOS/Demo_AutoRewrite/Ac10.con"(*,"finte costanti"*);
+ UriManager.uri_of_string "cic:/Rocq/DEMOS/Demo_AutoRewrite/Ack2.con"(*,"finte costanti"*)
+ ]@
+(* inutili mostri *)
+[UriManager.uri_of_string "cic:/Rocq/DEMOS/Demo_AutoRewrite/Resg0.con"(*,"useless monster"*);
+ UriManager.uri_of_string "cic:/Rocq/DEMOS/Demo_AutoRewrite/Resg1.con"(*,"useless monster"*);
+ UriManager.uri_of_string "cic:/Rocq/DEMOS/Demo_AutoRewrite/ResAck0.con"(*,"useless monster"*)
+ ]@
+(* istanze *)
+ (UriManager.uri_of_string "cic:/Coq/Init/Peano/eq_S.con"(*,UriManager.uri_of_string "cic:/Coq/Init/Logic/f_equal.con"*))::
+[
+UriManager.uri_of_string "cic:/Paris/ZF/src/useful/lem_iff_sym.con"(*,UriManager.uri_of_string "cic:/Coq/Init/Logic/iff_sym.con"*);
+UriManager.uri_of_string "cic:/Lyon/AUTOMATA/Ensf_types/False_imp_P.con"(*,UriManager.uri_of_string "cic:/Coq/Init/Logic/False_ind.con"*);
+UriManager.uri_of_string "cic:/Rocq/TreeAutomata/bases/plus_O_r.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Plus/plus_0_r.con"*);
+UriManager.uri_of_string "cic:/Coq/Reals/Rfunctions/sum_f_R0_triangle.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/PartSum/Rabs_triang_gen.con"*);
+UriManager.uri_of_string "cic:/Sophia-Antipolis/Bertrand/Misc/eq_plus.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Plus/plus_reg_l.con"*);
+UriManager.uri_of_string "cic:/Suresnes/BDD/rauzy/algorithme1/Prelude_BDT/deMorgan_not_and.con"(*,UriManager.uri_of_string "cic:/Coq/Logic/Classical_Prop/or_not_and.con"*);
+UriManager.uri_of_string "cic:/Rocq/DEMOS/Sorting/diff_true_false.con"(*,UriManager.uri_of_string "cic:/Coq/Bool/Bool/diff_true_false.con"*);
+UriManager.uri_of_string "cic:/CoRN/metrics/CMetricSpaces/nz.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Max/le_max_l.con"*);
+UriManager.uri_of_string "cic:/Coq/Logic/Decidable/not_or.con"(*,UriManager.uri_of_string "cic:/Coq/Logic/Classical_Prop/not_or_and.con"*);
+UriManager.uri_of_string "cic:/Coq/Init/Logic/sym_not_equal.con"(*,UriManager.uri_of_string "cic:/Coq/Init/Logic/sym_not_eq.con"*);
+UriManager.uri_of_string "cic:/Coq/Reals/R_sqrt/sqrt_sqrt.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/R_sqrt/sqrt_def.con"*);
+UriManager.uri_of_string "cic:/Coq/Reals/Rlimit/eps2_Rgt_R0_subproof.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/Rlimit/eps2_Rgt_R0.con"*);
+UriManager.uri_of_string "cic:/Coq/Logic/Eqdep_dec/eqT2eq.con"(*,UriManager.uri_of_string "cic:/Coq/Logic/Eqdep_dec/eq2eqT.con"*);
+UriManager.uri_of_string "cic:/Coq/Reals/R_sqr/Rsqr_eq_0.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/RIneq/Rsqr_0_uniq.con"*);
+UriManager.uri_of_string "cic:/Rocq/THREE_GAP/Nat_compl/en_plus.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Plus/plus_0_r.con"*);
+UriManager.uri_of_string "cic:/Nijmegen/QArith/Zaux/Zabs_10.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/Zabs/Zabs_pos.con"*);
+UriManager.uri_of_string "cic:/Coq/Reals/Rlimit/Rlt_eps4_eps_subproof0.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/Rlimit/Rlt_eps2_eps_subproof.con"*);
+UriManager.uri_of_string "cic:/Coq/Arith/Le/le_refl.con"(*,UriManager.uri_of_string "cic:/Coq/Init/Peano/le.ind#xpointer(1/1/1)"*);
+UriManager.uri_of_string "cic:/Rocq/TreeAutomata/bases/le_n_n.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Le/le_refl.con"*);
+UriManager.uri_of_string "cic:/Coq/ZArith/auxiliary/Zred_factor1.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/BinInt/Zplus_diag_eq_mult_2.con"*);
+UriManager.uri_of_string "cic:/Coq/Relations/Newman/caseRxy.con"(*,UriManager.uri_of_string "cic:/Coq/Relations/Newman/Ind_proof.con"*);
+UriManager.uri_of_string "cic:/Rocq/TreeAutomata/bases/S_plus_r.con"(*,UriManager.uri_of_string "cic:/Coq/Init/Peano/plus_n_Sm.con"*);
+UriManager.uri_of_string "cic:/Eindhoven/POCKLINGTON/lemmas/Zmult_ab0a0b0.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/BinInt/Zmult_integral.con"*);
+UriManager.uri_of_string "cic:/Sophia-Antipolis/Algebra/Z_group/ax8.con"(*,UriManager.uri_of_string "cic:/Coq/NArith/BinPos/ZC2.con"*);
+UriManager.uri_of_string "cic:/Sophia-Antipolis/Algebra/Z_group/Zlt_reg_l.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/Zorder/Zplus_lt_compat_l.con"*);
+UriManager.uri_of_string "cic:/Sophia-Antipolis/MATHS/Z/Nat_complements/mult_neutr.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Mult/mult_1_l.con"*);
+UriManager.uri_of_string "cic:/Coq/fourier/Fourier_util/Rlt_zero_1.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/RIneq/Rlt_0_1.con"*);
+UriManager.uri_of_string "cic:/Suresnes/BDD/rauzy/algorithme1/Prelude_BDT/Classic.con"(*,UriManager.uri_of_string "cic:/Coq/Logic/Classical_Prop/NNPP.con"*);
+UriManager.uri_of_string "cic:/Coq/Reals/R_sqr/Rsqr_pos_lt.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/RIneq/Rlt_0_sqr.con"*);
+UriManager.uri_of_string "cic:/Rocq/THREE_GAP/Nat_compl/lt_minus2.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/ArithProp/lt_minus_O_lt.con"*);
+UriManager.uri_of_string "cic:/Coq/Reals/Rtrigo_def/sin_antisym.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/Rtrigo/sin_neg.con"*);
+UriManager.uri_of_string "cic:/Sophia-Antipolis/Functions_in_ZFC/Functions_in_ZFC/false_implies_everything.con"(*,UriManager.uri_of_string "cic:/Coq/Init/Logic/False_ind.con"*);
+UriManager.uri_of_string "cic:/Coq/ring/Setoid_ring_normalize/index_eq_prop.con"(*,UriManager.uri_of_string "cic:/Coq/ring/Ring_normalize/index_eq_prop.con"*);
+UriManager.uri_of_string "cic:/CoRN/algebra/Basics/le_pred.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Le/le_pred.con"*);
+UriManager.uri_of_string "cic:/Lannion/continuations/FOUnify_cps/nat_complements/le_S_eqP.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Compare/le_le_S_eq.con"*);
+UriManager.uri_of_string "cic:/Coq/Sorting/Permutation/permut_right.con"(*,UriManager.uri_of_string "cic:/Coq/Sorting/Permutation/permut_cons.con"*);
+UriManager.uri_of_string "cic:/Eindhoven/POCKLINGTON/lemmas/Zlt_mult_l.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/Zorder/Zmult_lt_compat_l.con"*);
+UriManager.uri_of_string "cic:/Coq/Reals/RIneq/Rplus_lt_0_compat.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/DiscrR/Rplus_lt_pos.con"*);
+UriManager.uri_of_string "cic:/Nijmegen/QArith/Zaux/Zpower_1_subproof.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/BinInt/Zmult_1_r.con"*);
+UriManager.uri_of_string "cic:/CoRN/fta/KeyLemma/lem_1c.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Minus/le_minus.con"*);
+UriManager.uri_of_string "cic:/Coq/omega/OmegaLemmas/OMEGA20.con"(*,UriManager.uri_of_string "cic:/Coq/omega/OmegaLemmas/OMEGA17.con"*);
+UriManager.uri_of_string "cic:/Nijmegen/QArith/Zaux/pair_2.con"(*,UriManager.uri_of_string "cic:/Coq/Init/Datatypes/injective_projections.con"*);
+UriManager.uri_of_string "cic:/Coq/Reals/Rlimit/Rlt_eps4_eps_subproof.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/Rlimit/Rlt_eps2_eps_subproof.con"*);
+UriManager.uri_of_string "cic:/CoRN/algebra/Basics/le_mult_right.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Mult/mult_le_compat_r.con"*);
+UriManager.uri_of_string "cic:/Nijmegen/QArith/Zaux/Zle_lt_plus_plus.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/Zorder/Zplus_le_lt_compat.con"*);
+UriManager.uri_of_string "cic:/Rocq/ARITH/Chinese/Nat_complements/lt_minus2.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/ArithProp/lt_minus_O_lt.con"*);
+UriManager.uri_of_string "cic:/Rocq/THREE_GAP/Nat_compl/not_gt_le.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Compare_dec/not_gt.con"*);
+UriManager.uri_of_string "cic:/Rocq/ARITH/Chinese/Nat_complements/mult_commut.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Mult/mult_comm.con"*);
+UriManager.uri_of_string "cic:/CoRN/algebra/Basics/lt_mult_right.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Mult/mult_lt_compat_r.con"*);
+UriManager.uri_of_string "cic:/Rocq/ARITH/Chinese/Nat_complements/mult_neutr.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Mult/mult_1_l.con"*);
+UriManager.uri_of_string "cic:/Nijmegen/QArith/Zaux/Zabs_neg.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/Zabs/Zabs_non_eq.con"*);
+UriManager.uri_of_string "cic:/Lyon/FIRING-SQUAD/bib/plus_S.con"(*,UriManager.uri_of_string "cic:/Coq/Init/Peano/plus_Sn_m.con"*);
+UriManager.uri_of_string "cic:/Nijmegen/QArith/Qhomographic_Qpositive_to_Qpositive/one_non_negative.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/Zorder/Zle_0_1.con"*);
+UriManager.uri_of_string "cic:/Coq/fourier/Fourier_util/Rle_zero_1.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/RIneq/Rle_0_1.con"*);
+UriManager.uri_of_string "cic:/Coq/Logic/Diaconescu/proof_irrel.con"(*,UriManager.uri_of_string "cic:/Coq/Logic/Classical_Prop/proof_irrelevance.con"*);
+UriManager.uri_of_string "cic:/Coq/Init/Logic/sym_equal.con"(*,UriManager.uri_of_string "cic:/Coq/Init/Logic/sym_eq.con"*);
+UriManager.uri_of_string "cic:/Coq/IntMap/Mapiter/pair_sp.con"(*,UriManager.uri_of_string "cic:/Coq/Init/Datatypes/surjective_pairing.con"*);
+UriManager.uri_of_string "cic:/Coq/Logic/ProofIrrelevance/proof_irrelevance_cci.con"(*,UriManager.uri_of_string "cic:/Coq/Logic/Classical_Prop/proof_irrelevance.con"*);
+UriManager.uri_of_string "cic:/Suresnes/BDD/rauzy/algorithme1/Prelude_BDT/deMorgan_or_not.con"(*,UriManager.uri_of_string "cic:/Coq/Logic/Classical_Prop/not_and_or.con"*);
+UriManager.uri_of_string "cic:/CoRN/model/structures/Zsec/Zplus_wd0.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/BinInt/Zplus_eq_compat.con"*);
+UriManager.uri_of_string "cic:/Coq/ZArith/auxiliary/Zred_factor6.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/BinInt/Zplus_0_r_reverse.con"*);
+UriManager.uri_of_string "cic:/Eindhoven/POCKLINGTON/lemmas/S_inj.con"(*,UriManager.uri_of_string "cic:/Coq/Init/Peano/eq_add_S.con"*);
+UriManager.uri_of_string "cic:/Coq/ZArith/Wf_Z/Z_of_nat_complete.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/RIneq/IZN.con"*);
+UriManager.uri_of_string "cic:/Suresnes/BDD/rauzy/algorithme1/Prelude_BDT/Commutative_orb.con"(*,UriManager.uri_of_string "cic:/Coq/Bool/Bool/orb_comm.con"*);
+UriManager.uri_of_string "cic:/Coq/Reals/PartSum/plus_sum.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/Cauchy_prod/sum_plus.con"*);
+UriManager.uri_of_string "cic:/Nijmegen/QArith/Qpositive/minus_le.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Minus/le_minus.con"*);
+UriManager.uri_of_string "cic:/Lyon/FIRING-SQUAD/bib/plus_zero.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Plus/plus_0_r.con"*);
+UriManager.uri_of_string "cic:/Sophia-Antipolis/Cours-de-Coq/ex1_auto/not_not_converse.con"(*,UriManager.uri_of_string "cic:/Coq/Logic/Classical_Prop/NNPP.con"*);
+UriManager.uri_of_string "cic:/Suresnes/BDD/rauzy/algorithme1/Prelude_BDT/deMorgan_and_not.con"(*,UriManager.uri_of_string "cic:/Coq/Logic/Classical_Prop/not_or_and.con"*);
+UriManager.uri_of_string "cic:/Suresnes/BDD/rauzy/algorithme1/Prelude_BDT/Commutative_andb.con"(*,UriManager.uri_of_string "cic:/Coq/Bool/Bool/andb_comm.con"*);
+UriManager.uri_of_string "cic:/Sophia-Antipolis/MATHS/Z/Nat_complements/lt_minus2.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/ArithProp/lt_minus_O_lt.con"*);
+UriManager.uri_of_string "cic:/Suresnes/BDD/canonicite/Prelude0/Morgan_and_not.con"(*,UriManager.uri_of_string "cic:/Coq/Logic/Classical_Prop/not_or_and.con"*);
+UriManager.uri_of_string "cic:/Coq/Logic/ClassicalFacts/TrueP.con"(*,UriManager.uri_of_string "cic:/Coq/Logic/ClassicalFacts/FalseP.con"*);
+UriManager.uri_of_string "cic:/Nijmegen/QArith/Zaux/Zminus_eq.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/BinInt/Zminus_eq.con"*);
+UriManager.uri_of_string "cic:/Sophia-Antipolis/Cours-de-Coq/ex1/not_not_converse.con"(*,UriManager.uri_of_string "cic:/Coq/Logic/Classical_Prop/NNPP.con"*);
+UriManager.uri_of_string "cic:/Nijmegen/QArith/Zaux/pair_1.con"(*,UriManager.uri_of_string "cic:/Coq/Init/Datatypes/surjective_pairing.con"*);
+UriManager.uri_of_string "cic:/Orsay/Maths/divide/Zabs_ind.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/Zabs/Zabs_ind.con"*);
+UriManager.uri_of_string "cic:/CoRN/algebra/Basics/Zmult_minus_distr_r.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/BinInt/Zmult_minus_distr_l.con"*);
+UriManager.uri_of_string "cic:/Coq/fourier/Fourier_util/Rfourier_eqLR_to_le.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/RIneq/Req_le.con"*);
+UriManager.uri_of_string "cic:/Rocq/TreeAutomata/bases/Sn_eq_Sm_n_eq_m.con"(*,UriManager.uri_of_string "cic:/Coq/Init/Peano/eq_add_S.con"*);
+UriManager.uri_of_string "cic:/Coq/Init/Logic/trans_equal.con"(*,UriManager.uri_of_string "cic:/Coq/Init/Logic/trans_eq.con"*);
+UriManager.uri_of_string "cic:/Coq/omega/OmegaLemmas/OMEGA2.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/Zorder/Zplus_le_0_compat.con"*);
+UriManager.uri_of_string "cic:/Sophia-Antipolis/Bertrand/Raux/P_Rmin.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/Rpower/P_Rmin.con"*);
+UriManager.uri_of_string "cic:/Sophia-Antipolis/MATHS/Z/Nat_complements/mult_commut.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Mult/mult_comm.con"*);
+UriManager.uri_of_string "cic:/Sophia-Antipolis/Huffman/Aux/le_minus.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Minus/le_minus.con"*);
+UriManager.uri_of_string "cic:/Coq/Init/Peano/plus_O_n.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Plus/plus_0_l.con"*);
+UriManager.uri_of_string "cic:/Coq/Logic/Berardi/inv2.con"(*,UriManager.uri_of_string "cic:/Coq/Logic/Berardi/AC.con"*);
+UriManager.uri_of_string "cic:/Coq/Reals/SeqProp/not_Rlt.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/RIneq/Rnot_lt_ge.con"*);
+UriManager.uri_of_string "cic:/Nancy/FOUnify/nat_complements/le_S_eqP.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Compare/le_le_S_eq.con"*);
+UriManager.uri_of_string "cic:/Rocq/TreeAutomata/bases/le_mult_l.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Mult/mult_le_compat_r.con"*);
+UriManager.uri_of_string "cic:/Eindhoven/POCKLINGTON/natZ/isnat_mult.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/Zorder/Zmult_le_0_compat.con"*);
+UriManager.uri_of_string "cic:/Coq/fourier/Fourier_util/Rfourier_eqRL_to_le.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/RIneq/Req_le_sym.con"*);
+UriManager.uri_of_string "cic:/Nijmegen/QArith/Zaux/Zabs_mult.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/Zabs/Zabs_Zmult.con"*);
+UriManager.uri_of_string "cic:/Rocq/TreeAutomata/bases/plus_n_O.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Plus/plus_0_r.con"*);
+UriManager.uri_of_string "cic:/Suresnes/BDD/rauzy/algorithme1/Prelude_BDT/excluded_middle.con"(*,UriManager.uri_of_string "cic:/Coq/Logic/Classical_Prop/classic.con"*);
+UriManager.uri_of_string "cic:/Rocq/TreeAutomata/bases/le_mult_mult.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Mult/mult_le_compat.con"*);
+UriManager.uri_of_string "cic:/Coq/Bool/Bool/Is_true_eq_true2.con"(*,UriManager.uri_of_string "cic:/Coq/Bool/Bool/Is_true_eq_left.con"*);
+UriManager.uri_of_string "cic:/Eindhoven/POCKLINGTON/natZ/isnat_plus.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/Zorder/Zplus_le_0_compat.con"*);
+UriManager.uri_of_string "cic:/Eindhoven/POCKLINGTON/lemmas/lt_plus_plus.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Plus/plus_lt_compat.con"*);
+UriManager.uri_of_string "cic:/Rocq/TreeAutomata/bases/le_mult_r.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Mult/mult_le_compat_l.con"*);
+UriManager.uri_of_string "cic:/Sophia-Antipolis/Functions_in_ZFC/Functions_in_ZFC/excluded_middle.con"(*,UriManager.uri_of_string "cic:/Coq/Logic/Classical_Prop/NNPP.con"*);
+UriManager.uri_of_string "cic:/Sophia-Antipolis/Algebra/Z_group/ax3.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/Zorder/Zgt_pos_0.con"*);
+UriManager.uri_of_string "cic:/Nijmegen/QArith/Zaux/Zabs_plus.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/Zabs/Zabs_triangle.con"*);
+UriManager.uri_of_string "cic:/Sophia-Antipolis/Buchberger/Buch/Sdep.con"(*,UriManager.uri_of_string "cic:/Coq/Init/Datatypes/prod_ind.con"*);
+UriManager.uri_of_string "cic:/Coq/Reals/PartSum/Rsum_abs.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/PartSum/Rabs_triang_gen.con"*);
+UriManager.uri_of_string "cic:/Cachan/SMC/mu/minus_n_m_le_n.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Minus/le_minus.con"*);
+UriManager.uri_of_string "cic:/Marseille/GC/lib_arith/lib_S_pred/eqnm_eqSnSm.con"(*,UriManager.uri_of_string "cic:/Coq/Init/Peano/eq_S.con"*);
+UriManager.uri_of_string "cic:/Nijmegen/QArith/Zaux/Zpower_1_subproof_subproof.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/BinInt/Zmult_1_r.con"*);
+UriManager.uri_of_string "cic:/Eindhoven/POCKLINGTON/lemmas/predminus1.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Minus/pred_of_minus.con"*);
+UriManager.uri_of_string "cic:/Sophia-Antipolis/Bertrand/Raux/Rpower_pow.con"(*,UriManager.uri_of_string "cic:/Coq/Reals/Rpower/Rpower_pow.con"*);
+UriManager.uri_of_string "cic:/Lyon/FIRING-SQUAD/bib/lt_plus_plus.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Plus/plus_lt_compat.con"*);
+UriManager.uri_of_string "cic:/Eindhoven/POCKLINGTON/lemmas/Zlt_neq.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/Zorder/Zlt_not_eq.con"*);
+UriManager.uri_of_string "cic:/Coq/Arith/Lt/nat_total_order.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Compare_dec/not_eq.con"*);
+UriManager.uri_of_string "cic:/Rocq/TreeAutomata/bases/plus_O_l.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Plus/plus_0_r.con"*);
+UriManager.uri_of_string "cic:/Coq/Logic/ClassicalFacts/boolP.ind#xpointer(1/1/2)"(*,UriManager.uri_of_string "cic:/Coq/Logic/ClassicalFacts/boolP.ind#xpointer(1/1/1)"*);
+UriManager.uri_of_string "cic:/Nijmegen/QArith/Zaux/Zmult_pos_pos.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/Zorder/Zmult_lt_O_compat.con"*);
+UriManager.uri_of_string "cic:/Nijmegen/QArith/Zaux/Zlt_plus_plus.con"(*,UriManager.uri_of_string "cic:/Coq/ZArith/Zorder/Zplus_lt_compat.con"*);
+UriManager.uri_of_string "cic:/Coq/Logic/Diaconescu/pred_ext_and_rel_choice_imp_EM.con"(*,UriManager.uri_of_string "cic:/Coq/Logic/Classical_Prop/classic.con"*);
+UriManager.uri_of_string "cic:/Sophia-Antipolis/Rsa/MiscRsa/eq_plus.con"(*,UriManager.uri_of_string "cic:/Coq/Arith/Plus/plus_reg_l.con"*)
+]
+;;
+
+let equiv_table = Hashtbl.create 503
+;;
+
+let _ = List.iter (fun a -> Hashtbl.add equiv_table a "") equivalent_objects
+;;
+
+let not_a_duplicate u =
+ try
+ ignore(Hashtbl.find equiv_table u); false
+ with
+ Not_found -> true
+;;
diff --git a/helm/ocaml/tactics/hashtbl_equiv.mli b/helm/ocaml/tactics/hashtbl_equiv.mli
new file mode 100644
index 000000000..d2608b862
--- /dev/null
+++ b/helm/ocaml/tactics/hashtbl_equiv.mli
@@ -0,0 +1,38 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(*********************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Andrea Asperti *)
+(* 8/09/2004 *)
+(* *)
+(* *)
+(*********************************************************************)
+
+
+val not_a_duplicate : UriManager.uri -> bool
+
diff --git a/helm/ocaml/tactics/history.ml b/helm/ocaml/tactics/history.ml
new file mode 100644
index 000000000..7559f367e
--- /dev/null
+++ b/helm/ocaml/tactics/history.ml
@@ -0,0 +1,86 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+exception History_failure
+
+class ['a] history size =
+ let unsome = function Some x -> x | None -> assert false in
+ object (self)
+
+ val history_data = Array.create (size + 1) None
+
+ val mutable history_hd = 0 (* rightmost index *)
+ val mutable history_cur = 0 (* current index *)
+ val mutable history_tl = 0 (* leftmost index *)
+
+ method private is_empty = history_data.(history_cur) = None
+
+ method push (status: 'a) =
+ if self#is_empty then
+ history_data.(history_cur) <- Some status
+ else begin
+ history_cur <- (history_cur + 1) mod size;
+ history_data.(history_cur) <- Some status;
+ history_hd <- history_cur; (* throw away fake future line *)
+ if history_hd = history_tl then (* tail overwritten *)
+ history_tl <- (history_tl + 1) mod size
+ end
+
+ method undo = function
+ | 0 -> unsome history_data.(history_cur)
+ | steps when steps > 0 ->
+ let max_undo_steps =
+ if history_cur >= history_tl then
+ history_cur - history_tl
+ else
+ history_cur + (size - history_tl)
+ in
+ if steps > max_undo_steps then
+ raise History_failure;
+ history_cur <- history_cur - steps;
+ if history_cur < 0 then (* fix underflow *)
+ history_cur <- size + history_cur;
+ unsome history_data.(history_cur)
+ | steps (* when steps > 0 *) -> self#redo ~-steps
+
+ method redo = function
+ | 0 -> unsome history_data.(history_cur)
+ | steps when steps > 0 ->
+ let max_redo_steps =
+ if history_hd >= history_cur then
+ history_hd - history_cur
+ else
+ history_hd + (size - history_cur)
+ in
+ if steps > max_redo_steps then
+ raise History_failure;
+ history_cur <- (history_cur + steps) mod size;
+ unsome history_data.(history_cur)
+ | steps (* when steps > 0 *) -> self#undo ~-steps
+
+ end
+
diff --git a/helm/ocaml/tactics/history.mli b/helm/ocaml/tactics/history.mli
new file mode 100644
index 000000000..86bad463f
--- /dev/null
+++ b/helm/ocaml/tactics/history.mli
@@ -0,0 +1,35 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+exception History_failure
+
+class ['a] history :
+ int ->
+ object
+ method push : 'a -> unit
+ method redo : int -> 'a
+ method undo : int -> 'a
+ end
+
diff --git a/helm/ocaml/tactics/introductionTactics.ml b/helm/ocaml/tactics/introductionTactics.ml
new file mode 100644
index 000000000..9ed3647c1
--- /dev/null
+++ b/helm/ocaml/tactics/introductionTactics.ml
@@ -0,0 +1,49 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+let fake_constructor_tac ~n (proof, goal) =
+ let module C = Cic in
+ let module R = CicReduction in
+ let (_,metasenv,_,_) = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ match (R.whd context ty) with
+ (C.MutInd (uri, typeno, exp_named_subst))
+ | (C.Appl ((C.MutInd (uri, typeno, exp_named_subst))::_)) ->
+ ProofEngineTypes.apply_tactic (
+ PrimitiveTactics.apply_tac
+ ~term: (C.MutConstruct (uri, typeno, n, exp_named_subst)))
+ (proof, goal)
+ | _ -> raise (ProofEngineTypes.Fail (lazy "Constructor: failed"))
+;;
+
+let constructor_tac ~n = ProofEngineTypes.mk_tactic (fake_constructor_tac ~n)
+
+let exists_tac = ProofEngineTypes.mk_tactic (fake_constructor_tac ~n:1) ;;
+let split_tac = ProofEngineTypes.mk_tactic (fake_constructor_tac ~n:1) ;;
+let left_tac = ProofEngineTypes.mk_tactic (fake_constructor_tac ~n:1) ;;
+let right_tac = ProofEngineTypes.mk_tactic (fake_constructor_tac ~n:2) ;;
+
diff --git a/helm/ocaml/tactics/introductionTactics.mli b/helm/ocaml/tactics/introductionTactics.mli
new file mode 100644
index 000000000..c3a12720b
--- /dev/null
+++ b/helm/ocaml/tactics/introductionTactics.mli
@@ -0,0 +1,31 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val constructor_tac: n:int -> ProofEngineTypes.tactic
+
+val exists_tac: ProofEngineTypes.tactic
+val split_tac: ProofEngineTypes.tactic
+val left_tac: ProofEngineTypes.tactic
+val right_tac: ProofEngineTypes.tactic
diff --git a/helm/ocaml/tactics/inversion.ml b/helm/ocaml/tactics/inversion.ml
new file mode 100644
index 000000000..6b563fe6a
--- /dev/null
+++ b/helm/ocaml/tactics/inversion.ml
@@ -0,0 +1,253 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+*
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+exception TheTypeOfTheCurrentGoalIsAMetaICannotChooseTheRightElimiantionPrinciple
+exception NotAnInductiveTypeToEliminate
+
+let debug = false;;
+let debug_print =
+ fun msg -> if debug then prerr_endline (Lazy.force msg) else ()
+
+
+let inside_obj = function
+ | Cic.InductiveDefinition (l,params, nleft, _) ->
+ (l,params,nleft)
+ | _ -> raise (Invalid_argument "Errore in inside_obj")
+
+let term_to_list = function
+ | Cic.Appl l -> l
+ | _ -> raise (Invalid_argument "Errore in term_to_list")
+
+
+let rec baseuri_of_term = function
+ | Cic.Appl l -> baseuri_of_term (List.hd l)
+ | Cic.MutInd (baseuri, tyno, []) -> baseuri
+ | _ -> raise (Invalid_argument "baseuri_of_term")
+
+
+(* prende il numero dei parametri sinistri, la lista dei parametri, la lista
+dei tipi dei parametri, il tipo del GOAL e costruisce il termine per la cut
+ossia DX1 = DX1 -> ... DXn=DXn -> GOALTY *)
+
+let rec foo_cut nleft l param_ty_l body uri_of_eq =
+ if nleft > 0 then foo_cut (nleft-1) (List.tl l) (List.tl param_ty_l) body
+ uri_of_eq
+ else match l with
+ | hd::tl -> Cic.Prod (Cic.Anonymous, Cic.Appl[Cic.MutInd (uri_of_eq ,0,[]);
+ (List.hd param_ty_l) ; hd; hd], foo_cut nleft
+ (List.map (CicSubstitution.lift 1) tl) (List.tl param_ty_l)
+ (CicSubstitution.lift 1 body) uri_of_eq )
+ | [] -> body
+ ;;
+
+(* da una catena di prod costruisce una lista dei termini che lo compongono.*)
+let rec list_of_prod term =
+match term with
+ | Cic.Prod (Cic.Anonymous,src,tgt) -> [src] @ (list_of_prod tgt)
+ | _ -> [term]
+;;
+
+
+let rec cut_first n l =
+ if n>0 then
+ match l with
+ | hd::tl -> cut_first (n-1) tl
+ | [] -> []
+ else l
+;;
+
+
+let rec cut_last l =
+match l with
+ | hd::tl when tl != [] -> hd:: (cut_last tl)
+ | _ -> []
+;;
+
+
+let foo_appl nleft nright_consno term uri =
+ let l = [] in
+ let a = ref l in
+ for n = 1 to nleft do
+ a := !a @ [(Cic.Implicit None)]
+ done;
+ a:= !a @ [term];
+ for n = 1 to nright_consno do
+ a := !a @ [(Cic.Implicit None)]
+ done;
+ Cic.Appl ([Cic.Const(uri,[])] @ !a @ [Cic.Rel 1]) (*L'ipotesi e' sempre Rel 1. (?) *)
+;;
+
+
+let rec foo_prod nright param_ty_l l l2 base_rel body uri_of_eq nleft termty
+ isSetType term =
+ match param_ty_l with
+ | hd::tl -> Cic.Prod (
+ Cic.Anonymous,
+ Cic.Appl[Cic.MutInd(uri_of_eq,0,[]); hd; (List.hd l); Cic.Rel base_rel],
+ foo_prod (nright-1) tl (List.map (CicSubstitution.lift 1) (List.tl l))
+ (List.map (CicSubstitution.lift 1) l2)
+ base_rel (CicSubstitution.lift 1 body)
+ uri_of_eq nleft (CicSubstitution.lift 1 termty)
+ isSetType (CicSubstitution.lift 1 term))
+ | [] -> ProofEngineReduction.replace_lifting
+ ~equality:(ProofEngineReduction.alpha_equivalence)
+ ~what: (if isSetType
+ then ((cut_first (1+nleft) (term_to_list termty) ) @ [term] )
+ else (cut_first (1+nleft) (term_to_list termty) ) )
+ ~with_what: (List.map (CicSubstitution.lift (-1)) l2)
+ ~where:body
+(*TODO lo stesso sottotermine di body puo' essere sia sx che dx!*)
+;;
+
+let rec foo_lambda nright param_ty_l nright_ param_ty_l_ l l2 base_rel body
+ uri_of_eq nleft termty isSetType ty_indty term =
+ (*assert nright >0 *)
+ match param_ty_l with
+ | hd::tl ->Cic.Lambda (
+ (Cic.Name ("lambda" ^ (string_of_int nright))),
+ hd, (* typ *)
+ foo_lambda (nright-1) tl nright_ param_ty_l_
+ (List.map (CicSubstitution.lift 1) l)
+ (List.map (CicSubstitution.lift 1) (l2 @ [Cic.Rel 1]))
+ base_rel (CicSubstitution.lift 1 body)
+ uri_of_eq nleft
+ (CicSubstitution.lift 1 termty)
+ isSetType ty_indty
+ (CicSubstitution.lift 1 term))
+ | [] when isSetType -> Cic.Lambda (
+ (Cic.Name ("lambda" ^ (string_of_int nright))),
+ (ProofEngineReduction.replace_lifting
+ ~equality:(ProofEngineReduction.alpha_equivalence)
+ ~what: (cut_first (1+nleft) (term_to_list termty) )
+ ~with_what: (List.map (CicSubstitution.lift (-1)) l2)
+ ~where:termty), (* tipo di H con i parametri destri sostituiti *)
+ foo_prod nright_ param_ty_l_ (List.map (CicSubstitution.lift 1) l)
+ (List.map (CicSubstitution.lift 1) (l2 @ [Cic.Rel 1]))
+ (base_rel+1) (CicSubstitution.lift 1 body)
+ uri_of_eq nleft
+ (CicSubstitution.lift 1 termty) isSetType
+ (CicSubstitution.lift 1 term))
+ | [] -> foo_prod nright_ param_ty_l_ l l2 base_rel body uri_of_eq nleft
+ termty isSetType term
+;;
+
+let inversion_tac ~term =
+ let module T = CicTypeChecker in
+ let module R = CicReduction in
+ let module C = Cic in
+ let module P = PrimitiveTactics in
+ let module PET = ProofEngineTypes in
+ let module PEH = ProofEngineHelpers in
+ let inversion_tac ~term (proof, goal) =
+ let (_,metasenv,_,_) = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ let (newproof, metasenv') = PEH.subst_meta_in_proof proof metano term [] in
+ let uri_of_eq = HelmLibraryObjects.Logic.eq_URI in
+
+ (* dall'indice che indentifica il goal nel metasenv, ritorna il suo tipo, che
+ e' la terza componente della relativa congettura *)
+ let (_,_,body) = CicUtil.lookup_meta goal metasenv in
+ (* estrae il tipo del termine(ipotesi) oggetto di inversion,
+ di solito un Cic.Appl *)
+ let termty,_ = T.type_of_aux' metasenv context term CicUniv.empty_ugraph in
+ let uri = baseuri_of_term termty in
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ let l,params,nleft = inside_obj o in
+ let (_,_,typeno,_) =
+ match termty with
+ C.MutInd (uri,typeno,exp_named_subst) -> (uri,exp_named_subst,typeno,[])
+ | C.Appl ((C.MutInd (uri,typeno,exp_named_subst))::args) ->
+ (uri,exp_named_subst,typeno,args)
+ | _ -> raise NotAnInductiveTypeToEliminate
+ in
+ let eliminator_uri =
+ let buri = UriManager.buri_of_uri uri in
+ let name =
+ match o with
+ C.InductiveDefinition (tys,_,_,_) ->
+ let (name,_,_,_) = List.nth tys typeno in
+ name
+ |_ -> assert false
+ in
+ let ext = "_ind" in
+ UriManager.uri_of_string (buri ^ "/" ^ name ^ ext ^ ".con")
+ in
+ (* il tipo del tipo induttivo da cui viene l'ipotesi oggetto di inversione *)
+ let (_,_,ty_indty,cons_list) = (List.hd l) in
+ (*la lista di Cic.term ricavata dal tipo del tipo induttivo. *)
+ let param_ty_l = list_of_prod ty_indty in
+ let consno = List.length cons_list in
+ let nright= (List.length param_ty_l)- (nleft+1) in
+ let isSetType = ((Pervasives.compare
+ (List.nth param_ty_l ((List.length param_ty_l)-1))
+ (Cic.Sort Cic.Prop)) != 0)
+ in
+ (* eliminiamo la testa di termty, in quanto e' il nome del predicato e non un parametro.*)
+ let cut_term = foo_cut nleft (List.tl (term_to_list termty))
+ (list_of_prod ty_indty) body uri_of_eq in
+ (* cut DXn=DXn \to GOAL *)
+ let proof1,gl1 = PET.apply_tactic (P.cut_tac cut_term) (proof,goal) in
+ (* apply Hcut ; reflexivity (su tutti i goals aperti da apply_tac) *)
+ let proof2, gl2 = PET.apply_tactic
+ (Tacticals.then_
+ ~start: (P.apply_tac (C.Rel 1)) (* apply Hcut *)
+ ~continuation: (EqualityTactics.reflexivity_tac)
+ ) (proof1, (List.hd gl1))
+ in
+ (* apply (ledx_ind( lambda x. lambda y, ...)) *)
+ let (t1,metasenv,t3,t4) = proof2 in
+ let goal2 = List.hd (List.tl gl1) in
+ let (metano,context,_) = CicUtil.lookup_meta goal2 metasenv in
+ let cut_param_ty_l = (cut_first nleft (cut_last param_ty_l)) in
+ (* la lista dei soli parametri destri *)
+ let l= cut_first (1+nleft) (term_to_list termty) in
+ let lambda_t = foo_lambda nright cut_param_ty_l nright cut_param_ty_l l []
+ nright body uri_of_eq nleft termty isSetType ty_indty term in
+ let t = foo_appl nleft (nright+consno) lambda_t eliminator_uri in
+ debug_print (lazy ("Lambda_t: " ^ (CicPp.ppterm t)));
+ debug_print (lazy ("Term: " ^ (CicPp.ppterm termty)));
+ debug_print (lazy ("Body: " ^ (CicPp.ppterm body)));
+ debug_print (lazy ("Right param: " ^ (CicPp.ppterm (Cic.Appl l))));
+
+ let (ref_t,_,metasenv'',_) = CicRefine.type_of_aux' metasenv context t
+ CicUniv.empty_ugraph
+ in
+ let proof2 = (t1,metasenv'',t3,t4) in
+ let proof3,gl3 = PET.apply_tactic (P.apply_tac ref_t) (proof2, goal2) in
+ let new_goals = ProofEngineHelpers.compare_metasenvs
+ ~oldmetasenv:metasenv ~newmetasenv:metasenv''
+ in
+ let patched_new_goals =
+ let (_,metasenv''',_,_) = proof3 in
+ List.filter (function i -> List.exists (function (j,_,_) -> j=i) metasenv''')
+ new_goals @ gl3
+ in
+ (*prerr_endline ("METASENV: " ^ CicMetaSubst.ppmetasenv metasenv []); DEBUG*)
+ (proof3, patched_new_goals)
+in
+ProofEngineTypes.mk_tactic (inversion_tac ~term)
+;;
diff --git a/helm/ocaml/tactics/inversion.mli b/helm/ocaml/tactics/inversion.mli
new file mode 100644
index 000000000..50bdf58f2
--- /dev/null
+++ b/helm/ocaml/tactics/inversion.mli
@@ -0,0 +1,26 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val inversion_tac: term: Cic.term -> ProofEngineTypes.tactic
diff --git a/helm/ocaml/tactics/metadataQuery.ml b/helm/ocaml/tactics/metadataQuery.ml
new file mode 100644
index 000000000..b9c053653
--- /dev/null
+++ b/helm/ocaml/tactics/metadataQuery.ml
@@ -0,0 +1,367 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+let nonvar uri = not (UriManager.uri_is_var uri)
+
+module Constr = MetadataConstraints
+
+exception Goal_is_not_an_equation
+
+let debug = false
+let debug_print s = if debug then prerr_endline (Lazy.force s)
+
+let ( ** ) x y = int_of_float ((float_of_int x) ** (float_of_int y))
+
+let signature_of_hypothesis context =
+ List.fold_left
+ (fun set hyp ->
+ match hyp with
+ | None -> set
+ | Some (_, Cic.Decl t)
+ | Some (_, Cic.Def (t, _)) ->
+ Constr.UriManagerSet.union set (Constr.constants_of t))
+ Constr.UriManagerSet.empty context
+
+let intersect uris siguris =
+ let set1 = List.fold_right Constr.UriManagerSet.add uris Constr.UriManagerSet.empty in
+ let set2 =
+ List.fold_right Constr.UriManagerSet.add siguris Constr.UriManagerSet.empty
+ in
+ let inter = Constr.UriManagerSet.inter set1 set2 in
+ List.filter (fun s -> Constr.UriManagerSet.mem s inter) uris
+
+(* Profiling code
+let at_most =
+ let profiler = CicUtil.profile "at_most" in
+ fun ~dbd ~where uri -> profiler.profile (Constr.at_most ~dbd ~where) uri
+
+let sigmatch =
+ let profiler = CicUtil.profile "sigmatch" in
+ fun ~dbd ~facts ~where signature ->
+ profiler.profile (MetadataConstraints.sigmatch ~dbd ~facts ~where) signature
+*)
+let at_most = Constr.at_most
+let sigmatch = MetadataConstraints.sigmatch
+
+let filter_uris_forward ~dbd (main, constants) uris =
+ let main_uris =
+ match main with
+ | None -> []
+ | Some (main, types) -> main :: types
+ in
+ let full_signature =
+ List.fold_right Constr.UriManagerSet.add main_uris constants
+ in
+ List.filter (at_most ~dbd ~where:`Statement full_signature) uris
+
+let filter_uris_backward ~dbd ~facts signature uris =
+ let siguris =
+ List.map snd
+ (sigmatch ~dbd ~facts ~where:`Statement signature)
+ in
+ intersect uris siguris
+
+let compare_goal_list proof goal1 goal2 =
+ let _,metasenv,_,_ = proof in
+ let (_, ey1, ty1) = CicUtil.lookup_meta goal1 metasenv in
+ let (_, ey2, ty2) = CicUtil.lookup_meta goal2 metasenv in
+ let ty_sort1,_ =
+ CicTypeChecker.type_of_aux' metasenv ey1 ty1 CicUniv.empty_ugraph
+ in
+ let ty_sort2,_ =
+ CicTypeChecker.type_of_aux' metasenv ey2 ty2 CicUniv.empty_ugraph
+ in
+ let prop1 =
+ let b,_ =
+ CicReduction.are_convertible
+ ey1 (Cic.Sort Cic.Prop) ty_sort1 CicUniv.empty_ugraph
+ in
+ if b then 0
+ else 1
+ in
+ let prop2 =
+ let b,_ =
+ CicReduction.are_convertible
+ ey2 (Cic.Sort Cic.Prop) ty_sort2 CicUniv.empty_ugraph
+ in
+ if b then 0
+ else 1
+ in
+ prop1 - prop2
+
+(* experimental_hint is a version of hint for experimental
+ purposes. It uses auto_tac_verbose instead of auto tac.
+ Auto_tac verbose also returns a substitution - for the moment
+ as a function from cic to cic, to be changed into an association
+ list in the future -. This substitution is used to build a
+ hash table of the inspected goals with their associated proofs.
+ The cose is a cut and paste of the previous one: at the end
+ of the experimentation we shall make a choice. *)
+
+let close_with_types s metasenv context =
+ Constr.UriManagerSet.fold
+ (fun e bag ->
+ let t = CicUtil.term_of_uri e in
+ let ty, _ =
+ CicTypeChecker.type_of_aux' metasenv context t CicUniv.empty_ugraph
+ in
+ Constr.UriManagerSet.union bag (Constr.constants_of ty))
+ s s
+
+let close_with_constructors s metasenv context =
+ Constr.UriManagerSet.fold
+ (fun e bag ->
+ let t = CicUtil.term_of_uri e in
+ match t with
+ Cic.MutInd (uri,_,_)
+ | Cic.MutConstruct (uri,_,_,_) ->
+ (match fst (CicEnvironment.get_obj CicUniv.empty_ugraph uri) with
+ Cic.InductiveDefinition(tl,_,_,_) ->
+ snd
+ (List.fold_left
+ (fun (i,s) (_,_,_,cl) ->
+ let _,s =
+ List.fold_left
+ (fun (j,s) _ ->
+ let curi = UriManager.uri_of_uriref uri i (Some j) in
+ j+1,Constr.UriManagerSet.add curi s) (1,s) cl in
+ (i+1,s)) (0,bag) tl)
+ | _ -> assert false)
+ | _ -> bag)
+ s s
+
+(* Profiling code
+let apply_tac_verbose =
+ let profiler = CicUtil.profile "apply_tac_verbose" in
+ fun ~term status -> profiler.profile (PrimitiveTactics.apply_tac_verbose ~term) status
+
+let sigmatch =
+ let profiler = CicUtil.profile "sigmatch" in
+ fun ~dbd ~facts ?(where=`Conclusion) signature -> profiler.profile (Constr.sigmatch ~dbd ~facts ~where) signature
+
+let cmatch' =
+ let profiler = CicUtil.profile "cmatch'" in
+ fun ~dbd ~facts signature -> profiler.profile (Constr.cmatch' ~dbd ~facts) signature
+*)
+let apply_tac_verbose = PrimitiveTactics.apply_tac_verbose
+let cmatch' = Constr.cmatch'
+
+let signature_of_goal ~(dbd:HMysql.dbd) ((proof, goal) as _status) =
+ let (_, metasenv, _, _) = proof in
+ let (_, context, ty) = CicUtil.lookup_meta goal metasenv in
+ let main, sig_constants = Constr.signature_of ty in
+ let set = signature_of_hypothesis context in
+ let set =
+ match main with
+ None -> set
+ | Some (main,l) ->
+ List.fold_right Constr.UriManagerSet.add (main::l) set in
+ let set = Constr.UriManagerSet.union set sig_constants in
+ let all_constants_closed = close_with_types set metasenv context in
+ let uris =
+ sigmatch ~dbd ~facts:false ~where:`Statement (None,all_constants_closed) in
+ let uris = List.filter nonvar (List.map snd uris) in
+ let uris = List.filter Hashtbl_equiv.not_a_duplicate uris in
+ uris
+
+let equations_for_goal ~(dbd:HMysql.dbd) ((proof, goal) as _status) =
+(* let to_string set =
+ "{ " ^
+ (String.concat ", "
+ (Constr.UriManagerSet.fold
+ (fun u l -> (UriManager.string_of_uri u)::l) set []))
+ ^ " }"
+ in *)
+ let (_, metasenv, _, _) = proof in
+ let (_, context, ty) = CicUtil.lookup_meta goal metasenv in
+ let main, sig_constants = Constr.signature_of ty in
+(* Printf.printf "\nsig_constants: %s\n\n" (to_string sig_constants); *)
+(* match main with *)
+(* None -> raise Goal_is_not_an_equation *)
+(* | Some (m,l) -> *)
+ let m, l =
+ let eq_URI =
+ let us = UriManager.string_of_uri (LibraryObjects.eq_URI ()) in
+ UriManager.uri_of_string (us ^ "#xpointer(1/1)")
+ in
+ match main with
+ | None -> eq_URI, []
+ | Some (m, l) when UriManager.eq m eq_URI -> m, l
+ | Some (m, l) -> eq_URI, []
+ in
+ Printf.printf "\nSome (m, l): %s, [%s]\n\n"
+ (UriManager.string_of_uri m)
+ (String.concat "; " (List.map UriManager.string_of_uri l));
+ (* if m == UriManager.uri_of_string HelmLibraryObjects.Logic.eq_XURI then ( *)
+ let set = signature_of_hypothesis context in
+ (* Printf.printf "\nsignature_of_hypothesis: %s\n\n" (to_string set); *)
+ let set = Constr.UriManagerSet.union set sig_constants in
+ let set = close_with_types set metasenv context in
+ (* Printf.printf "\ndopo close_with_types: %s\n\n" (to_string set); *)
+ let set = close_with_constructors set metasenv context in
+ (* Printf.printf "\ndopo close_with_constructors: %s\n\n" (to_string set); *)
+ let set = List.fold_right Constr.UriManagerSet.remove (m::l) set in
+ let uris =
+ sigmatch ~dbd ~facts:false ~where:`Statement (main,set) in
+ let uris = List.filter nonvar (List.map snd uris) in
+ let uris = List.filter Hashtbl_equiv.not_a_duplicate uris in
+ uris
+ (* ) *)
+ (* else raise Goal_is_not_an_equation *)
+
+let experimental_hint
+ ~(dbd:HMysql.dbd) ?(facts=false) ?signature ((proof, goal) as status) =
+ let (_, metasenv, _, _) = proof in
+ let (_, context, ty) = CicUtil.lookup_meta goal metasenv in
+ let (uris, (main, sig_constants)) =
+ match signature with
+ | Some signature ->
+ (sigmatch ~dbd ~facts signature, signature)
+ | None ->
+ (cmatch' ~dbd ~facts ty, Constr.signature_of ty)
+ in
+ let uris = List.filter nonvar (List.map snd uris) in
+ let uris = List.filter Hashtbl_equiv.not_a_duplicate uris in
+ let types_constants =
+ match main with
+ | None -> Constr.UriManagerSet.empty
+ | Some (main, types) ->
+ List.fold_right Constr.UriManagerSet.add (main :: types)
+ Constr.UriManagerSet.empty
+ in
+ let all_constants =
+ let hyp_and_sug =
+ Constr.UriManagerSet.union
+ (signature_of_hypothesis context)
+ sig_constants
+ in
+ let main =
+ match main with
+ | None -> Constr.UriManagerSet.empty
+ | Some (main,_) ->
+ let ty, _ =
+ CicTypeChecker.type_of_aux'
+ metasenv context (CicUtil.term_of_uri main) CicUniv.empty_ugraph
+ in
+ Constr.constants_of ty
+ in
+ Constr.UriManagerSet.union main hyp_and_sug
+ in
+(* Constr.UriManagerSet.iter debug_print hyp_constants; *)
+ let all_constants_closed = close_with_types all_constants metasenv context in
+ let other_constants =
+ Constr.UriManagerSet.diff all_constants_closed types_constants
+ in
+ debug_print (lazy "all_constants_closed");
+ if debug then Constr.UriManagerSet.iter (fun s -> debug_print (lazy (UriManager.string_of_uri s))) all_constants_closed;
+ debug_print (lazy "other_constants");
+ if debug then Constr.UriManagerSet.iter (fun s -> debug_print (lazy (UriManager.string_of_uri s))) other_constants;
+ let uris =
+ let pow = 2 ** (Constr.UriManagerSet.cardinal other_constants) in
+ if ((List.length uris < pow) or (pow <= 0))
+ then begin
+ debug_print (lazy "MetadataQuery: large sig, falling back to old method");
+ filter_uris_forward ~dbd (main, other_constants) uris
+ end else
+ filter_uris_backward ~dbd ~facts (main, other_constants) uris
+ in
+ let rec aux = function
+ | [] -> []
+ | uri :: tl ->
+ (let status' =
+ try
+ let (subst,(proof, goal_list)) =
+ (* debug_print (lazy ("STO APPLICANDO" ^ uri)); *)
+ apply_tac_verbose
+ ~term:(CicUtil.term_of_uri uri)
+ status
+ in
+ let goal_list =
+ List.stable_sort (compare_goal_list proof) goal_list
+ in
+ Some (uri, (subst,(proof, goal_list)))
+ with ProofEngineTypes.Fail _ -> None
+ in
+ match status' with
+ | None -> aux tl
+ | Some status' -> status' :: aux tl)
+ in
+ List.stable_sort
+ (fun (_,(_, (_, goals1))) (_,(_, (_, goals2))) ->
+ Pervasives.compare (List.length goals1) (List.length goals2))
+ (aux uris)
+
+let new_experimental_hint
+ ~(dbd:HMysql.dbd) ?(facts=false) ?signature ~universe
+ ((proof, goal) as status)
+=
+ let (_, metasenv, _, _) = proof in
+ let (_, context, ty) = CicUtil.lookup_meta goal metasenv in
+ let (uris, (main, sig_constants)) =
+ match signature with
+ | Some signature ->
+ (sigmatch ~dbd ~facts signature, signature)
+ | None ->
+ (cmatch' ~dbd ~facts ty, Constr.signature_of ty) in
+ let universe =
+ List.fold_left
+ (fun res u -> Constr.UriManagerSet.add u res)
+ Constr.UriManagerSet.empty universe in
+ let uris =
+ List.fold_left
+ (fun res (_,u) -> Constr.UriManagerSet.add u res)
+ Constr.UriManagerSet.empty uris in
+ let uris = Constr.UriManagerSet.inter uris universe in
+ let uris = Constr.UriManagerSet.elements uris in
+ let rec aux = function
+ | [] -> []
+ | uri :: tl ->
+ (let status' =
+ try
+ let (subst,(proof, goal_list)) =
+ (* debug_print (lazy ("STO APPLICANDO" ^ uri)); *)
+ apply_tac_verbose
+ ~term:(CicUtil.term_of_uri uri)
+ status
+ in
+ let goal_list =
+ List.stable_sort (compare_goal_list proof) goal_list
+ in
+ Some (uri, (subst,(proof, goal_list)))
+ with ProofEngineTypes.Fail _ -> None
+ in
+ match status' with
+ | None -> aux tl
+ | Some status' -> status' :: aux tl)
+ in
+ List.stable_sort
+ (fun (_,(_, (_, goals1))) (_,(_, (_, goals2))) ->
+ Pervasives.compare (List.length goals1) (List.length goals2))
+ (aux uris)
+
diff --git a/helm/ocaml/tactics/metadataQuery.mli b/helm/ocaml/tactics/metadataQuery.mli
new file mode 100644
index 000000000..b65a23fa9
--- /dev/null
+++ b/helm/ocaml/tactics/metadataQuery.mli
@@ -0,0 +1,55 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+ (** @param vars if set variables (".var" URIs) are considered. Defaults to
+ * false
+ * @param pat shell like pattern matching over object names, a string where "*"
+ * is interpreted as 0 or more characters and "?" as exactly one character *)
+
+val signature_of_goal:
+ dbd:HMysql.dbd -> ProofEngineTypes.status -> UriManager.uri list
+
+val equations_for_goal:
+ dbd:HMysql.dbd -> ProofEngineTypes.status -> UriManager.uri list
+
+val experimental_hint:
+ dbd:HMysql.dbd ->
+ ?facts:bool ->
+ ?signature:MetadataConstraints.term_signature ->
+ ProofEngineTypes.status ->
+ (UriManager.uri *
+ ((Cic.term -> Cic.term) *
+ (ProofEngineTypes.proof * ProofEngineTypes.goal list))) list
+
+val new_experimental_hint:
+ dbd:HMysql.dbd ->
+ ?facts:bool ->
+ ?signature:MetadataConstraints.term_signature ->
+ universe:UriManager.uri list ->
+ ProofEngineTypes.status ->
+ (UriManager.uri *
+ ((Cic.term -> Cic.term) *
+ (ProofEngineTypes.proof * ProofEngineTypes.goal list))) list
+
diff --git a/helm/ocaml/tactics/negationTactics.ml b/helm/ocaml/tactics/negationTactics.ml
new file mode 100644
index 000000000..7ee79e534
--- /dev/null
+++ b/helm/ocaml/tactics/negationTactics.ml
@@ -0,0 +1,88 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+let absurd_tac ~term =
+ let absurd_tac ~term status =
+ let (proof, goal) = status in
+ let module C = Cic in
+ let module U = UriManager in
+ let module P = PrimitiveTactics in
+ let _,metasenv,_,_ = proof in
+ let _,context,ty = CicUtil.lookup_meta goal metasenv in
+ let ty_term,_ =
+ CicTypeChecker.type_of_aux' metasenv context term CicUniv.empty_ugraph in
+ if (ty_term = (C.Sort C.Prop)) (* ma questo controllo serve?? *)
+ then ProofEngineTypes.apply_tactic
+ (P.apply_tac
+ ~term:(
+ C.Appl [(C.Const (LibraryObjects.absurd_URI (), [] )) ;
+ term ; ty])
+ )
+ status
+ else raise (ProofEngineTypes.Fail (lazy "Absurd: Not a Proposition"))
+ in
+ ProofEngineTypes.mk_tactic (absurd_tac ~term)
+;;
+
+(* FG: METTERE I NOMI ANCHE QUI? CSC: in teoria si', per la intros*)
+let contradiction_tac =
+ let contradiction_tac status =
+ let module C = Cic in
+ let module U = UriManager in
+ let module P = PrimitiveTactics in
+ let module T = Tacticals in
+ try
+ ProofEngineTypes.apply_tactic (
+ T.then_
+ ~start:(P.intros_tac ())
+ ~continuation:(
+ T.then_
+ ~start:
+ (EliminationTactics.elim_type_tac
+ (C.MutInd (LibraryObjects.false_URI (), 0, [])))
+ ~continuation: VariousTactics.assumption_tac))
+ status
+ with
+ ProofEngineTypes.Fail msg when Lazy.force msg = "Assumption: No such assumption" -> raise (ProofEngineTypes.Fail (lazy "Contradiction: No such assumption"))
+ (* sarebbe piu' elegante se Assumtion sollevasse un'eccezione tutta sua che questa cattura, magari con l'aiuto di try_tactics *)
+ in
+ ProofEngineTypes.mk_tactic contradiction_tac
+;;
+
+(* Questa era in fourierR.ml
+(* !!!!! fix !!!!!!!!!! *)
+let contradiction_tac (proof,goal)=
+ Tacticals.then_
+ ~start:(PrimitiveTactics.intros_tac ~name:"bo?" ) (*inutile sia questo che quello prima della chiamata*)
+ ~continuation:(Tacticals.then_
+ ~start:(VariousTactics.elim_type_tac ~term:_False)
+ ~continuation:(assumption_tac))
+ (proof,goal)
+;;
+*)
+
+
diff --git a/helm/ocaml/tactics/negationTactics.mli b/helm/ocaml/tactics/negationTactics.mli
new file mode 100644
index 000000000..bfa3e8d5d
--- /dev/null
+++ b/helm/ocaml/tactics/negationTactics.mli
@@ -0,0 +1,28 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val absurd_tac: term:Cic.term -> ProofEngineTypes.tactic
+val contradiction_tac: ProofEngineTypes.tactic
+
diff --git a/helm/ocaml/tactics/primitiveTactics.ml b/helm/ocaml/tactics/primitiveTactics.ml
new file mode 100644
index 000000000..7a732a572
--- /dev/null
+++ b/helm/ocaml/tactics/primitiveTactics.ml
@@ -0,0 +1,567 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+open ProofEngineHelpers
+open ProofEngineTypes
+
+exception TheTypeOfTheCurrentGoalIsAMetaICannotChooseTheRightElimiantionPrinciple
+exception NotAnInductiveTypeToEliminate
+exception WrongUriToVariable of string
+
+(* lambda_abstract newmeta ty *)
+(* returns a triple [bo],[context],[ty'] where *)
+(* [ty] = Pi/LetIn [context].[ty'] ([context] is a vector!) *)
+(* and [bo] = Lambda/LetIn [context].(Meta [newmeta]) *)
+(* So, lambda_abstract is the core of the implementation of *)
+(* the Intros tactic. *)
+(* howmany = -1 means Intros, howmany > 0 means Intros n *)
+let lambda_abstract ?(howmany=(-1)) metasenv context newmeta ty mk_fresh_name =
+ let module C = Cic in
+ let rec collect_context context howmany ty =
+ match howmany with
+ | 0 ->
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context
+ in
+ context, ty, (C.Meta (newmeta,irl))
+ | _ ->
+ match ty with
+ C.Cast (te,_) -> collect_context context howmany te
+ | C.Prod (n,s,t) ->
+ let n' = mk_fresh_name metasenv context n ~typ:s in
+ let (context',ty,bo) =
+ collect_context ((Some (n',(C.Decl s)))::context) (howmany - 1) t
+ in
+ (context',ty,C.Lambda(n',s,bo))
+ | C.LetIn (n,s,t) ->
+ let (context',ty,bo) =
+ collect_context ((Some (n,(C.Def (s,None))))::context) (howmany - 1) t
+ in
+ (context',ty,C.LetIn(n,s,bo))
+ | _ as t ->
+ if howmany <= 0 then
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context
+ in
+ context, t, (C.Meta (newmeta,irl))
+ else
+ raise (Fail (lazy "intro(s): not enough products or let-ins"))
+ in
+ collect_context context howmany ty
+
+let eta_expand metasenv context t arg =
+ let module T = CicTypeChecker in
+ let module S = CicSubstitution in
+ let module C = Cic in
+ let rec aux n =
+ function
+ t' when t' = S.lift n arg -> C.Rel (1 + n)
+ | C.Rel m -> if m <= n then C.Rel m else C.Rel (m+1)
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' = aux_exp_named_subst n exp_named_subst in
+ C.Var (uri,exp_named_subst')
+ | C.Meta (i,l) ->
+ let l' =
+ List.map (function None -> None | Some t -> Some (aux n t)) l
+ in
+ C.Meta (i, l')
+ | C.Sort _
+ | C.Implicit _ as t -> t
+ | C.Cast (te,ty) -> C.Cast (aux n te, aux n ty)
+ | C.Prod (nn,s,t) -> C.Prod (nn, aux n s, aux (n+1) t)
+ | C.Lambda (nn,s,t) -> C.Lambda (nn, aux n s, aux (n+1) t)
+ | C.LetIn (nn,s,t) -> C.LetIn (nn, aux n s, aux (n+1) t)
+ | C.Appl l -> C.Appl (List.map (aux n) l)
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst' = aux_exp_named_subst n exp_named_subst in
+ C.Const (uri,exp_named_subst')
+ | C.MutInd (uri,i,exp_named_subst) ->
+ let exp_named_subst' = aux_exp_named_subst n exp_named_subst in
+ C.MutInd (uri,i,exp_named_subst')
+ | C.MutConstruct (uri,i,j,exp_named_subst) ->
+ let exp_named_subst' = aux_exp_named_subst n exp_named_subst in
+ C.MutConstruct (uri,i,j,exp_named_subst')
+ | C.MutCase (sp,i,outt,t,pl) ->
+ C.MutCase (sp,i,aux n outt, aux n t,
+ List.map (aux n) pl)
+ | C.Fix (i,fl) ->
+ let tylen = List.length fl in
+ let substitutedfl =
+ List.map
+ (fun (name,i,ty,bo) -> (name, i, aux n ty, aux (n+tylen) bo))
+ fl
+ in
+ C.Fix (i, substitutedfl)
+ | C.CoFix (i,fl) ->
+ let tylen = List.length fl in
+ let substitutedfl =
+ List.map
+ (fun (name,ty,bo) -> (name, aux n ty, aux (n+tylen) bo))
+ fl
+ in
+ C.CoFix (i, substitutedfl)
+ and aux_exp_named_subst n =
+ List.map (function uri,t -> uri,aux n t)
+ in
+ let argty,_ =
+ T.type_of_aux' metasenv context arg CicUniv.empty_ugraph (* TASSI: FIXME *)
+ in
+ let fresh_name =
+ FreshNamesGenerator.mk_fresh_name ~subst:[]
+ metasenv context (Cic.Name "Heta") ~typ:argty
+ in
+ (C.Appl [C.Lambda (fresh_name,argty,aux 0 t) ; arg])
+
+(*CSC: ma serve solamente la prima delle new_uninst e l'unione delle due!!! *)
+let classify_metas newmeta in_subst_domain subst_in metasenv =
+ List.fold_right
+ (fun (i,canonical_context,ty) (old_uninst,new_uninst) ->
+ if in_subst_domain i then
+ old_uninst,new_uninst
+ else
+ let ty' = subst_in canonical_context ty in
+ let canonical_context' =
+ List.fold_right
+ (fun entry canonical_context' ->
+ let entry' =
+ match entry with
+ Some (n,Cic.Decl s) ->
+ Some (n,Cic.Decl (subst_in canonical_context' s))
+ | Some (n,Cic.Def (s,None)) ->
+ Some (n,Cic.Def ((subst_in canonical_context' s),None))
+ | None -> None
+ | Some (n,Cic.Def (bo,Some ty)) ->
+ Some
+ (n,
+ Cic.Def
+ (subst_in canonical_context' bo,
+ Some (subst_in canonical_context' ty)))
+ in
+ entry'::canonical_context'
+ ) canonical_context []
+ in
+ if i < newmeta then
+ ((i,canonical_context',ty')::old_uninst),new_uninst
+ else
+ old_uninst,((i,canonical_context',ty')::new_uninst)
+ ) metasenv ([],[])
+
+(* Useful only inside apply_tac *)
+let
+ generalize_exp_named_subst_with_fresh_metas context newmeta uri exp_named_subst
+=
+ let module C = Cic in
+ let params =
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ CicUtil.params_of_obj o
+ in
+ let exp_named_subst_diff,new_fresh_meta,newmetasenvfragment,exp_named_subst'=
+ let next_fresh_meta = ref newmeta in
+ let newmetasenvfragment = ref [] in
+ let exp_named_subst_diff = ref [] in
+ let rec aux =
+ function
+ [],[] -> []
+ | uri::tl,[] ->
+ let ty =
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ C.Variable (_,_,ty,_,_) ->
+ CicSubstitution.subst_vars !exp_named_subst_diff ty
+ | _ -> raise (WrongUriToVariable (UriManager.string_of_uri uri))
+ in
+(* CSC: patch to generate ?1 : ?2 : Type in place of ?1 : Type to simulate ?1 :< Type
+ (match ty with
+ C.Sort (C.Type _) as s -> (* TASSI: ?? *)
+ let fresh_meta = !next_fresh_meta in
+ let fresh_meta' = fresh_meta + 1 in
+ next_fresh_meta := !next_fresh_meta + 2 ;
+ let subst_item = uri,C.Meta (fresh_meta',[]) in
+ newmetasenvfragment :=
+ (fresh_meta,[],C.Sort (C.Type (CicUniv.fresh()))) ::
+ (* TASSI: ?? *)
+ (fresh_meta',[],C.Meta (fresh_meta,[])) :: !newmetasenvfragment ;
+ exp_named_subst_diff := !exp_named_subst_diff @ [subst_item] ;
+ subst_item::(aux (tl,[]))
+ | _ ->
+*)
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context
+ in
+ let subst_item = uri,C.Meta (!next_fresh_meta,irl) in
+ newmetasenvfragment :=
+ (!next_fresh_meta,context,ty)::!newmetasenvfragment ;
+ exp_named_subst_diff := !exp_named_subst_diff @ [subst_item] ;
+ incr next_fresh_meta ;
+ subst_item::(aux (tl,[]))(*)*)
+ | uri::tl1,((uri',_) as s)::tl2 ->
+ assert (UriManager.eq uri uri') ;
+ s::(aux (tl1,tl2))
+ | [],_ -> assert false
+ in
+ let exp_named_subst' = aux (params,exp_named_subst) in
+ !exp_named_subst_diff,!next_fresh_meta,
+ List.rev !newmetasenvfragment, exp_named_subst'
+ in
+ new_fresh_meta,newmetasenvfragment,exp_named_subst',exp_named_subst_diff
+;;
+
+let new_metasenv_and_unify_and_t newmeta' metasenv' context term' ty termty goal_arity =
+ let (consthead,newmetasenv,arguments,_) =
+ saturate_term newmeta' metasenv' context termty goal_arity in
+ let subst,newmetasenv',_ =
+ CicUnification.fo_unif newmetasenv context consthead ty CicUniv.empty_ugraph
+ in
+ let t =
+ if List.length arguments = 0 then term' else Cic.Appl (term'::arguments)
+ in
+ subst,newmetasenv',t
+
+let rec count_prods context ty =
+ match CicReduction.whd context ty with
+ Cic.Prod (n,s,t) -> 1 + count_prods (Some (n,Cic.Decl s)::context) t
+ | _ -> 0
+
+let apply_tac_verbose_with_subst ~term (proof, goal) =
+ (* Assumption: The term "term" must be closed in the current context *)
+ let module T = CicTypeChecker in
+ let module R = CicReduction in
+ let module C = Cic in
+ let (_,metasenv,_,_) = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ let newmeta = new_meta_of_proof ~proof in
+ let exp_named_subst_diff,newmeta',newmetasenvfragment,term' =
+ match term with
+ C.Var (uri,exp_named_subst) ->
+ let newmeta',newmetasenvfragment,exp_named_subst',exp_named_subst_diff =
+ generalize_exp_named_subst_with_fresh_metas context newmeta uri
+ exp_named_subst
+ in
+ exp_named_subst_diff,newmeta',newmetasenvfragment,
+ C.Var (uri,exp_named_subst')
+ | C.Const (uri,exp_named_subst) ->
+ let newmeta',newmetasenvfragment,exp_named_subst',exp_named_subst_diff =
+ generalize_exp_named_subst_with_fresh_metas context newmeta uri
+ exp_named_subst
+ in
+ exp_named_subst_diff,newmeta',newmetasenvfragment,
+ C.Const (uri,exp_named_subst')
+ | C.MutInd (uri,tyno,exp_named_subst) ->
+ let newmeta',newmetasenvfragment,exp_named_subst',exp_named_subst_diff =
+ generalize_exp_named_subst_with_fresh_metas context newmeta uri
+ exp_named_subst
+ in
+ exp_named_subst_diff,newmeta',newmetasenvfragment,
+ C.MutInd (uri,tyno,exp_named_subst')
+ | C.MutConstruct (uri,tyno,consno,exp_named_subst) ->
+ let newmeta',newmetasenvfragment,exp_named_subst',exp_named_subst_diff =
+ generalize_exp_named_subst_with_fresh_metas context newmeta uri
+ exp_named_subst
+ in
+ exp_named_subst_diff,newmeta',newmetasenvfragment,
+ C.MutConstruct (uri,tyno,consno,exp_named_subst')
+ | _ -> [],newmeta,[],term
+ in
+ let metasenv' = metasenv@newmetasenvfragment in
+ let termty,_ =
+ CicTypeChecker.type_of_aux' metasenv' context term' CicUniv.empty_ugraph
+ in
+ let termty =
+ CicSubstitution.subst_vars exp_named_subst_diff termty in
+ let goal_arity = count_prods context ty in
+ let subst,newmetasenv',t =
+ let rec add_one_argument n =
+ try
+ new_metasenv_and_unify_and_t newmeta' metasenv' context term' ty
+ termty n
+ with CicUnification.UnificationFailure _ when n > 0 ->
+ add_one_argument (n - 1)
+ in
+ add_one_argument goal_arity
+ in
+ let in_subst_domain i = List.exists (function (j,_) -> i=j) subst in
+ let apply_subst = CicMetaSubst.apply_subst subst in
+ let old_uninstantiatedmetas,new_uninstantiatedmetas =
+ (* subst_in doesn't need the context. Hence the underscore. *)
+ let subst_in _ = CicMetaSubst.apply_subst subst in
+ classify_metas newmeta in_subst_domain subst_in newmetasenv'
+ in
+ let bo' = apply_subst t in
+ let newmetasenv'' = new_uninstantiatedmetas@old_uninstantiatedmetas in
+ let subst_in =
+ (* if we just apply the subtitution, the type is irrelevant:
+ we may use Implicit, since it will be dropped *)
+ CicMetaSubst.apply_subst ((metano,(context,bo',Cic.Implicit None))::subst)
+ in
+ let (newproof, newmetasenv''') =
+ subst_meta_and_metasenv_in_proof proof metano subst_in newmetasenv''
+ in
+ (((metano,(context,bo',Cic.Implicit None))::subst)(* subst_in *), (* ALB *)
+ (newproof,
+ List.map (function (i,_,_) -> i) new_uninstantiatedmetas))
+
+
+(* ALB *)
+let apply_tac_verbose_with_subst ~term status =
+ try
+(* apply_tac_verbose ~term status *)
+ apply_tac_verbose_with_subst ~term status
+ (* TODO cacciare anche altre eccezioni? *)
+ with
+ | CicUnification.UnificationFailure msg
+ | CicTypeChecker.TypeCheckerFailure msg ->
+ raise (Fail msg)
+
+(* ALB *)
+let apply_tac_verbose ~term status =
+ let subst, status = apply_tac_verbose_with_subst ~term status in
+ (CicMetaSubst.apply_subst subst), status
+
+let apply_tac ~term status = snd (apply_tac_verbose ~term status)
+
+ (* TODO per implementare i tatticali e' necessario che tutte le tattiche
+ sollevino _solamente_ Fail *)
+let apply_tac ~term =
+ let apply_tac ~term status =
+ try
+ apply_tac ~term status
+ (* TODO cacciare anche altre eccezioni? *)
+ with
+ | CicUnification.UnificationFailure msg
+ | CicTypeChecker.TypeCheckerFailure msg ->
+ raise (Fail msg)
+ in
+ mk_tactic (apply_tac ~term)
+
+let intros_tac ?howmany ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[]) ()=
+ let intros_tac
+ ?(mk_fresh_name_callback = (FreshNamesGenerator.mk_fresh_name ~subst:[])) ()
+ (proof, goal)
+ =
+ let module C = Cic in
+ let module R = CicReduction in
+ let (_,metasenv,_,_) = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ let newmeta = new_meta_of_proof ~proof in
+ let (context',ty',bo') =
+ lambda_abstract ?howmany metasenv context newmeta ty mk_fresh_name_callback
+ in
+ let (newproof, _) =
+ subst_meta_in_proof proof metano bo' [newmeta,context',ty']
+ in
+ (newproof, [newmeta])
+ in
+ mk_tactic (intros_tac ~mk_fresh_name_callback ())
+
+let cut_tac ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[]) term =
+ let cut_tac
+ ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[])
+ term (proof, goal)
+ =
+ let module C = Cic in
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ let newmeta1 = new_meta_of_proof ~proof in
+ let newmeta2 = newmeta1 + 1 in
+ let fresh_name =
+ mk_fresh_name_callback metasenv context (Cic.Name "Hcut") ~typ:term in
+ let context_for_newmeta1 =
+ (Some (fresh_name,C.Decl term))::context in
+ let irl1 =
+ CicMkImplicit.identity_relocation_list_for_metavariable
+ context_for_newmeta1
+ in
+ let irl2 =
+ CicMkImplicit.identity_relocation_list_for_metavariable context
+ in
+ let newmeta1ty = CicSubstitution.lift 1 ty in
+ let bo' =
+ C.Appl
+ [C.Lambda (fresh_name,term,C.Meta (newmeta1,irl1)) ;
+ C.Meta (newmeta2,irl2)]
+ in
+ let (newproof, _) =
+ subst_meta_in_proof proof metano bo'
+ [newmeta2,context,term; newmeta1,context_for_newmeta1,newmeta1ty];
+ in
+ (newproof, [newmeta1 ; newmeta2])
+ in
+ mk_tactic (cut_tac ~mk_fresh_name_callback term)
+
+let letin_tac ?(mk_fresh_name_callback=FreshNamesGenerator.mk_fresh_name ~subst:[]) term =
+ let letin_tac
+ ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[])
+ term (proof, goal)
+ =
+ let module C = Cic in
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ let _,_ = (* TASSI: FIXME *)
+ CicTypeChecker.type_of_aux' metasenv context term CicUniv.empty_ugraph in
+ let newmeta = new_meta_of_proof ~proof in
+ let fresh_name =
+ mk_fresh_name_callback metasenv context (Cic.Name "Hletin") ~typ:term in
+ let context_for_newmeta =
+ (Some (fresh_name,C.Def (term,None)))::context in
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable
+ context_for_newmeta
+ in
+ let newmetaty = CicSubstitution.lift 1 ty in
+ let bo' = C.LetIn (fresh_name,term,C.Meta (newmeta,irl)) in
+ let (newproof, _) =
+ subst_meta_in_proof
+ proof metano bo'[newmeta,context_for_newmeta,newmetaty]
+ in
+ (newproof, [newmeta])
+ in
+ mk_tactic (letin_tac ~mk_fresh_name_callback term)
+
+ (** functional part of the "exact" tactic *)
+let exact_tac ~term =
+ let exact_tac ~term (proof, goal) =
+ (* Assumption: the term bo must be closed in the current context *)
+ let (_,metasenv,_,_) = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ let module T = CicTypeChecker in
+ let module R = CicReduction in
+ let ty_term,u = T.type_of_aux' metasenv context term CicUniv.empty_ugraph in
+ let b,_ = R.are_convertible context ty_term ty u in (* TASSI: FIXME *)
+ if b then
+ begin
+ let (newproof, metasenv') =
+ subst_meta_in_proof proof metano term [] in
+ (newproof, [])
+ end
+ else
+ raise (Fail (lazy "The type of the provided term is not the one expected."))
+ in
+ mk_tactic (exact_tac ~term)
+
+(* not really "primitive" tactics .... *)
+let elim_tac ~term =
+ let elim_tac ~term (proof, goal) =
+ let module T = CicTypeChecker in
+ let module U = UriManager in
+ let module R = CicReduction in
+ let module C = Cic in
+ let (curi,metasenv,proofbo,proofty) = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ let termty,_ = T.type_of_aux' metasenv context term CicUniv.empty_ugraph in
+ let (termty,metasenv',arguments,fresh_meta) =
+ ProofEngineHelpers.saturate_term
+ (ProofEngineHelpers.new_meta_of_proof proof) metasenv context termty 0 in
+ let term = if arguments = [] then term else Cic.Appl (term::arguments) in
+ let uri,exp_named_subst,typeno,args =
+ match termty with
+ C.MutInd (uri,typeno,exp_named_subst) -> (uri,exp_named_subst,typeno,[])
+ | C.Appl ((C.MutInd (uri,typeno,exp_named_subst))::args) ->
+ (uri,exp_named_subst,typeno,args)
+ | _ -> raise NotAnInductiveTypeToEliminate
+ in
+ let eliminator_uri =
+ let buri = U.buri_of_uri uri in
+ let name =
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ C.InductiveDefinition (tys,_,_,_) ->
+ let (name,_,_,_) = List.nth tys typeno in
+ name
+ | _ -> assert false
+ in
+ let ty_ty,_ = T.type_of_aux' metasenv' context ty CicUniv.empty_ugraph in
+ let ext =
+ match ty_ty with
+ C.Sort C.Prop -> "_ind"
+ | C.Sort C.Set -> "_rec"
+ | C.Sort C.CProp -> "_rec"
+ | C.Sort (C.Type _)-> "_rect"
+ | C.Meta (_,_) -> raise TheTypeOfTheCurrentGoalIsAMetaICannotChooseTheRightElimiantionPrinciple
+ | _ -> assert false
+ in
+ U.uri_of_string (buri ^ "/" ^ name ^ ext ^ ".con")
+ in
+ let eliminator_ref = C.Const (eliminator_uri,exp_named_subst) in
+ let ety,_ =
+ T.type_of_aux' metasenv' context eliminator_ref CicUniv.empty_ugraph in
+ let rec find_args_no =
+ function
+ C.Prod (_,_,t) -> 1 + find_args_no t
+ | C.Cast (s,_) -> find_args_no s
+ | C.LetIn (_,_,t) -> 0 + find_args_no t
+ | _ -> 0
+ in
+ let args_no = find_args_no ety in
+ let term_to_refine =
+ let rec make_tl base_case =
+ function
+ 0 -> [base_case]
+ | n -> (C.Implicit None)::(make_tl base_case (n - 1))
+ in
+ C.Appl (eliminator_ref :: make_tl term (args_no - 1))
+ in
+ let refined_term,_,metasenv'',_ =
+ CicRefine.type_of_aux' metasenv' context term_to_refine
+ CicUniv.empty_ugraph
+ in
+ let new_goals =
+ ProofEngineHelpers.compare_metasenvs
+ ~oldmetasenv:metasenv ~newmetasenv:metasenv''
+ in
+ let proof' = curi,metasenv'',proofbo,proofty in
+ let proof'', new_goals' =
+ apply_tactic (apply_tac ~term:refined_term) (proof',goal)
+ in
+ (* The apply_tactic can have closed some of the new_goals *)
+ let patched_new_goals =
+ let (_,metasenv''',_,_) = proof'' in
+ List.filter
+ (function i -> List.exists (function (j,_,_) -> j=i) metasenv'''
+ ) new_goals @ new_goals'
+ in
+ proof'', patched_new_goals
+ in
+ mk_tactic (elim_tac ~term)
+;;
+
+let elim_intros_tac ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[])
+ ?depth ?using what =
+ Tacticals.then_ ~start:(elim_tac ~term:what)
+ ~continuation:(intros_tac ~mk_fresh_name_callback ?howmany:depth ())
+;;
+
+(* The simplification is performed only on the conclusion *)
+let elim_intros_simpl_tac ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[])
+ ?depth ?using what =
+ Tacticals.then_ ~start:(elim_tac ~term:what)
+ ~continuation:
+ (Tacticals.thens
+ ~start:(intros_tac ~mk_fresh_name_callback ?howmany:depth ())
+ ~continuations:
+ [ReductionTactics.simpl_tac
+ ~pattern:(ProofEngineTypes.conclusion_pattern None)])
+;;
diff --git a/helm/ocaml/tactics/primitiveTactics.mli b/helm/ocaml/tactics/primitiveTactics.mli
new file mode 100644
index 000000000..01d200eb7
--- /dev/null
+++ b/helm/ocaml/tactics/primitiveTactics.mli
@@ -0,0 +1,59 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* ALB, needed by the new paramodulation... *)
+val apply_tac_verbose_with_subst:
+ term:Cic.term -> ProofEngineTypes.proof * int ->
+ Cic.substitution * (ProofEngineTypes.proof * int list)
+
+(* not a real tactic *)
+val apply_tac_verbose :
+ term:Cic.term ->
+ ProofEngineTypes.proof * int ->
+ (Cic.term -> Cic.term) * (ProofEngineTypes.proof * int list)
+
+val apply_tac:
+ term: Cic.term -> ProofEngineTypes.tactic
+val exact_tac:
+ term: Cic.term -> ProofEngineTypes.tactic
+val intros_tac:
+ ?howmany:int ->
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type -> unit ->
+ ProofEngineTypes.tactic
+val cut_tac:
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ Cic.term ->
+ ProofEngineTypes.tactic
+val letin_tac:
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ Cic.term ->
+ ProofEngineTypes.tactic
+
+val elim_intros_simpl_tac:
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ ?depth:int -> ?using:Cic.term -> Cic.term -> ProofEngineTypes.tactic
+val elim_intros_tac:
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ ?depth:int -> ?using:Cic.term -> Cic.term -> ProofEngineTypes.tactic
diff --git a/helm/ocaml/tactics/proofEngineHelpers.ml b/helm/ocaml/tactics/proofEngineHelpers.ml
new file mode 100644
index 000000000..cf7df2d58
--- /dev/null
+++ b/helm/ocaml/tactics/proofEngineHelpers.ml
@@ -0,0 +1,688 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+exception Bad_pattern of string Lazy.t
+
+let new_meta_of_proof ~proof:(_, metasenv, _, _) =
+ CicMkImplicit.new_meta metasenv []
+
+let subst_meta_in_proof proof meta term newmetasenv =
+ let uri,metasenv,bo,ty = proof in
+ (* empty context is ok for term since it wont be used by apply_subst *)
+ (* hack: since we do not know the context and the type of term, we
+ create a substitution with cc =[] and type = Implicit; they will be
+ in any case dropped by apply_subst, but it would be better to rewrite
+ the code. Cannot we just use apply_subst_metasenv, etc. ?? *)
+ let subst_in = CicMetaSubst.apply_subst [meta,([], term,Cic.Implicit None)] in
+ let metasenv' =
+ newmetasenv @ (List.filter (function (m,_,_) -> m <> meta) metasenv)
+ in
+ let metasenv'' =
+ List.map
+ (function i,canonical_context,ty ->
+ let canonical_context' =
+ List.map
+ (function
+ Some (n,Cic.Decl s) -> Some (n,Cic.Decl (subst_in s))
+ | Some (n,Cic.Def (s,None)) -> Some (n,Cic.Def (subst_in s,None))
+ | None -> None
+ | Some (n,Cic.Def (bo,Some ty)) ->
+ Some (n,Cic.Def (subst_in bo,Some (subst_in ty)))
+ ) canonical_context
+ in
+ i,canonical_context',(subst_in ty)
+ ) metasenv'
+ in
+ let bo' = subst_in bo in
+ (* Metavariables can appear also in the *statement* of the theorem
+ * since the parser does not reject as statements terms with
+ * metavariable therein *)
+ let ty' = subst_in ty in
+ let newproof = uri,metasenv'',bo',ty' in
+ (newproof, metasenv'')
+
+(*CSC: commento vecchio *)
+(* refine_meta_with_brand_new_metasenv meta term subst_in newmetasenv *)
+(* This (heavy) function must be called when a tactic can instantiate old *)
+(* metavariables (i.e. existential variables). It substitues the metasenv *)
+(* of the proof with the result of removing [meta] from the domain of *)
+(* [newmetasenv]. Then it replaces Cic.Meta [meta] with [term] everywhere *)
+(* in the current proof. Finally it applies [apply_subst_replacing] to *)
+(* current proof. *)
+(*CSC: A questo punto perche' passare un bo' gia' istantiato, se tanto poi *)
+(*CSC: ci ripasso sopra apply_subst!!! *)
+(*CSC: Attenzione! Ora questa funzione applica anche [subst_in] a *)
+(*CSC: [newmetasenv]. *)
+let subst_meta_and_metasenv_in_proof proof meta subst_in newmetasenv =
+ let (uri,_,bo,ty) = proof in
+ let bo' = subst_in bo in
+ (* Metavariables can appear also in the *statement* of the theorem
+ * since the parser does not reject as statements terms with
+ * metavariable therein *)
+ let ty' = subst_in ty in
+ let metasenv' =
+ List.fold_right
+ (fun metasenv_entry i ->
+ match metasenv_entry with
+ (m,canonical_context,ty) when m <> meta ->
+ let canonical_context' =
+ List.map
+ (function
+ None -> None
+ | Some (i,Cic.Decl t) -> Some (i,Cic.Decl (subst_in t))
+ | Some (i,Cic.Def (t,None)) ->
+ Some (i,Cic.Def (subst_in t,None))
+ | Some (i,Cic.Def (bo,Some ty)) ->
+ Some (i,Cic.Def (subst_in bo,Some (subst_in ty)))
+ ) canonical_context
+ in
+ (m,canonical_context',subst_in ty)::i
+ | _ -> i
+ ) newmetasenv []
+ in
+ let newproof = uri,metasenv',bo',ty' in
+ (newproof, metasenv')
+
+let compare_metasenvs ~oldmetasenv ~newmetasenv =
+ List.map (function (i,_,_) -> i)
+ (List.filter
+ (function (i,_,_) ->
+ not (List.exists (fun (j,_,_) -> i=j) oldmetasenv)) newmetasenv)
+;;
+
+(** finds the _pointers_ to subterms that are alpha-equivalent to wanted in t *)
+let find_subterms ~subst ~metasenv ~ugraph ~wanted ~context t =
+ let rec find subst metasenv ugraph context w t =
+ try
+ let subst,metasenv,ugraph =
+ CicUnification.fo_unif_subst subst context metasenv w t ugraph
+ in
+ subst,metasenv,ugraph,[context,t]
+ with
+ CicUnification.UnificationFailure _
+ | CicUnification.Uncertain _ ->
+ match t with
+ | Cic.Sort _
+ | Cic.Rel _ -> subst,metasenv,ugraph,[]
+ | Cic.Meta (_, ctx) ->
+ List.fold_left (
+ fun (subst,metasenv,ugraph,acc) e ->
+ match e with
+ | None -> subst,metasenv,ugraph,acc
+ | Some t ->
+ let subst,metasenv,ugraph,res =
+ find subst metasenv ugraph context w t
+ in
+ subst,metasenv,ugraph, res @ acc
+ ) (subst,metasenv,ugraph,[]) ctx
+ | Cic.Lambda (name, t1, t2)
+ | Cic.Prod (name, t1, t2) ->
+ let subst,metasenv,ugraph,rest1 =
+ find subst metasenv ugraph context w t1 in
+ let subst,metasenv,ugraph,rest2 =
+ find subst metasenv ugraph (Some (name, Cic.Decl t1)::context)
+ (CicSubstitution.lift 1 w) t2
+ in
+ subst,metasenv,ugraph,rest1 @ rest2
+ | Cic.LetIn (name, t1, t2) ->
+ let subst,metasenv,ugraph,rest1 =
+ find subst metasenv ugraph context w t1 in
+ let subst,metasenv,ugraph,rest2 =
+ find subst metasenv ugraph (Some (name, Cic.Def (t1,None))::context)
+ (CicSubstitution.lift 1 w) t2
+ in
+ subst,metasenv,ugraph,rest1 @ rest2
+ | Cic.Appl l ->
+ List.fold_left
+ (fun (subst,metasenv,ugraph,acc) t ->
+ let subst,metasenv,ugraph,res =
+ find subst metasenv ugraph context w t
+ in
+ subst,metasenv,ugraph,res @ acc)
+ (subst,metasenv,ugraph,[]) l
+ | Cic.Cast (t, ty) ->
+ let subst,metasenv,ugraph,rest =
+ find subst metasenv ugraph context w t in
+ let subst,metasenv,ugraph,resty =
+ find subst metasenv ugraph context w ty
+ in
+ subst,metasenv,ugraph,rest @ resty
+ | Cic.Implicit _ -> assert false
+ | Cic.Const (_, esubst)
+ | Cic.Var (_, esubst)
+ | Cic.MutInd (_, _, esubst)
+ | Cic.MutConstruct (_, _, _, esubst) ->
+ List.fold_left
+ (fun (subst,metasenv,ugraph,acc) (_, t) ->
+ let subst,metasenv,ugraph,res =
+ find subst metasenv ugraph context w t
+ in
+ subst,metasenv,ugraph,res @ acc)
+ (subst,metasenv,ugraph,[]) esubst
+ | Cic.MutCase (_, _, outty, indterm, patterns) ->
+ let subst,metasenv,ugraph,resoutty =
+ find subst metasenv ugraph context w outty in
+ let subst,metasenv,ugraph,resindterm =
+ find subst metasenv ugraph context w indterm in
+ let subst,metasenv,ugraph,respatterns =
+ List.fold_left
+ (fun (subst,metasenv,ugraph,acc) p ->
+ let subst,metaseng,ugraph,res =
+ find subst metasenv ugraph context w p
+ in
+ subst,metasenv,ugraph,res @ acc
+ ) (subst,metasenv,ugraph,[]) patterns
+ in
+ subst,metasenv,ugraph,resoutty @ resindterm @ respatterns
+ | Cic.Fix (_, funl) ->
+ let tys =
+ List.map (fun (n,_,ty,_) -> Some (Cic.Name n,(Cic.Decl ty))) funl
+ in
+ List.fold_left (
+ fun (subst,metasenv,ugraph,acc) (_, _, ty, bo) ->
+ let subst,metasenv,ugraph,resty =
+ find subst metasenv ugraph context w ty in
+ let subst,metasenv,ugraph,resbo =
+ find subst metasenv ugraph (tys @ context) w bo
+ in
+ subst,metasenv,ugraph, resty @ resbo @ acc
+ ) (subst,metasenv,ugraph,[]) funl
+ | Cic.CoFix (_, funl) ->
+ let tys =
+ List.map (fun (n,ty,_) -> Some (Cic.Name n,(Cic.Decl ty))) funl
+ in
+ List.fold_left (
+ fun (subst,metasenv,ugraph,acc) (_, ty, bo) ->
+ let subst,metasenv,ugraph,resty =
+ find subst metasenv ugraph context w ty in
+ let subst,metasenv,ugraph,resbo =
+ find subst metasenv ugraph (tys @ context) w bo
+ in
+ subst,metasenv,ugraph, resty @ resbo @ acc
+ ) (subst,metasenv,ugraph,[]) funl
+ in
+ find subst metasenv ugraph context wanted t
+
+let select_in_term ~metasenv ~context ~ugraph ~term ~pattern:(wanted,where) =
+ let add_ctx context name entry = (Some (name, entry)) :: context in
+ let map2 error_msg f l1 l2 =
+ try
+ List.map2 f l1 l2
+ with
+ | Invalid_argument _ -> raise (Bad_pattern (lazy error_msg))
+ in
+ let rec aux context where term =
+ match (where, term) with
+ | Cic.Implicit (Some `Hole), t -> [context,t]
+ | Cic.Implicit (Some `Type), t -> []
+ | Cic.Implicit None,_ -> []
+ | Cic.Meta (_, ctxt1), Cic.Meta (_, ctxt2) ->
+ List.concat
+ (map2 "wrong number of argument in explicit substitution"
+ (fun t1 t2 ->
+ (match (t1, t2) with
+ Some t1, Some t2 -> aux context t1 t2
+ | _ -> []))
+ ctxt1 ctxt2)
+ | Cic.Cast (te1, ty1), Cic.Cast (te2, ty2) ->
+ aux context te1 te2 @ aux context ty1 ty2
+ | Cic.Prod (Cic.Anonymous, s1, t1), Cic.Prod (name, s2, t2)
+ | Cic.Lambda (Cic.Anonymous, s1, t1), Cic.Lambda (name, s2, t2) ->
+ aux context s1 s2 @ aux (add_ctx context name (Cic.Decl s2)) t1 t2
+ | Cic.Prod (Cic.Name n1, s1, t1),
+ Cic.Prod ((Cic.Name n2) as name , s2, t2)
+ | Cic.Lambda (Cic.Name n1, s1, t1),
+ Cic.Lambda ((Cic.Name n2) as name, s2, t2) when n1 = n2->
+ aux context s1 s2 @ aux (add_ctx context name (Cic.Decl s2)) t1 t2
+ | Cic.Prod (name1, s1, t1), Cic.Prod (name2, s2, t2)
+ | Cic.Lambda (name1, s1, t1), Cic.Lambda (name2, s2, t2) -> []
+ | Cic.LetIn (Cic.Anonymous, s1, t1), Cic.LetIn (name, s2, t2) ->
+ aux context s1 s2 @ aux (add_ctx context name (Cic.Def (s2,None))) t1 t2
+ | Cic.LetIn (Cic.Name n1, s1, t1),
+ Cic.LetIn ((Cic.Name n2) as name, s2, t2) when n1 = n2->
+ aux context s1 s2 @ aux (add_ctx context name (Cic.Def (s2,None))) t1 t2
+ | Cic.LetIn (name1, s1, t1), Cic.LetIn (name2, s2, t2) -> []
+ | Cic.Appl terms1, Cic.Appl terms2 -> auxs context terms1 terms2
+ | Cic.Var (_, subst1), Cic.Var (_, subst2)
+ | Cic.Const (_, subst1), Cic.Const (_, subst2)
+ | Cic.MutInd (_, _, subst1), Cic.MutInd (_, _, subst2)
+ | Cic.MutConstruct (_, _, _, subst1), Cic.MutConstruct (_, _, _, subst2) ->
+ auxs context (List.map snd subst1) (List.map snd subst2)
+ | Cic.MutCase (_, _, out1, t1, pat1), Cic.MutCase (_ , _, out2, t2, pat2) ->
+ aux context out1 out2 @ aux context t1 t2 @ auxs context pat1 pat2
+ | Cic.Fix (_, funs1), Cic.Fix (_, funs2) ->
+ let tys =
+ List.map (fun (n,_,ty,_) -> Some (Cic.Name n,(Cic.Decl ty))) funs2
+ in
+ List.concat
+ (map2 "wrong number of mutually recursive functions"
+ (fun (_, _, ty1, bo1) (_, _, ty2, bo2) ->
+ aux context ty1 ty2 @ aux (tys @ context) bo1 bo2)
+ funs1 funs2)
+ | Cic.CoFix (_, funs1), Cic.CoFix (_, funs2) ->
+ let tys =
+ List.map (fun (n,ty,_) -> Some (Cic.Name n,(Cic.Decl ty))) funs2
+ in
+ List.concat
+ (map2 "wrong number of mutually co-recursive functions"
+ (fun (_, ty1, bo1) (_, ty2, bo2) ->
+ aux context ty1 ty2 @ aux (tys @ context) bo1 bo2)
+ funs1 funs2)
+ | x,y ->
+ raise (Bad_pattern
+ (lazy (Printf.sprintf "Pattern %s versus term %s"
+ (CicPp.ppterm x)
+ (CicPp.ppterm y))))
+ and auxs context terms1 terms2 = (* as aux for list of terms *)
+ List.concat (map2 "wrong number of arguments in application"
+ (fun t1 t2 -> aux context t1 t2) terms1 terms2)
+ in
+ let roots =
+ match where with
+ | None -> []
+ | Some where -> aux context where term
+ in
+ match wanted with
+ None -> [],metasenv,ugraph,roots
+ | Some wanted ->
+ let rec find_in_roots =
+ function
+ [] -> [],metasenv,ugraph,[]
+ | (context',where)::tl ->
+ let subst,metasenv,ugraph,tl' = find_in_roots tl in
+ let subst,metasenv,ugraph,found =
+ let wanted, metasenv, ugraph = wanted context' metasenv ugraph in
+ find_subterms ~subst ~metasenv ~ugraph ~wanted ~context:context'
+ where
+ in
+ subst,metasenv,ugraph,found @ tl'
+ in
+ find_in_roots roots
+
+(** create a pattern from a term and a list of subterms.
+* the pattern is granted to have a ? for every subterm that has no selected
+* subterms
+* @param equality equality function used while walking the term. Defaults to
+* physical equality (==) *)
+let pattern_of ?(equality=(==)) ~term terms =
+ let (===) x y = equality x y in
+ let not_found = false, Cic.Implicit None in
+ let rec aux t =
+ match t with
+ | t when List.exists (fun t' -> t === t') terms ->
+ true,Cic.Implicit (Some `Hole)
+ | Cic.Var (uri, subst) ->
+ let b,subst = aux_subst subst in
+ if b then
+ true,Cic.Var (uri, subst)
+ else
+ not_found
+ | Cic.Meta (i, ctxt) ->
+ let b,ctxt =
+ List.fold_right
+ (fun e (b,ctxt) ->
+ match e with
+ None -> b,None::ctxt
+ | Some t -> let bt,t = aux t in b||bt ,Some t::ctxt
+ ) ctxt (false,[])
+ in
+ if b then
+ true,Cic.Meta (i, ctxt)
+ else
+ not_found
+ | Cic.Cast (te, ty) ->
+ let b1,te = aux te in
+ let b2,ty = aux ty in
+ if b1||b2 then true,Cic.Cast (te, ty)
+ else
+ not_found
+ | Cic.Prod (name, s, t) ->
+ let b1,s = aux s in
+ let b2,t = aux t in
+ if b1||b2 then
+ true, Cic.Prod (name, s, t)
+ else
+ not_found
+ | Cic.Lambda (name, s, t) ->
+ let b1,s = aux s in
+ let b2,t = aux t in
+ if b1||b2 then
+ true, Cic.Lambda (name, s, t)
+ else
+ not_found
+ | Cic.LetIn (name, s, t) ->
+ let b1,s = aux s in
+ let b2,t = aux t in
+ if b1||b2 then
+ true, Cic.LetIn (name, s, t)
+ else
+ not_found
+ | Cic.Appl terms ->
+ let b,terms =
+ List.fold_right
+ (fun t (b,terms) ->
+ let bt,t = aux t in
+ b||bt,t::terms
+ ) terms (false,[])
+ in
+ if b then
+ true,Cic.Appl terms
+ else
+ not_found
+ | Cic.Const (uri, subst) ->
+ let b,subst = aux_subst subst in
+ if b then
+ true, Cic.Const (uri, subst)
+ else
+ not_found
+ | Cic.MutInd (uri, tyno, subst) ->
+ let b,subst = aux_subst subst in
+ if b then
+ true, Cic.MutInd (uri, tyno, subst)
+ else
+ not_found
+ | Cic.MutConstruct (uri, tyno, consno, subst) ->
+ let b,subst = aux_subst subst in
+ if b then
+ true, Cic.MutConstruct (uri, tyno, consno, subst)
+ else
+ not_found
+ | Cic.MutCase (uri, tyno, outty, t, pat) ->
+ let b1,outty = aux outty in
+ let b2,t = aux t in
+ let b3,pat =
+ List.fold_right
+ (fun t (b,pat) ->
+ let bt,t = aux t in
+ bt||b,t::pat
+ ) pat (false,[])
+ in
+ if b1 || b2 || b3 then
+ true, Cic.MutCase (uri, tyno, outty, t, pat)
+ else
+ not_found
+ | Cic.Fix (funno, funs) ->
+ let b,funs =
+ List.fold_right
+ (fun (name, i, ty, bo) (b,funs) ->
+ let b1,ty = aux ty in
+ let b2,bo = aux bo in
+ b||b1||b2, (name, i, ty, bo)::funs) funs (false,[])
+ in
+ if b then
+ true, Cic.Fix (funno, funs)
+ else
+ not_found
+ | Cic.CoFix (funno, funs) ->
+ let b,funs =
+ List.fold_right
+ (fun (name, ty, bo) (b,funs) ->
+ let b1,ty = aux ty in
+ let b2,bo = aux bo in
+ b||b1||b2, (name, ty, bo)::funs) funs (false,[])
+ in
+ if b then
+ true, Cic.CoFix (funno, funs)
+ else
+ not_found
+ | Cic.Rel _
+ | Cic.Sort _
+ | Cic.Implicit _ -> not_found
+ and aux_subst subst =
+ List.fold_right
+ (fun (uri, t) (b,subst) ->
+ let b1,t = aux t in
+ b||b1,(uri, t)::subst) subst (false,[])
+ in
+ snd (aux term)
+
+exception Fail of string Lazy.t
+
+ (** select metasenv conjecture pattern
+ * select all subterms of [conjecture] matching [pattern].
+ * It returns the set of matched terms (that can be compared using physical
+ * equality to the subterms of [conjecture]) together with their contexts.
+ * The representation of the set mimics the ProofEngineTypes.pattern type:
+ * a list of hypothesis (names of) together with the list of its matched
+ * subterms (and their contexts) + the list of matched subterms of the
+ * with their context conclusion. Note: in the result the list of hypothesis
+ * has an entry for each entry in the context and in the same order.
+ * Of course the list of terms (with their context) associated to the
+ * hypothesis name may be empty.
+ *
+ * @raise Bad_pattern
+ * *)
+ let select ~metasenv ~ugraph ~conjecture:(_,context,ty)
+ ~(pattern: (Cic.term, Cic.lazy_term) ProofEngineTypes.pattern)
+ =
+ let what, hyp_patterns, goal_pattern = pattern in
+ let find_pattern_for name =
+ try Some (snd (List.find (fun (n, pat) -> Cic.Name n = name) hyp_patterns))
+ with Not_found -> None in
+ let subst,metasenv,ugraph,ty_terms =
+ select_in_term ~metasenv ~context ~ugraph ~term:ty
+ ~pattern:(what,goal_pattern) in
+ let subst,metasenv,ugraph,context_terms =
+ let subst,metasenv,ugraph,res,_ =
+ (List.fold_right
+ (fun entry (subst,metasenv,ugraph,res,context) ->
+ match entry with
+ None -> subst,metasenv,ugraph,(None::res),(None::context)
+ | Some (name,Cic.Decl term) ->
+ (match find_pattern_for name with
+ | None ->
+ subst,metasenv,ugraph,((Some (`Decl []))::res),(entry::context)
+ | Some pat ->
+ let subst,metasenv,ugraph,terms =
+ select_in_term ~metasenv ~context ~ugraph ~term
+ ~pattern:(what, Some pat)
+ in
+ subst,metasenv,ugraph,((Some (`Decl terms))::res),
+ (entry::context))
+ | Some (name,Cic.Def (bo, ty)) ->
+ (match find_pattern_for name with
+ | None ->
+ let selected_ty=match ty with None -> None | Some _ -> Some [] in
+ subst,metasenv,ugraph,((Some (`Def ([],selected_ty)))::res),
+ (entry::context)
+ | Some pat ->
+ let subst,metasenv,ugraph,terms_bo =
+ select_in_term ~metasenv ~context ~ugraph ~term:bo
+ ~pattern:(what, Some pat) in
+ let subst,metasenv,ugraph,terms_ty =
+ match ty with
+ None -> subst,metasenv,ugraph,None
+ | Some ty ->
+ let subst,metasenv,ugraph,res =
+ select_in_term ~metasenv ~context ~ugraph ~term:ty
+ ~pattern:(what, Some pat)
+ in
+ subst,metasenv,ugraph,Some res
+ in
+ subst,metasenv,ugraph,((Some (`Def (terms_bo,terms_ty)))::res),
+ (entry::context))
+ ) context (subst,metasenv,ugraph,[],[]))
+ in
+ subst,metasenv,ugraph,res
+ in
+ subst,metasenv,ugraph,context_terms, ty_terms
+
+(** locate_in_term equality what where context
+* [what] must match a subterm of [where] according to [equality]
+* It returns the matched terms together with their contexts in [where]
+* [equality] defaults to physical equality
+* [context] must be the context of [where]
+*)
+let locate_in_term ?(equality=(fun _ -> (==))) what ~where context =
+ let add_ctx context name entry =
+ (Some (name, entry)) :: context in
+ let rec aux context where =
+ if equality context what where then [context,where]
+ else
+ match where with
+ | Cic.Implicit _
+ | Cic.Meta _
+ | Cic.Rel _
+ | Cic.Sort _
+ | Cic.Var _
+ | Cic.Const _
+ | Cic.MutInd _
+ | Cic.MutConstruct _ -> []
+ | Cic.Cast (te, ty) -> aux context te @ aux context ty
+ | Cic.Prod (name, s, t)
+ | Cic.Lambda (name, s, t) ->
+ aux context s @ aux (add_ctx context name (Cic.Decl s)) t
+ | Cic.LetIn (name, s, t) ->
+ aux context s @ aux (add_ctx context name (Cic.Def (s,None))) t
+ | Cic.Appl tl -> auxs context tl
+ | Cic.MutCase (_, _, out, t, pat) ->
+ aux context out @ aux context t @ auxs context pat
+ | Cic.Fix (_, funs) ->
+ let tys =
+ List.map (fun (n,_,ty,_) -> Some (Cic.Name n,(Cic.Decl ty))) funs
+ in
+ List.concat
+ (List.map
+ (fun (_, _, ty, bo) ->
+ aux context ty @ aux (tys @ context) bo)
+ funs)
+ | Cic.CoFix (_, funs) ->
+ let tys =
+ List.map (fun (n,ty,_) -> Some (Cic.Name n,(Cic.Decl ty))) funs
+ in
+ List.concat
+ (List.map
+ (fun (_, ty, bo) ->
+ aux context ty @ aux (tys @ context) bo)
+ funs)
+ and auxs context tl = (* as aux for list of terms *)
+ List.concat (List.map (fun t -> aux context t) tl)
+ in
+ aux context where
+
+(** locate_in_conjecture equality what where context
+* [what] must match a subterm of [where] according to [equality]
+* It returns the matched terms together with their contexts in [where]
+* [equality] defaults to physical equality
+* [context] must be the context of [where]
+*)
+let locate_in_conjecture ?(equality=fun _ -> (==)) what (_,context,ty) =
+ let context,res =
+ List.fold_right
+ (fun entry (context,res) ->
+ match entry with
+ None -> entry::context, res
+ | Some (_, Cic.Decl ty) ->
+ let res = res @ locate_in_term what ~where:ty context in
+ let context' = entry::context in
+ context',res
+ | Some (_, Cic.Def (bo,ty)) ->
+ let res = res @ locate_in_term what ~where:bo context in
+ let res =
+ match ty with
+ None -> res
+ | Some ty ->
+ res @ locate_in_term what ~where:ty context in
+ let context' = entry::context in
+ context',res
+ ) context ([],[])
+ in
+ res @ locate_in_term what ~where:ty context
+
+(* saturate_term newmeta metasenv context ty goal_arity *)
+(* Given a type [ty] (a backbone), it returns its suffix of length *)
+(* [goal_arity] head and a new metasenv in which there is new a META for each *)
+(* hypothesis, a list of arguments for the new applications and the index of *)
+(* the last new META introduced. The nth argument in the list of arguments is *)
+(* just the nth new META. *)
+let saturate_term newmeta metasenv context ty goal_arity =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ assert (goal_arity >= 0);
+ let rec aux newmeta ty =
+ match ty with
+ C.Cast (he,_) -> aux newmeta he
+(* CSC: patch to generate ?1 : ?2 : Type in place of ?1 : Type to simulate ?1 :< Type
+ (* If the expected type is a Type, then also Set is OK ==>
+ * we accept any term of type Type *)
+ (*CSC: BUG HERE: in this way it is possible for the term of
+ * type Type to be different from a Sort!!! *)
+ | C.Prod (name,(C.Sort (C.Type _) as s),t) ->
+ (* TASSI: ask CSC if BUG HERE refers to the C.Cast or C.Propd case *)
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context
+ in
+ let newargument = C.Meta (newmeta+1,irl) in
+ let (res,newmetasenv,arguments,lastmeta) =
+ aux (newmeta + 2) (S.subst newargument t)
+ in
+ res,
+ (newmeta,[],s)::(newmeta+1,context,C.Meta (newmeta,[]))::newmetasenv,
+ newargument::arguments,lastmeta
+*)
+ | C.Prod (name,s,t) ->
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context
+ in
+ let newargument = C.Meta (newmeta,irl) in
+ let res,newmetasenv,arguments,lastmeta,prod_no =
+ aux (newmeta + 1) (S.subst newargument t)
+ in
+ if prod_no + 1 = goal_arity then
+ let head = CicReduction.normalize ~delta:false context ty in
+ head,[],[],lastmeta,goal_arity + 1
+ else
+ (** NORMALIZE RATIONALE
+ * we normalize the target only NOW since we may be in this case:
+ * A1 -> A2 -> T where T = (\lambda x.A3 -> P) k
+ * and we want a mesasenv with ?1:A1 and ?2:A2 and not
+ * ?1, ?2, ?3 (that is the one we whould get if we start from the
+ * beta-normalized A1 -> A2 -> A3 -> P **)
+ let s' = CicReduction.normalize ~delta:false context s in
+ res,(newmeta,context,s')::newmetasenv,newargument::arguments,
+ lastmeta,prod_no + 1
+ | t ->
+ let head = CicReduction.normalize ~delta:false context t in
+ match CicReduction.whd context head with
+ C.Prod _ as head' -> aux newmeta head'
+ | _ -> head,[],[],newmeta,0
+ in
+ (* WARNING: here we are using the invariant that above the most *)
+ (* recente new_meta() there are no used metas. *)
+ let res,newmetasenv,arguments,lastmeta,_ = aux newmeta ty in
+ res,metasenv @ newmetasenv,arguments,lastmeta
+
+let lookup_type metasenv context hyp =
+ let rec aux p = function
+ | Some (Cic.Name name, Cic.Decl t) :: _ when name = hyp -> p, t
+ | Some (Cic.Name name, Cic.Def (_, Some t)) :: _ when name = hyp -> p, t
+ | Some (Cic.Name name, Cic.Def (u, _)) :: tail when name = hyp ->
+ p, fst (CicTypeChecker.type_of_aux' metasenv tail u CicUniv.empty_ugraph)
+ | _ :: tail -> aux (succ p) tail
+ | [] -> raise (ProofEngineTypes.Fail (lazy "lookup_type: not premise in the current goal"))
+ in
+ aux 1 context
diff --git a/helm/ocaml/tactics/proofEngineHelpers.mli b/helm/ocaml/tactics/proofEngineHelpers.mli
new file mode 100644
index 000000000..a7c0e5b54
--- /dev/null
+++ b/helm/ocaml/tactics/proofEngineHelpers.mli
@@ -0,0 +1,118 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+exception Bad_pattern of string Lazy.t
+
+(* Returns the first meta whose number is above the *)
+(* number of the higher meta. *)
+val new_meta_of_proof : proof:ProofEngineTypes.proof -> int
+
+val subst_meta_in_proof :
+ ProofEngineTypes.proof ->
+ int -> Cic.term -> Cic.metasenv ->
+ ProofEngineTypes.proof * Cic.metasenv
+val subst_meta_and_metasenv_in_proof :
+ ProofEngineTypes.proof ->
+ int -> (Cic.term -> Cic.term) -> Cic.metasenv ->
+ ProofEngineTypes.proof * Cic.metasenv
+
+(* returns the list of goals that are in newmetasenv and were not in
+ oldmetasenv *)
+val compare_metasenvs :
+ oldmetasenv:Cic.metasenv -> newmetasenv:Cic.metasenv -> int list
+
+
+(** { Patterns }
+ * A pattern is a Cic term in which Cic.Implicit terms annotated with `Hole
+ * appears *)
+
+(** create a pattern from a term and a list of subterms.
+* the pattern is granted to have a ? for every subterm that has no selected
+* subterms
+* @param equality equality function used while walking the term. Defaults to
+* physical equality (==) *)
+val pattern_of:
+ ?equality:(Cic.term -> Cic.term -> bool) -> term:Cic.term -> Cic.term list ->
+ Cic.term
+
+
+(** select metasenv conjecture pattern
+* select all subterms of [conjecture] matching [pattern].
+* It returns the set of matched terms (that can be compared using physical
+* equality to the subterms of [conjecture]) together with their contexts.
+* The representation of the set mimics the conjecture type (but for the id):
+* a list of (possibly removed) hypothesis (without their names) together with
+* the list of its matched subterms (and their contexts) + the list of matched
+* subterms of the conclusion with their context. Note: in the result the list
+* of hypotheses * has an entry for each entry in the context and in the same
+* order. Of course the list of terms (with their context) associated to one
+* hypothesis may be empty.
+*
+* @raise Bad_pattern
+* *)
+val select:
+ metasenv:Cic.metasenv ->
+ ugraph:CicUniv.universe_graph ->
+ conjecture:Cic.conjecture ->
+ pattern:ProofEngineTypes.lazy_pattern ->
+ Cic.substitution * Cic.metasenv * CicUniv.universe_graph *
+ [ `Decl of (Cic.context * Cic.term) list
+ | `Def of (Cic.context * Cic.term) list * (Cic.context * Cic.term) list option
+ ] option list *
+ (Cic.context * Cic.term) list
+
+(** locate_in_term equality what where context
+* [what] must match a subterm of [where] according to [equality]
+* It returns the matched terms together with their contexts in [where]
+* [equality] defaults to physical equality
+* [context] must be the context of [where]
+*)
+val locate_in_term:
+ ?equality:(Cic.context -> Cic.term -> Cic.term -> bool) ->
+ Cic.term -> where:Cic.term -> Cic.context -> (Cic.context * Cic.term) list
+
+(** locate_in_conjecture equality what where context
+* [what] must match a subterm of [where] according to [equality]
+* It returns the matched terms together with their contexts in [where]
+* [equality] defaults to physical equality
+* [context] must be the context of [where]
+*)
+val locate_in_conjecture:
+ ?equality:(Cic.context -> Cic.term -> Cic.term -> bool) ->
+ Cic.term -> Cic.conjecture -> (Cic.context * Cic.term) list
+
+(* saturate_term newmeta metasenv context ty goal_arity *)
+(* Given a type [ty] (a backbone), it returns its suffix of length *)
+(* [goal_arity] head and a new metasenv in which there is new a META for each *)
+(* hypothesis, a list of arguments for the new applications and the index of *)
+(* the last new META introduced. The nth argument in the list of arguments is *)
+(* just the nth new META. *)
+val saturate_term:
+ int -> Cic.metasenv -> Cic.context -> Cic.term -> int ->
+ Cic.term * Cic.metasenv * Cic.term list * int
+
+(* returns the index and the type of a premise in a context *)
+val lookup_type: Cic.metasenv -> Cic.context -> string -> int * Cic.term
+
diff --git a/helm/ocaml/tactics/proofEngineReduction.ml b/helm/ocaml/tactics/proofEngineReduction.ml
new file mode 100644
index 000000000..755a09854
--- /dev/null
+++ b/helm/ocaml/tactics/proofEngineReduction.ml
@@ -0,0 +1,973 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(******************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Claudio Sacerdoti Coen <sacerdot@cs.unibo.it> *)
+(* 12/04/2002 *)
+(* *)
+(* *)
+(******************************************************************************)
+
+(* $Id$ *)
+
+(* The code of this module is derived from the code of CicReduction *)
+
+exception Impossible of int;;
+exception ReferenceToConstant;;
+exception ReferenceToVariable;;
+exception ReferenceToCurrentProof;;
+exception ReferenceToInductiveDefinition;;
+exception WrongUriToInductiveDefinition;;
+exception WrongUriToConstant;;
+exception RelToHiddenHypothesis;;
+
+let alpha_equivalence =
+ let module C = Cic in
+ let rec aux t t' =
+ if t = t' then true
+ else
+ match t,t' with
+ C.Var (uri1,exp_named_subst1), C.Var (uri2,exp_named_subst2) ->
+ UriManager.eq uri1 uri2 &&
+ aux_exp_named_subst exp_named_subst1 exp_named_subst2
+ | C.Cast (te,ty), C.Cast (te',ty') ->
+ aux te te' && aux ty ty'
+ | C.Prod (_,s,t), C.Prod (_,s',t') ->
+ aux s s' && aux t t'
+ | C.Lambda (_,s,t), C.Lambda (_,s',t') ->
+ aux s s' && aux t t'
+ | C.LetIn (_,s,t), C.LetIn(_,s',t') ->
+ aux s s' && aux t t'
+ | C.Appl l, C.Appl l' ->
+ (try
+ List.fold_left2
+ (fun b t1 t2 -> b && aux t1 t2) true l l'
+ with
+ Invalid_argument _ -> false)
+ | C.Const (uri,exp_named_subst1), C.Const (uri',exp_named_subst2) ->
+ UriManager.eq uri uri' &&
+ aux_exp_named_subst exp_named_subst1 exp_named_subst2
+ | C.MutInd (uri,i,exp_named_subst1), C.MutInd (uri',i',exp_named_subst2) ->
+ UriManager.eq uri uri' && i = i' &&
+ aux_exp_named_subst exp_named_subst1 exp_named_subst2
+ | C.MutConstruct (uri,i,j,exp_named_subst1),
+ C.MutConstruct (uri',i',j',exp_named_subst2) ->
+ UriManager.eq uri uri' && i = i' && j = j' &&
+ aux_exp_named_subst exp_named_subst1 exp_named_subst2
+ | C.MutCase (sp,i,outt,t,pl), C.MutCase (sp',i',outt',t',pl') ->
+ UriManager.eq sp sp' && i = i' &&
+ aux outt outt' && aux t t' &&
+ (try
+ List.fold_left2
+ (fun b t1 t2 -> b && aux t1 t2) true pl pl'
+ with
+ Invalid_argument _ -> false)
+ | C.Fix (i,fl), C.Fix (i',fl') ->
+ i = i' &&
+ (try
+ List.fold_left2
+ (fun b (_,i,ty,bo) (_,i',ty',bo') ->
+ b && i = i' && aux ty ty' && aux bo bo'
+ ) true fl fl'
+ with
+ Invalid_argument _ -> false)
+ | C.CoFix (i,fl), C.CoFix (i',fl') ->
+ i = i' &&
+ (try
+ List.fold_left2
+ (fun b (_,ty,bo) (_,ty',bo') ->
+ b && aux ty ty' && aux bo bo'
+ ) true fl fl'
+ with
+ Invalid_argument _ -> false)
+ | _,_ -> false (* we already know that t != t' *)
+ and aux_exp_named_subst exp_named_subst1 exp_named_subst2 =
+ try
+ List.fold_left2
+ (fun b (uri1,t1) (uri2,t2) ->
+ b && UriManager.eq uri1 uri2 && aux t1 t2
+ ) true exp_named_subst1 exp_named_subst2
+ with
+ Invalid_argument _ -> false
+ in
+ aux
+;;
+
+exception WhatAndWithWhatDoNotHaveTheSameLength;;
+
+(* "textual" replacement of several subterms with other ones *)
+let replace ~equality ~what ~with_what ~where =
+ let module C = Cic in
+ let find_image t =
+ let rec find_image_aux =
+ function
+ [],[] -> raise Not_found
+ | what::tl1,with_what::tl2 ->
+ if equality what t then with_what else find_image_aux (tl1,tl2)
+ | _,_ -> raise WhatAndWithWhatDoNotHaveTheSameLength
+ in
+ find_image_aux (what,with_what)
+ in
+ let rec aux t =
+ try
+ find_image t
+ with Not_found ->
+ match t with
+ C.Rel _ -> t
+ | C.Var (uri,exp_named_subst) ->
+ C.Var (uri,List.map (function (uri,t) -> uri, aux t) exp_named_subst)
+ | C.Meta _ -> t
+ | C.Sort _ -> t
+ | C.Implicit _ as t -> t
+ | C.Cast (te,ty) -> C.Cast (aux te, aux ty)
+ | C.Prod (n,s,t) -> C.Prod (n, aux s, aux t)
+ | C.Lambda (n,s,t) -> C.Lambda (n, aux s, aux t)
+ | C.LetIn (n,s,t) -> C.LetIn (n, aux s, aux t)
+ | C.Appl l ->
+ (* Invariant enforced: no application of an application *)
+ (match List.map aux l with
+ (C.Appl l')::tl -> C.Appl (l'@tl)
+ | l' -> C.Appl l')
+ | C.Const (uri,exp_named_subst) ->
+ C.Const (uri,List.map (function (uri,t) -> uri, aux t) exp_named_subst)
+ | C.MutInd (uri,i,exp_named_subst) ->
+ C.MutInd
+ (uri,i,List.map (function (uri,t) -> uri, aux t) exp_named_subst)
+ | C.MutConstruct (uri,i,j,exp_named_subst) ->
+ C.MutConstruct
+ (uri,i,j,List.map (function (uri,t) -> uri, aux t) exp_named_subst)
+ | C.MutCase (sp,i,outt,t,pl) ->
+ C.MutCase (sp,i,aux outt, aux t,List.map aux pl)
+ | C.Fix (i,fl) ->
+ let substitutedfl =
+ List.map
+ (fun (name,i,ty,bo) -> (name, i, aux ty, aux bo))
+ fl
+ in
+ C.Fix (i, substitutedfl)
+ | C.CoFix (i,fl) ->
+ let substitutedfl =
+ List.map
+ (fun (name,ty,bo) -> (name, aux ty, aux bo))
+ fl
+ in
+ C.CoFix (i, substitutedfl)
+ in
+ aux where
+;;
+
+(* replaces in a term a term with another one. *)
+(* Lifting are performed as usual. *)
+let replace_lifting ~equality ~what ~with_what ~where =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ let find_image what t =
+ let rec find_image_aux =
+ function
+ [],[] -> raise Not_found
+ | what::tl1,with_what::tl2 ->
+ if equality what t then with_what else find_image_aux (tl1,tl2)
+ | _,_ -> raise WhatAndWithWhatDoNotHaveTheSameLength
+ in
+ find_image_aux (what,with_what)
+ in
+ let rec substaux k what t =
+ try
+ S.lift (k-1) (find_image what t)
+ with Not_found ->
+ match t with
+ C.Rel n as t -> t
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> uri,substaux k what t) exp_named_subst
+ in
+ C.Var (uri,exp_named_subst')
+ | C.Meta (i, l) ->
+ let l' =
+ List.map
+ (function
+ None -> None
+ | Some t -> Some (substaux k what t)
+ ) l
+ in
+ C.Meta(i,l')
+ | C.Sort _ as t -> t
+ | C.Implicit _ as t -> t
+ | C.Cast (te,ty) -> C.Cast (substaux k what te, substaux k what ty)
+ | C.Prod (n,s,t) ->
+ C.Prod
+ (n, substaux k what s, substaux (k + 1) (List.map (S.lift 1) what) t)
+ | C.Lambda (n,s,t) ->
+ C.Lambda
+ (n, substaux k what s, substaux (k + 1) (List.map (S.lift 1) what) t)
+ | C.LetIn (n,s,t) ->
+ C.LetIn
+ (n, substaux k what s, substaux (k + 1) (List.map (S.lift 1) what) t)
+ | C.Appl (he::tl) ->
+ (* Invariant: no Appl applied to another Appl *)
+ let tl' = List.map (substaux k what) tl in
+ begin
+ match substaux k what he with
+ C.Appl l -> C.Appl (l@tl')
+ | _ as he' -> C.Appl (he'::tl')
+ end
+ | C.Appl _ -> assert false
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> uri,substaux k what t) exp_named_subst
+ in
+ C.Const (uri,exp_named_subst')
+ | C.MutInd (uri,i,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> uri,substaux k what t) exp_named_subst
+ in
+ C.MutInd (uri,i,exp_named_subst')
+ | C.MutConstruct (uri,i,j,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> uri,substaux k what t) exp_named_subst
+ in
+ C.MutConstruct (uri,i,j,exp_named_subst')
+ | C.MutCase (sp,i,outt,t,pl) ->
+ C.MutCase (sp,i,substaux k what outt, substaux k what t,
+ List.map (substaux k what) pl)
+ | C.Fix (i,fl) ->
+ let len = List.length fl in
+ let substitutedfl =
+ List.map
+ (fun (name,i,ty,bo) ->
+ (name, i, substaux k what ty,
+ substaux (k+len) (List.map (S.lift len) what) bo)
+ ) fl
+ in
+ C.Fix (i, substitutedfl)
+ | C.CoFix (i,fl) ->
+ let len = List.length fl in
+ let substitutedfl =
+ List.map
+ (fun (name,ty,bo) ->
+ (name, substaux k what ty,
+ substaux (k+len) (List.map (S.lift len) what) bo)
+ ) fl
+ in
+ C.CoFix (i, substitutedfl)
+ in
+ substaux 1 what where
+;;
+
+(* replaces in a term a list of terms with other ones. *)
+(* Lifting are performed as usual. *)
+let replace_lifting_csc nnn ~equality ~what ~with_what ~where =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ let find_image t =
+ let rec find_image_aux =
+ function
+ [],[] -> raise Not_found
+ | what::tl1,with_what::tl2 ->
+ if equality what t then with_what else find_image_aux (tl1,tl2)
+ | _,_ -> raise WhatAndWithWhatDoNotHaveTheSameLength
+ in
+ find_image_aux (what,with_what)
+ in
+ let rec substaux k t =
+ try
+ S.lift (k-1) (find_image t)
+ with Not_found ->
+ match t with
+ C.Rel n ->
+ if n < k then C.Rel n else C.Rel (n + nnn)
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> uri,substaux k t) exp_named_subst
+ in
+ C.Var (uri,exp_named_subst')
+ | C.Meta (i, l) ->
+ let l' =
+ List.map
+ (function
+ None -> None
+ | Some t -> Some (substaux k t)
+ ) l
+ in
+ C.Meta(i,l')
+ | C.Sort _ as t -> t
+ | C.Implicit _ as t -> t
+ | C.Cast (te,ty) -> C.Cast (substaux k te, substaux k ty)
+ | C.Prod (n,s,t) ->
+ C.Prod (n, substaux k s, substaux (k + 1) t)
+ | C.Lambda (n,s,t) ->
+ C.Lambda (n, substaux k s, substaux (k + 1) t)
+ | C.LetIn (n,s,t) ->
+ C.LetIn (n, substaux k s, substaux (k + 1) t)
+ | C.Appl (he::tl) ->
+ (* Invariant: no Appl applied to another Appl *)
+ let tl' = List.map (substaux k) tl in
+ begin
+ match substaux k he with
+ C.Appl l -> C.Appl (l@tl')
+ | _ as he' -> C.Appl (he'::tl')
+ end
+ | C.Appl _ -> assert false
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> uri,substaux k t) exp_named_subst
+ in
+ C.Const (uri,exp_named_subst')
+ | C.MutInd (uri,i,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> uri,substaux k t) exp_named_subst
+ in
+ C.MutInd (uri,i,exp_named_subst')
+ | C.MutConstruct (uri,i,j,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (function (uri,t) -> uri,substaux k t) exp_named_subst
+ in
+ C.MutConstruct (uri,i,j,exp_named_subst')
+ | C.MutCase (sp,i,outt,t,pl) ->
+ C.MutCase (sp,i,substaux k outt, substaux k t,
+ List.map (substaux k) pl)
+ | C.Fix (i,fl) ->
+ let len = List.length fl in
+ let substitutedfl =
+ List.map
+ (fun (name,i,ty,bo) ->
+ (name, i, substaux k ty, substaux (k+len) bo))
+ fl
+ in
+ C.Fix (i, substitutedfl)
+ | C.CoFix (i,fl) ->
+ let len = List.length fl in
+ let substitutedfl =
+ List.map
+ (fun (name,ty,bo) ->
+ (name, substaux k ty, substaux (k+len) bo))
+ fl
+ in
+ C.CoFix (i, substitutedfl)
+ in
+ substaux 1 where
+;;
+
+(* Takes a well-typed term and fully reduces it. *)
+(*CSC: It does not perform reduction in a Case *)
+let reduce context =
+ let rec reduceaux context l =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ function
+ C.Rel n as t ->
+ (match List.nth context (n-1) with
+ Some (_,C.Decl _) -> if l = [] then t else C.Appl (t::l)
+ | Some (_,C.Def (bo,_)) -> reduceaux context l (S.lift n bo)
+ | None -> raise RelToHiddenHypothesis
+ )
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ reduceaux_exp_named_subst context l exp_named_subst
+ in
+ (let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ C.Constant _ -> raise ReferenceToConstant
+ | C.CurrentProof _ -> raise ReferenceToCurrentProof
+ | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+ | C.Variable (_,None,_,_,_) ->
+ let t' = C.Var (uri,exp_named_subst') in
+ if l = [] then t' else C.Appl (t'::l)
+ | C.Variable (_,Some body,_,_,_) ->
+ (reduceaux context l
+ (CicSubstitution.subst_vars exp_named_subst' body))
+ )
+ | C.Meta _ as t -> if l = [] then t else C.Appl (t::l)
+ | C.Sort _ as t -> t (* l should be empty *)
+ | C.Implicit _ as t -> t
+ | C.Cast (te,ty) ->
+ C.Cast (reduceaux context l te, reduceaux context l ty)
+ | C.Prod (name,s,t) ->
+ assert (l = []) ;
+ C.Prod (name,
+ reduceaux context [] s,
+ reduceaux ((Some (name,C.Decl s))::context) [] t)
+ | C.Lambda (name,s,t) ->
+ (match l with
+ [] ->
+ C.Lambda (name,
+ reduceaux context [] s,
+ reduceaux ((Some (name,C.Decl s))::context) [] t)
+ | he::tl -> reduceaux context tl (S.subst he t)
+ (* when name is Anonimous the substitution should be superfluous *)
+ )
+ | C.LetIn (n,s,t) ->
+ reduceaux context l (S.subst (reduceaux context [] s) t)
+ | C.Appl (he::tl) ->
+ let tl' = List.map (reduceaux context []) tl in
+ reduceaux context (tl'@l) he
+ | C.Appl [] -> raise (Impossible 1)
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ reduceaux_exp_named_subst context l exp_named_subst
+ in
+ (let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ C.Constant (_,Some body,_,_,_) ->
+ (reduceaux context l
+ (CicSubstitution.subst_vars exp_named_subst' body))
+ | C.Constant (_,None,_,_,_) ->
+ let t' = C.Const (uri,exp_named_subst') in
+ if l = [] then t' else C.Appl (t'::l)
+ | C.Variable _ -> raise ReferenceToVariable
+ | C.CurrentProof (_,_,body,_,_,_) ->
+ (reduceaux context l
+ (CicSubstitution.subst_vars exp_named_subst' body))
+ | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+ )
+ | C.MutInd (uri,i,exp_named_subst) ->
+ let exp_named_subst' =
+ reduceaux_exp_named_subst context l exp_named_subst
+ in
+ let t' = C.MutInd (uri,i,exp_named_subst') in
+ if l = [] then t' else C.Appl (t'::l)
+ | C.MutConstruct (uri,i,j,exp_named_subst) ->
+ let exp_named_subst' =
+ reduceaux_exp_named_subst context l exp_named_subst
+ in
+ let t' = C.MutConstruct (uri,i,j,exp_named_subst') in
+ if l = [] then t' else C.Appl (t'::l)
+ | C.MutCase (mutind,i,outtype,term,pl) ->
+ let decofix =
+ function
+ C.CoFix (i,fl) ->
+ let (_,_,body) = List.nth fl i in
+ let body' =
+ let counter = ref (List.length fl) in
+ List.fold_right
+ (fun _ -> decr counter ; S.subst (C.CoFix (!counter,fl)))
+ fl
+ body
+ in
+ reduceaux context [] body'
+ | C.Appl (C.CoFix (i,fl) :: tl) ->
+ let (_,_,body) = List.nth fl i in
+ let body' =
+ let counter = ref (List.length fl) in
+ List.fold_right
+ (fun _ -> decr counter ; S.subst (C.CoFix (!counter,fl)))
+ fl
+ body
+ in
+ let tl' = List.map (reduceaux context []) tl in
+ reduceaux context tl' body'
+ | t -> t
+ in
+ (match decofix (reduceaux context [] term) with
+ C.MutConstruct (_,_,j,_) -> reduceaux context l (List.nth pl (j-1))
+ | C.Appl (C.MutConstruct (_,_,j,_) :: tl) ->
+ let (arity, r) =
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph mutind in
+ match o with
+ C.InductiveDefinition (tl,_,r,_) ->
+ let (_,_,arity,_) = List.nth tl i in
+ (arity,r)
+ | _ -> raise WrongUriToInductiveDefinition
+ in
+ let ts =
+ let rec eat_first =
+ function
+ (0,l) -> l
+ | (n,he::tl) when n > 0 -> eat_first (n - 1, tl)
+ | _ -> raise (Impossible 5)
+ in
+ eat_first (r,tl)
+ in
+ reduceaux context (ts@l) (List.nth pl (j-1))
+ | C.Cast _ | C.Implicit _ ->
+ raise (Impossible 2) (* we don't trust our whd ;-) *)
+ | _ ->
+ let outtype' = reduceaux context [] outtype in
+ let term' = reduceaux context [] term in
+ let pl' = List.map (reduceaux context []) pl in
+ let res =
+ C.MutCase (mutind,i,outtype',term',pl')
+ in
+ if l = [] then res else C.Appl (res::l)
+ )
+ | C.Fix (i,fl) ->
+ let tys =
+ List.map (function (name,_,ty,_) -> Some (C.Name name, C.Decl ty)) fl
+ in
+ let t' () =
+ let fl' =
+ List.map
+ (function (n,recindex,ty,bo) ->
+ (n,recindex,reduceaux context [] ty, reduceaux (tys@context) [] bo)
+ ) fl
+ in
+ C.Fix (i, fl')
+ in
+ let (_,recindex,_,body) = List.nth fl i in
+ let recparam =
+ try
+ Some (List.nth l recindex)
+ with
+ _ -> None
+ in
+ (match recparam with
+ Some recparam ->
+ (match reduceaux context [] recparam with
+ C.MutConstruct _
+ | C.Appl ((C.MutConstruct _)::_) ->
+ let body' =
+ let counter = ref (List.length fl) in
+ List.fold_right
+ (fun _ -> decr counter ; S.subst (C.Fix (!counter,fl)))
+ fl
+ body
+ in
+ (* Possible optimization: substituting whd recparam in l*)
+ reduceaux context l body'
+ | _ -> if l = [] then t' () else C.Appl ((t' ())::l)
+ )
+ | None -> if l = [] then t' () else C.Appl ((t' ())::l)
+ )
+ | C.CoFix (i,fl) ->
+ let tys =
+ List.map (function (name,ty,_) -> Some (C.Name name, C.Decl ty)) fl
+ in
+ let t' =
+ let fl' =
+ List.map
+ (function (n,ty,bo) ->
+ (n,reduceaux context [] ty, reduceaux (tys@context) [] bo)
+ ) fl
+ in
+ C.CoFix (i, fl')
+ in
+ if l = [] then t' else C.Appl (t'::l)
+ and reduceaux_exp_named_subst context l =
+ List.map (function uri,t -> uri,reduceaux context [] t)
+ in
+ reduceaux context []
+;;
+
+exception WrongShape;;
+exception AlreadySimplified;;
+
+(* Takes a well-typed term and *)
+(* 1) Performs beta-iota-zeta reduction until delta reduction is needed *)
+(* 2) Attempts delta-reduction. If the residual is a Fix lambda-abstracted *)
+(* w.r.t. zero or more variables and if the Fix can be reductaed, than it*)
+(* is reduced, the delta-reduction is succesfull and the whole algorithm *)
+(* is applied again to the new redex; Step 3.1) is applied to the result *)
+(* of the recursive simplification. Otherwise, if the Fix can not be *)
+(* reduced, than the delta-reductions fails and the delta-redex is *)
+(* not reduced. Otherwise, if the delta-residual is not the *)
+(* lambda-abstraction of a Fix, then it performs step 3.2). *)
+(* 3.1) Folds the application of the constant to the arguments that did not *)
+(* change in every iteration, i.e. to the actual arguments for the *)
+(* lambda-abstractions that precede the Fix. *)
+(* 3.2) Computes the head beta-zeta normal form of the term. Then it tries *)
+(* reductions. If the reduction cannot be performed, it returns the *)
+(* original term (not the head beta-zeta normal form of the definiendum) *)
+(*CSC: It does not perform simplification in a Case *)
+
+let simpl context =
+ (* reduceaux is equal to the reduceaux locally defined inside *)
+ (* reduce, but for the const case. *)
+ (**** Step 1 ****)
+ let rec reduceaux context l =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ function
+ C.Rel n as t ->
+ (try
+ match List.nth context (n-1) with
+ Some (_,C.Decl _) -> if l = [] then t else C.Appl (t::l)
+ | Some (_,C.Def (bo,_)) ->
+ try_delta_expansion context l t (S.lift n bo)
+ | None -> raise RelToHiddenHypothesis
+ with
+ Failure _ -> assert false)
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ reduceaux_exp_named_subst context l exp_named_subst
+ in
+ (let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ C.Constant _ -> raise ReferenceToConstant
+ | C.CurrentProof _ -> raise ReferenceToCurrentProof
+ | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+ | C.Variable (_,None,_,_,_) ->
+ let t' = C.Var (uri,exp_named_subst') in
+ if l = [] then t' else C.Appl (t'::l)
+ | C.Variable (_,Some body,_,_,_) ->
+ reduceaux context l
+ (CicSubstitution.subst_vars exp_named_subst' body)
+ )
+ | C.Meta _ as t -> if l = [] then t else C.Appl (t::l)
+ | C.Sort _ as t -> t (* l should be empty *)
+ | C.Implicit _ as t -> t
+ | C.Cast (te,ty) ->
+ C.Cast (reduceaux context l te, reduceaux context l ty)
+ | C.Prod (name,s,t) ->
+ assert (l = []) ;
+ C.Prod (name,
+ reduceaux context [] s,
+ reduceaux ((Some (name,C.Decl s))::context) [] t)
+ | C.Lambda (name,s,t) ->
+ (match l with
+ [] ->
+ C.Lambda (name,
+ reduceaux context [] s,
+ reduceaux ((Some (name,C.Decl s))::context) [] t)
+ | he::tl -> reduceaux context tl (S.subst he t)
+ (* when name is Anonimous the substitution should be superfluous *)
+ )
+ | C.LetIn (n,s,t) ->
+ reduceaux context l (S.subst (reduceaux context [] s) t)
+ | C.Appl (he::tl) ->
+ let tl' = List.map (reduceaux context []) tl in
+ reduceaux context (tl'@l) he
+ | C.Appl [] -> raise (Impossible 1)
+ | C.Const (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ reduceaux_exp_named_subst context l exp_named_subst
+ in
+ (let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ match o with
+ C.Constant (_,Some body,_,_,_) ->
+ try_delta_expansion context l
+ (C.Const (uri,exp_named_subst'))
+ (CicSubstitution.subst_vars exp_named_subst' body)
+ | C.Constant (_,None,_,_,_) ->
+ let t' = C.Const (uri,exp_named_subst') in
+ if l = [] then t' else C.Appl (t'::l)
+ | C.Variable _ -> raise ReferenceToVariable
+ | C.CurrentProof (_,_,body,_,_,_) -> reduceaux context l body
+ | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+ )
+ | C.MutInd (uri,i,exp_named_subst) ->
+ let exp_named_subst' =
+ reduceaux_exp_named_subst context l exp_named_subst
+ in
+ let t' = C.MutInd (uri,i,exp_named_subst') in
+ if l = [] then t' else C.Appl (t'::l)
+ | C.MutConstruct (uri,i,j,exp_named_subst) ->
+ let exp_named_subst' =
+ reduceaux_exp_named_subst context l exp_named_subst
+ in
+ let t' = C.MutConstruct(uri,i,j,exp_named_subst') in
+ if l = [] then t' else C.Appl (t'::l)
+ | C.MutCase (mutind,i,outtype,term,pl) ->
+ let decofix =
+ function
+ C.CoFix (i,fl) ->
+ let (_,_,body) = List.nth fl i in
+ let body' =
+ let counter = ref (List.length fl) in
+ List.fold_right
+ (fun _ -> decr counter ; S.subst (C.CoFix (!counter,fl)))
+ fl
+ body
+ in
+ reduceaux context [] body'
+ | C.Appl (C.CoFix (i,fl) :: tl) ->
+ let tys =
+ List.map (function (name,ty,_) -> Some (C.Name name, C.Decl ty)) fl in
+ let (_,_,body) = List.nth fl i in
+ let body' =
+ let counter = ref (List.length fl) in
+ List.fold_right
+ (fun _ -> decr counter ; S.subst (C.CoFix (!counter,fl)))
+ fl
+ body
+ in
+ let tl' = List.map (reduceaux context []) tl in
+ reduceaux context tl' body'
+ | t -> t
+ in
+ (match decofix (CicReduction.whd context term) with
+ C.MutConstruct (_,_,j,_) -> reduceaux context l (List.nth pl (j-1))
+ | C.Appl (C.MutConstruct (_,_,j,_) :: tl) ->
+ let (arity, r) =
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph mutind in
+ match o with
+ C.InductiveDefinition (tl,ingredients,r,_) ->
+ let (_,_,arity,_) = List.nth tl i in
+ (arity,r)
+ | _ -> raise WrongUriToInductiveDefinition
+ in
+ let ts =
+ let rec eat_first =
+ function
+ (0,l) -> l
+ | (n,he::tl) when n > 0 -> eat_first (n - 1, tl)
+ | _ -> raise (Impossible 5)
+ in
+ eat_first (r,tl)
+ in
+ reduceaux context (ts@l) (List.nth pl (j-1))
+ | C.Cast _ | C.Implicit _ ->
+ raise (Impossible 2) (* we don't trust our whd ;-) *)
+ | _ ->
+ let outtype' = reduceaux context [] outtype in
+ let term' = reduceaux context [] term in
+ let pl' = List.map (reduceaux context []) pl in
+ let res =
+ C.MutCase (mutind,i,outtype',term',pl')
+ in
+ if l = [] then res else C.Appl (res::l)
+ )
+ | C.Fix (i,fl) ->
+ let tys =
+ List.map (function (name,_,ty,_) -> Some (C.Name name, C.Decl ty)) fl
+ in
+ let t' () =
+ let fl' =
+ List.map
+ (function (n,recindex,ty,bo) ->
+ (n,recindex,reduceaux context [] ty, reduceaux (tys@context) [] bo)
+ ) fl
+ in
+ C.Fix (i, fl')
+ in
+ let (_,recindex,_,body) = List.nth fl i in
+ let recparam =
+ try
+ Some (List.nth l recindex)
+ with
+ _ -> None
+ in
+ (match recparam with
+ Some recparam ->
+ (match reduceaux context [] recparam with
+ C.MutConstruct _
+ | C.Appl ((C.MutConstruct _)::_) ->
+ let body' =
+ let counter = ref (List.length fl) in
+ List.fold_right
+ (fun _ -> decr counter ; S.subst (C.Fix (!counter,fl)))
+ fl
+ body
+ in
+ (* Possible optimization: substituting whd recparam in l*)
+ reduceaux context l body'
+ | _ -> if l = [] then t' () else C.Appl ((t' ())::l)
+ )
+ | None -> if l = [] then t' () else C.Appl ((t' ())::l)
+ )
+ | C.CoFix (i,fl) ->
+ let tys =
+ List.map (function (name,ty,_) -> Some (C.Name name, C.Decl ty)) fl
+ in
+ let t' =
+ let fl' =
+ List.map
+ (function (n,ty,bo) ->
+ (n,reduceaux context [] ty, reduceaux (tys@context) [] bo)
+ ) fl
+ in
+ C.CoFix (i, fl')
+ in
+ if l = [] then t' else C.Appl (t'::l)
+ and reduceaux_exp_named_subst context l =
+ List.map (function uri,t -> uri,reduceaux context [] t)
+ (**** Step 2 ****)
+ and try_delta_expansion context l term body =
+ let module C = Cic in
+ let module S = CicSubstitution in
+ try
+ let res,constant_args =
+ let rec aux rev_constant_args l =
+ function
+ C.Lambda (name,s,t) ->
+ begin
+ match l with
+ [] -> raise WrongShape
+ | he::tl ->
+ (* when name is Anonimous the substitution should *)
+ (* be superfluous *)
+ aux (he::rev_constant_args) tl (S.subst he t)
+ end
+ | C.LetIn (_,s,t) ->
+ aux rev_constant_args l (S.subst s t)
+ | C.Fix (i,fl) ->
+ let (_,recindex,_,body) = List.nth fl i in
+ let recparam =
+ try
+ List.nth l recindex
+ with
+ _ -> raise AlreadySimplified
+ in
+ (match CicReduction.whd context recparam with
+ C.MutConstruct _
+ | C.Appl ((C.MutConstruct _)::_) ->
+ let body' =
+ let counter = ref (List.length fl) in
+ List.fold_right
+ (function _ ->
+ decr counter ; S.subst (C.Fix (!counter,fl))
+ ) fl body
+ in
+ (* Possible optimization: substituting whd *)
+ (* recparam in l *)
+ reduceaux context l body',
+ List.rev rev_constant_args
+ | _ -> raise AlreadySimplified
+ )
+ | _ -> raise WrongShape
+ in
+ aux [] l body
+ in
+ (**** Step 3.1 ****)
+ let term_to_fold, delta_expanded_term_to_fold =
+ match constant_args with
+ [] -> term,body
+ | _ -> C.Appl (term::constant_args), C.Appl (body::constant_args)
+ in
+ let simplified_term_to_fold =
+ reduceaux context [] delta_expanded_term_to_fold
+ in
+ replace (=) [simplified_term_to_fold] [term_to_fold] res
+ with
+ WrongShape ->
+ (**** Step 3.2 ****)
+ let rec aux l =
+ function
+ C.Lambda (name,s,t) ->
+ (match l with
+ [] -> raise AlreadySimplified
+ | he::tl ->
+ (* when name is Anonimous the substitution should *)
+ (* be superfluous *)
+ aux tl (S.subst he t))
+ | C.LetIn (_,s,t) -> aux l (S.subst s t)
+ | t ->
+ let simplified = reduceaux context l t in
+ if t = simplified then
+ raise AlreadySimplified
+ else
+ simplified
+ in
+ (try aux l body
+ with
+ AlreadySimplified ->
+ if l = [] then term else C.Appl (term::l))
+ | AlreadySimplified ->
+ (* If we performed delta-reduction, we would find a Fix *)
+ (* not applied to a constructor. So, we refuse to perform *)
+ (* delta-reduction. *)
+ if l = [] then term else C.Appl (term::l)
+ in
+ reduceaux context []
+;;
+
+let unfold ?what context where =
+ let contextlen = List.length context in
+ let first_is_the_expandable_head_of_second context' t1 t2 =
+ match t1,t2 with
+ Cic.Const (uri,_), Cic.Const (uri',_)
+ | Cic.Var (uri,_), Cic.Var (uri',_)
+ | Cic.Const (uri,_), Cic.Appl (Cic.Const (uri',_)::_)
+ | Cic.Var (uri,_), Cic.Appl (Cic.Var (uri',_)::_) -> UriManager.eq uri uri'
+ | Cic.Const _, _
+ | Cic.Var _, _ -> false
+ | Cic.Rel n, Cic.Rel m
+ | Cic.Rel n, Cic.Appl (Cic.Rel m::_) ->
+ n + (List.length context' - contextlen) = m
+ | Cic.Rel _, _ -> false
+ | _,_ ->
+ raise
+ (ProofEngineTypes.Fail
+ (lazy "The term to unfold is not a constant, a variable or a bound variable "))
+ in
+ let appl he tl =
+ if tl = [] then he else Cic.Appl (he::tl) in
+ let cannot_delta_expand t =
+ raise
+ (ProofEngineTypes.Fail
+ (lazy ("The term " ^ CicPp.ppterm t ^ " cannot be delta-expanded"))) in
+ let rec hd_delta_beta context tl =
+ function
+ Cic.Rel n as t ->
+ (try
+ match List.nth context (n-1) with
+ Some (_,Cic.Decl _) -> cannot_delta_expand t
+ | Some (_,Cic.Def (bo,_)) ->
+ CicReduction.head_beta_reduce
+ (appl (CicSubstitution.lift n bo) tl)
+ | None -> raise RelToHiddenHypothesis
+ with
+ Failure _ -> assert false)
+ | Cic.Const (uri,exp_named_subst) as t ->
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ (match o with
+ Cic.Constant (_,Some body,_,_,_) ->
+ CicReduction.head_beta_reduce
+ (appl (CicSubstitution.subst_vars exp_named_subst body) tl)
+ | Cic.Constant (_,None,_,_,_) -> cannot_delta_expand t
+ | Cic.Variable _ -> raise ReferenceToVariable
+ | Cic.CurrentProof _ -> raise ReferenceToCurrentProof
+ | Cic.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+ )
+ | Cic.Var (uri,exp_named_subst) as t ->
+ let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
+ (match o with
+ Cic.Constant _ -> raise ReferenceToConstant
+ | Cic.CurrentProof _ -> raise ReferenceToCurrentProof
+ | Cic.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+ | Cic.Variable (_,Some body,_,_,_) ->
+ CicReduction.head_beta_reduce
+ (appl (CicSubstitution.subst_vars exp_named_subst body) tl)
+ | Cic.Variable (_,None,_,_,_) -> cannot_delta_expand t
+ )
+ | Cic.Appl [] -> assert false
+ | Cic.Appl (he::tl) -> hd_delta_beta context tl he
+ | t -> cannot_delta_expand t
+ in
+ let context_and_matched_term_list =
+ match what with
+ None -> [context, where]
+ | Some what ->
+ let res =
+ ProofEngineHelpers.locate_in_term
+ ~equality:first_is_the_expandable_head_of_second
+ what ~where context
+ in
+ if res = [] then
+ raise
+ (ProofEngineTypes.Fail
+ (lazy ("Term "^ CicPp.ppterm what ^ " not found in " ^ CicPp.ppterm where)))
+ else
+ res
+ in
+ let reduced_terms =
+ List.map
+ (function (context,where) -> hd_delta_beta context [] where)
+ context_and_matched_term_list in
+ let whats = List.map snd context_and_matched_term_list in
+ replace ~equality:(==) ~what:whats ~with_what:reduced_terms ~where
+;;
diff --git a/helm/ocaml/tactics/proofEngineReduction.mli b/helm/ocaml/tactics/proofEngineReduction.mli
new file mode 100644
index 000000000..67247876a
--- /dev/null
+++ b/helm/ocaml/tactics/proofEngineReduction.mli
@@ -0,0 +1,49 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+exception Impossible of int
+exception ReferenceToConstant
+exception ReferenceToVariable
+exception ReferenceToCurrentProof
+exception ReferenceToInductiveDefinition
+exception WrongUriToInductiveDefinition
+exception RelToHiddenHypothesis
+exception WrongShape
+exception AlreadySimplified
+exception WhatAndWithWhatDoNotHaveTheSameLength;;
+
+val alpha_equivalence: Cic.term -> Cic.term -> bool
+val replace :
+ equality:('a -> Cic.term -> bool) ->
+ what:'a list -> with_what:Cic.term list -> where:Cic.term -> Cic.term
+val replace_lifting :
+ equality:(Cic.term -> Cic.term -> bool) ->
+ what:Cic.term list -> with_what:Cic.term list -> where:Cic.term -> Cic.term
+val replace_lifting_csc :
+ int -> equality:(Cic.term -> Cic.term -> bool) ->
+ what:Cic.term list -> with_what:Cic.term list -> where:Cic.term -> Cic.term
+val reduce : Cic.context -> Cic.term -> Cic.term
+val simpl : Cic.context -> Cic.term -> Cic.term
+val unfold : ?what:Cic.term -> Cic.context -> Cic.term -> Cic.term
diff --git a/helm/ocaml/tactics/proofEngineStructuralRules.ml b/helm/ocaml/tactics/proofEngineStructuralRules.ml
new file mode 100644
index 000000000..4677a33ac
--- /dev/null
+++ b/helm/ocaml/tactics/proofEngineStructuralRules.ml
@@ -0,0 +1,195 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+open ProofEngineTypes
+
+let clearbody ~hyp =
+ let clearbody ~hyp (proof, goal) =
+ let module C = Cic in
+ let curi,metasenv,pbo,pty = proof in
+ let metano,_,_ = CicUtil.lookup_meta goal metasenv in
+ let string_of_name =
+ function
+ C.Name n -> n
+ | C.Anonymous -> "_"
+ in
+ let metasenv' =
+ List.map
+ (function
+ (m,canonical_context,ty) when m = metano ->
+ let canonical_context' =
+ List.fold_right
+ (fun entry context ->
+ match entry with
+ Some (C.Name hyp',C.Def (term,ty)) when hyp = hyp' ->
+ let cleared_entry =
+ let ty =
+ match ty with
+ Some ty -> ty
+ | None ->
+ fst
+ (CicTypeChecker.type_of_aux' metasenv context term
+ CicUniv.empty_ugraph) (* TASSI: FIXME *)
+ in
+ Some (C.Name hyp, Cic.Decl ty)
+ in
+ cleared_entry::context
+ | None -> None::context
+ | Some (n,C.Decl t)
+ | Some (n,C.Def (t,None)) ->
+ let _,_ =
+ try
+ CicTypeChecker.type_of_aux' metasenv context t
+ CicUniv.empty_ugraph (* TASSI: FIXME *)
+ with
+ _ ->
+ raise
+ (Fail
+ (lazy ("The correctness of hypothesis " ^
+ string_of_name n ^
+ " relies on the body of " ^ hyp)
+ ))
+ in
+ entry::context
+ | Some (_,Cic.Def (_,Some _)) -> assert false
+ ) canonical_context []
+ in
+ let _,_ =
+ try
+ CicTypeChecker.type_of_aux' metasenv canonical_context' ty
+ CicUniv.empty_ugraph (* TASSI: FIXME *)
+ with
+ _ ->
+ raise
+ (Fail
+ (lazy ("The correctness of the goal relies on the body of " ^
+ hyp)))
+ in
+ m,canonical_context',ty
+ | t -> t
+ ) metasenv
+ in
+ (curi,metasenv',pbo,pty), [goal]
+ in
+ mk_tactic (clearbody ~hyp)
+
+let clear ~hyp =
+ let clear ~hyp (proof, goal) =
+ let module C = Cic in
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty =
+ CicUtil.lookup_meta goal metasenv
+ in
+ let string_of_name =
+ function
+ C.Name n -> n
+ | C.Anonymous -> "_"
+ in
+ let metasenv' =
+ List.map
+ (function
+ (m,canonical_context,ty) when m = metano ->
+ let context_changed, canonical_context' =
+ List.fold_right
+ (fun entry (b, context) ->
+ match entry with
+ Some (Cic.Name hyp',_) when hyp' = hyp ->
+ (true, None::context)
+ | None -> (b, None::context)
+ | Some (n,C.Decl t)
+ | Some (n,Cic.Def (t,Some _))
+ | Some (n,C.Def (t,None)) ->
+ if b then
+ let _,_ =
+ try
+ CicTypeChecker.type_of_aux' metasenv context t
+ CicUniv.empty_ugraph
+ with _ ->
+ raise
+ (Fail
+ (lazy ("Hypothesis " ^ string_of_name n ^
+ " uses hypothesis " ^ hyp)))
+ in
+ (b, entry::context)
+ else
+ (b, entry::context)
+ ) canonical_context (false, [])
+ in
+ if not context_changed then
+ raise (Fail (lazy ("Hypothesis " ^ hyp ^ " does not exist")));
+ let _,_ =
+ try
+ CicTypeChecker.type_of_aux' metasenv canonical_context' ty
+ CicUniv.empty_ugraph
+ with _ ->
+ raise (Fail (lazy ("Hypothesis " ^ hyp ^ " occurs in the goal")))
+ in
+ m,canonical_context',ty
+ | t -> t
+ ) metasenv
+ in
+ (curi,metasenv',pbo,pty), [goal]
+ in
+ mk_tactic (clear ~hyp)
+
+(* Warning: this tactic has no effect on the proof term.
+ It just changes the name of an hypothesis in the current sequent *)
+let rename ~from ~to_ =
+ let rename ~from ~to_ (proof, goal) =
+ let module C = Cic in
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty =
+ CicUtil.lookup_meta goal metasenv
+ in
+ let metasenv' =
+ List.map
+ (function
+ (m,canonical_context,ty) when m = metano ->
+ let canonical_context' =
+ List.map
+ (function
+ Some (Cic.Name hyp,decl_or_def) when hyp = from ->
+ Some (Cic.Name to_,decl_or_def)
+ | item -> item
+ ) canonical_context
+ in
+ m,canonical_context',ty
+ | t -> t
+ ) metasenv
+ in
+ (curi,metasenv',pbo,pty), [goal]
+ in
+ mk_tactic (rename ~from ~to_)
+
+let set_goal n =
+ ProofEngineTypes.mk_tactic
+ (fun (proof, goal) ->
+ let (_, metasenv, _, _) = proof in
+ if CicUtil.exists_meta n metasenv then
+ (proof, [n])
+ else
+ raise (ProofEngineTypes.Fail (lazy ("no such meta: " ^ string_of_int n))))
diff --git a/helm/ocaml/tactics/proofEngineStructuralRules.mli b/helm/ocaml/tactics/proofEngineStructuralRules.mli
new file mode 100644
index 000000000..91ebfecfb
--- /dev/null
+++ b/helm/ocaml/tactics/proofEngineStructuralRules.mli
@@ -0,0 +1,34 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val clearbody: hyp:string -> ProofEngineTypes.tactic
+val clear: hyp:string -> ProofEngineTypes.tactic
+
+(* Warning: this tactic has no effect on the proof term.
+ It just changes the name of an hypothesis in the current sequent *)
+val rename: from:string -> to_:string -> ProofEngineTypes.tactic
+
+ (* change the current goal to those referred by the given meta number *)
+val set_goal: int -> ProofEngineTypes.tactic
diff --git a/helm/ocaml/tactics/proofEngineTypes.ml b/helm/ocaml/tactics/proofEngineTypes.ml
new file mode 100644
index 000000000..68ea561f9
--- /dev/null
+++ b/helm/ocaml/tactics/proofEngineTypes.ml
@@ -0,0 +1,101 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+ (**
+ current proof (proof uri * metas * (in)complete proof * term to be prooved)
+ *)
+type proof = UriManager.uri option * Cic.metasenv * Cic.term * Cic.term
+ (** current goal, integer index *)
+type goal = int
+type status = proof * goal
+
+let initial_status ty metasenv =
+ let rec aux max = function
+ | [] -> max + 1
+ | (idx, _, _) :: tl ->
+ if idx > max then
+ aux idx tl
+ else
+ aux max tl
+ in
+ let newmeta_idx = aux 0 metasenv in
+ let proof =
+ None, (newmeta_idx, [], ty) :: metasenv, Cic.Meta (newmeta_idx, []), ty
+ in
+ (proof, newmeta_idx)
+
+ (**
+ a tactic: make a transition from one status to another one or, usually,
+ raise a "Fail" (@see Fail) exception in case of failure
+ *)
+ (** an unfinished proof with the optional current goal *)
+type tactic = status -> proof * goal list
+
+ (** creates an opaque tactic from a status->proof*goal list function *)
+let mk_tactic t = t
+
+type reduction = Cic.context -> Cic.term -> Cic.term
+
+let const_lazy_term t =
+ (fun _ metasenv ugraph -> t, metasenv, ugraph)
+
+type lazy_reduction =
+ Cic.context -> Cic.metasenv -> CicUniv.universe_graph ->
+ reduction * Cic.metasenv * CicUniv.universe_graph
+
+let const_lazy_reduction red =
+ (fun _ metasenv ugraph -> red, metasenv, ugraph)
+
+type ('term, 'lazy_term) pattern =
+ 'lazy_term option * (string * 'term) list * 'term option
+
+type lazy_pattern = (Cic.term, Cic.lazy_term) pattern
+
+let conclusion_pattern t =
+ let t' =
+ match t with
+ | None -> None
+ | Some t -> Some (fun _ m u -> t, m, u)
+ in
+ t',[],Some (Cic.Implicit (Some `Hole))
+
+ (** tactic failure *)
+exception Fail of string Lazy.t
+
+ (**
+ calls the opaque tactic on the status, restoring the original
+ universe graph if the tactic Fails
+ *)
+let apply_tactic t status =
+ t status
+
+ (** constraint: the returned value will always be constructed by Cic.Name **)
+type mk_fresh_name_type =
+ Cic.metasenv -> Cic.context -> Cic.name -> typ:Cic.term -> Cic.name
+
+let goals_of_proof (_,metasenv,_,_) = List.map (fun (g,_,_) -> g) metasenv
+
diff --git a/helm/ocaml/tactics/proofEngineTypes.mli b/helm/ocaml/tactics/proofEngineTypes.mli
new file mode 100644
index 000000000..4396ea78f
--- /dev/null
+++ b/helm/ocaml/tactics/proofEngineTypes.mli
@@ -0,0 +1,76 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+ (**
+ current proof (proof uri * metas * (in)complete proof * term to be prooved)
+ *)
+type proof = UriManager.uri option * Cic.metasenv * Cic.term * Cic.term
+ (** current goal, integer index *)
+type goal = int
+type status = proof * goal
+
+ (** @param goal
+ * @param goal's metasenv
+ * @return initial proof status for the given goal *)
+val initial_status: Cic.term -> Cic.metasenv -> status
+
+ (**
+ a tactic: make a transition from one status to another one or, usually,
+ raise a "Fail" (@see Fail) exception in case of failure
+ *)
+ (** an unfinished proof with the optional current goal *)
+type tactic
+val mk_tactic: (status -> proof * goal list) -> tactic
+
+type reduction = Cic.context -> Cic.term -> Cic.term
+
+val const_lazy_term: Cic.term -> Cic.lazy_term
+
+type lazy_reduction =
+ Cic.context -> Cic.metasenv -> CicUniv.universe_graph ->
+ reduction * Cic.metasenv * CicUniv.universe_graph
+
+val const_lazy_reduction: reduction -> lazy_reduction
+
+ (** what, hypothesis patterns, conclusion pattern *)
+type ('term, 'lazy_term) pattern =
+ 'lazy_term option * (string * 'term) list * 'term option
+
+type lazy_pattern = (Cic.term, Cic.lazy_term) pattern
+
+ (** conclusion_pattern [t] returns the pattern (t,[],%) *)
+val conclusion_pattern : Cic.term option -> lazy_pattern
+
+ (** tactic failure *)
+exception Fail of string Lazy.t
+
+val apply_tactic: tactic -> status -> proof * goal list
+
+ (** constraint: the returned value will always be constructed by Cic.Name **)
+type mk_fresh_name_type =
+ Cic.metasenv -> Cic.context -> Cic.name -> typ:Cic.term -> Cic.name
+
+val goals_of_proof: proof -> goal list
+
diff --git a/helm/ocaml/tactics/reductionTactics.ml b/helm/ocaml/tactics/reductionTactics.ml
new file mode 100644
index 000000000..115faa80b
--- /dev/null
+++ b/helm/ocaml/tactics/reductionTactics.ml
@@ -0,0 +1,220 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+open ProofEngineTypes
+
+(* Note: this code is almost identical to change_tac and
+* it could be unified by making the change function a callback *)
+let reduction_tac ~reduction ~pattern (proof,goal) =
+ let curi,metasenv,pbo,pty = proof in
+ let (metano,context,ty) as conjecture = CicUtil.lookup_meta goal metasenv in
+ let change subst where terms metasenv ugraph =
+ if terms = [] then where, metasenv, ugraph
+ else
+ let pairs, metasenv, ugraph =
+ List.fold_left
+ (fun (pairs, metasenv, ugraph) (context, t) ->
+ let reduction, metasenv, ugraph = reduction context metasenv ugraph in
+ ((t, reduction context t) :: pairs), metasenv, ugraph)
+ ([], metasenv, ugraph)
+ terms
+ in
+ let terms, terms' = List.split pairs in
+ let where' =
+ ProofEngineReduction.replace ~equality:(==) ~what:terms ~with_what:terms'
+ ~where:where
+ in
+ CicMetaSubst.apply_subst subst where', metasenv, ugraph
+ in
+ let (subst,metasenv,ugraph,selected_context,selected_ty) =
+ ProofEngineHelpers.select ~metasenv ~ugraph:CicUniv.empty_ugraph
+ ~conjecture ~pattern
+ in
+ let ty', metasenv, ugraph = change subst ty selected_ty metasenv ugraph in
+ let context', metasenv, ugraph =
+ List.fold_right2
+ (fun entry selected_entry (context', metasenv, ugraph) ->
+ match entry,selected_entry with
+ None,None -> None::context', metasenv, ugraph
+ | Some (name,Cic.Decl ty),Some (`Decl selected_ty) ->
+ let ty', metasenv, ugraph =
+ change subst ty selected_ty metasenv ugraph
+ in
+ Some (name,Cic.Decl ty')::context', metasenv, ugraph
+ | Some (name,Cic.Def (bo,ty)),Some (`Def (selected_bo,selected_ty)) ->
+ let bo', metasenv, ugraph =
+ change subst bo selected_bo metasenv ugraph
+ in
+ let ty', metasenv, ugraph =
+ match ty,selected_ty with
+ None,None -> None, metasenv, ugraph
+ | Some ty,Some selected_ty ->
+ let ty', metasenv, ugraph =
+ change subst ty selected_ty metasenv ugraph
+ in
+ Some ty', metasenv, ugraph
+ | _,_ -> assert false
+ in
+ (Some (name,Cic.Def (bo',ty'))::context'), metasenv, ugraph
+ | _,_ -> assert false
+ ) context selected_context ([], metasenv, ugraph) in
+ let metasenv' =
+ List.map (function
+ | (n,_,_) when n = metano -> (metano,context',ty')
+ | _ as t -> t
+ ) metasenv
+ in
+ (curi,metasenv',pbo,pty), [metano]
+;;
+
+let simpl_tac ~pattern =
+ mk_tactic (reduction_tac
+ ~reduction:(const_lazy_reduction ProofEngineReduction.simpl) ~pattern)
+
+let reduce_tac ~pattern =
+ mk_tactic (reduction_tac
+ ~reduction:(const_lazy_reduction ProofEngineReduction.reduce) ~pattern)
+
+let unfold_tac what ~pattern =
+ let reduction =
+ match what with
+ | None -> const_lazy_reduction (ProofEngineReduction.unfold ?what:None)
+ | Some lazy_term ->
+ (fun context metasenv ugraph ->
+ let what, metasenv, ugraph = lazy_term context metasenv ugraph in
+ ProofEngineReduction.unfold ~what, metasenv, ugraph)
+ in
+ mk_tactic (reduction_tac ~reduction ~pattern)
+
+let whd_tac ~pattern =
+ mk_tactic (reduction_tac
+ ~reduction:(const_lazy_reduction CicReduction.whd) ~pattern)
+
+let normalize_tac ~pattern =
+ mk_tactic (reduction_tac
+ ~reduction:(const_lazy_reduction CicReduction.normalize) ~pattern)
+
+exception NotConvertible
+
+(* Note: this code is almost identical to reduction_tac and
+* it could be unified by making the change function a callback *)
+(* CSC: with_what is parsed in the context of the goal, but it should replace
+ something that lives in a completely different context. Thus we
+ perform a delift + lift phase to move it in the right context. However,
+ in this way the tactic is less powerful than expected: with_what cannot
+ reference variables that are local to the term that is going to be
+ replaced. To fix this we should parse with_what in the context of the
+ term(s) to be replaced. *)
+let change_tac ~pattern with_what =
+ let change_tac ~pattern ~with_what (proof, goal) =
+ let curi,metasenv,pbo,pty = proof in
+ let (metano,context,ty) as conjecture = CicUtil.lookup_meta goal metasenv in
+ let change subst where terms metasenv ugraph =
+ if terms = [] then where, metasenv, ugraph
+ else
+ let pairs, metasenv, ugraph =
+ List.fold_left
+ (fun (pairs, metasenv, ugraph) (context_of_t, t) ->
+ let with_what, metasenv, ugraph =
+ with_what context_of_t metasenv ugraph
+ in
+ let _,u =
+ CicTypeChecker.type_of_aux' metasenv context_of_t with_what ugraph
+ in
+ let b,_ =
+ CicReduction.are_convertible ~metasenv context_of_t t with_what u
+ in
+ if b then
+ ((t, with_what) :: pairs), metasenv, ugraph
+ else
+ raise NotConvertible)
+ ([], metasenv, ugraph)
+ terms
+ in
+ let terms, terms' = List.split pairs in
+ let where' =
+ ProofEngineReduction.replace ~equality:(==) ~what:terms ~with_what:terms'
+ ~where:where
+ in
+ CicMetaSubst.apply_subst subst where', metasenv, ugraph
+ in
+ let (subst,metasenv,ugraph,selected_context,selected_ty) =
+ ProofEngineHelpers.select ~metasenv ~ugraph:CicUniv.empty_ugraph ~conjecture
+ ~pattern in
+ let ty', metasenv, ugraph = change subst ty selected_ty metasenv ugraph in
+ let context', metasenv, ugraph =
+ List.fold_right2
+ (fun entry selected_entry (context', metasenv, ugraph) ->
+ match entry,selected_entry with
+ None,None -> (None::context'), metasenv, ugraph
+ | Some (name,Cic.Decl ty),Some (`Decl selected_ty) ->
+ let ty', metasenv, ugraph =
+ change subst ty selected_ty metasenv ugraph
+ in
+ (Some (name,Cic.Decl ty')::context'), metasenv, ugraph
+ | Some (name,Cic.Def (bo,ty)),Some (`Def (selected_bo,selected_ty)) ->
+ let bo', metasenv, ugraph =
+ change subst bo selected_bo metasenv ugraph
+ in
+ let ty', metasenv, ugraph =
+ match ty,selected_ty with
+ None,None -> None, metasenv, ugraph
+ | Some ty,Some selected_ty ->
+ let ty', metasenv, ugraph =
+ change subst ty selected_ty metasenv ugraph
+ in
+ Some ty', metasenv, ugraph
+ | _,_ -> assert false
+ in
+ (Some (name,Cic.Def (bo',ty'))::context'), metasenv, ugraph
+ | _,_ -> assert false
+ ) context selected_context ([], metasenv, ugraph) in
+ let metasenv' =
+ List.map
+ (function
+ | (n,_,_) when n = metano -> (metano,context',ty')
+ | _ as t -> t)
+ metasenv
+ in
+ (curi,metasenv',pbo,pty), [metano]
+ in
+ mk_tactic (change_tac ~pattern ~with_what)
+
+let fold_tac ~reduction ~term ~pattern =
+ let fold_tac ~reduction ~term ~pattern:(wanted,hyps_pat,concl_pat) status =
+ assert (wanted = None); (* this should be checked syntactically *)
+ let reduced_term =
+ (fun context metasenv ugraph ->
+ let term, metasenv, ugraph = term context metasenv ugraph in
+ let reduction, metasenv, ugraph = reduction context metasenv ugraph in
+ reduction context term, metasenv, ugraph)
+ in
+ apply_tactic
+ (change_tac ~pattern:(Some reduced_term,hyps_pat,concl_pat) term) status
+ in
+ mk_tactic (fold_tac ~reduction ~term ~pattern)
+
diff --git a/helm/ocaml/tactics/reductionTactics.mli b/helm/ocaml/tactics/reductionTactics.mli
new file mode 100644
index 000000000..16e2bc23c
--- /dev/null
+++ b/helm/ocaml/tactics/reductionTactics.mli
@@ -0,0 +1,47 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val simpl_tac: pattern:ProofEngineTypes.lazy_pattern -> ProofEngineTypes.tactic
+val reduce_tac: pattern:ProofEngineTypes.lazy_pattern -> ProofEngineTypes.tactic
+val whd_tac: pattern:ProofEngineTypes.lazy_pattern -> ProofEngineTypes.tactic
+val normalize_tac: pattern:ProofEngineTypes.lazy_pattern -> ProofEngineTypes.tactic
+
+(* The default of term is the thesis of the goal to be prooved *)
+val unfold_tac:
+ Cic.lazy_term option ->
+ pattern:ProofEngineTypes.lazy_pattern ->
+ ProofEngineTypes.tactic
+
+val change_tac:
+ pattern:ProofEngineTypes.lazy_pattern ->
+ Cic.lazy_term ->
+ ProofEngineTypes.tactic
+
+val fold_tac:
+ reduction:ProofEngineTypes.lazy_reduction ->
+ term:Cic.lazy_term ->
+ pattern:ProofEngineTypes.lazy_pattern ->
+ ProofEngineTypes.tactic
+
diff --git a/helm/ocaml/tactics/ring.ml b/helm/ocaml/tactics/ring.ml
new file mode 100644
index 000000000..4c58f1004
--- /dev/null
+++ b/helm/ocaml/tactics/ring.ml
@@ -0,0 +1,596 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+open CicReduction
+open PrimitiveTactics
+open ProofEngineTypes
+open UriManager
+
+(** DEBUGGING *)
+
+ (** perform debugging output? *)
+let debug = false
+let debug_print = fun _ -> ()
+
+ (** debugging print *)
+let warn s = debug_print (lazy ("RING WARNING: " ^ (Lazy.force s)))
+
+(** CIC URIS *)
+
+(**
+ Note: For constructors URIs aren't really URIs but rather triples of
+ the form (uri, typeno, consno). This discrepancy is to preserver an
+ uniformity of invocation of "mkXXX" functions.
+*)
+
+let equality_is_a_congruence_A =
+ uri_of_string "cic:/Coq/Init/Logic/Logic_lemmas/equality/A.var"
+let equality_is_a_congruence_x =
+ uri_of_string "cic:/Coq/Init/Logic/Logic_lemmas/equality/x.var"
+let equality_is_a_congruence_y =
+ uri_of_string "cic:/Coq/Init/Logic/Logic_lemmas/equality/y.var"
+
+let apolynomial_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/apolynomial.ind"
+let apvar_uri = (apolynomial_uri, 0, 1)
+let ap0_uri = (apolynomial_uri, 0, 2)
+let ap1_uri = (apolynomial_uri, 0, 3)
+let applus_uri = (apolynomial_uri, 0, 4)
+let apmult_uri = (apolynomial_uri, 0, 5)
+let apopp_uri = (apolynomial_uri, 0, 6)
+
+let quote_varmap_A_uri = uri_of_string "cic:/Coq/ring/Quote/variables_map/A.var"
+let varmap_uri = uri_of_string "cic:/Coq/ring/Quote/varmap.ind"
+let empty_vm_uri = (varmap_uri, 0, 1)
+let node_vm_uri = (varmap_uri, 0, 2)
+let varmap_find_uri = uri_of_string "cic:/Coq/ring/Quote/varmap_find.con"
+let index_uri = uri_of_string "cic:/Coq/ring/Quote/index.ind"
+let left_idx_uri = (index_uri, 0, 1)
+let right_idx_uri = (index_uri, 0, 2)
+let end_idx_uri = (index_uri, 0, 3)
+
+let abstract_rings_A_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/A.var"
+let abstract_rings_Aplus_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/Aplus.var"
+let abstract_rings_Amult_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/Amult.var"
+let abstract_rings_Aone_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/Aone.var"
+let abstract_rings_Azero_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/Azero.var"
+let abstract_rings_Aopp_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/Aopp.var"
+let abstract_rings_Aeq_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/Aeq.var"
+let abstract_rings_vm_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/vm.var"
+let abstract_rings_T_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/T.var"
+let interp_ap_uri = uri_of_string "cic:/Coq/ring/Ring_abstract/interp_ap.con"
+let interp_sacs_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/interp_sacs.con"
+let apolynomial_normalize_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/apolynomial_normalize.con"
+let apolynomial_normalize_ok_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/apolynomial_normalize_ok.con"
+
+(** CIC PREDICATES *)
+
+ (**
+ check whether a term is a constant or not, if argument "uri" is given and is
+ not "None" also check if the constant correspond to the given one or not
+ *)
+let cic_is_const ?(uri: uri option = None) term =
+ match uri with
+ | None ->
+ (match term with
+ | Cic.Const _ -> true
+ | _ -> false)
+ | Some realuri ->
+ (match term with
+ | Cic.Const (u, _) when (eq u realuri) -> true
+ | _ -> false)
+
+(** PROOF AND GOAL ACCESSORS *)
+
+ (**
+ @param proof a proof
+ @return the uri of a given proof
+ *)
+let uri_of_proof ~proof:(uri, _, _, _) = uri
+
+ (**
+ @param status current proof engine status
+ @raise Failure if proof is None
+ @return current goal's metasenv
+ *)
+let metasenv_of_status ((_,m,_,_), _) = m
+
+ (**
+ @param status a proof engine status
+ @raise Failure when proof or goal are None
+ @return context corresponding to current goal
+ *)
+let context_of_status status =
+ let (proof, goal) = status in
+ let metasenv = metasenv_of_status status in
+ let _, context, _ = CicUtil.lookup_meta goal metasenv in
+ context
+
+(** CIC TERM CONSTRUCTORS *)
+
+ (**
+ Create a Cic term consisting of a constant
+ @param uri URI of the constant
+ @proof current proof
+ @exp_named_subst explicit named substitution
+ *)
+let mkConst ~uri ~exp_named_subst =
+ Cic.Const (uri, exp_named_subst)
+
+ (**
+ Create a Cic term consisting of a constructor
+ @param uri triple <uri, typeno, consno> where uri is the uri of an inductive
+ type, typeno is the type number in a mutind structure (0 based), consno is
+ the constructor number (1 based)
+ @exp_named_subst explicit named substitution
+ *)
+let mkCtor ~uri:(uri, typeno, consno) ~exp_named_subst =
+ Cic.MutConstruct (uri, typeno, consno, exp_named_subst)
+
+ (**
+ Create a Cic term consisting of a type member of a mutual induction
+ @param uri pair <uri, typeno> where uri is the uri of a mutual inductive
+ type and typeno is the type number (0 based) in the mutual induction
+ @exp_named_subst explicit named substitution
+ *)
+let mkMutInd ~uri:(uri, typeno) ~exp_named_subst =
+ Cic.MutInd (uri, typeno, exp_named_subst)
+
+(** EXCEPTIONS *)
+
+ (**
+ raised when the current goal is not ringable; a goal is ringable when is an
+ equality on reals (@see r_uri)
+ *)
+exception GoalUnringable
+
+(** RING's FUNCTIONS LIBRARY *)
+
+ (**
+ Check whether the ring tactic can be applied on a given term (i.e. that is
+ an equality on reals)
+ @param term to be tested
+ @return true if the term is ringable, false otherwise
+ *)
+let ringable =
+ let is_equality = function
+ | Cic.MutInd (uri, 0, []) when (eq uri HelmLibraryObjects.Logic.eq_URI) -> true
+ | _ -> false
+ in
+ let is_real = function
+ | Cic.Const (uri, _) when (eq uri HelmLibraryObjects.Reals.r_URI) -> true
+ | _ -> false
+ in
+ function
+ | Cic.Appl (app::set::_::_::[]) when (is_equality app && is_real set) ->
+ warn (lazy "Goal Ringable!");
+ true
+ | _ ->
+ warn (lazy "Goal Not Ringable :-((");
+ false
+
+ (**
+ split an equality goal of the form "t1 = t2" in its two subterms t1 and t2
+ after checking that the goal is ringable
+ @param goal the current goal
+ @return a pair (t1,t2) that are two sides of the equality goal
+ @raise GoalUnringable if the goal isn't ringable
+ *)
+let split_eq = function
+ | (Cic.Appl (_::_::t1::t2::[])) as term when ringable term ->
+ warn (lazy ("<term1>" ^ (CicPp.ppterm t1) ^ "</term1>"));
+ warn (lazy ("<term2>" ^ (CicPp.ppterm t2) ^ "</term2>"));
+ (t1, t2)
+ | _ -> raise GoalUnringable
+
+ (**
+ @param i an integer index representing a 1 based number of node in a binary
+ search tree counted in a fbs manner (i.e.: 1 is the root, 2 is the left
+ child of the root (if any), 3 is the right child of the root (if any), 4 is
+ the left child of the left child of the root (if any), ....)
+ @param proof the current proof
+ @return an index representing the same node in a varmap (@see varmap_uri),
+ the returned index is as defined in index (@see index_uri)
+ *)
+let path_of_int n =
+ let rec digits_of_int n =
+ if n=1 then [] else (n mod 2 = 1)::(digits_of_int (n lsr 1))
+ in
+ List.fold_right
+ (fun digit path ->
+ Cic.Appl [
+ mkCtor (if (digit = true) then right_idx_uri else left_idx_uri) [];
+ path])
+ (List.rev (digits_of_int n)) (* remove leading true (i.e. digit 1) *)
+ (mkCtor end_idx_uri [])
+
+ (**
+ Build a variable map (@see varmap_uri) from a variables array.
+ A variable map is almost a binary tree so this function receiving a var list
+ like [v;w;x;y;z] will build a varmap of shape: v
+ / \
+ w x
+ / \
+ y z
+ @param vars variables array
+ @return a cic term representing the variable map containing vars variables
+ *)
+let btree_of_array ~vars =
+ let r = HelmLibraryObjects.Reals.r in
+ let empty_vm_r = mkCtor empty_vm_uri [quote_varmap_A_uri,r] in
+ let node_vm_r = mkCtor node_vm_uri [quote_varmap_A_uri,r] in
+ let size = Array.length vars in
+ let halfsize = size lsr 1 in
+ let rec aux n = (* build the btree starting from position n *)
+ (*
+ n is the position in the vars array _1_based_ in order to access
+ left and right child using (n*2, n*2+1) trick
+ *)
+ if n > size then
+ empty_vm_r
+ else if n > halfsize then (* no more children *)
+ Cic.Appl [node_vm_r; vars.(n-1); empty_vm_r; empty_vm_r]
+ else (* still children *)
+ Cic.Appl [node_vm_r; vars.(n-1); aux (n*2); aux (n*2+1)]
+ in
+ aux 1
+
+ (**
+ abstraction function:
+ concrete polynoms -----> (abstract polynoms, varmap)
+ @param terms list of conrete polynoms
+ @return a pair <aterms, varmap> where aterms is a list of abstract polynoms
+ and varmap is the variable map needed to interpret them
+ *)
+let abstract_poly ~terms =
+ let varhash = Hashtbl.create 19 in (* vars hash, to speed up lookup *)
+ let varlist = ref [] in (* vars list in reverse order *)
+ let counter = ref 1 in (* index of next new variable *)
+ let rec aux = function (* TODO not tail recursive *)
+ (* "bop" -> binary operator | "uop" -> unary operator *)
+ | Cic.Appl (bop::t1::t2::[])
+ when (cic_is_const ~uri:(Some HelmLibraryObjects.Reals.rplus_URI) bop) -> (* +. *)
+ Cic.Appl [mkCtor applus_uri []; aux t1; aux t2]
+ | Cic.Appl (bop::t1::t2::[])
+ when (cic_is_const ~uri:(Some HelmLibraryObjects.Reals.rmult_URI) bop) -> (* *. *)
+ Cic.Appl [mkCtor apmult_uri []; aux t1; aux t2]
+ | Cic.Appl (uop::t::[])
+ when (cic_is_const ~uri:(Some HelmLibraryObjects.Reals.ropp_URI) uop) -> (* ~-. *)
+ Cic.Appl [mkCtor apopp_uri []; aux t]
+ | t when (cic_is_const ~uri:(Some HelmLibraryObjects.Reals.r0_URI) t) -> (* 0. *)
+ mkCtor ap0_uri []
+ | t when (cic_is_const ~uri:(Some HelmLibraryObjects.Reals.r1_URI) t) -> (* 1. *)
+ mkCtor ap1_uri []
+ | t -> (* variable *)
+ try
+ Hashtbl.find varhash t (* use an old var *)
+ with Not_found -> begin (* create a new var *)
+ let newvar =
+ Cic.Appl [mkCtor apvar_uri []; path_of_int !counter]
+ in
+ incr counter;
+ varlist := t :: !varlist;
+ Hashtbl.add varhash t newvar;
+ newvar
+ end
+ in
+ let aterms = List.map aux terms in (* abstract vars *)
+ let varmap = (* build varmap *)
+ btree_of_array ~vars:(Array.of_list (List.rev !varlist))
+ in
+ (aterms, varmap)
+
+ (**
+ given a list of abstract terms (i.e. apolynomials) build the ring "segments"
+ that is triples like (t', t'', t''') where
+ t' = interp_ap(varmap, at)
+ t'' = interp_sacs(varmap, (apolynomial_normalize at))
+ t''' = apolynomial_normalize_ok(varmap, at)
+ at is the abstract term built from t, t is a single member of aterms
+ *)
+let build_segments ~terms =
+ let theory_args_subst varmap =
+ [abstract_rings_A_uri, HelmLibraryObjects.Reals.r ;
+ abstract_rings_Aplus_uri, HelmLibraryObjects.Reals.rplus ;
+ abstract_rings_Amult_uri, HelmLibraryObjects.Reals.rmult ;
+ abstract_rings_Aone_uri, HelmLibraryObjects.Reals.r1 ;
+ abstract_rings_Azero_uri, HelmLibraryObjects.Reals.r0 ;
+ abstract_rings_Aopp_uri, HelmLibraryObjects.Reals.ropp ;
+ abstract_rings_vm_uri, varmap] in
+ let theory_args_subst' eq varmap t =
+ [abstract_rings_A_uri, HelmLibraryObjects.Reals.r ;
+ abstract_rings_Aplus_uri, HelmLibraryObjects.Reals.rplus ;
+ abstract_rings_Amult_uri, HelmLibraryObjects.Reals.rmult ;
+ abstract_rings_Aone_uri, HelmLibraryObjects.Reals.r1 ;
+ abstract_rings_Azero_uri, HelmLibraryObjects.Reals.r0 ;
+ abstract_rings_Aopp_uri, HelmLibraryObjects.Reals.ropp ;
+ abstract_rings_Aeq_uri, eq ;
+ abstract_rings_vm_uri, varmap ;
+ abstract_rings_T_uri, t] in
+ let interp_ap varmap =
+ mkConst interp_ap_uri (theory_args_subst varmap) in
+ let interp_sacs varmap =
+ mkConst interp_sacs_uri (theory_args_subst varmap) in
+ let apolynomial_normalize = mkConst apolynomial_normalize_uri [] in
+ let apolynomial_normalize_ok eq varmap t =
+ mkConst apolynomial_normalize_ok_uri (theory_args_subst' eq varmap t) in
+ let lxy_false = (** Cic funcion "fun (x,y):R -> false" *)
+ Cic.Lambda (Cic.Anonymous, HelmLibraryObjects.Reals.r,
+ Cic.Lambda (Cic.Anonymous, HelmLibraryObjects.Reals.r, HelmLibraryObjects.Datatypes.falseb))
+ in
+ let (aterms, varmap) = abstract_poly ~terms in (* abstract polys *)
+ List.map (* build ring segments *)
+ (fun t ->
+ Cic.Appl [interp_ap varmap ; t],
+ Cic.Appl (
+ [interp_sacs varmap ; Cic.Appl [apolynomial_normalize; t]]),
+ Cic.Appl [apolynomial_normalize_ok lxy_false varmap HelmLibraryObjects.Reals.rtheory ; t]
+ ) aterms
+
+
+let status_of_single_goal_tactic_result =
+ function
+ proof,[goal] -> proof,goal
+ | _ ->
+ raise (Fail (lazy "status_of_single_goal_tactic_result: the tactic did not produce exactly a new goal"))
+
+(* Galla: spostata in variousTactics.ml
+ (**
+ auxiliary tactic "elim_type"
+ @param status current proof engine status
+ @param term term to cut
+ *)
+let elim_type_tac ~term status =
+ warn (lazy "in Ring.elim_type_tac");
+ Tacticals.thens ~start:(cut_tac ~term)
+ ~continuations:[elim_simpl_intros_tac ~term:(Cic.Rel 1) ; Tacticals.id_tac] status
+*)
+
+ (**
+ auxiliary tactic, use elim_type and try to close 2nd subgoal using proof
+ @param status current proof engine status
+ @param term term to cut
+ @param proof term used to prove second subgoal generated by elim_type
+ *)
+(* FG: METTERE I NOMI ANCHE QUI? *)
+let elim_type2_tac ~term ~proof =
+ let elim_type2_tac ~term ~proof status =
+ let module E = EliminationTactics in
+ warn (lazy "in Ring.elim_type2");
+ ProofEngineTypes.apply_tactic
+ (Tacticals.thens ~start:(E.elim_type_tac term)
+ ~continuations:[Tacticals.id_tac ; exact_tac ~term:proof]) status
+ in
+ ProofEngineTypes.mk_tactic (elim_type2_tac ~term ~proof)
+
+(* Galla: spostata in variousTactics.ml
+ (**
+ Reflexivity tactic, try to solve current goal using "refl_eqT"
+ Warning: this isn't equale to the coq's Reflexivity because this one tries
+ only refl_eqT, coq's one also try "refl_equal"
+ @param status current proof engine status
+ *)
+let reflexivity_tac (proof, goal) =
+ warn (lazy "in Ring.reflexivity_tac");
+ let refl_eqt = mkCtor ~uri:refl_eqt_uri ~exp_named_subst:[] in
+ try
+ apply_tac (proof, goal) ~term:refl_eqt
+ with (Fail _) as e ->
+ let e_str = Printexc.to_string e in
+ raise (Fail ("Reflexivity failed with exception: " ^ e_str))
+*)
+
+ (** lift an 8-uple of debrujins indexes of n *)
+let lift ~n (a,b,c,d,e,f,g,h) =
+ match (List.map (CicSubstitution.lift n) [a;b;c;d;e;f;g;h]) with
+ | [a;b;c;d;e;f;g;h] -> (a,b,c,d,e,f,g,h)
+ | _ -> assert false
+
+ (**
+ remove hypothesis from a given status starting from the last one
+ @param count number of hypotheses to remove
+ @param status current proof engine status
+ *)
+let purge_hyps_tac ~count =
+ let purge_hyps_tac ~count status =
+ let module S = ProofEngineStructuralRules in
+ let (proof, goal) = status in
+ let rec aux n context status =
+ assert(n>=0);
+ match (n, context) with
+ | (0, _) -> status
+ | (n, hd::tl) ->
+ let name_of_hyp =
+ match hd with
+ None
+ | Some (Cic.Anonymous,_) -> assert false
+ | Some (Cic.Name name,_) -> name
+ in
+ aux (n-1) tl
+ (status_of_single_goal_tactic_result
+ (ProofEngineTypes.apply_tactic (S.clear ~hyp:name_of_hyp) status))
+ | (_, []) -> failwith "Ring.purge_hyps_tac: no hypotheses left"
+ in
+ let (_, metasenv, _, _) = proof in
+ let (_, context, _) = CicUtil.lookup_meta goal metasenv in
+ let proof',goal' = aux count context status in
+ assert (goal = goal') ;
+ proof',[goal']
+ in
+ ProofEngineTypes.mk_tactic (purge_hyps_tac ~count)
+
+(** THE TACTIC! *)
+
+ (**
+ Ring tactic, does associative and commutative rewritings in Reals ring
+ @param status current proof engine status
+ *)
+
+let ring_tac status =
+ let (proof, goal) = status in
+ warn (lazy "in Ring tactic");
+ let eqt = mkMutInd (HelmLibraryObjects.Logic.eq_URI, 0) [] in
+ let r = HelmLibraryObjects.Reals.r in
+ let metasenv = metasenv_of_status status in
+ let (metano, context, ty) = CicUtil.lookup_meta goal metasenv in
+ let (t1, t2) = split_eq ty in (* goal like t1 = t2 *)
+ match (build_segments ~terms:[t1; t2]) with
+ | (t1', t1'', t1'_eq_t1'')::(t2', t2'', t2'_eq_t2'')::[] -> begin
+ if debug then
+ List.iter (* debugging, feel free to remove *)
+ (fun (descr, term) ->
+ warn (lazy (descr ^ " " ^ (CicPp.ppterm term))))
+ (List.combine
+ ["t1"; "t1'"; "t1''"; "t1'_eq_t1''";
+ "t2"; "t2'"; "t2''"; "t2'_eq_t2''"]
+ [t1; t1'; t1''; t1'_eq_t1'';
+ t2; t2'; t2''; t2'_eq_t2'']);
+ try
+ let new_hyps = ref 0 in (* number of new hypotheses created *)
+ ProofEngineTypes.apply_tactic
+ (Tacticals.first
+ ~tactics:[
+ "reflexivity", EqualityTactics.reflexivity_tac ;
+ "exact t1'_eq_t1''", exact_tac ~term:t1'_eq_t1'' ;
+ "exact t2'_eq_t2''", exact_tac ~term:t2'_eq_t2'' ;
+ "exact sym_eqt su t1 ...", exact_tac
+ ~term:(
+ Cic.Appl
+ [mkConst HelmLibraryObjects.Logic.sym_eq_URI
+ [equality_is_a_congruence_A, HelmLibraryObjects.Reals.r;
+ equality_is_a_congruence_x, t1'' ;
+ equality_is_a_congruence_y, t1
+ ] ;
+ t1'_eq_t1''
+ ]) ;
+ "elim_type eqt su t1 ...", ProofEngineTypes.mk_tactic (fun status ->
+ let status' = (* status after 1st elim_type use *)
+ let context = context_of_status status in
+ let b,_ = (*TASSI : FIXME*)
+ are_convertible context t1'' t1 CicUniv.empty_ugraph in
+ if not b then begin
+ warn (lazy "t1'' and t1 are NOT CONVERTIBLE");
+ let newstatus =
+ ProofEngineTypes.apply_tactic
+ (elim_type2_tac (* 1st elim_type use *)
+ ~proof:t1'_eq_t1''
+ ~term:(Cic.Appl [eqt; r; t1''; t1]))
+ status
+ in
+ incr new_hyps; (* elim_type add an hyp *)
+ match newstatus with
+ (proof,[goal]) -> proof,goal
+ | _ -> assert false
+ end else begin
+ warn (lazy "t1'' and t1 are CONVERTIBLE");
+ status
+ end
+ in
+ let (t1,t1',t1'',t1'_eq_t1'',t2,t2',t2'',t2'_eq_t2'') =
+ lift 1 (t1,t1',t1'',t1'_eq_t1'', t2,t2',t2'',t2'_eq_t2'')
+ in
+ let status'' =
+ ProofEngineTypes.apply_tactic
+ (Tacticals.first (* try to solve 1st subgoal *)
+ ~tactics:[
+ "exact t2'_eq_t2''", exact_tac ~term:t2'_eq_t2'';
+ "exact sym_eqt su t2 ...",
+ exact_tac
+ ~term:(
+ Cic.Appl
+ [mkConst HelmLibraryObjects.Logic.sym_eq_URI
+ [equality_is_a_congruence_A, HelmLibraryObjects.Reals.r;
+ equality_is_a_congruence_x, t2'' ;
+ equality_is_a_congruence_y, t2
+ ] ;
+ t2'_eq_t2''
+ ]) ;
+ "elim_type eqt su t2 ...",
+ ProofEngineTypes.mk_tactic (fun status ->
+ let status' =
+ let context = context_of_status status in
+ let b,_ = (* TASSI:FIXME *)
+ are_convertible context t2'' t2 CicUniv.empty_ugraph
+ in
+ if not b then begin
+ warn (lazy "t2'' and t2 are NOT CONVERTIBLE");
+ let newstatus =
+ ProofEngineTypes.apply_tactic
+ (elim_type2_tac (* 2nd elim_type use *)
+ ~proof:t2'_eq_t2''
+ ~term:(Cic.Appl [eqt; r; t2''; t2]))
+ status
+ in
+ incr new_hyps; (* elim_type add an hyp *)
+ match newstatus with
+ (proof,[goal]) -> proof,goal
+ | _ -> assert false
+ end else begin
+ warn (lazy "t2'' and t2 are CONVERTIBLE");
+ status
+ end
+ in
+ try (* try to solve main goal *)
+ warn (lazy "trying reflexivity ....");
+ ProofEngineTypes.apply_tactic
+ EqualityTactics.reflexivity_tac status'
+ with (Fail _) -> (* leave conclusion to the user *)
+ warn (lazy "reflexivity failed, solution's left as an ex :-)");
+ ProofEngineTypes.apply_tactic
+ (purge_hyps_tac ~count:!new_hyps) status')])
+ status'
+ in
+ status'')])
+ status
+ with (Fail s) ->
+ raise (Fail (lazy ("Ring failure: " ^ Lazy.force s)))
+ end
+ | _ -> (* impossible: we are applying ring exacty to 2 terms *)
+ assert false
+
+ (* wrap ring_tac catching GoalUnringable and raising Fail *)
+
+let ring_tac status =
+ try
+ ring_tac status
+ with GoalUnringable ->
+ raise (Fail (lazy "goal unringable"))
+
+let ring_tac = ProofEngineTypes.mk_tactic ring_tac
+
diff --git a/helm/ocaml/tactics/ring.mli b/helm/ocaml/tactics/ring.mli
new file mode 100644
index 000000000..b6eb34b69
--- /dev/null
+++ b/helm/ocaml/tactics/ring.mli
@@ -0,0 +1,12 @@
+
+ (* ring tactics *)
+val ring_tac: ProofEngineTypes.tactic
+
+(*Galla: spostata in variuosTactics.ml
+ (* auxiliary tactics *)
+val elim_type_tac: term: Cic.term -> ProofEngineTypes.tactic
+*)
+
+(* spostata in variousTactics.ml
+val reflexivity_tac: ProofEngineTypes.tactic
+*)
diff --git a/helm/ocaml/tactics/statefulProofEngine.ml b/helm/ocaml/tactics/statefulProofEngine.ml
new file mode 100644
index 000000000..9529c897c
--- /dev/null
+++ b/helm/ocaml/tactics/statefulProofEngine.ml
@@ -0,0 +1,214 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let default_history_size = 20
+
+exception No_goal_left
+exception Uri_redefinition
+type event = [ `Proof_changed | `Proof_completed ]
+let all_events = [ `Proof_changed; `Proof_completed ]
+let default_events: event list = [ `Proof_changed ]
+
+type proof_status = ProofEngineTypes.proof * ProofEngineTypes.goal option
+
+type 'a observer = (proof_status * 'a) option -> (proof_status * 'a) -> unit
+type observer_id = int
+
+exception Observer_failures of (observer_id * exn) list
+exception Tactic_failure of exn
+exception Data_failure of exn
+
+class ['a] status
+ ?(history_size = default_history_size)
+ ?uri ~typ ~body ~metasenv init_data compute_data ()
+ =
+ let next_observer_id =
+ let next_id = ref 0 in
+ fun () ->
+ incr next_id;
+ !next_id
+ in
+ let initial_proof = ((uri: UriManager.uri option), metasenv, body, typ) in
+ let next_goal (goals, proof) =
+ match goals, proof with
+ | goal :: _, _ -> Some goal
+ | [], (_, (goal, _, _) :: _, _, _) ->
+ (* the tactic left no open goal: let's choose the first open goal *)
+ Some goal
+ | _, _ -> None
+ in
+ let initial_goal = next_goal ([], initial_proof) in
+ object (self)
+
+ val mutable _proof = initial_proof
+ val mutable _goal = initial_goal
+ val mutable _data: 'a = init_data (initial_proof, initial_goal)
+
+ (* event -> (id, observer) list *)
+ val observers = Hashtbl.create 7
+
+ (* assumption: all items in history are uncompleted proofs, thus option on
+ * goal could be ignored and goal are stored as bare integers *)
+ val history = new History.history history_size
+
+ initializer
+ history#push self#internal_status
+
+ method proof = _proof
+ method private status = (_proof, _goal) (* logic status *)
+ method private set_status (proof, (goal: int option)) =
+ _proof <- proof;
+ _goal <- goal
+
+ method goal =
+ match _goal with
+ | Some goal -> goal
+ | None -> raise No_goal_left
+
+ (* what will be kept in history *)
+ method private internal_status = (self#status, _data)
+ method private set_internal_status (status, data) =
+ self#set_status status;
+ _data <- data
+
+ method set_goal goal =
+ _goal <- Some goal
+(*
+ let old_internal_status = self#internal_status in
+ _goal <- Some goal;
+ try
+ self#update_data old_internal_status;
+ history#push self#internal_status;
+ self#private_notify (Some old_internal_status)
+ with (Data_failure _) as exn ->
+ self#set_internal_status old_internal_status;
+ raise exn
+*)
+
+ method uri = let (uri, _, _, _) = _proof in uri
+ method metasenv = let (_, metasenv, _, _) = _proof in metasenv
+ method body = let (_, _, body, _) = _proof in body
+ method typ = let (_, _, _, typ) = _proof in typ
+
+ method set_metasenv metasenv =
+ let (uri, _, body, typ) = _proof in
+ _proof <- (uri, metasenv, body, typ)
+
+ method set_uri uri =
+ let (old_uri, metasenv, body, typ) = _proof in
+ if old_uri <> None then
+ raise Uri_redefinition;
+ _proof <- (Some uri, metasenv, body, typ)
+
+ method conjecture goal =
+ let (_, metasenv, _, _) = _proof in
+ CicUtil.lookup_meta goal metasenv
+
+ method apply_tactic tactic =
+ let old_internal_status = self#internal_status in
+ let (new_proof, new_goals) =
+ try
+ ProofEngineTypes.apply_tactic tactic (_proof, self#goal)
+ with exn -> raise (Tactic_failure exn)
+ in
+ _proof <- new_proof;
+ _goal <- next_goal (new_goals, new_proof);
+ try
+ self#update_data old_internal_status;
+ history#push self#internal_status;
+ self#private_notify (Some old_internal_status)
+ with (Data_failure _) as exn ->
+ self#set_internal_status old_internal_status;
+ raise exn
+
+ method proof_completed = _goal = None
+
+ method attach_observer ?(interested_in = default_events) observer
+ =
+ let id = next_observer_id () in
+ List.iter
+ (fun event ->
+ let prev_observers =
+ try Hashtbl.find observers event with Not_found -> []
+ in
+ Hashtbl.replace observers event ((id, observer)::prev_observers))
+ interested_in;
+ id
+
+ method detach_observer id =
+ List.iter
+ (fun event ->
+ let prev_observers =
+ try Hashtbl.find observers event with Not_found -> []
+ in
+ let new_observers =
+ List.filter (fun (id', _) -> id' <> id) prev_observers
+ in
+ Hashtbl.replace observers event new_observers)
+ all_events
+
+ method private private_notify old_internal_status =
+ let cur_internal_status = (self#status, _data) in
+ let exns = ref [] in
+ let notify (id, observer) =
+ try
+ observer old_internal_status cur_internal_status
+ with exn -> exns := (id, exn) :: !exns
+ in
+ List.iter notify
+ (try Hashtbl.find observers `Proof_changed with Not_found -> []);
+ if self#proof_completed then
+ List.iter notify
+ (try Hashtbl.find observers `Proof_completed with Not_found -> []);
+ match !exns with
+ | [] -> ()
+ | exns -> raise (Observer_failures exns)
+
+ method private update_data old_internal_status =
+ (* invariant: _goal and/or _proof has been changed
+ * invariant: proof is not yet completed *)
+ let status = self#status in
+ try
+ _data <- compute_data old_internal_status status
+ with exn -> raise (Data_failure exn)
+
+ method undo ?(steps = 1) () =
+ let ((proof, goal), data) = history#undo steps in
+ _proof <- proof;
+ _goal <- goal;
+ _data <- data;
+ self#private_notify None
+
+ method redo ?(steps = 1) () = self#undo ~steps:~-steps ()
+
+ method notify = self#private_notify None
+
+ end
+
+let trivial_status ?uri ~typ ~body ~metasenv () =
+ new status ?uri ~typ ~body ~metasenv (fun _ -> ()) (fun _ _ -> ()) ()
+
diff --git a/helm/ocaml/tactics/statefulProofEngine.mli b/helm/ocaml/tactics/statefulProofEngine.mli
new file mode 100644
index 000000000..4198876ca
--- /dev/null
+++ b/helm/ocaml/tactics/statefulProofEngine.mli
@@ -0,0 +1,120 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** Stateful handling of proof status *)
+
+exception No_goal_left
+exception Uri_redefinition
+
+type event = [ `Proof_changed | `Proof_completed ]
+
+val all_events: event list
+
+ (** from our point of view a status is the status of an incomplete proof, thus
+ * we have an optional goal which is None if the proof is not yet completed
+ * (i.e. some goal is still open) *)
+type proof_status = ProofEngineTypes.proof * ProofEngineTypes.goal option
+
+ (** Proof observer. First callback argument is Some extended_status
+ * when a 'real 'change of the proof happened and None when Proof_changed event
+ * was triggered by a time travel by the means of undo/redo actions or by an
+ * external "#notify" invocation. Embedded status is the status _before_ the
+ * current change. Second status is the status reached _after_ the current
+ * change. *)
+type 'a observer = (proof_status * 'a) option -> (proof_status * 'a) -> unit
+
+ (** needed to detach previously attached observers *)
+type observer_id
+
+ (** tactic application failed. @see apply_tactic *)
+exception Tactic_failure of exn
+
+ (** one or more observers failed. @see apply_tactic *)
+exception Observer_failures of (observer_id * exn) list
+
+ (** failure while updating internal data (: 'a). @see apply_tactic *)
+exception Data_failure of exn
+
+(** {2 OO interface} *)
+
+class ['a] status:
+ ?history_size:int -> (** default 20 *)
+ ?uri:UriManager.uri ->
+ typ:Cic.term -> body:Cic.term -> metasenv:Cic.metasenv ->
+ (proof_status -> 'a) -> (* init data *)
+ (proof_status * 'a -> proof_status -> 'a) -> (* update data *)
+ unit ->
+ object
+
+ method proof: ProofEngineTypes.proof
+ method metasenv: Cic.metasenv
+ method body: Cic.term
+ method typ: Cic.term
+
+ (** change metasenv _without_ triggering any notification *)
+ method set_metasenv: Cic.metasenv -> unit
+
+ (** goal -> conjecture
+ * @raise CicUtil.Meta_not_found *)
+ method conjecture: int -> Cic.conjecture
+
+ method proof_completed: bool
+ method goal: int (** @raise No_goal_left *)
+ method set_goal: int -> unit (** @raise Data_failure *)
+
+ method uri: UriManager.uri option
+ method set_uri: UriManager.uri -> unit (** @raise Uri_redefinition *)
+
+ (** @raise Tactic_failure
+ * @raise Observer_failures
+ * @raise Data_failure
+ *
+ * In case of tactic failure, internal status is left unchanged.
+ * In case of observer failures internal status will be changed and is
+ * granted that all observer will be invoked collecting their failures.
+ * In case of data failure, internal status is left unchanged (rolling back
+ * last tactic application if needed)
+ *)
+ method apply_tactic: ProofEngineTypes.tactic -> unit
+
+ method undo: ?steps:int -> unit -> unit
+ method redo: ?steps:int -> unit -> unit
+
+ method attach_observer:
+ ?interested_in:(event list) -> 'a observer -> observer_id
+
+ method detach_observer: observer_id -> unit
+
+ (** force a notification to all observer, old status is passed as None *)
+ method notify: unit
+
+ end
+
+val trivial_status:
+ ?uri:UriManager.uri ->
+ typ:Cic.term -> body:Cic.term -> metasenv:Cic.metasenv ->
+ unit ->
+ unit status
+
diff --git a/helm/ocaml/tactics/tacticChaser.ml b/helm/ocaml/tactics/tacticChaser.ml
new file mode 100644
index 000000000..cb700f776
--- /dev/null
+++ b/helm/ocaml/tactics/tacticChaser.ml
@@ -0,0 +1,259 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(*****************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* Claudio Sacerdoti Coen <sacerdot@cs.unibo.it> *)
+(* 18/02/2003 *)
+(* *)
+(* *)
+(*****************************************************************************)
+
+(* $Id$ *)
+
+module MQI = MQueryInterpreter
+module MQIC = MQIConn
+module I = MQueryInterpreter
+module U = MQGUtil
+module G = MQueryGenerator
+
+ (* search arguments on which Apply tactic doesn't fail *)
+let matchConclusion mqi_handle ?(output_html = (fun _ -> ())) ~choose_must() status =
+ let ((_, metasenv, _, _), metano) = status in
+ let (_, ey ,ty) = CicUtil.lookup_meta metano metasenv in
+ let list_of_must, only = CGMatchConclusion.get_constraints metasenv ey ty in
+match list_of_must with
+ [] -> []
+|_ ->
+ let must = choose_must list_of_must only in
+ let result =
+ I.execute mqi_handle
+ (G.query_of_constraints
+ (Some CGMatchConclusion.universe)
+ (must,[],[]) (Some only,None,None)) in
+ let uris =
+ List.map
+ (function uri,_ ->
+ MQueryMisc.wrong_xpointer_format_from_wrong_xpointer_format' uri
+ ) result
+ in
+ let uris =
+ (* TODO ristretto per ragioni di efficienza *)
+ prerr_endline "STO FILTRANDO";
+ List.filter (fun uri -> Pcre.pmatch ~pat:"^cic:/Coq/" uri) uris
+ in
+ prerr_endline "HO FILTRATO";
+ let uris',exc =
+ let rec filter_out =
+ function
+ [] -> [],""
+ | uri::tl ->
+ let tl',exc = filter_out tl in
+ try
+ if
+ let time = Unix.gettimeofday() in
+ (try
+ ignore(ProofEngineTypes.apply_tactic
+ (PrimitiveTactics.apply_tac
+ ~term:(MQueryMisc.term_of_cic_textual_parser_uri
+ (MQueryMisc.cic_textual_parser_uri_of_string uri)))
+ status);
+ let time1 = Unix.gettimeofday() in
+ prerr_endline (Printf.sprintf "%1.3f" (time1 -. time) );
+ true
+ with ProofEngineTypes.Fail _ ->
+ let time1 = Unix.gettimeofday() in
+ prerr_endline (Printf.sprintf "%1.3f" (time1 -. time)); false)
+ then
+ uri::tl',exc
+ else
+ tl',exc
+ with
+ (ProofEngineTypes.Fail _) as e ->
+ let exc' =
+ "<h1 color=\"red\"> ^ Exception raised trying to apply " ^
+ uri ^ ": " ^ Printexc.to_string e ^ " </h1>" ^ exc
+ in
+ tl',exc'
+ in
+ filter_out uris
+ in
+ let html' =
+ " <h1>Objects that can actually be applied: </h1> " ^
+ String.concat "<br>" uris' ^ exc ^
+ " <h1>Number of false matches: " ^
+ string_of_int (List.length uris - List.length uris') ^ "</h1>" ^
+ " <h1>Number of good matches: " ^
+ string_of_int (List.length uris') ^ "</h1>"
+ in
+ output_html html' ;
+ uris'
+;;
+
+
+(*matchConclusion modificata per evitare una doppia apply*)
+let matchConclusion2 mqi_handle ?(output_html = (fun _ -> ())) ~choose_must() status =
+ let ((_, metasenv, _, _), metano) = status in
+ let (_, ey ,ty) = CicUtil.lookup_meta metano metasenv in
+ let conn =
+ match mqi_handle.MQIConn.pgc with
+ MQIConn.MySQL_C conn -> conn
+ | _ -> assert false in
+ let uris = Match_concl.cmatch conn ty in
+ (* List.iter
+ (fun (n,u) -> prerr_endline ((string_of_int n) ^ " " ^u)) uris; *)
+ (* delete all .var uris *)
+ let uris = List.filter UriManager.is_var uris in
+ (* delete all not "cic:/Coq" uris *)
+ (*
+ let uris =
+ (* TODO ristretto per ragioni di efficienza *)
+ List.filter (fun _,uri -> Pcre.pmatch ~pat:"^cic:/Coq/" uri) uris in
+ *)
+ (* concl_cost are the costants in the conclusion of the proof
+ while hyp_const are the constants in the hypothesis *)
+ let (main_concl,concl_const) = NewConstraints.mainandcons ty in
+ prerr_endline ("Ne sono rimasti" ^ string_of_int (List.length uris));
+ let hyp t set =
+ match t with
+ Some (_,Cic.Decl t) -> (NewConstraints.StringSet.union set (NewConstraints.constants_concl t))
+ | Some (_,Cic.Def (t,_)) -> (NewConstraints.StringSet.union set (NewConstraints.constants_concl t))
+ | _ -> set in
+ let hyp_const =
+ List.fold_right hyp ey NewConstraints.StringSet.empty in
+ prerr_endline (NewConstraints.pp_StringSet (NewConstraints.StringSet.union hyp_const concl_const));
+ (* uris with new constants in the proof are filtered *)
+ let all_const = NewConstraints.StringSet.union hyp_const concl_const in
+ let uris =
+ if (List.length uris < (Filter_auto.power 2 (List.length (NewConstraints.StringSet.elements all_const))))
+ then
+ (prerr_endline("metodo vecchio");List.filter (Filter_auto.filter_new_constants conn all_const) uris)
+ else Filter_auto.filter_uris conn all_const uris main_concl in
+(*
+ let uris =
+ (* ristretto all cache *)
+ prerr_endline "SOLO CACHE";
+ List.filter
+ (fun uri -> CicEnvironment.in_cache (UriManager.uri_of_string uri)) uris
+ in
+ prerr_endline "HO FILTRATO2";
+*)
+ let uris =
+ List.map
+ (fun (n,u) ->
+ (n,MQueryMisc.wrong_xpointer_format_from_wrong_xpointer_format' u))
+ uris in
+ let uris' =
+ let rec filter_out =
+ function
+ [] -> []
+ | (m,uri)::tl ->
+ let tl' = filter_out tl in
+ try
+ prerr_endline ("STO APPLICANDO " ^ uri);
+ let res = (m,
+ (ProofEngineTypes.apply_tactic( PrimitiveTactics.apply_tac
+ ~term:(MQueryMisc.term_of_cic_textual_parser_uri
+ (MQueryMisc.cic_textual_parser_uri_of_string uri)))
+ status))::tl' in
+ prerr_endline ("OK");res
+ (* with ProofEngineTypes.Fail _ -> tl' *)
+ (* patch to cover CSC's exportation bug *)
+ with _ -> prerr_endline ("FAIL");tl'
+ in
+ prerr_endline ("Ne sono rimasti 2 " ^ string_of_int (List.length uris));
+ filter_out uris
+ in
+ prerr_endline ("Ne sono rimasti 3 " ^ string_of_int (List.length uris'));
+
+ uris'
+;;
+
+(*funzione che sceglie il penultimo livello di profondita' dei must*)
+
+(*
+let choose_must list_of_must only=
+let n = (List.length list_of_must) - 1 in
+ List.nth list_of_must n
+;;*)
+
+(* questa prende solo il main *)
+let choose_must list_of_must only =
+ List.nth list_of_must 0
+
+(* livello 1
+let choose_must list_of_must only =
+ try
+ List.nth list_of_must 1
+ with _ ->
+ List.nth list_of_must 0 *)
+
+let searchTheorems mqi_handle (proof,goal) =
+ let subproofs =
+ matchConclusion2 mqi_handle ~choose_must() (proof, goal) in
+ let res =
+ List.sort
+ (fun (n1,(_,gl1)) (n2,(_,gl2)) ->
+ let l1 = List.length gl1 in
+ let l2 = List.length gl2 in
+ (* if the list of subgoals have the same lenght we use the
+ prefix tag, where higher tags have precedence *)
+ if l1 = l2 then n2 - n1
+ else l1 - l2)
+ subproofs
+ in
+ (* now we may drop the prefix tag *)
+ (*let res' =
+ List.map snd res in*)
+ let order_goal_list proof goal1 goal2 =
+ let _,metasenv,_,_ = proof in
+ let (_, ey1, ty1) = CicUtil.lookup_meta goal1 metasenv in
+ let (_, ey2, ty2) = CicUtil.lookup_meta goal2 metasenv in
+(*
+ prerr_endline "PRIMA DELLA PRIMA TYPE OF " ;
+*)
+ let ty_sort1,u = (*TASSI: FIXME *)
+ CicTypeChecker.type_of_aux' metasenv ey1 ty1 CicUniv.empty_ugraph in
+(*
+ prerr_endline (Printf.sprintf "PRIMA DELLA SECONDA TYPE OF %s \n### %s @@@%s " (CicMetaSubst.ppmetasenv metasenv []) (CicMetaSubst.ppcontext [] ey2) (CicMetaSubst.ppterm [] ty2));
+*)
+ let ty_sort2,u1 = CicTypeChecker.type_of_aux' metasenv ey2 ty2 u in
+(*
+ prerr_endline "DOPO LA SECONDA TYPE OF " ;
+*)
+ let b,u2 =
+ CicReduction.are_convertible ey1 (Cic.Sort Cic.Prop) ty_sort1 u1 in
+ let prop1 = if b then 0 else 1 in
+ let b,_ = CicReduction.are_convertible ey2 (Cic.Sort Cic.Prop) ty_sort2 u2 in
+ let prop2 = if b then 0 else 1 in
+ prop1 - prop2 in
+ List.map (
+ fun (level,(proof,goallist)) ->
+ (proof, (List.stable_sort (order_goal_list proof) goallist))
+ ) res
+;;
+
diff --git a/helm/ocaml/tactics/tacticals.ml b/helm/ocaml/tactics/tacticals.ml
new file mode 100644
index 000000000..a674fe313
--- /dev/null
+++ b/helm/ocaml/tactics/tacticals.ml
@@ -0,0 +1,351 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+(* open CicReduction
+open ProofEngineTypes
+open UriManager *)
+
+(** DEBUGGING *)
+
+ (** perform debugging output? *)
+let debug = false
+let debug_print = fun _ -> ()
+
+ (** debugging print *)
+let info s = debug_print (lazy ("TACTICALS INFO: " ^ (Lazy.force s)))
+
+let id_tac =
+ let id_tac (proof,goal) =
+ let _, metasenv, _, _ = proof in
+ let _, _, _ = CicUtil.lookup_meta goal metasenv in
+ (proof,[goal])
+ in
+ ProofEngineTypes.mk_tactic id_tac
+
+let fail_tac =
+ let fail_tac (proof,goal) =
+ let _, metasenv, _, _ = proof in
+ let _, _, _ = CicUtil.lookup_meta goal metasenv in
+ raise (ProofEngineTypes.Fail (lazy "fail tactical"))
+ in
+ ProofEngineTypes.mk_tactic fail_tac
+
+type goal = ProofEngineTypes.goal
+
+ (** TODO needed until tactics start returning both opened and closed goals
+ * First part of the function performs a diff among goals ~before tactic
+ * application and ~after it. Second part will add as both opened and closed
+ * the goals which are returned as opened by the tactic *)
+let goals_diff ~before ~after ~opened =
+ let sort_opened opened add =
+ opened @ (List.filter (fun g -> not (List.mem g opened)) add)
+ in
+ let remove =
+ List.fold_left
+ (fun remove e -> if List.mem e after then remove else e :: remove)
+ [] before
+ in
+ let add =
+ List.fold_left
+ (fun add e -> if List.mem e before then add else e :: add)
+ []
+ after
+ in
+ let add, remove = (* adds goals which have been both opened _and_ closed *)
+ List.fold_left
+ (fun (add, remove) opened_goal ->
+ if List.mem opened_goal before
+ then opened_goal :: add, opened_goal :: remove
+ else add, remove)
+ (add, remove)
+ opened
+ in
+ sort_opened opened add, remove
+
+module type T =
+sig
+ type tactic
+ val first: tactics: (string * tactic) list -> tactic
+ val thens: start: tactic -> continuations: tactic list -> tactic
+ val then_: start: tactic -> continuation: tactic -> tactic
+ val seq: tactics: tactic list -> tactic
+ val repeat_tactic: tactic: tactic -> tactic
+ val do_tactic: n: int -> tactic: tactic -> tactic
+ val try_tactic: tactic: tactic -> tactic
+ val solve_tactics: tactics: (string * tactic) list -> tactic
+
+ val tactic: tactic -> tactic
+ val skip: tactic
+ val dot: tactic
+ val semicolon: tactic
+ val branch: tactic
+ val shift: tactic
+ val pos: int -> tactic
+ val merge: tactic
+ val focus: int list -> tactic
+ val unfocus: tactic
+end
+
+module Make (S: Continuationals.Status) : T with type tactic = S.tactic =
+struct
+ module C = Continuationals.Make (S)
+
+ type tactic = S.tactic
+
+ let fold_eval status ts =
+ let istatus =
+ List.fold_left (fun istatus t -> S.focus ~-1 (C.eval t istatus)) status ts
+ in
+ S.inject istatus
+
+ (**
+ naive implementation of ORELSE tactical, try a sequence of tactics in turn:
+ if one fails pass to the next one and so on, eventually raises (failure "no
+ tactics left")
+ *)
+ let first ~tactics =
+ let rec first ~(tactics: (string * tactic) list) istatus =
+ info (lazy "in Tacticals.first");
+ match tactics with
+ | (descr, tac)::tactics ->
+ info (lazy ("Tacticals.first IS TRYING " ^ descr));
+ (try
+ let res = S.apply_tactic tac istatus in
+ info (lazy ("Tacticals.first: " ^ descr ^ " succedeed!!!"));
+ res
+ with
+ e ->
+ match e with
+ | (ProofEngineTypes.Fail _)
+ | (CicTypeChecker.TypeCheckerFailure _)
+ | (CicUnification.UnificationFailure _) ->
+ info (lazy (
+ "Tacticals.first failed with exn: " ^
+ Printexc.to_string e));
+ first ~tactics istatus
+ | _ -> raise e) (* [e] must not be caught ; let's re-raise it *)
+ | [] -> raise (ProofEngineTypes.Fail (lazy "first: no tactics left"))
+ in
+ S.mk_tactic (first ~tactics)
+
+ let thens ~start ~continuations =
+ S.mk_tactic
+ (fun istatus ->
+ fold_eval istatus
+ ([ C.Tactical (C.Tactic start); C.Branch ]
+ @ (HExtlib.list_concat ~sep:[ C.Shift ]
+ (List.map (fun t -> [ C.Tactical (C.Tactic t) ]) continuations))
+ @ [ C.Merge ]))
+
+ let then_ ~start ~continuation =
+ S.mk_tactic
+ (fun istatus ->
+ let ostatus = C.eval (C.Tactical (C.Tactic start)) istatus in
+ let opened,closed = S.goals ostatus in
+ match opened with
+ [] -> ostatus
+ | _ ->
+ fold_eval (S.focus ~-1 ostatus)
+ [ C.Semicolon;
+ C.Tactical (C.Tactic continuation) ])
+
+ let seq ~tactics =
+ S.mk_tactic
+ (fun istatus ->
+ fold_eval istatus
+ (HExtlib.list_concat ~sep:[ C.Semicolon ]
+ (List.map (fun t -> [ C.Tactical (C.Tactic t) ]) tactics)))
+
+ (* TODO: x debug: i due tatticali seguenti non contano quante volte hanno
+ * applicato la tattica *)
+
+ let rec step f output_status opened closed =
+ match opened with
+ | [] -> output_status, [], closed
+ | head :: tail ->
+ let status = S.focus head output_status in
+ let output_status' = f status in
+ let opened', closed' = S.goals output_status' in
+ let output_status'', opened'', closed'' =
+ step f output_status' tail []
+ in
+ output_status'', opened' @ opened'', closed' @ closed''
+
+ (* This keep on appling tactic until it fails. When <tactic> generates more
+ * than one goal, you have a tree of application on the tactic, repeat_tactic
+ * works in depth on this tree *)
+ let repeat_tactic ~tactic =
+ let rec repeat_tactic ~tactic status =
+ info (lazy "in repeat_tactic");
+ try
+ let output_status = S.apply_tactic tactic status in
+ let opened, closed = S.goals output_status in
+ let output_status, opened', closed' =
+ step (repeat_tactic ~tactic) output_status opened closed
+ in
+ S.set_goals (opened', closed') output_status
+ with
+ (ProofEngineTypes.Fail _) as e ->
+ info (lazy
+ ("Tacticals.repeat_tactic failed after nth time with exception: "
+ ^ Printexc.to_string e));
+ S.apply_tactic S.id_tactic status
+ in
+ S.mk_tactic (repeat_tactic ~tactic)
+
+ (* This tries to apply tactic n times *)
+ let do_tactic ~n ~tactic =
+ let rec do_tactic ~n ~tactic status =
+ if n = 0 then
+ S.apply_tactic S.id_tactic status
+ else
+ try
+ let output_status = S.apply_tactic tactic status in
+ let opened, closed = S.goals output_status in
+ let output_status, opened', closed' =
+ step (do_tactic ~n:(n-1) ~tactic) output_status opened closed
+ in
+ S.set_goals (opened', closed') output_status
+ with
+ (ProofEngineTypes.Fail _) as e ->
+ info (lazy
+ ("Tacticals.do_tactic failed after nth time with exception: "
+ ^ Printexc.to_string e)) ;
+ S.apply_tactic S.id_tactic status
+ in
+ S.mk_tactic (do_tactic ~n ~tactic)
+
+ (* This applies tactic and catches its possible failure *)
+ let try_tactic ~tactic =
+ let rec try_tactic ~tactic status =
+ info (lazy "in Tacticals.try_tactic");
+ try
+ S.apply_tactic tactic status
+ with
+ (ProofEngineTypes.Fail _) as e ->
+ info (lazy (
+ "Tacticals.try_tactic failed with exn: " ^ Printexc.to_string e));
+ S.apply_tactic S.id_tactic status
+ in
+ S.mk_tactic (try_tactic ~tactic)
+
+ (* This tries tactics until one of them doesn't _solve_ the goal *)
+ (* TODO: si puo' unificare le 2(due) chiamate ricorsive? *)
+ let solve_tactics ~tactics =
+ let rec solve_tactics ~(tactics: (string * tactic) list) status =
+ info (lazy "in Tacticals.solve_tactics");
+ match tactics with
+ | (descr, currenttactic)::moretactics ->
+ info (lazy ("Tacticals.solve_tactics is trying " ^ descr));
+ (try
+ let output_status = S.apply_tactic currenttactic status in
+ let opened, closed = S.goals output_status in
+ match opened with
+ | [] -> info (lazy ("Tacticals.solve_tactics: " ^ descr ^
+ " solved the goal!!!"));
+ (* questo significa che non ci sono piu' goal, o che current_tactic non ne ha
+ * aperti di nuovi? (la 2a!) ##### nel secondo caso basta per dire che
+ * solve_tactics has solved the goal? (si!) *)
+ output_status
+ | _ -> info (lazy ("Tacticals.solve_tactics: try the next tactic"));
+ solve_tactics ~tactics:(moretactics) status
+ with
+ (ProofEngineTypes.Fail _) as e ->
+ info (lazy (
+ "Tacticals.solve_tactics: current tactic failed with exn: "
+ ^ Printexc.to_string e));
+ solve_tactics ~tactics status
+ )
+ | [] ->
+ raise (ProofEngineTypes.Fail
+ (lazy "solve_tactics cannot solve the goal"))
+ in
+ S.mk_tactic (solve_tactics ~tactics)
+
+ let cont_proxy cont = S.mk_tactic (C.eval cont)
+
+ let tactic t = cont_proxy (C.Tactical (C.Tactic t))
+ let skip = cont_proxy (C.Tactical C.Skip)
+ let dot = cont_proxy C.Dot
+ let semicolon = cont_proxy C.Semicolon
+ let branch = cont_proxy C.Branch
+ let shift = cont_proxy C.Shift
+ let pos i = cont_proxy (C.Pos i)
+ let merge = cont_proxy C.Merge
+ let focus goals = cont_proxy (C.Focus goals)
+ let unfocus = cont_proxy C.Unfocus
+end
+
+module ProofEngineStatus =
+struct
+ module Stack = Continuationals.Stack
+
+ type input_status =
+ ProofEngineTypes.status (* (proof, goal) *) * Stack.t
+
+ type output_status =
+ (ProofEngineTypes.proof * goal list * goal list) * Stack.t
+
+ type tactic = ProofEngineTypes.tactic
+
+ let id_tactic = id_tac
+
+ let mk_tactic f =
+ ProofEngineTypes.mk_tactic
+ (fun (proof, goal) as pstatus ->
+ let stack = [ [ 1, Stack.Open goal ], [], [], `NoTag ] in
+ let istatus = pstatus, stack in
+(* let ostatus = f istatus in
+ let ((proof, opened, _), _) = ostatus in *)
+ let (proof, _, _), stack = f istatus in
+ let opened = Continuationals.Stack.open_goals stack in
+ proof, opened)
+
+ let apply_tactic tac ((proof, _) as pstatus, stack) =
+ let proof', opened = ProofEngineTypes.apply_tactic tac pstatus in
+(* let _ = prerr_endline ("goal aperti dalla tattica " ^ String.concat "," (List.map string_of_int opened)) in *)
+ let before = ProofEngineTypes.goals_of_proof proof in
+ let after = ProofEngineTypes.goals_of_proof proof' in
+ let opened_goals, closed_goals = goals_diff ~before ~after ~opened in
+(* let _ = prerr_endline ("goal ritornati dalla tattica " ^ String.concat "," (List.map string_of_int opened_goals)) in *)
+ (proof', opened_goals, closed_goals), stack
+
+ let goals ((_, opened, closed), _) = opened, closed
+ let set_goals (opened, closed) ((proof, _, _), stack) =
+ (proof, opened, closed), stack
+
+ let get_stack = snd
+ let set_stack stack (opstatus, _) = opstatus, stack
+
+ let inject ((proof, _), stack) = ((proof, [], []), stack)
+ let focus goal ((proof, _, _), stack) = (proof, goal), stack
+end
+
+module ProofEngineTacticals = Make (ProofEngineStatus)
+
+include ProofEngineTacticals
+
diff --git a/helm/ocaml/tactics/tacticals.mli b/helm/ocaml/tactics/tacticals.mli
new file mode 100644
index 000000000..88fafc1f8
--- /dev/null
+++ b/helm/ocaml/tactics/tacticals.mli
@@ -0,0 +1,92 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val id_tac : ProofEngineTypes.tactic
+val fail_tac: ProofEngineTypes.tactic
+
+(* module type Status =
+ sig
+|+ type external_input_status +|
+ type input_status
+ type output_status
+|+ type external_output_status +|
+
+|+ val internalize: external_input_status -> input_status
+ val externalize: output_status -> external_output_status +|
+
+ type tactic
+
+ val mk_tactic : (input_status -> output_status) -> tactic
+ val apply_tactic : tactic -> input_status -> output_status
+
+ val id_tac : tactic
+
+ val goals : output_status -> ProofEngineTypes.goal list
+ val get_stack : input_status -> stack
+ val set_stack : stack -> output_status -> output_status
+
+ val inject : input_status -> output_status
+ val focus : goal -> output_status -> input_status
+ end *)
+
+module type T =
+sig
+ type tactic
+
+ val first: tactics: (string * tactic) list -> tactic
+ val thens: start: tactic -> continuations: tactic list -> tactic
+ val then_: start: tactic -> continuation: tactic -> tactic
+ val seq: tactics: tactic list -> tactic (** "folding" of then_ *)
+ val repeat_tactic: tactic: tactic -> tactic
+ val do_tactic: n: int -> tactic: tactic -> tactic
+ val try_tactic: tactic: tactic -> tactic
+ val solve_tactics: tactics: (string * tactic) list -> tactic
+
+(* module C:
+ sig *)
+ val tactic: tactic -> tactic (** apply tactic to all goal in env *)
+ val skip: tactic
+ val dot: tactic
+ val semicolon: tactic
+ val branch: tactic
+ val shift: tactic
+ val pos: int -> tactic
+ val merge: tactic
+ val focus: int list -> tactic
+ val unfocus: tactic
+(* end *)
+end
+
+module Make (S: Continuationals.Status) : T with type tactic = S.tactic
+
+include T with type tactic = ProofEngineTypes.tactic
+
+(* TODO temporary *)
+val goals_diff:
+ before:ProofEngineTypes.goal list ->
+ after:ProofEngineTypes.goal list ->
+ opened:ProofEngineTypes.goal list ->
+ ProofEngineTypes.goal list * ProofEngineTypes.goal list
+
diff --git a/helm/ocaml/tactics/tactics.ml b/helm/ocaml/tactics/tactics.ml
new file mode 100644
index 000000000..170d6887f
--- /dev/null
+++ b/helm/ocaml/tactics/tactics.ml
@@ -0,0 +1,73 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+let absurd = NegationTactics.absurd_tac
+let apply = PrimitiveTactics.apply_tac
+let assumption = VariousTactics.assumption_tac
+let auto = AutoTactic.auto_tac
+let change = ReductionTactics.change_tac
+let clear = ProofEngineStructuralRules.clear
+let clearbody = ProofEngineStructuralRules.clearbody
+let compare = DiscriminationTactics.compare_tac
+let constructor = IntroductionTactics.constructor_tac
+let contradiction = NegationTactics.contradiction_tac
+let cut = PrimitiveTactics.cut_tac
+let decide_equality = DiscriminationTactics.decide_equality_tac
+let decompose = EliminationTactics.decompose_tac
+let discriminate = DiscriminationTactics.discriminate_tac
+let elim_intros = PrimitiveTactics.elim_intros_tac
+let elim_intros_simpl = PrimitiveTactics.elim_intros_simpl_tac
+let elim_type = EliminationTactics.elim_type_tac
+let exact = PrimitiveTactics.exact_tac
+let exists = IntroductionTactics.exists_tac
+let fail = Tacticals.fail_tac
+let fold = ReductionTactics.fold_tac
+let fourier = FourierR.fourier_tac
+let fwd_simpl = FwdSimplTactic.fwd_simpl_tac
+let generalize = VariousTactics.generalize_tac
+let id = Tacticals.id_tac
+let injection = DiscriminationTactics.injection_tac
+let intros = PrimitiveTactics.intros_tac
+let inversion = Inversion.inversion_tac
+let lapply = FwdSimplTactic.lapply_tac
+let left = IntroductionTactics.left_tac
+let letin = PrimitiveTactics.letin_tac
+let normalize = ReductionTactics.normalize_tac
+let reduce = ReductionTactics.reduce_tac
+let reflexivity = EqualityTactics.reflexivity_tac
+let replace = EqualityTactics.replace_tac
+let rewrite = EqualityTactics.rewrite_tac
+let rewrite_simpl = EqualityTactics.rewrite_simpl_tac
+let right = IntroductionTactics.right_tac
+let ring = Ring.ring_tac
+let set_goal = ProofEngineStructuralRules.set_goal
+let simpl = ReductionTactics.simpl_tac
+let split = IntroductionTactics.split_tac
+let symmetry = EqualityTactics.symmetry_tac
+let transitivity = EqualityTactics.transitivity_tac
+let unfold = ReductionTactics.unfold_tac
+let whd = ReductionTactics.whd_tac
diff --git a/helm/ocaml/tactics/tactics.mli b/helm/ocaml/tactics/tactics.mli
new file mode 100644
index 000000000..25e479b47
--- /dev/null
+++ b/helm/ocaml/tactics/tactics.mli
@@ -0,0 +1,90 @@
+(* GENERATED FILE, DO NOT EDIT *)
+val absurd : term:Cic.term -> ProofEngineTypes.tactic
+val apply : term:Cic.term -> ProofEngineTypes.tactic
+val assumption : ProofEngineTypes.tactic
+val auto :
+ ?depth:int ->
+ ?width:int ->
+ ?paramodulation:string ->
+ ?full:string -> dbd:HMysql.dbd -> unit -> ProofEngineTypes.tactic
+val change :
+ pattern:ProofEngineTypes.lazy_pattern ->
+ Cic.lazy_term -> ProofEngineTypes.tactic
+val clear : hyp:string -> ProofEngineTypes.tactic
+val clearbody : hyp:string -> ProofEngineTypes.tactic
+val compare : term:Cic.term -> ProofEngineTypes.tactic
+val constructor : n:int -> ProofEngineTypes.tactic
+val contradiction : ProofEngineTypes.tactic
+val cut :
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ Cic.term -> ProofEngineTypes.tactic
+val decide_equality : ProofEngineTypes.tactic
+val decompose :
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ ?user_types:(UriManager.uri * int) list ->
+ dbd:HMysql.dbd -> string -> ProofEngineTypes.tactic
+val discriminate : term:Cic.term -> ProofEngineTypes.tactic
+val elim_intros :
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ ?depth:int -> ?using:Cic.term -> Cic.term -> ProofEngineTypes.tactic
+val elim_intros_simpl :
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ ?depth:int -> ?using:Cic.term -> Cic.term -> ProofEngineTypes.tactic
+val elim_type :
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ ?depth:int -> ?using:Cic.term -> Cic.term -> ProofEngineTypes.tactic
+val exact : term:Cic.term -> ProofEngineTypes.tactic
+val exists : ProofEngineTypes.tactic
+val fail : ProofEngineTypes.tactic
+val fold :
+ reduction:ProofEngineTypes.lazy_reduction ->
+ term:Cic.lazy_term ->
+ pattern:ProofEngineTypes.lazy_pattern -> ProofEngineTypes.tactic
+val fourier : ProofEngineTypes.tactic
+val fwd_simpl :
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ dbd:HMysql.dbd -> string -> ProofEngineTypes.tactic
+val generalize :
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ ProofEngineTypes.lazy_pattern -> ProofEngineTypes.tactic
+val id : ProofEngineTypes.tactic
+val injection : term:Cic.term -> ProofEngineTypes.tactic
+val intros :
+ ?howmany:int ->
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ unit -> ProofEngineTypes.tactic
+val inversion : term:Cic.term -> ProofEngineTypes.tactic
+val lapply :
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ ?how_many:int ->
+ ?to_what:Cic.term list -> Cic.term -> ProofEngineTypes.tactic
+val left : ProofEngineTypes.tactic
+val letin :
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ Cic.term -> ProofEngineTypes.tactic
+val normalize :
+ pattern:ProofEngineTypes.lazy_pattern -> ProofEngineTypes.tactic
+val reduce : pattern:ProofEngineTypes.lazy_pattern -> ProofEngineTypes.tactic
+val reflexivity : ProofEngineTypes.tactic
+val replace :
+ pattern:ProofEngineTypes.lazy_pattern ->
+ with_what:Cic.lazy_term -> ProofEngineTypes.tactic
+val rewrite :
+ direction:[ `LeftToRight | `RightToLeft ] ->
+ pattern:ProofEngineTypes.lazy_pattern ->
+ Cic.term -> ProofEngineTypes.tactic
+val rewrite_simpl :
+ direction:[ `LeftToRight | `RightToLeft ] ->
+ pattern:ProofEngineTypes.lazy_pattern ->
+ Cic.term -> ProofEngineTypes.tactic
+val right : ProofEngineTypes.tactic
+val ring : ProofEngineTypes.tactic
+val set_goal : int -> ProofEngineTypes.tactic
+val simpl : pattern:ProofEngineTypes.lazy_pattern -> ProofEngineTypes.tactic
+val split : ProofEngineTypes.tactic
+val symmetry : ProofEngineTypes.tactic
+val transitivity : term:Cic.term -> ProofEngineTypes.tactic
+val unfold :
+ Cic.lazy_term option ->
+ pattern:ProofEngineTypes.lazy_pattern -> ProofEngineTypes.tactic
+val whd : pattern:ProofEngineTypes.lazy_pattern -> ProofEngineTypes.tactic
diff --git a/helm/ocaml/tactics/variousTactics.ml b/helm/ocaml/tactics/variousTactics.ml
new file mode 100644
index 000000000..fc6413eb5
--- /dev/null
+++ b/helm/ocaml/tactics/variousTactics.ml
@@ -0,0 +1,178 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+
+(* TODO se ce n'e' piu' di una, prende la prima che trova... sarebbe meglio
+chiedere: find dovrebbe restituire una lista di hyp (?) da passare all'utonto con una
+funzione di callback che restituisce la (sola) hyp da applicare *)
+
+let assumption_tac =
+ let module PET = ProofEngineTypes in
+ let assumption_tac status =
+ let (proof, goal) = status in
+ let module C = Cic in
+ let module R = CicReduction in
+ let module S = CicSubstitution in
+ let module PT = PrimitiveTactics in
+ let _,metasenv,_,_ = proof in
+ let _,context,ty = CicUtil.lookup_meta goal metasenv in
+ let rec find n = function
+ hd::tl ->
+ (match hd with
+ (Some (_, C.Decl t)) when
+ fst (R.are_convertible context (S.lift n t) ty
+ CicUniv.empty_ugraph) -> n
+ | (Some (_, C.Def (_,Some ty'))) when
+ fst (R.are_convertible context (S.lift n ty') ty
+ CicUniv.empty_ugraph) -> n
+ | (Some (_, C.Def (t,None))) ->
+ let ty_t, u = (* TASSI: FIXME *)
+ CicTypeChecker.type_of_aux' metasenv context (S.lift n t)
+ CicUniv.empty_ugraph in
+ let b,_ = R.are_convertible context ty_t ty u in
+ if b then n else find (n+1) tl
+ | _ -> find (n+1) tl
+ )
+ | [] -> raise (PET.Fail (lazy "Assumption: No such assumption"))
+ in PET.apply_tactic (PT.apply_tac ~term:(C.Rel (find 1 context))) status
+ in
+ PET.mk_tactic assumption_tac
+;;
+
+(* ANCORA DA DEBUGGARE *)
+
+exception UnableToDetectTheTermThatMustBeGeneralizedYouMustGiveItExplicitly;;
+exception TheSelectedTermsMustLiveInTheGoalContext
+exception AllSelectedTermsMustBeConvertible;;
+exception GeneralizationInHypothesesNotImplementedYet;;
+
+let generalize_tac
+ ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[])
+ pattern
+ =
+ let module PET = ProofEngineTypes in
+ let generalize_tac mk_fresh_name_callback
+ ~pattern:(term,hyps_pat,concl_pat) status
+ =
+ if hyps_pat <> [] then raise GeneralizationInHypothesesNotImplementedYet;
+ let (proof, goal) = status in
+ let module C = Cic in
+ let module P = PrimitiveTactics in
+ let module T = Tacticals in
+ let uri,metasenv,pbo,pty = proof in
+ let (_,context,ty) as conjecture = CicUtil.lookup_meta goal metasenv in
+ let subst,metasenv,u,selected_hyps,terms_with_context =
+ ProofEngineHelpers.select ~metasenv ~ugraph:CicUniv.empty_ugraph
+ ~conjecture ~pattern in
+ let context = CicMetaSubst.apply_subst_context subst context in
+ let metasenv = CicMetaSubst.apply_subst_metasenv subst metasenv in
+ let pbo = CicMetaSubst.apply_subst subst pbo in
+ let pty = CicMetaSubst.apply_subst subst pty in
+ let status = (uri,metasenv,pbo,pty),goal in
+ let term =
+ match term with
+ None -> None
+ | Some term ->
+ Some (fun context metasenv ugraph ->
+ let term, metasenv, ugraph = term context metasenv ugraph in
+ CicMetaSubst.apply_subst subst term, metasenv, ugraph)
+ in
+ let u,typ,term, metasenv =
+ let context_of_t, (t, metasenv, u) =
+ match terms_with_context, term with
+ [], None ->
+ raise
+ UnableToDetectTheTermThatMustBeGeneralizedYouMustGiveItExplicitly
+ | [], Some t -> context, t context metasenv u
+ | (context_of_t, _)::_, Some t ->
+ context_of_t, t context_of_t metasenv u
+ | (context_of_t, t)::_, None -> context_of_t, (t, metasenv, u)
+ in
+ let t,subst,metasenv' =
+ try
+ CicMetaSubst.delift_rels [] metasenv
+ (List.length context_of_t - List.length context) t
+ with
+ CicMetaSubst.DeliftingARelWouldCaptureAFreeVariable ->
+ raise TheSelectedTermsMustLiveInTheGoalContext in
+ (*CSC: I am not sure about the following two assertions;
+ maybe I need to propagate the new subst and metasenv *)
+ assert (subst = []);
+ assert (metasenv' = metasenv);
+ let typ,u = CicTypeChecker.type_of_aux' ~subst metasenv context t u in
+ u,typ,t,metasenv
+ in
+ (* We need to check:
+ 1. whether they live in the context of the goal;
+ if they do they are also well-typed since they are closed subterms
+ of a well-typed term in the well-typed context of the well-typed
+ term
+ 2. whether they are convertible
+ *)
+ ignore (
+ (* TASSI: FIXME *)
+ List.fold_left
+ (fun u (context_of_t,t) ->
+ (* 1 *)
+ let t,subst,metasenv' =
+ try
+ CicMetaSubst.delift_rels [] metasenv
+ (List.length context_of_t - List.length context) t
+ with
+ CicMetaSubst.DeliftingARelWouldCaptureAFreeVariable ->
+ raise TheSelectedTermsMustLiveInTheGoalContext in
+ (*CSC: I am not sure about the following two assertions;
+ maybe I need to propagate the new subst and metasenv *)
+ assert (subst = []);
+ assert (metasenv' = metasenv);
+ (* 2 *)
+ let b,u1 = CicReduction.are_convertible ~subst context term t u in
+ if not b then
+ raise AllSelectedTermsMustBeConvertible
+ else
+ u1
+ ) u terms_with_context) ;
+ PET.apply_tactic
+ (T.thens
+ ~start:
+ (P.cut_tac
+ (C.Prod(
+ (mk_fresh_name_callback metasenv context C.Anonymous ~typ:typ),
+ typ,
+ (ProofEngineReduction.replace_lifting_csc 1
+ ~equality:(==)
+ ~what:(List.map snd terms_with_context)
+ ~with_what:(List.map (function _ -> C.Rel 1) terms_with_context)
+ ~where:ty)
+ )))
+ ~continuations:
+ [(P.apply_tac ~term:(C.Appl [C.Rel 1; CicSubstitution.lift 1 term])) ;
+ T.id_tac])
+ status
+ in
+ PET.mk_tactic (generalize_tac mk_fresh_name_callback ~pattern)
+;;
diff --git a/helm/ocaml/tactics/variousTactics.mli b/helm/ocaml/tactics/variousTactics.mli
new file mode 100644
index 000000000..35576326e
--- /dev/null
+++ b/helm/ocaml/tactics/variousTactics.mli
@@ -0,0 +1,35 @@
+
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+exception AllSelectedTermsMustBeConvertible;;
+
+val assumption_tac: ProofEngineTypes.tactic
+
+val generalize_tac:
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+ ProofEngineTypes.lazy_pattern ->
+ ProofEngineTypes.tactic
+
diff --git a/helm/ocaml/thread/.depend b/helm/ocaml/thread/.depend
new file mode 100644
index 000000000..7759190c6
--- /dev/null
+++ b/helm/ocaml/thread/.depend
@@ -0,0 +1,4 @@
+threadSafe.cmo: threadSafe.cmi
+threadSafe.cmx: threadSafe.cmi
+extThread.cmo: extThread.cmi
+extThread.cmx: extThread.cmi
diff --git a/helm/ocaml/thread/Makefile b/helm/ocaml/thread/Makefile
new file mode 100644
index 000000000..24a96b6e9
--- /dev/null
+++ b/helm/ocaml/thread/Makefile
@@ -0,0 +1,27 @@
+
+PACKAGE = thread
+INTERFACE_FILES = threadSafe.mli extThread.mli
+IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml)
+
+all: thread_fake.cma
+opt: thread_fake.cmxa
+
+include ../Makefile.common
+
+fake/threadSafe.cmi: fake/threadSafe.mli
+ cd fake/ \
+ && ocamlfind ocamlc -c threadSafe.mli
+thread_fake.cma: fake/threadSafe.cmi
+ cd fake/ \
+ && ocamlfind ocamlc -a -o $@ threadSafe.ml \
+ && cp $@ ../
+thread_fake.cmxa: fake/threadSafe.cmi
+ cd fake/ \
+ && ocamlfind opt -a -o $@ threadSafe.ml \
+ && cp $@ ../
+
+clean: clean_fake
+clean_fake:
+ rm -f fake/*.cm[aiox] fake/*.cmxa fake/*.[ao]
+ rm -f thread_fake.cma thread_fake.cmxa
+
diff --git a/helm/ocaml/thread/extThread.ml b/helm/ocaml/thread/extThread.ml
new file mode 100644
index 000000000..d59cccd26
--- /dev/null
+++ b/helm/ocaml/thread/extThread.ml
@@ -0,0 +1,110 @@
+(*
+ * Copyright (C) 2003-2004:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let debug = true
+let debug_print s = if debug then prerr_endline (Lazy.force s)
+
+exception Can_t_kill of Thread.t * string (* thread, reason *)
+exception Thread_not_found of Thread.t
+
+module OrderedPid =
+ struct
+ type t = int
+ let compare = Pervasives.compare
+ end
+module PidSet = Set.Make (OrderedPid)
+
+ (* perform an action inside a critical section controlled by given mutex *)
+let do_critical mutex =
+ fun action ->
+ try
+ Mutex.lock mutex;
+ let res = Lazy.force action in
+ Mutex.unlock mutex;
+ res
+ with e -> Mutex.unlock mutex; raise e
+
+let kill_signal = Sys.sigusr2 (* signal used to kill children *)
+let chan = Event.new_channel () (* communication channel between threads *)
+let creation_mutex = Mutex.create ()
+let dead_threads_walking = ref PidSet.empty
+let pids: (Thread.t, int) Hashtbl.t = Hashtbl.create 17
+
+ (* given a thread body (i.e. first argument of a Thread.create invocation)
+ return a new thread body which unblock the kill signal and send its pid to
+ parent over "chan" *)
+let wrap_thread body =
+ fun arg ->
+ ignore (Unix.sigprocmask Unix.SIG_UNBLOCK [ kill_signal ]);
+ Event.sync (Event.send chan (Unix.getpid ()));
+ body arg
+
+(*
+(* FAKE IMPLEMENTATION *)
+let create = Thread.create
+let kill _ = ()
+*)
+
+let create body arg =
+ do_critical creation_mutex (lazy (
+ let thread_t = Thread.create (wrap_thread body) arg in
+ let pid = Event.sync (Event.receive chan) in
+ Hashtbl.add pids thread_t pid;
+ thread_t
+ ))
+
+let kill thread_t =
+ try
+ let pid =
+ try
+ Hashtbl.find pids thread_t
+ with Not_found -> raise (Thread_not_found thread_t)
+ in
+ dead_threads_walking := PidSet.add pid !dead_threads_walking;
+ Unix.kill pid kill_signal
+ with e -> raise (Can_t_kill (thread_t, Printexc.to_string e))
+
+ (* "kill_signal" handler, check if current process must die, if this is the
+ case exits with Thread.exit *)
+let _ =
+ ignore (Sys.signal kill_signal (Sys.Signal_handle
+ (fun signal ->
+ let myself = Unix.getpid () in
+ match signal with
+ | sg when (sg = kill_signal) &&
+ (PidSet.mem myself !dead_threads_walking) ->
+ dead_threads_walking := PidSet.remove myself !dead_threads_walking;
+ debug_print (lazy "AYEEEEH!");
+ Thread.exit ()
+ | _ -> ())))
+
+ (* block kill signal in main process *)
+let _ = ignore (Unix.sigprocmask Unix.SIG_BLOCK [ kill_signal ])
+
diff --git a/helm/ocaml/thread/extThread.mli b/helm/ocaml/thread/extThread.mli
new file mode 100644
index 000000000..5fb3bd487
--- /dev/null
+++ b/helm/ocaml/thread/extThread.mli
@@ -0,0 +1,35 @@
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** {2 Extended Thread module with killing capabilities} *)
+
+exception Can_t_kill of Thread.t * string
+
+val create: ('a -> 'b) -> 'a -> Thread.t
+val kill: Thread.t -> unit
+
diff --git a/helm/ocaml/thread/fake/threadSafe.ml b/helm/ocaml/thread/fake/threadSafe.ml
new file mode 100644
index 000000000..b2c427710
--- /dev/null
+++ b/helm/ocaml/thread/fake/threadSafe.ml
@@ -0,0 +1,35 @@
+(*
+ * Copyright (C) 2003-2005:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+class threadSafe =
+ object
+ method private doCritical: 'a. 'a lazy_t -> 'a = fun a -> Lazy.force a
+ method private doReader: 'a. 'a lazy_t -> 'a = fun a -> Lazy.force a
+ method private doWriter: 'a. 'a lazy_t -> 'a = fun a -> Lazy.force a
+ end
+
diff --git a/helm/ocaml/thread/fake/threadSafe.mli b/helm/ocaml/thread/fake/threadSafe.mli
new file mode 100644
index 000000000..78166abcc
--- /dev/null
+++ b/helm/ocaml/thread/fake/threadSafe.mli
@@ -0,0 +1,44 @@
+(*
+ * Copyright (C) 2003-2004:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+class threadSafe:
+ object
+
+ (** execute 'action' in mutual exclusion between all other threads *)
+ method private doCritical: 'a. 'a lazy_t -> 'a
+
+ (** execute 'action' acting as a 'reader' i.e.: multiple readers can act
+ at the same time but no writer can act until no readers are acting *)
+ method private doReader: 'a. 'a lazy_t -> 'a
+
+ (** execute 'action' acting as a 'writer' i.e.: when a writer is acting,
+ no readers or writer can act, beware that writers can starve *)
+ method private doWriter: 'a. 'a lazy_t -> 'a
+
+ end
+
diff --git a/helm/ocaml/thread/threadSafe.ml b/helm/ocaml/thread/threadSafe.ml
new file mode 100644
index 000000000..afe953370
--- /dev/null
+++ b/helm/ocaml/thread/threadSafe.ml
@@ -0,0 +1,100 @@
+(*
+ * Copyright (C) 2003-2004:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let debug = false
+let debug_print s = if debug then prerr_endline (Lazy.force s)
+
+class threadSafe =
+ object (self)
+
+ val mutex = Mutex.create ()
+
+ (** condition variable: 'no readers is currently reading' *)
+ val noReaders = Condition.create ()
+
+ (** readers count *)
+ val mutable readersCount = 0
+
+ method private incrReadersCount = (* internal, not exported *)
+ self#doCritical (lazy (
+ readersCount <- readersCount + 1
+ ))
+
+ method private decrReadersCount = (* internal, not exported *)
+ self#doCritical (lazy (
+ if readersCount > 0 then readersCount <- readersCount - 1;
+ ))
+
+ method private signalNoReaders = (* internal, not exported *)
+ self#doCritical (lazy (
+ if readersCount = 0 then Condition.signal noReaders
+ ))
+
+ method private doCritical: 'a. 'a lazy_t -> 'a =
+ fun action ->
+ debug_print (lazy "<doCritical>");
+ (try
+ Mutex.lock mutex;
+ let res = Lazy.force action in
+ Mutex.unlock mutex;
+ debug_print (lazy "</doCritical>");
+ res
+ with e ->
+ Mutex.unlock mutex;
+ raise e);
+
+ method private doReader: 'a. 'a lazy_t -> 'a =
+ fun action ->
+ debug_print (lazy "<doReader>");
+ let cleanup () =
+ self#decrReadersCount;
+ self#signalNoReaders
+ in
+ self#incrReadersCount;
+ let res = (try Lazy.force action with e -> (cleanup (); raise e)) in
+ cleanup ();
+ debug_print (lazy "</doReader>");
+ res
+
+ (* TODO may starve!!!! is what we want or not? *)
+ method private doWriter: 'a. 'a lazy_t -> 'a =
+ fun action ->
+ debug_print (lazy "<doWriter>");
+ self#doCritical (lazy (
+ while readersCount > 0 do
+ Condition.wait noReaders mutex
+ done;
+ let res = Lazy.force action in
+ debug_print (lazy "</doWriter>");
+ res
+ ))
+
+ end
+
diff --git a/helm/ocaml/thread/threadSafe.mli b/helm/ocaml/thread/threadSafe.mli
new file mode 100644
index 000000000..78166abcc
--- /dev/null
+++ b/helm/ocaml/thread/threadSafe.mli
@@ -0,0 +1,44 @@
+(*
+ * Copyright (C) 2003-2004:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+class threadSafe:
+ object
+
+ (** execute 'action' in mutual exclusion between all other threads *)
+ method private doCritical: 'a. 'a lazy_t -> 'a
+
+ (** execute 'action' acting as a 'reader' i.e.: multiple readers can act
+ at the same time but no writer can act until no readers are acting *)
+ method private doReader: 'a. 'a lazy_t -> 'a
+
+ (** execute 'action' acting as a 'writer' i.e.: when a writer is acting,
+ no readers or writer can act, beware that writers can starve *)
+ method private doWriter: 'a. 'a lazy_t -> 'a
+
+ end
+
diff --git a/helm/ocaml/urimanager/.depend b/helm/ocaml/urimanager/.depend
new file mode 100644
index 000000000..482148423
--- /dev/null
+++ b/helm/ocaml/urimanager/.depend
@@ -0,0 +1,2 @@
+uriManager.cmo: uriManager.cmi
+uriManager.cmx: uriManager.cmi
diff --git a/helm/ocaml/urimanager/Makefile b/helm/ocaml/urimanager/Makefile
new file mode 100644
index 000000000..afd7d4442
--- /dev/null
+++ b/helm/ocaml/urimanager/Makefile
@@ -0,0 +1,9 @@
+PACKAGE = urimanager
+PREDICATES =
+
+INTERFACE_FILES = uriManager.mli
+IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml)
+EXTRA_OBJECTS_TO_INSTALL =
+EXTRA_OBJECTS_TO_CLEAN =
+
+include ../Makefile.common
diff --git a/helm/ocaml/urimanager/uriManager.ml b/helm/ocaml/urimanager/uriManager.ml
new file mode 100644
index 000000000..9ff6a7966
--- /dev/null
+++ b/helm/ocaml/urimanager/uriManager.ml
@@ -0,0 +1,225 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+(*
+ * "cic:/a/b/c.con" => ("cic:/a/b/c.con", id )
+ * "cic:/a/b/c.ind#xpointer(1/1)" => ("cic:/a/b/c.con#xpointer(1/1)", id)
+ * "cic:/a/b/c.ind#xpointer(1/1/1)" => ("cic:/a/b/c.con#xpointer(1/1/1)", id)
+ *)
+
+let fresh_id =
+ let id = ref 0 in
+ function () ->
+ incr id;
+ !id
+
+(* (uriwithxpointer, uniqueid)
+ * where uniqueid is used to build a set of uri *)
+type uri = string * int;;
+
+let eq uri1 uri2 =
+ uri1 == uri2
+;;
+
+let string_of_uri (uri,_) =
+ uri
+
+let name_of_uri (uri, _) =
+ let xpointer_offset =
+ try String.rindex uri '#' with Not_found -> String.length uri - 1
+ in
+ let index1 = String.rindex_from uri xpointer_offset '/' + 1 in
+ let index2 = String.rindex uri '.' in
+ String.sub uri index1 (index2 - index1)
+
+let buri_of_uri (uri,_) =
+ let xpointer_offset =
+ try String.rindex uri '#' with Not_found -> String.length uri - 1
+ in
+ let index = String.rindex_from uri xpointer_offset '/' in
+ String.sub uri 0 index
+
+module OrderedStrings =
+ struct
+ type t = string
+ let compare (s1 : t) (s2 : t) = compare s1 s2
+ end
+;;
+
+module MapStringsToUri = Map.Make(OrderedStrings);;
+
+(* Invariant: the map is the identity function,
+ * i.e.
+ * let str' = (MapStringsToUri.find str !set_of_uri) in
+ * str' == (MapStringsToUri.find str' !set_of_uri)
+ *)
+let set_of_uri = ref MapStringsToUri.empty;;
+
+exception IllFormedUri of string;;
+
+let _dottypes = ".types"
+let _types = "types",5
+let _dotuniv = ".univ"
+let _univ = "univ",4
+let _dotann = ".ann"
+let _ann = "ann",3
+let _var = "var",3
+let _dotbody = ".body"
+let _con = "con",3
+let _ind = "ind",3
+let _xpointer = "#xpointer(1/"
+let _con3 = "con"
+let _var3 = "var"
+let _ind3 = "ind"
+let _ann3 = "ann"
+let _univ4 = "univ"
+let _types5 = "types"
+let _xpointer8 = "xpointer"
+let _cic5 = "cic:/"
+
+let is_malformed suri =
+ try
+ if String.sub suri 0 5 <> _cic5 then true
+ else
+ let len = String.length suri - 5 in
+ let last5 = String.sub suri len 5 in
+ let last4 = String.sub last5 1 4 in
+ let last3 = String.sub last5 2 3 in
+ if last3 = _con3 || last3 = _var3 || last3 = _ind3 ||
+ last3 = _ann3 || last5 = _types5 || last5 = _dotbody ||
+ last4 = _univ4 then
+ false
+ else
+ try
+ let index = String.rindex suri '#' + 1 in
+ let xptr = String.sub suri index 8 in
+ if xptr = _xpointer8 then
+ false
+ else
+ true
+ with Not_found -> true
+ with Invalid_argument _ -> true
+
+(* hash conses an uri *)
+let uri_of_string suri =
+ try
+ MapStringsToUri.find suri !set_of_uri
+ with Not_found ->
+ if is_malformed suri then
+ raise (IllFormedUri suri)
+ else
+ let new_uri = suri, fresh_id () in
+ set_of_uri := MapStringsToUri.add suri new_uri !set_of_uri;
+ new_uri
+
+
+let strip_xpointer ((uri,_) as olduri) =
+ try
+ let index = String.rindex uri '#' in
+ let no_xpointer = String.sub uri 0 index in
+ uri_of_string no_xpointer
+ with
+ Not_found -> olduri
+
+let clear_suffix uri ?(pat2="",0) pat1 =
+ try
+ let index = String.rindex uri '.' in
+ let index' = index + 1 in
+ let suffix = String.sub uri index' (String.length uri - index') in
+ if fst pat1 = suffix || fst pat2 = suffix then
+ String.sub uri 0 index
+ else
+ uri
+ with
+ Not_found -> assert false
+
+let has_suffix uri (pat,n) =
+ try
+ let suffix = String.sub uri (String.length uri - n) n in
+ pat = suffix
+ with
+ Not_found -> assert false
+
+
+let cicuri_of_uri (uri, _) = uri_of_string (clear_suffix uri ~pat2:_types _ann)
+
+let annuri_of_uri (uri , _) = uri_of_string ((clear_suffix uri _ann) ^ _dotann)
+
+let uri_is_annuri (uri, _) = has_suffix uri _ann
+
+let uri_is_var (uri, _) = has_suffix uri _var
+
+let uri_is_con (uri, _) = has_suffix uri _con
+
+let uri_is_ind (uri, _) = has_suffix uri _ind
+
+let bodyuri_of_uri (uri, _) =
+ if has_suffix uri _con then
+ Some (uri_of_string (uri ^ _dotbody))
+ else
+ None
+;;
+
+(* these are bugged!
+ * we should remove _types, _univ, _ann all toghether *)
+let innertypesuri_of_uri (uri, _) =
+ uri_of_string ((clear_suffix uri _types) ^ _dottypes)
+;;
+let univgraphuri_of_uri (uri,_) =
+ uri_of_string ((clear_suffix uri _univ) ^ _dotuniv)
+;;
+
+
+let uri_of_uriref (uri, _) typeno consno =
+ let typeno = typeno + 1 in
+ let suri =
+ match consno with
+ | None -> Printf.sprintf "%s%s%d)" uri _xpointer typeno
+ | Some n -> Printf.sprintf "%s%s%d/%d)" uri _xpointer typeno n
+ in
+ uri_of_string suri
+
+let compare (_,id1) (_,id2) = id1 - id2
+
+module OrderedUri =
+struct
+ type t = uri
+ let compare = compare (* the one above, not Pervasives.compare *)
+end
+
+module UriSet = Set.Make (OrderedUri)
+
+module HashedUri =
+struct
+ type t = uri
+ let equal = eq
+ let hash = snd
+end
+
+module UriHashtbl = Hashtbl.Make (HashedUri)
+
+
diff --git a/helm/ocaml/urimanager/uriManager.mli b/helm/ocaml/urimanager/uriManager.mli
new file mode 100644
index 000000000..8250cc839
--- /dev/null
+++ b/helm/ocaml/urimanager/uriManager.mli
@@ -0,0 +1,71 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+exception IllFormedUri of string;;
+
+type uri
+
+val eq : uri -> uri -> bool
+val compare : uri -> uri -> int
+
+val uri_of_string : string -> uri
+
+val string_of_uri : uri -> string (* complete uri *)
+val name_of_uri : uri -> string (* name only (without extension)*)
+val buri_of_uri : uri -> string (* base uri only, without trailing '/' *)
+
+(* given an uri, returns the uri of the corresponding cic file, *)
+(* i.e. removes the [.types][.ann] suffix *)
+val cicuri_of_uri : uri -> uri
+
+val strip_xpointer: uri -> uri (* remove trailing #xpointer..., if any *)
+
+(* given an uri, returns the uri of the corresponding annotation file, *)
+(* i.e. adds the .ann suffix if not already present *)
+val annuri_of_uri : uri -> uri
+
+val uri_is_annuri : uri -> bool
+val uri_is_var : uri -> bool
+val uri_is_con : uri -> bool
+val uri_is_ind : uri -> bool
+
+(* given an uri of a constant, it gives back the uri of its body *)
+(* it gives back None if the uri refers to a Variable or MutualInductiveType *)
+val bodyuri_of_uri : uri -> uri option
+
+(* given an uri, it gives back the uri of its inner types *)
+val innertypesuri_of_uri : uri -> uri
+(* given an uri, it gives back the uri of its univgraph *)
+val univgraphuri_of_uri : uri -> uri
+
+(* builder for MutInd and MutConstruct URIs
+ * [uri] -> [typeno] -> [consno option]
+ *)
+val uri_of_uriref : uri -> int -> int option -> uri
+
+module UriSet: Set.S with type elt = uri
+
+module UriHashtbl : Hashtbl.S with type key = uri
+
diff --git a/helm/ocaml/utf8_macros/.depend b/helm/ocaml/utf8_macros/.depend
new file mode 100644
index 000000000..f3c6a8bd1
--- /dev/null
+++ b/helm/ocaml/utf8_macros/.depend
@@ -0,0 +1,2 @@
+utf8Macro.cmo: utf8MacroTable.cmo utf8Macro.cmi
+utf8Macro.cmx: utf8MacroTable.cmx utf8Macro.cmi
diff --git a/helm/ocaml/utf8_macros/Makefile b/helm/ocaml/utf8_macros/Makefile
new file mode 100644
index 000000000..e3afd40f6
--- /dev/null
+++ b/helm/ocaml/utf8_macros/Makefile
@@ -0,0 +1,36 @@
+PACKAGE = utf8_macros
+PREDICATES =
+MAKE_TABLE_PACKAGES = helm-xml
+
+# modules which have both a .ml and a .mli
+INTERFACE_FILES = utf8Macro.mli
+IMPLEMENTATION_FILES = utf8MacroTable.ml $(INTERFACE_FILES:%.mli=%.ml)
+EXTRA_OBJECTS_TO_INSTALL =
+EXTRA_OBJECTS_TO_CLEAN =
+
+all: utf8_macros.cma pa_unicode_macro.cma
+
+make_table: make_table.ml
+ $(OCAMLFIND) ocamlc -package $(MAKE_TABLE_PACKAGES) -linkpkg -o $@ $^
+
+utf8MacroTable.ml:
+ ./make_table $@
+utf8MacroTable.cmo: utf8MacroTable.ml
+ $(OCAMLFIND) ocamlc -c $<
+
+pa_unicode_macro.cmo: pa_unicode_macro.ml utf8Macro.cmo
+ $(OCAMLFIND) ocamlc -package camlp4 -pp "camlp4o q_MLast.cmo pa_extend.cmo -loc loc" -c $<
+pa_unicode_macro.cma: utf8MacroTable.cmo utf8Macro.cmo pa_unicode_macro.cmo
+ $(OCAMLFIND) ocamlc -a -o $@ $^
+
+.PHONY: test
+test: test.ml
+ $(OCAMLFIND) ocamlc -package helm-utf8_macros -syntax camlp4o $< -o $@
+
+clean:
+distclean: extra_clean
+extra_clean:
+ rm -f make_table test
+
+include ../Makefile.common
+
diff --git a/helm/ocaml/utf8_macros/README.syntax b/helm/ocaml/utf8_macros/README.syntax
new file mode 100644
index 000000000..210ecc095
--- /dev/null
+++ b/helm/ocaml/utf8_macros/README.syntax
@@ -0,0 +1,15 @@
+
+Helm Utf8 macro syntax extension for Camlp4
+
+Sample file:
+
+ --- test.ml ---
+
+ prerr_endline <:unicode<lambda>>
+
+ ---------------
+
+Compile it with:
+
+ ocamlfind ocamlc -package helm-utf8_macros -syntax camlp4o test.ml
+
diff --git a/helm/ocaml/utf8_macros/data/dictionary-tex.xml b/helm/ocaml/utf8_macros/data/dictionary-tex.xml
new file mode 100644
index 000000000..47995454f
--- /dev/null
+++ b/helm/ocaml/utf8_macros/data/dictionary-tex.xml
@@ -0,0 +1,378 @@
+<?xml version="1.0"?>
+
+<!--
+ This file is part of EdiTeX, an editor of mathematical
+ expressions based on TeX syntax.
+
+ Copyright (C) 2002-2003 Luca Padovani <lpadovan@cs.unibo.it>,
+ 2003 Paolo Marinelli <pmarinel@cs.unibo.it>.
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library 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
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+ For more information, please visit the project's home page
+ http://helm.cs.unibo.it/editex/
+ or send an email to <lpadovan@cs.unibo.it>
+-->
+
+<dictionary name="TeX">
+
+ <include href="dictionary-basic.xml"/>
+
+ <!-- Greek Letters (lower case) -->
+
+ <entry name="alpha" class="i" val="α"/>
+ <entry name="beta" class="i" val="β"/>
+ <entry name="gamma" class="i" val="γ"/>
+ <entry name="delta" class="i" val="δ"/>
+ <entry name="epsilon" class="i" val="ϵ"/>
+ <entry name="varepsilon" class="i" val="ε"/>
+ <entry name="zeta" class="i" val="ζ"/>
+ <entry name="eta" class="i" val="η"/>
+ <entry name="theta" class="i" val="θ"/>
+ <entry name="vartheta" class="i" val="ϑ"/>
+ <entry name="iota" class="i" val="ι"/>
+ <entry name="kappa" class="i" val="κ"/>
+ <entry name="lambda" class="i" val="λ"/>
+ <entry name="mu" class="i" val="μ"/>
+ <entry name="nu" class="i" val="ν"/>
+ <entry name="xi" class="i" val="ξ"/>
+ <entry name="o" class="i" val="ο"/>
+ <entry name="pi" class="i" val="π"/>
+ <entry name="varpi" class="i" val="ϖ"/>
+ <entry name="rho" class="i" val="ρ"/>
+ <entry name="varrho" class="i" val="ϱ"/>
+ <entry name="sigma" class="i" val="σ"/>
+ <entry name="varsigma" class="i" val="ς"/>
+ <entry name="tau" class="i" val="τ"/>
+ <entry name="upsilon" class="i" val="υ"/>
+ <entry name="phi" class="i" val="ϕ"/>
+ <entry name="varphi" class="i" val="φ"/>
+ <entry name="chi" class="i" val="χ"/>
+ <entry name="psi" class="i" val="ψ"/>
+ <entry name="omega" class="i" val="ω"/>
+
+ <!-- Greek Letters (upper case) -->
+
+ <entry name="Gamma" class="i" val="Γ"/>
+ <entry name="Delta" class="i" val="Δ"/>
+ <entry name="Theta" class="i" val="Θ"/>
+ <entry name="Lambda" class="i" val="Λ"/>
+ <entry name="Xi" class="i" val="Ξ"/>
+ <entry name="Pi" class="i" val="Π"/>
+ <entry name="Sigma" class="i" val="Σ"/>
+ <entry name="Upsilon" class="i" val="ϒ"/>
+ <entry name="Phi" class="i" val="Φ"/>
+ <entry name="Psi" class="i" val="Ψ"/>
+ <entry name="Omega" class="i" val="Ω"/>
+
+ <!-- Symbols of Type Ord -->
+
+ <entry name="aleph" class="i" val="ℵ"/>
+ <entry name="hbar" class="i" val="ℏ︀"/>
+ <entry name="imath" class="i" val="ı"/>
+ <entry name="jmath" class="i" val="j︀"/>
+ <entry name="ell" class="i" val="ℓ"/>
+ <entry name="wp" class="i" val="℘"/>
+ <entry name="Re" class="o" val="ℜ"/>
+ <entry name="Im" class="o" val="ℑ"/>
+ <entry name="partial" class="o" val="∂"/>
+ <entry name="infty" class="i" val="∞"/>
+ <entry name="prime" class="o" val="′"/>
+ <entry name="emptyset" class="i" val="∅︀"/>
+ <entry name="nabla" class="o" val="∇"/>
+ <entry name="surd" class="o" val="????"/>
+ <entry name="top" class="i" val="⊤"/>
+ <entry name="bot" class="i" val="⊥"/>
+ <entry name="|" class="o" val="|" delimiter="1"/>
+ <entry name="angle" class="o" val="∠"/>
+ <entry name="triangle" class="o" val="▵"/>
+ <entry name="backslash" class="o" val="\"/>
+ <entry name="forall" class="o" val="∀"/>
+ <entry name="exists" class="o" val="∃"/>
+ <entry name="neg" class="o" val="¬"/>
+ <entry name="lnot" class="o" val="¬"/>
+ <entry name="flat" class="i" val="♭"/>
+ <entry name="natural" class="i" val="♮"/>
+ <entry name="sharp" class="i" val="♯"/>
+ <entry name="clubsuit" class="i" val="♣"/>
+ <entry name="diamondsuit" class="i" val="♢"/>
+ <entry name="heartsuit" class="i" val="♡"/>
+ <entry name="spadesuit" class="i" val="♠"/>
+
+ <!-- Large Operators -->
+
+ <entry name="sum" class="o" val="∑" limits="1"/>
+ <entry name="prod" class="o" val="∏" limits="1"/>
+ <entry name="coprod" class="o" val="∐" limits="1"/>
+ <entry name="int" class="o" val="∫" limits="1"/>
+ <entry name="oint" class="o" val="∮" limits="1"/>
+ <entry name="bigcap" class="o" val="⋂" limits="1"/>
+ <entry name="bigcup" class="o" val="⋃" limits="1"/>
+ <entry name="bigsqcup" class="o" val="⊔" limits="1"/>
+ <entry name="bigvee" class="o" val="⋁" limits="1"/>
+ <entry name="bigwedge" class="o" val="⋀" limits="1"/>
+ <entry name="bigodot" class="o" val="⊙" limits="1"/>
+ <entry name="bigotimes" class="o" val="⊗" limits="1"/>
+ <entry name="bigoplus" class="o" val="⊕" limits="1"/>
+ <entry name="biguplus" class="o" val="⊎" limits="1"/>
+
+ <!-- Binary Operations -->
+
+ <entry name="pm" class="o" val="±"/>
+ <entry name="mp" class="o" val="∓"/>
+ <entry name="setminus" class="o" val="∖"/>
+ <entry name="cdot" class="o" val="ċ"/>
+ <entry name="times" class="o" val="×"/>
+ <entry name="ast" class="o" val="*"/>
+ <entry name="star" class="o" val="⋆"/>
+ <entry name="diamond" class="o" val="⋄"/>
+ <entry name="circ" class="o" val="^"/>
+ <entry name="bullet" class="o" val="•"/>
+ <entry name="div" class="o" val="÷"/>
+ <entry name="cap" class="o" val="∩"/>
+ <entry name="cup" class="o" val="∪"/>
+ <entry name="uplus" class="o" val="⊎"/>
+ <entry name="sqcap" class="o" val="⊓"/>
+ <entry name="sqcup" class="o" val="⊔"/>
+ <entry name="triangleleft" class="o" val="◃"/>
+ <entry name="triangleright" class="o" val="▹"/>
+ <entry name="wr" class="o" val="≀"/>
+ <entry name="bigcirc" class="o" val="◯"/>
+ <entry name="bigtriangleup" class="o" val="△"/>
+ <entry name="bigtriangledown" class="o" val="▽"/>
+ <entry name="vee" class="o" val="∨"/>
+ <entry name="lor" class="o" val="∨"/>
+ <entry name="wedge" class="o" val="∧"/>
+ <entry name="land" class="o" val="∧"/>
+ <entry name="oplus" class="o" val="⊕"/>
+ <entry name="ominus" class="o" val="⊖"/>
+ <entry name="otimes" class="o" val="⊗"/>
+ <entry name="oslash" class="o" val="ø"/>
+ <entry name="odot" class="o" val="⊙"/>
+ <entry name="dagger" class="o" val="†"/>
+ <entry name="ddagger" class="o" val="‡"/>
+ <entry name="amalg" class="o" val="⨿"/>
+
+ <!-- Relations -->
+
+ <entry name="leq" class="o" val="≤"/>
+ <entry name="le" class="o" val="≤"/>
+ <entry name="prec" class="o" val="≺"/>
+ <entry name="preceq" class="o" val="⪯"/>
+ <entry name="ll" class="o" val="≪"/>
+ <entry name="subset" class="o" val="⊂"/>
+ <entry name="subseteq" class="o" val="⊆"/>
+ <entry name="in" class="o" val="∈"/>
+ <entry name="vdash" class="o" val="⊢"/>
+ <entry name="smile" class="o" val="⌣"/>
+ <entry name="frown" class="o" val="⌢"/>
+ <entry name="propto" class="o" val="∝"/>
+ <entry name="geq" class="o" val="≥"/>
+ <entry name="ge" class="o" val="≥"/>
+ <entry name="succ" class="o" val="≻"/>
+ <entry name="succeq" class="o" val="≽"/>
+ <entry name="gg" class="o" val="≫"/>
+ <entry name="supset" class="o" val="⊃"/>
+ <entry name="supseteq" class="o" val="⊇"/>
+ <entry name="sqsupseteq" class="o" val="⊒"/>
+ <entry name="notin" class="o" val="∉"/>
+ <entry name="dashv" class="o" val="⊣"/>
+ <entry name="mid" class="o" val="∣"/>
+ <entry name="parallet" class="o" val="????"/>
+ <entry name="equiv" class="o" val="≡"/>
+ <entry name="sim" class="o" val="∼"/>
+ <entry name="simeq" class="o" val="≃"/>
+ <entry name="asymp" class="o" val="≍"/>
+ <entry name="approx" class="o" val="≈"/>
+ <entry name="cong" class="o" val="≅"/>
+ <entry name="bowtie" class="o" val="⋈"/>
+ <entry name="ni" class="o" val="∋"/>
+ <entry name="owns" class="o" val="∋"/>
+ <entry name="models" class="o" val="⊧"/>
+ <entry name="doteq" class="o" val="≐"/>
+ <entry name="perp" class="o" val="⊥"/>
+
+ <entry name="not" pattern="#1" embellishment="1"/>
+ <entry name="ne" class="o" val="≠"/>
+
+ <!-- Arrows -->
+
+ <entry name="leftarrow" class="o" val="←"/>
+ <entry name="gets" class="o" val="←"/>
+ <entry name="Leftarrow" class="o" val="⇐"/>
+ <entry name="rightarrow" class="o" val="→"/>
+ <entry name="to" class="o" val="→"/>
+ <entry name="Rightarrow" class="o" val="⇒"/>
+ <entry name="leftrightarrow" class="o" val="↔"/>
+ <entry name="Leftrightarrow" class="o" val="⇔"/>
+ <entry name="mapsto" class="o" val="↦"/>
+ <entry name="hookleftarrow" class="o" val="↩"/>
+ <entry name="uparrow" class="o" val="↑"/>
+ <entry name="downarrow" class="o" val="↓"/>
+ <entry name="updownarrow" class="o" val="↕"/>
+ <entry name="nearrow" class="o" val="↗"/>
+ <entry name="nwarrow" class="o" val="↖"/>
+ <entry name="longleftarrow" class="o" val="????;"/>
+ <entry name="Longleftarrow" class="o" val="????"/>
+ <entry name="longrightarrow" class="o" val="????"/>
+ <entry name="Longrightarrow" class="o" val="⇒"/>
+ <entry name="longleftrightarrow" class="o" val="????"/>
+ <entry name="Longleftrightarrow" class="o" val="????"/>
+ <entry name="longmapsto" class="o" val="????"/>
+ <entry name="hookrightarrow" class="o" val="↪"/>
+ <entry name="Uparrow" class="o" val="⇑"/>
+ <entry name="Downarrow" class="o" val="⇓"/>
+ <entry name="searrow" class="o" val="↘"/>
+ <entry name="swarrow" class="o" val="↙"/>
+
+ <entry name="buildrel" pattern="#1\over#2" embellishment="1"/>
+
+ <!-- Delimiters -->
+
+ <entry name="lbrack" class="o" val="[" delimiter="1"/>
+ <entry name="rbrack" class="o" val="]" delimiter="1"/>
+ <entry name="vert" class="o" val="|" delimiter="1"/>
+ <entry name="Vert" class="o" val="‖" delimiter="1"/>
+ <entry name="lbrace" class="o" val="{" delimiter="1"/>
+ <entry name="{" class="o" val="{" delimiter="1"/>
+ <entry name="rbrace" class="o" val="}" delimiter="1"/>
+ <entry name="}" class="o" val="}" delimiter="1"/>
+ <entry name="lfloor" class="o" val="⌊" delimiter="1"/>
+ <entry name="rfloor" class="o" val="⌋" delimiter="1"/>
+ <entry name="langle" class="o" val="〈" delimiter="1"/>
+ <entry name="rangle" class="o" val="〉" delimiter="1"/>
+ <entry name="lceil" class="o" val="⌈" delimiter="1"/>
+ <entry name="rceil" class="o" val="⌉" delimiter="1"/>
+
+ <entry name="left" pattern="#1" embellishment="1" delimiter="1"/>
+ <entry name="right" pattern="#1" embellishment="1" delimiter="1"/>
+ <entry name="bigl" pattern="#1" embellishment="1" delimiter="1"/>
+ <entry name="bigr" pattern="#1" embellishment="1" delimiter="1"/>
+ <entry name="bigm" pattern="#1" embellishment="1" delimiter="1"/>
+ <entry name="big" pattern="#1" embellishment="1" delimiter="1"/>
+ <entry name="Bigl" pattern="#1" embellishment="1" delimiter="1"/>
+ <entry name="Bigr" pattern="#1" embellishment="1" delimiter="1"/>
+ <entry name="Bigm" pattern="#1" embellishment="1" delimiter="1"/>
+ <entry name="biggl" pattern="#1" embellishment="1" delimiter="1"/>
+ <entry name="biggr" pattern="#1" embellishment="1" delimiter="1"/>
+ <entry name="biggm" pattern="#1" embellishment="1" delimiter="1"/>
+ <entry name="Biggl" pattern="#1" embellishment="1" delimiter="1"/>
+ <entry name="Biggr" pattern="#1" embellishment="1" delimiter="1"/>
+ <entry name="Biggm" pattern="#1" embellishment="1" delimiter="1"/>
+
+ <!-- Accents -->
+
+ <entry name="hat" pattern="#1" embellishment="1"/>
+ <entry name="widehat" pattern="#1" embellishment="1"/>
+ <entry name="check" pattern="#1" embellishment="1"/>
+ <entry name="tilde" pattern="#1" embellishment="1"/>
+ <entry name="widetilde" pattern="#1" embellishment="1"/>
+ <entry name="acute" pattern="#1" embellishment="1"/>
+ <entry name="grave" pattern="#1" embellishment="1"/>
+ <entry name="dot" pattern="#1" embellishment="1"/>
+ <entry name="ddot" pattern="#1" embellishment="1"/>
+ <entry name="breve" pattern="#1" embellishment="1"/>
+ <entry name="bar" pattern="#1" embellishment="1"/>
+ <entry name="vec" pattern="#1" embellishment="1"/>
+
+ <!-- Elementary Math Control Sequences -->
+
+ <entry name="overline" pattern="#1"/>
+ <entry name="underline" pattern="#1"/>
+ <entry name="sqrt" pattern="#1"/>
+ <entry name="root" pattern="#1\of#2"/>
+ <entry name="over" pattern="{}"/>
+ <entry name="atop" pattern="{}"/>
+ <entry name="choose" pattern="{}"/>
+ <entry name="brace" pattern="{}"/>
+ <entry name="brack" pattern="{}"/>
+
+ <!-- Style -->
+
+ <entry name="displaystyle" pattern="}"/>
+ <entry name="textstyle" pattern="}"/>
+ <entry name="scriptstyle" pattern="}"/>
+ <entry name="scriptscriptstyle" pattern="}"/>
+
+ <!-- Non-Italic Function Names -->
+
+ <entry name="arccos" class="i" val="arccos"/>
+ <entry name="arcsin" class="i" val="arcsin"/>
+ <entry name="arctan" class="i" val="arctan"/>
+ <entry name="arg" class="i" val="arg"/>
+ <entry name="cos" class="i" val="cos"/>
+ <entry name="cosh" class="i" val="cosh"/>
+ <entry name="cot" class="i" val="cot"/>
+ <entry name="coth" class="i" val="coth"/>
+ <entry name="csc" class="i" val="csc"/>
+ <entry name="exp" class="i" val="exp"/>
+ <entry name="deg" class="i" val="deg"/>
+ <entry name="det" class="o" val="det" limits="1"/>
+ <entry name="dim" class="i" val="dim"/>
+ <entry name="gcd" class="o" val="gcd" limits="1"/>
+ <entry name="hom" class="i" val="hom"/>
+ <entry name="inf" class="o" val="inf" limits="1"/>
+ <entry name="ker" class="i" val="ker"/>
+ <entry name="lg" class="i" val="lg"/>
+ <entry name="lim" class="o" val="lim" limits="1"/>
+ <entry name="liminf" class="o" val="liminf" limits="1"/>
+ <entry name="limsup" class="o" val="limsup" limits="1"/>
+ <entry name="ln" class="i" val="ln"/>
+ <entry name="log" class="i" val="log"/>
+ <entry name="max" class="o" val="max" limits="1"/>
+ <entry name="min" class="o" val="max" limits="1"/>
+ <entry name="Pr" class="o" val="Pr" limits="1"/>
+ <entry name="sec" class="i" val="sec"/>
+ <entry name="sin" class="i" val="sin"/>
+ <entry name="sinh" class="i" val="sinh"/>
+ <entry name="sup" class="o" limits="1"/>
+ <entry name="tan" class="i" val="tan"/>
+ <entry name="tanh" class="i" val="tanh"/>
+ <entry name="pmod" pattern="#1"/>
+ <entry name="bmod" class="o" val="mod"/>
+
+ <!-- Ellipses -->
+
+ <entry name="dots" class="i" val="…"/>
+ <entry name="ldots" class="i" val="…"/>
+ <entry name="cdots" class="i" val="⋯"/>
+ <entry name="vdots" class="i" val="⋮"/>
+ <entry name="ddots" class="i" val="⋱"/>
+
+ <!-- Fonts -->
+
+ <entry name="rm" pattern="}"/>
+ <entry name="bf" pattern="}"/>
+ <entry name="tt" pattern="}"/>
+ <entry name="sl" pattern="}"/>
+ <entry name="it" pattern="}"/>
+
+ <!-- Horizontal Spacing -->
+
+ <entry name=","/>
+ <entry name=">"/>
+ <entry name=";"/>
+ <entry name="!"/>
+
+ <!-- Braces and Matrices -->
+
+ <entry name="matrix" pattern="#1" table="1"/>
+ <entry name="pmatrix" pattern="#1" table="1"/>
+ <entry name="bordermatrix" pattern="#1" table="1"/>
+ <entry name="overbrace" pattern="#1" limits="1"/>
+ <entry name="underbrace" pattern="#1" limits="1"/>
+ <entry name="cases" pattern="#1" table="1"/>
+
+</dictionary>
diff --git a/helm/ocaml/utf8_macros/data/entities-table.xml b/helm/ocaml/utf8_macros/data/entities-table.xml
new file mode 100644
index 000000000..c283631b4
--- /dev/null
+++ b/helm/ocaml/utf8_macros/data/entities-table.xml
@@ -0,0 +1,2079 @@
+<?xml version="1.0"?>
+
+<entities-table>
+ <entity name="aacute" value="á"/>
+ <entity name="Aacute" value="Á"/>
+ <entity name="abreve" value="ă"/>
+ <entity name="Abreve" value="Ă"/>
+ <entity name="ac" value="⤏"/>
+ <entity name="acd" value="∿"/>
+ <entity name="acE" value="⧛"/>
+ <entity name="acirc" value="â"/>
+ <entity name="Acirc" value="Â"/>
+ <entity name="acute" value="´"/>
+ <entity name="acy" value="а"/>
+ <entity name="Acy" value="А"/>
+ <entity name="aelig" value="æ"/>
+ <entity name="AElig" value="Æ"/>
+ <entity name="af" value="⁡"/>
+ <entity name="afr" value="𝔞"/>
+ <entity name="Afr" value="𝔄"/>
+ <entity name="agrave" value="à"/>
+ <entity name="Agrave" value="À"/>
+ <entity name="aleph" value="ℵ"/>
+ <entity name="alpha" value="α"/>
+ <entity name="amacr" value="ā"/>
+ <entity name="Amacr" value="Ā"/>
+ <entity name="amalg" value="⨿"/>
+ <entity name="amp" value="&"/>
+ <entity name="and" value="∧"/>
+ <entity name="And" value="⩓"/>
+ <entity name="andand" value="⩕"/>
+ <entity name="andd" value="⩜"/>
+ <entity name="andslope" value="⩘"/>
+ <entity name="andv" value="⩚"/>
+ <entity name="ang" value="∠"/>
+ <entity name="ange" value="⦤"/>
+ <entity name="angle" value="∠"/>
+ <entity name="angmsd" value="∡"/>
+ <entity name="angmsdaa" value="⦨"/>
+ <entity name="angmsdab" value="⦩"/>
+ <entity name="angmsdac" value="⦪"/>
+ <entity name="angmsdad" value="⦫"/>
+ <entity name="angmsdae" value="⦬"/>
+ <entity name="angmsdaf" value="⦭"/>
+ <entity name="angmsdag" value="⦮"/>
+ <entity name="angmsdah" value="⦯"/>
+ <entity name="angrt" value="∟"/>
+ <entity name="angrtvb" value="⦝︀"/>
+ <entity name="angrtvbd" value="⦝"/>
+ <entity name="angsph" value="∢"/>
+ <entity name="angst" value="Å"/>
+ <entity name="angzarr" value="⍼"/>
+ <entity name="aogon" value="ą"/>
+ <entity name="Aogon" value="Ą"/>
+ <entity name="aopf" value="𝕒"/>
+ <entity name="Aopf" value="𝔸"/>
+ <entity name="ap" value="≈"/>
+ <entity name="apacir" value="⩯"/>
+ <entity name="ape" value="≊"/>
+ <entity name="apE" value="≊"/>
+ <entity name="apid" value="≋"/>
+ <entity name="apos" value="'"/>
+ <entity name="ApplyFunction" value="⁡"/>
+ <entity name="approx" value="≈"/>
+ <entity name="approxeq" value="≊"/>
+ <entity name="aring" value="å"/>
+ <entity name="Aring" value="Å"/>
+ <entity name="ascr" value="𝒶"/>
+ <entity name="Ascr" value="𝒜"/>
+ <entity name="Assign" value="≔"/>
+ <entity name="ast" value="*"/>
+ <entity name="asymp" value="≍"/>
+ <entity name="atilde" value="ã"/>
+ <entity name="Atilde" value="Ã"/>
+ <entity name="auml" value="ä"/>
+ <entity name="Auml" value="Ä"/>
+ <entity name="awconint" value="∳"/>
+ <entity name="awint" value="⨑"/>
+ <entity name="backcong" value="≌"/>
+ <entity name="backepsilon" value="϶"/>
+ <entity name="backprime" value="‵"/>
+ <entity name="backsim" value="∽"/>
+ <entity name="backsimeq" value="⋍"/>
+ <entity name="Backslash" value="∖"/>
+ <entity name="Barv" value="⫧"/>
+ <entity name="barvee" value="⊽"/>
+ <entity name="barwed" value="⊼"/>
+ <entity name="Barwed" value="⌆"/>
+ <entity name="barwedge" value="⊼"/>
+ <entity name="bbrk" value="⎵"/>
+ <entity name="bcong" value="≌"/>
+ <entity name="bcy" value="б"/>
+ <entity name="Bcy" value="Б"/>
+ <entity name="becaus" value="∵"/>
+ <entity name="because" value="∵"/>
+ <entity name="Because" value="∵"/>
+ <entity name="bemptyv" value="⦰"/>
+ <entity name="bepsi" value="϶"/>
+ <entity name="bernou" value="ℬ"/>
+ <entity name="Bernoullis" value="ℬ"/>
+ <entity name="beta" value="β"/>
+ <entity name="beth" value="ℶ"/>
+ <entity name="between" value="≬"/>
+ <entity name="bfr" value="𝔟"/>
+ <entity name="Bfr" value="𝔅"/>
+ <entity name="bigcap" value="⋂"/>
+ <entity name="bigcirc" value="◯"/>
+ <entity name="bigcup" value="⋃"/>
+ <entity name="bigodot" value="⊙"/>
+ <entity name="bigoplus" value="⊕"/>
+ <entity name="bigotimes" value="⊗"/>
+ <entity name="bigsqcup" value="⊔"/>
+ <entity name="bigstar" value="★"/>
+ <entity name="bigtriangledown" value="▽"/>
+ <entity name="bigtriangleup" value="△"/>
+ <entity name="biguplus" value="⊎"/>
+ <entity name="bigvee" value="⋁"/>
+ <entity name="bigwedge" value="⋀"/>
+ <entity name="bkarow" value="⤍"/>
+ <entity name="blacklozenge" value="⧫"/>
+ <entity name="blacksquare" value="▪"/>
+ <entity name="blacktriangle" value="▴"/>
+ <entity name="blacktriangledown" value="▾"/>
+ <entity name="blacktriangleleft" value="◂"/>
+ <entity name="blacktriangleright" value="▸"/>
+ <entity name="blank" value="␣"/>
+ <entity name="blk12" value="▒"/>
+ <entity name="blk14" value="░"/>
+ <entity name="blk34" value="▓"/>
+ <entity name="block" value="█"/>
+ <entity name="bne" value="=⃥"/>
+ <entity name="bnequiv" value="≡⃥"/>
+ <entity name="bnot" value="⌐"/>
+ <entity name="bNot" value="⫭"/>
+ <entity name="bopf" value="𝕓"/>
+ <entity name="Bopf" value="𝔹"/>
+ <entity name="bot" value="⊥"/>
+ <entity name="bottom" value="⊥"/>
+ <entity name="bowtie" value="⋈"/>
+ <entity name="boxbox" value="⧉"/>
+ <entity name="boxdl" value="┐"/>
+ <entity name="boxdL" value="╕"/>
+ <entity name="boxDl" value="╖"/>
+ <entity name="boxDL" value="╗"/>
+ <entity name="boxdr" value="┌"/>
+ <entity name="boxdR" value="╒"/>
+ <entity name="boxDr" value="╓"/>
+ <entity name="boxDR" value="╔"/>
+ <entity name="boxh" value="─"/>
+ <entity name="boxH" value="═"/>
+ <entity name="boxhd" value="┬"/>
+ <entity name="boxhD" value="╥"/>
+ <entity name="boxHd" value="╤"/>
+ <entity name="boxHD" value="╦"/>
+ <entity name="boxhu" value="┴"/>
+ <entity name="boxhU" value="╨"/>
+ <entity name="boxHu" value="╧"/>
+ <entity name="boxHU" value="╩"/>
+ <entity name="boxminus" value="⊟"/>
+ <entity name="boxplus" value="⊞"/>
+ <entity name="boxtimes" value="⊠"/>
+ <entity name="boxul" value="┘"/>
+ <entity name="boxuL" value="╛"/>
+ <entity name="boxUl" value="╜"/>
+ <entity name="boxUL" value="╝"/>
+ <entity name="boxur" value="└"/>
+ <entity name="boxuR" value="╘"/>
+ <entity name="boxUr" value="╙"/>
+ <entity name="boxUR" value="╚"/>
+ <entity name="boxv" value="│"/>
+ <entity name="boxV" value="║"/>
+ <entity name="boxvh" value="┼"/>
+ <entity name="boxvH" value="╪"/>
+ <entity name="boxVh" value="╫"/>
+ <entity name="boxVH" value="╬"/>
+ <entity name="boxvl" value="┤"/>
+ <entity name="boxvL" value="╡"/>
+ <entity name="boxVl" value="╢"/>
+ <entity name="boxVL" value="╣"/>
+ <entity name="boxvr" value="├"/>
+ <entity name="boxvR" value="╞"/>
+ <entity name="boxVr" value="╟"/>
+ <entity name="boxVR" value="╠"/>
+ <entity name="bprime" value="‵"/>
+ <entity name="breve" value="˘"/>
+ <entity name="Breve" value="˘"/>
+ <entity name="brvbar" value="¦"/>
+ <entity name="bscr" value="𝒷"/>
+ <entity name="Bscr" value="ℬ"/>
+ <entity name="bsemi" value="⁏"/>
+ <entity name="bsim" value="∽"/>
+ <entity name="bsime" value="⋍"/>
+ <entity name="bsol" value="\"/>
+ <entity name="bsolb" value="⧅"/>
+ <entity name="bsolhsub" value="\⊂"/>
+ <entity name="bull" value="•"/>
+ <entity name="bullet" value="•"/>
+ <entity name="bump" value="≎"/>
+ <entity name="bumpe" value="≏"/>
+ <entity name="bumpE" value="⪮"/>
+ <entity name="bumpeq" value="≏"/>
+ <entity name="Bumpeq" value="≎"/>
+ <entity name="cacute" value="ć"/>
+ <entity name="Cacute" value="Ć"/>
+ <entity name="cap" value="∩"/>
+ <entity name="Cap" value="⋒"/>
+ <entity name="capand" value="⩄"/>
+ <entity name="capbrcup" value="⩉"/>
+ <entity name="capcap" value="⩋"/>
+ <entity name="capcup" value="⩇"/>
+ <entity name="capdot" value="⩀"/>
+ <entity name="CapitalDifferentialD" value="ⅅ"/>
+ <entity name="caps" value="∩︀"/>
+ <entity name="caret" value="⁁"/>
+ <entity name="caron" value="ˇ"/>
+ <entity name="Cayleys" value="ℭ"/>
+ <entity name="ccaps" value="⩍"/>
+ <entity name="ccaron" value="č"/>
+ <entity name="Ccaron" value="Č"/>
+ <entity name="ccedil" value="ç"/>
+ <entity name="Ccedil" value="Ç"/>
+ <entity name="ccirc" value="ĉ"/>
+ <entity name="Ccirc" value="Ĉ"/>
+ <entity name="Cconint" value="∰"/>
+ <entity name="ccups" value="⩌"/>
+ <entity name="ccupssm" value="⩐"/>
+ <entity name="cdot" value="ċ"/>
+ <entity name="Cdot" value="Ċ"/>
+ <entity name="cedil" value="¸"/>
+ <entity name="Cedilla" value="¸"/>
+ <entity name="cemptyv" value="⦲"/>
+ <entity name="cent" value="¢"/>
+ <entity name="centerdot" value="·"/>
+ <entity name="CenterDot" value="·"/>
+ <entity name="cfr" value="𝔠"/>
+ <entity name="Cfr" value="ℭ"/>
+ <entity name="chcy" value="ч"/>
+ <entity name="CHcy" value="Ч"/>
+ <entity name="check" value="✓"/>
+ <entity name="checkmark" value="✓"/>
+ <entity name="chi" value="χ"/>
+ <entity name="cir" value="○"/>
+ <entity name="circ" value="^"/>
+ <entity name="circeq" value="≗"/>
+ <entity name="circlearrowleft" value="↺"/>
+ <entity name="circlearrowright" value="↻"/>
+ <entity name="circledast" value="⊛"/>
+ <entity name="circledcirc" value="⊚"/>
+ <entity name="circleddash" value="⊝"/>
+ <entity name="CircleDot" value="⊙"/>
+ <entity name="circledR" value="®"/>
+ <entity name="circledS" value="Ⓢ"/>
+ <entity name="CircleMinus" value="⊖"/>
+ <entity name="CirclePlus" value="⊕"/>
+ <entity name="CircleTimes" value="⊗"/>
+ <entity name="cire" value="≗"/>
+ <entity name="cirE" value="⧃"/>
+ <entity name="cirfnint" value="⨐"/>
+ <entity name="cirmid" value="⫯"/>
+ <entity name="cirscir" value="⧂"/>
+ <entity name="ClockwiseContourIntegral" value="∲"/>
+ <entity name="CloseCurlyDoubleQuote" value="”"/>
+ <entity name="CloseCurlyQuote" value="’"/>
+ <entity name="clubs" value="♣"/>
+ <entity name="clubsuit" value="♣"/>
+ <entity name="colon" value=":"/>
+ <entity name="Colon" value="∷"/>
+ <entity name="colone" value="≔"/>
+ <entity name="Colone" value="⩴"/>
+ <entity name="coloneq" value="≔"/>
+ <entity name="comma" value=","/>
+ <entity name="commat" value="@"/>
+ <entity name="comp" value="∁"/>
+ <entity name="compfn" value="∘"/>
+ <entity name="complement" value="∁"/>
+ <entity name="complexes" value="ℂ"/>
+ <entity name="cong" value="≅"/>
+ <entity name="congdot" value="⩭"/>
+ <entity name="Congruent" value="≡"/>
+ <entity name="conint" value="∮"/>
+ <entity name="Conint" value="∯"/>
+ <entity name="ContourIntegral" value="∮"/>
+ <entity name="copf" value="𝕔"/>
+ <entity name="Copf" value="ℂ"/>
+ <entity name="coprod" value="∐"/>
+ <entity name="Coproduct" value="∐"/>
+ <entity name="copy" value="©"/>
+ <entity name="copysr" value="℗"/>
+ <entity name="CounterClockwiseContourIntegral" value="∳"/>
+ <entity name="cross" value="✗"/>
+ <entity name="Cross" value="⨯"/>
+ <entity name="cscr" value="𝒸"/>
+ <entity name="Cscr" value="𝒞"/>
+ <entity name="csub" value="⫏"/>
+ <entity name="csube" value="⫑"/>
+ <entity name="csup" value="⫐"/>
+ <entity name="csupe" value="⫒"/>
+ <entity name="ctdot" value="⋯"/>
+ <entity name="cudarrl" value="⤸"/>
+ <entity name="cudarrr" value="⤵"/>
+ <entity name="cuepr" value="⋞"/>
+ <entity name="cuesc" value="⋟"/>
+ <entity name="cularr" value="↶"/>
+ <entity name="cularrp" value="⤽"/>
+ <entity name="cup" value="∪"/>
+ <entity name="Cup" value="⋓"/>
+ <entity name="cupbrcap" value="⩈"/>
+ <entity name="cupcap" value="⩆"/>
+ <entity name="CupCap" value="≍"/>
+ <entity name="cupcup" value="⩊"/>
+ <entity name="cupdot" value="⊍"/>
+ <entity name="cupor" value="⩅"/>
+ <entity name="cups" value="∪︀"/>
+ <entity name="curarr" value="↷"/>
+ <entity name="curarrm" value="⤼"/>
+ <entity name="curlyeqprec" value="⋞"/>
+ <entity name="curlyeqsucc" value="⋟"/>
+ <entity name="curlyvee" value="⋎"/>
+ <entity name="curlywedge" value="⋏"/>
+ <entity name="curren" value="¤"/>
+ <entity name="curvearrowleft" value="↶"/>
+ <entity name="curvearrowright" value="↷"/>
+ <entity name="cuvee" value="⋎"/>
+ <entity name="cuwed" value="⋏"/>
+ <entity name="cwconint" value="∲"/>
+ <entity name="cwint" value="∱"/>
+ <entity name="cylcty" value="⌭"/>
+ <entity name="dagger" value="†"/>
+ <entity name="dagger" value="†"/>
+ <entity name="Dagger" value="‡"/>
+ <entity name="Dagger" value="‡"/>
+ <entity name="daleth" value="ℸ"/>
+ <entity name="darr" value="↓"/>
+ <entity name="dArr" value="⇓"/>
+ <entity name="Darr" value="↡"/>
+ <entity name="dash" value="‐"/>
+ <entity name="dashv" value="⊣"/>
+ <entity name="Dashv" value="⫤"/>
+ <entity name="dbkarow" value="⤏"/>
+ <entity name="dblac" value="˝"/>
+ <entity name="dcaron" value="ď"/>
+ <entity name="Dcaron" value="Ď"/>
+ <entity name="dcy" value="д"/>
+ <entity name="Dcy" value="Д"/>
+ <entity name="dd" value="ⅆ"/>
+ <entity name="DD" value="ⅅ"/>
+ <entity name="ddagger" value="‡"/>
+ <entity name="ddarr" value="⇊"/>
+ <entity name="DDotrahd" value="⤑"/>
+ <entity name="ddotseq" value="⩷"/>
+ <entity name="deg" value="°"/>
+ <entity name="Del" value="∇"/>
+ <entity name="delta" value="δ"/>
+ <entity name="Delta" value="Δ"/>
+ <entity name="demptyv" value="⦱"/>
+ <entity name="dfisht" value="⥿"/>
+ <entity name="dfr" value="𝔡"/>
+ <entity name="Dfr" value="𝔇"/>
+ <entity name="dHar" value="⥥"/>
+ <entity name="dharl" value="⇃"/>
+ <entity name="dharr" value="⇂"/>
+ <entity name="DiacriticalAcute" value="´"/>
+ <entity name="DiacriticalDot" value="˙"/>
+ <entity name="DiacriticalDoubleAcute" value="˝"/>
+ <entity name="DiacriticalGrave" value="`"/>
+ <entity name="DiacriticalTilde" value="˜"/>
+ <entity name="diam" value="⋄"/>
+ <entity name="diamond" value="⋄"/>
+ <entity name="Diamond" value="⋄"/>
+ <entity name="diamondsuit" value="♦"/>
+ <entity name="diams" value="♦"/>
+ <entity name="die" value="¨"/>
+ <entity name="DifferentialD" value="ⅆ"/>
+ <entity name="digamma" value="Ϝ"/>
+ <entity name="disin" value="⋲"/>
+ <entity name="div" value="÷"/>
+ <entity name="divide" value="÷"/>
+ <entity name="divideontimes" value="⋇"/>
+ <entity name="divonx" value="⋇"/>
+ <entity name="djcy" value="ђ"/>
+ <entity name="DJcy" value="Ђ"/>
+ <entity name="dlcorn" value="⌞"/>
+ <entity name="dlcrop" value="⌍"/>
+ <entity name="dollar" value="$"/>
+ <entity name="dopf" value="𝕕"/>
+ <entity name="Dopf" value="𝔻"/>
+ <entity name="dot" value="˙"/>
+ <entity name="Dot" value="¨"/>
+ <entity name="DotDot" value="⃜"/>
+ <entity name="doteq" value="≐"/>
+ <entity name="doteqdot" value="≑"/>
+ <entity name="DotEqual" value="≐"/>
+ <entity name="dotminus" value="∸"/>
+ <entity name="dotplus" value="∔"/>
+ <entity name="dotsquare" value="⊡"/>
+ <entity name="doublebarwedge" value="⌆"/>
+ <entity name="DoubleContourIntegral" value="∯"/>
+ <entity name="DoubleDot" value="¨"/>
+ <entity name="DoubleDownArrow" value="⇓"/>
+ <entity name="DoubleLeftArrow" value="⇐"/>
+ <entity name="DoubleLeftRightArrow" value="⇔"/>
+ <entity name="DoubleLeftTee" value="⫤"/>
+ <entity name="DoubleLongLeftArrow" value=""/>
+ <entity name="DoubleLongLeftRightArrow" value=""/>
+ <entity name="DoubleLongRightArrow" value=""/>
+ <entity name="DoubleRightArrow" value="⇒"/>
+ <entity name="DoubleRightTee" value="⊨"/>
+ <entity name="DoubleUpArrow" value="⇑"/>
+ <entity name="DoubleUpDownArrow" value="⇕"/>
+ <entity name="DoubleVerticalBar" value="∥"/>
+ <entity name="downarrow" value="↓"/>
+ <entity name="Downarrow" value="⇓"/>
+ <entity name="DownArrow" value="↓"/>
+ <entity name="DownArrowBar" value="⤓"/>
+ <entity name="DownArrowUpArrow" value="⇵"/>
+ <entity name="DownBreve" value="̑"/>
+ <entity name="downdownarrows" value="⇊"/>
+ <entity name="downharpoonleft" value="⇃"/>
+ <entity name="downharpoonright" value="⇂"/>
+ <entity name="DownLeftRightVector" value="⥐"/>
+ <entity name="DownLeftTeeVector" value="⥞"/>
+ <entity name="DownLeftVector" value="↽"/>
+ <entity name="DownLeftVectorBar" value="⥖"/>
+ <entity name="DownRightTeeVector" value="⥟"/>
+ <entity name="DownRightVector" value="⇁"/>
+ <entity name="DownRightVectorBar" value="⥗"/>
+ <entity name="DownTee" value="⊤"/>
+ <entity name="DownTeeArrow" value="↧"/>
+ <entity name="drbkarow" value="⤐"/>
+ <entity name="drcorn" value="⌟"/>
+ <entity name="drcrop" value="⌌"/>
+ <entity name="dscr" value="𝒹"/>
+ <entity name="Dscr" value="𝒟"/>
+ <entity name="dscy" value="ѕ"/>
+ <entity name="DScy" value="Ѕ"/>
+ <entity name="dsol" value="⧶"/>
+ <entity name="dstrok" value="đ"/>
+ <entity name="Dstrok" value="Đ"/>
+ <entity name="dtdot" value="⋱"/>
+ <entity name="dtri" value="▿"/>
+ <entity name="dtrif" value="▾"/>
+ <entity name="duarr" value="⇵"/>
+ <entity name="duhar" value="⥯"/>
+ <entity name="dwangle" value="⦦"/>
+ <entity name="dzcy" value="џ"/>
+ <entity name="DZcy" value="Џ"/>
+ <entity name="dzigrarr" value=""/>
+ <entity name="eacute" value="é"/>
+ <entity name="Eacute" value="É"/>
+ <entity name="easter" value="≛"/>
+ <entity name="ecaron" value="ě"/>
+ <entity name="Ecaron" value="Ě"/>
+ <entity name="ecir" value="≖"/>
+ <entity name="ecirc" value="ê"/>
+ <entity name="Ecirc" value="Ê"/>
+ <entity name="ecolon" value="≕"/>
+ <entity name="ecy" value="э"/>
+ <entity name="Ecy" value="Э"/>
+ <entity name="eDDot" value="⩷"/>
+ <entity name="edot" value="ė"/>
+ <entity name="eDot" value="≑"/>
+ <entity name="Edot" value="Ė"/>
+ <entity name="ee" value="ⅇ"/>
+ <entity name="efDot" value="≒"/>
+ <entity name="efr" value="𝔢"/>
+ <entity name="Efr" value="𝔈"/>
+ <entity name="eg" value="⪚"/>
+ <entity name="egrave" value="è"/>
+ <entity name="Egrave" value="È"/>
+ <entity name="egs" value="⋝"/>
+ <entity name="egsdot" value="⪘"/>
+ <entity name="el" value="⪙"/>
+ <entity name="Element" value="∈"/>
+ <entity name="ell" value="ℓ"/>
+ <entity name="els" value="⋜"/>
+ <entity name="elsdot" value="⪗"/>
+ <entity name="emacr" value="ē"/>
+ <entity name="Emacr" value="Ē"/>
+ <entity name="empty" value="∅︀"/>
+ <entity name="emptyset" value="∅︀"/>
+ <entity name="EmptySmallSquare" value="◽"/>
+ <entity name="emptyv" value="∅"/>
+ <entity name="EmptyVerySmallSquare" value=""/>
+ <entity name="emsp" value=" "/>
+ <entity name="emsp13" value=" "/>
+ <entity name="emsp14" value=" "/>
+ <entity name="eng" value="ŋ"/>
+ <entity name="ENG" value="Ŋ"/>
+ <entity name="ensp" value=" "/>
+ <entity name="eogon" value="ę"/>
+ <entity name="Eogon" value="Ę"/>
+ <entity name="eopf" value="𝕖"/>
+ <entity name="Eopf" value="𝔼"/>
+ <entity name="epar" value="⋕"/>
+ <entity name="eparsl" value="⧣"/>
+ <entity name="eplus" value="⩱"/>
+ <entity name="epsi" value="ε"/>
+ <entity name="epsiv" value="ɛ"/>
+ <entity name="eqcirc" value="≖"/>
+ <entity name="eqcolon" value="≕"/>
+ <entity name="eqsim" value="≂"/>
+ <entity name="eqslantgtr" value="⋝"/>
+ <entity name="eqslantless" value="⋜"/>
+ <entity name="Equal" value="⩵"/>
+ <entity name="equals" value="="/>
+ <entity name="EqualTilde" value="≂"/>
+ <entity name="equest" value="≟"/>
+ <entity name="Equilibrium" value="⇌"/>
+ <entity name="equiv" value="≡"/>
+ <entity name="equivDD" value="⩸"/>
+ <entity name="eqvparsl" value="⧥"/>
+ <entity name="erarr" value="⥱"/>
+ <entity name="erDot" value="≓"/>
+ <entity name="escr" value="ℯ"/>
+ <entity name="Escr" value="ℰ"/>
+ <entity name="esdot" value="≐"/>
+ <entity name="esim" value="≂"/>
+ <entity name="Esim" value="⩳"/>
+ <entity name="eta" value="η"/>
+ <entity name="eth" value="ð"/>
+ <entity name="ETH" value="Ð"/>
+ <entity name="euml" value="ë"/>
+ <entity name="Euml" value="Ë"/>
+ <entity name="excl" value="!"/>
+ <entity name="exist" value="∃"/>
+ <entity name="Exists" value="∃"/>
+ <entity name="expectation" value="ℰ"/>
+ <entity name="exponentiale" value="ⅇ"/>
+ <entity name="ExponentialE" value="ⅇ"/>
+ <entity name="fallingdotseq" value="≒"/>
+ <entity name="fcy" value="ф"/>
+ <entity name="Fcy" value="Ф"/>
+ <entity name="female" value="♀"/>
+ <entity name="ffilig" value="ffi"/>
+ <entity name="fflig" value="ff"/>
+ <entity name="ffllig" value="ffl"/>
+ <entity name="ffr" value="𝔣"/>
+ <entity name="Ffr" value="𝔉"/>
+ <entity name="filig" value="fi"/>
+ <entity name="FilledSmallSquare" value="◾"/>
+ <entity name="FilledVerySmallSquare" value=""/>
+ <entity name="flat" value="♭"/>
+ <entity name="fllig" value="fl"/>
+ <entity name="fnof" value="ƒ"/>
+ <entity name="fopf" value="𝕗"/>
+ <entity name="Fopf" value="𝔽"/>
+ <entity name="forall" value="∀"/>
+ <entity name="ForAll" value="∀"/>
+ <entity name="fork" value="⋔"/>
+ <entity name="forkv" value="⫙"/>
+ <entity name="Fouriertrf" value="ℱ"/>
+ <entity name="fpartint" value="⨍"/>
+ <entity name="frac12" value="½"/>
+ <entity name="frac13" value="⅓"/>
+ <entity name="frac14" value="¼"/>
+ <entity name="frac15" value="⅕"/>
+ <entity name="frac16" value="⅙"/>
+ <entity name="frac18" value="⅛"/>
+ <entity name="frac23" value="⅔"/>
+ <entity name="frac25" value="⅖"/>
+ <entity name="frac34" value="¾"/>
+ <entity name="frac35" value="⅗"/>
+ <entity name="frac38" value="⅜"/>
+ <entity name="frac45" value="⅘"/>
+ <entity name="frac56" value="⅚"/>
+ <entity name="frac58" value="⅝"/>
+ <entity name="frac78" value="⅞"/>
+ <entity name="frown" value="⌢"/>
+ <entity name="fscr" value="𝒻"/>
+ <entity name="Fscr" value="ℱ"/>
+ <entity name="gacute" value="ǵ"/>
+ <entity name="gamma" value="γ"/>
+ <entity name="Gamma" value="Γ"/>
+ <entity name="gammad" value="Ϝ"/>
+ <entity name="Gammad" value="Ϝ"/>
+ <entity name="gap" value="≳"/>
+ <entity name="gbreve" value="ğ"/>
+ <entity name="Gbreve" value="Ğ"/>
+ <entity name="Gcedil" value="Ģ"/>
+ <entity name="gcirc" value="ĝ"/>
+ <entity name="Gcirc" value="Ĝ"/>
+ <entity name="gcy" value="г"/>
+ <entity name="Gcy" value="Г"/>
+ <entity name="gdot" value="ġ"/>
+ <entity name="Gdot" value="Ġ"/>
+ <entity name="ge" value="≥"/>
+ <entity name="gE" value="≧"/>
+ <entity name="gel" value="⋛"/>
+ <entity name="gEl" value="⋛"/>
+ <entity name="geq" value="≥"/>
+ <entity name="geqq" value="≧"/>
+ <entity name="geqslant" value="⩾"/>
+ <entity name="ges" value="⩾"/>
+ <entity name="gescc" value="⪩"/>
+ <entity name="gesdot" value="⪀"/>
+ <entity name="gesdoto" value="⪂"/>
+ <entity name="gesdotol" value="⪄"/>
+ <entity name="gesl" value="⋛︀"/>
+ <entity name="gesles" value="⪔"/>
+ <entity name="gfr" value="𝔤"/>
+ <entity name="Gfr" value="𝔊"/>
+ <entity name="gg" value="≫"/>
+ <entity name="Gg" value="⋙"/>
+ <entity name="ggg" value="⋙"/>
+ <entity name="gimel" value="ℷ"/>
+ <entity name="gjcy" value="ѓ"/>
+ <entity name="GJcy" value="Ѓ"/>
+ <entity name="gl" value="≷"/>
+ <entity name="gla" value="⪥"/>
+ <entity name="glE" value="⪒"/>
+ <entity name="glj" value="⪤"/>
+ <entity name="gnap" value="⪊"/>
+ <entity name="gnapprox" value="⪊"/>
+ <entity name="gne" value="≩"/>
+ <entity name="gnE" value="≩"/>
+ <entity name="gneq" value="≩"/>
+ <entity name="gneqq" value="≩"/>
+ <entity name="gnsim" value="⋧"/>
+ <entity name="gopf" value="𝕘"/>
+ <entity name="Gopf" value="𝔾"/>
+ <entity name="grave" value="`"/>
+ <entity name="GreaterEqual" value="≥"/>
+ <entity name="GreaterEqualLess" value="⋛"/>
+ <entity name="GreaterFullEqual" value="≧"/>
+ <entity name="GreaterGreater" value="⪢"/>
+ <entity name="GreaterLess" value="≷"/>
+ <entity name="GreaterSlantEqual" value="⩾"/>
+ <entity name="GreaterTilde" value="≳"/>
+ <entity name="gscr" value="ℊ"/>
+ <entity name="Gscr" value="𝒢"/>
+ <entity name="gsim" value="≳"/>
+ <entity name="gsime" value="⪎"/>
+ <entity name="gsiml" value="⪐"/>
+ <entity name="gt" value=">"/>
+ <entity name="Gt" value="≫"/>
+ <entity name="gtcc" value="⪧"/>
+ <entity name="gtcir" value="⩺"/>
+ <entity name="gtdot" value="⋗"/>
+ <entity name="gtlPar" value="⦕"/>
+ <entity name="gtquest" value="⩼"/>
+ <entity name="gtrapprox" value="≳"/>
+ <entity name="gtrarr" value="⥸"/>
+ <entity name="gtrdot" value="⋗"/>
+ <entity name="gtreqless" value="⋛"/>
+ <entity name="gtreqqless" value="⋛"/>
+ <entity name="gtrless" value="≷"/>
+ <entity name="gtrsim" value="≳"/>
+ <entity name="gvertneqq" value="≩︀"/>
+ <entity name="gvnE" value="≩︀"/>
+ <entity name="Hacek" value="ˇ"/>
+ <entity name="hairsp" value=" "/>
+ <entity name="half" value="½"/>
+ <entity name="hamilt" value="ℋ"/>
+ <entity name="hardcy" value="ъ"/>
+ <entity name="HARDcy" value="Ъ"/>
+ <entity name="harr" value="↔"/>
+ <entity name="hArr" value="⇔"/>
+ <entity name="harrcir" value="⥈"/>
+ <entity name="harrw" value="↭"/>
+ <entity name="Hat" value="̂"/>
+ <entity name="hbar" value="ℏ︀"/>
+ <entity name="hcirc" value="ĥ"/>
+ <entity name="Hcirc" value="Ĥ"/>
+ <entity name="heartsuit" value="♡"/>
+ <entity name="hellip" value="…"/>
+ <entity name="hercon" value="⊹"/>
+ <entity name="hfr" value="𝔥"/>
+ <entity name="Hfr" value="ℌ"/>
+ <entity name="HilbertSpace" value="ℋ"/>
+ <entity name="hksearow" value="⤥"/>
+ <entity name="hkswarow" value="⤦"/>
+ <entity name="hoarr" value="⇿"/>
+ <entity name="homtht" value="∻"/>
+ <entity name="hookleftarrow" value="↩"/>
+ <entity name="hookrightarrow" value="↪"/>
+ <entity name="hopf" value="𝕙"/>
+ <entity name="Hopf" value="ℍ"/>
+ <entity name="horbar" value="―"/>
+ <entity name="HorizontalLine" value="─"/>
+ <entity name="hscr" value="𝒽"/>
+ <entity name="Hscr" value="ℋ"/>
+ <entity name="hslash" value="ℏ"/>
+ <entity name="hstrok" value="ħ"/>
+ <entity name="Hstrok" value="Ħ"/>
+ <entity name="HumpDownHump" value="≎"/>
+ <entity name="HumpEqual" value="≏"/>
+ <entity name="hybull" value="⁃"/>
+ <entity name="hyphen" value="‐"/>
+ <entity name="iacute" value="í"/>
+ <entity name="Iacute" value="Í"/>
+ <entity name="ic" value="​"/>
+ <entity name="icirc" value="î"/>
+ <entity name="Icirc" value="Î"/>
+ <entity name="icy" value="и"/>
+ <entity name="Icy" value="И"/>
+ <entity name="Idot" value="İ"/>
+ <entity name="iecy" value="е"/>
+ <entity name="IEcy" value="Е"/>
+ <entity name="iexcl" value="¡"/>
+ <entity name="iff" value="⇔"/>
+ <entity name="ifr" value="𝔦"/>
+ <entity name="Ifr" value="ℑ"/>
+ <entity name="igrave" value="ì"/>
+ <entity name="Igrave" value="Ì"/>
+ <entity name="ii" value="ⅈ"/>
+ <entity name="iiiint" value="⨌"/>
+ <entity name="iiint" value="∭"/>
+ <entity name="iinfin" value="⧜"/>
+ <entity name="iiota" value="℩"/>
+ <entity name="ijlig" value="ij"/>
+ <entity name="IJlig" value="IJ"/>
+ <entity name="Im" value="ℑ"/>
+ <entity name="imacr" value="ī"/>
+ <entity name="Imacr" value="Ī"/>
+ <entity name="image" value="ℑ"/>
+ <entity name="ImaginaryI" value="ⅈ"/>
+ <entity name="imagline" value="ℐ"/>
+ <entity name="imagpart" value="ℑ"/>
+ <entity name="imath" value="ı"/>
+ <entity name="imof" value="⊷"/>
+ <entity name="imped" value="𝕃"/>
+ <entity name="Implies" value="⇒"/>
+ <entity name="in" value="∈"/>
+ <entity name="incare" value="℅"/>
+ <entity name="infin" value="∞"/>
+ <entity name="inodot" value="ı"/>
+ <entity name="int" value="∫"/>
+ <entity name="Int" value="∬"/>
+ <entity name="intcal" value="⊺"/>
+ <entity name="integers" value="ℤ"/>
+ <entity name="Integral" value="∫"/>
+ <entity name="intercal" value="⊺"/>
+ <entity name="Intersection" value="⋂"/>
+ <entity name="intlarhk" value="⨗"/>
+ <entity name="intprod" value="⨼"/>
+ <entity name="InvisibleComma" value="​"/>
+ <entity name="InvisibleTimes" value="⁢"/>
+ <entity name="iocy" value="ё"/>
+ <entity name="IOcy" value="Ё"/>
+ <entity name="iogon" value="į"/>
+ <entity name="Iogon" value="Į"/>
+ <entity name="iopf" value="𝕚"/>
+ <entity name="Iopf" value="𝕀"/>
+ <entity name="iota" value="ι"/>
+ <entity name="iprod" value="⨼"/>
+ <entity name="iquest" value="¿"/>
+ <entity name="iscr" value="𝒾"/>
+ <entity name="Iscr" value="ℐ"/>
+ <entity name="isin" value="∈"/>
+ <entity name="isindot" value="⋵"/>
+ <entity name="isinE" value="⋹"/>
+ <entity name="isins" value="⋴"/>
+ <entity name="isinsv" value="⋳"/>
+ <entity name="isinv" value="∈"/>
+ <entity name="it" value="⁢"/>
+ <entity name="itilde" value="ĩ"/>
+ <entity name="Itilde" value="Ĩ"/>
+ <entity name="iukcy" value="і"/>
+ <entity name="Iukcy" value="І"/>
+ <entity name="iuml" value="ï"/>
+ <entity name="Iuml" value="Ï"/>
+ <entity name="jcirc" value="ĵ"/>
+ <entity name="Jcirc" value="Ĵ"/>
+ <entity name="jcy" value="й"/>
+ <entity name="Jcy" value="Й"/>
+ <entity name="jfr" value="𝔧"/>
+ <entity name="Jfr" value="𝔍"/>
+ <entity name="jmath" value="j︀"/>
+ <entity name="jopf" value="𝕛"/>
+ <entity name="Jopf" value="𝕁"/>
+ <entity name="jscr" value="𝒿"/>
+ <entity name="Jscr" value="𝒥"/>
+ <entity name="jsercy" value="ј"/>
+ <entity name="Jsercy" value="Ј"/>
+ <entity name="jukcy" value="є"/>
+ <entity name="Jukcy" value="Є"/>
+ <entity name="kappa" value="κ"/>
+ <entity name="kappav" value="ϰ"/>
+ <entity name="kcedil" value="ķ"/>
+ <entity name="Kcedil" value="Ķ"/>
+ <entity name="kcy" value="к"/>
+ <entity name="Kcy" value="К"/>
+ <entity name="kfr" value="𝔨"/>
+ <entity name="Kfr" value="𝔎"/>
+ <entity name="kgreen" value="ĸ"/>
+ <entity name="khcy" value="х"/>
+ <entity name="KHcy" value="Х"/>
+ <entity name="kjcy" value="ќ"/>
+ <entity name="KJcy" value="Ќ"/>
+ <entity name="kopf" value="𝕜"/>
+ <entity name="Kopf" value="𝕂"/>
+ <entity name="kscr" value="𝓀"/>
+ <entity name="Kscr" value="𝒦"/>
+ <entity name="lAarr" value="⇚"/>
+ <entity name="lacute" value="ĺ"/>
+ <entity name="Lacute" value="Ĺ"/>
+ <entity name="laemptyv" value="⦴"/>
+ <entity name="lagran" value="ℒ"/>
+ <entity name="lambda" value="λ"/>
+ <entity name="Lambda" value="Λ"/>
+ <entity name="lang" value="〈"/>
+ <entity name="Lang" value="《"/>
+ <entity name="langd" value="⦑"/>
+ <entity name="langle" value="〈"/>
+ <entity name="lap" value="≲"/>
+ <entity name="Laplacetrf" value="ℒ"/>
+ <entity name="laquo" value="«"/>
+ <entity name="larr" value="←"/>
+ <entity name="lArr" value="⇐"/>
+ <entity name="Larr" value="↞"/>
+ <entity name="larrb" value="⇤"/>
+ <entity name="larrbfs" value="⤟"/>
+ <entity name="larrfs" value="⤝"/>
+ <entity name="larrhk" value="↩"/>
+ <entity name="larrlp" value="↫"/>
+ <entity name="larrpl" value="⤹"/>
+ <entity name="larrsim" value="⥳"/>
+ <entity name="larrtl" value="↢"/>
+ <entity name="lat" value="⪫"/>
+ <entity name="latail" value="⤙"/>
+ <entity name="lAtail" value="⤛"/>
+ <entity name="late" value="⪭"/>
+ <entity name="lates" value="⪭︀"/>
+ <entity name="lbarr" value="⤌"/>
+ <entity name="lBarr" value="⤎"/>
+ <entity name="lbbrk" value="〔"/>
+ <entity name="lbrace" value="{"/>
+ <entity name="lbrack" value="["/>
+ <entity name="lbrke" value="⦋"/>
+ <entity name="lbrksld" value="⦏"/>
+ <entity name="lbrkslu" value="⦍"/>
+ <entity name="lcaron" value="ľ"/>
+ <entity name="Lcaron" value="Ľ"/>
+ <entity name="lcedil" value="ļ"/>
+ <entity name="Lcedil" value="Ļ"/>
+ <entity name="lceil" value="⌈"/>
+ <entity name="lcub" value="{"/>
+ <entity name="lcy" value="л"/>
+ <entity name="Lcy" value="Л"/>
+ <entity name="ldca" value="⤶"/>
+ <entity name="ldquo" value="“"/>
+ <entity name="ldquor" value="„"/>
+ <entity name="ldrdhar" value="⥧"/>
+ <entity name="ldrushar" value="⥋"/>
+ <entity name="ldsh" value="↲"/>
+ <entity name="le" value="≤"/>
+ <entity name="lE" value="≦"/>
+ <entity name="LeftAngleBracket" value="〈"/>
+ <entity name="leftarrow" value="←"/>
+ <entity name="Leftarrow" value="⇐"/>
+ <entity name="LeftArrow" value="←"/>
+ <entity name="LeftArrowBar" value="⇤"/>
+ <entity name="LeftArrowRightArrow" value="⇆"/>
+ <entity name="leftarrowtail" value="↢"/>
+ <entity name="LeftCeiling" value="⌈"/>
+ <entity name="LeftDoubleBracket" value="〚"/>
+ <entity name="LeftDownTeeVector" value="⥡"/>
+ <entity name="LeftDownVector" value="⇃"/>
+ <entity name="LeftDownVectorBar" value="⥙"/>
+ <entity name="LeftFloor" value="⌊"/>
+ <entity name="leftharpoondown" value="↽"/>
+ <entity name="leftharpoonup" value="↼"/>
+ <entity name="leftleftarrows" value="⇇"/>
+ <entity name="leftrightarrow" value="↔"/>
+ <entity name="Leftrightarrow" value="⇔"/>
+ <entity name="LeftRightArrow" value="↔"/>
+ <entity name="leftrightarrows" value="⇆"/>
+ <entity name="leftrightharpoons" value="⇋"/>
+ <entity name="leftrightsquigarrow" value="↭"/>
+ <entity name="LeftRightVector" value="⥎"/>
+ <entity name="LeftTee" value="⊣"/>
+ <entity name="LeftTeeArrow" value="↤"/>
+ <entity name="LeftTeeVector" value="⥚"/>
+ <entity name="leftthreetimes" value="⋋"/>
+ <entity name="LeftTriangle" value="⊲"/>
+ <entity name="LeftTriangleBar" value="⧏"/>
+ <entity name="LeftTriangleEqual" value="⊴"/>
+ <entity name="LeftUpDownVector" value="⥑"/>
+ <entity name="LeftUpTeeVector" value="⥠"/>
+ <entity name="LeftUpVector" value="↿"/>
+ <entity name="LeftUpVectorBar" value="⥘"/>
+ <entity name="LeftVector" value="↼"/>
+ <entity name="LeftVectorBar" value="⥒"/>
+ <entity name="leg" value="⋚"/>
+ <entity name="lEg" value="⋚"/>
+ <entity name="leq" value="≤"/>
+ <entity name="leqq" value="≦"/>
+ <entity name="leqslant" value="⩽"/>
+ <entity name="les" value="⩽"/>
+ <entity name="lescc" value="⪨"/>
+ <entity name="lesdot" value="⩿"/>
+ <entity name="lesdoto" value="⪁"/>
+ <entity name="lesdotor" value="⪃"/>
+ <entity name="lesg" value="⋚︀"/>
+ <entity name="lesges" value="⪓"/>
+ <entity name="lessapprox" value="≲"/>
+ <entity name="lessdot" value="⋖"/>
+ <entity name="lesseqgtr" value="⋚"/>
+ <entity name="lesseqqgtr" value="⋚"/>
+ <entity name="LessEqualGreater" value="⋚"/>
+ <entity name="LessFullEqual" value="≦"/>
+ <entity name="LessGreater" value="≶"/>
+ <entity name="lessgtr" value="≶"/>
+ <entity name="LessLess" value="⪡"/>
+ <entity name="lesssim" value="≲"/>
+ <entity name="LessSlantEqual" value="⩽"/>
+ <entity name="LessTilde" value="≲"/>
+ <entity name="lfisht" value="⥼"/>
+ <entity name="lfloor" value="⌊"/>
+ <entity name="lfr" value="𝔩"/>
+ <entity name="Lfr" value="𝔏"/>
+ <entity name="lg" value="≶"/>
+ <entity name="lgE" value="⪑"/>
+ <entity name="lHar" value="⥢"/>
+ <entity name="lhard" value="↽"/>
+ <entity name="lharu" value="↼"/>
+ <entity name="lharul" value="⥪"/>
+ <entity name="lhblk" value="▄"/>
+ <entity name="ljcy" value="љ"/>
+ <entity name="LJcy" value="Љ"/>
+ <entity name="ll" value="≪"/>
+ <entity name="Ll" value="⋘"/>
+ <entity name="llarr" value="⇇"/>
+ <entity name="llcorner" value="⌞"/>
+ <entity name="Lleftarrow" value="⇚"/>
+ <entity name="llhard" value="⥫"/>
+ <entity name="lltri" value="◺"/>
+ <entity name="lmidot" value="ŀ"/>
+ <entity name="Lmidot" value="Ŀ"/>
+ <entity name="lmoust" value="⎰"/>
+ <entity name="lmoustache" value="⎰"/>
+ <entity name="lnap" value="⪉"/>
+ <entity name="lnapprox" value="⪉"/>
+ <entity name="lne" value="≨"/>
+ <entity name="lnE" value="≨"/>
+ <entity name="lneq" value="≨"/>
+ <entity name="lneqq" value="≨"/>
+ <entity name="lnsim" value="⋦"/>
+ <entity name="loang" value=""/>
+ <entity name="loarr" value="⇽"/>
+ <entity name="lobrk" value="〚"/>
+ <entity name="longleftarrow" value=""/>
+ <entity name="Longleftarrow" value=""/>
+ <entity name="LongLeftArrow" value=""/>
+ <entity name="longleftrightarrow" value=""/>
+ <entity name="Longleftrightarrow" value=""/>
+ <entity name="LongLeftRightArrow" value=""/>
+ <entity name="longmapsto" value=""/>
+ <entity name="longrightarrow" value=""/>
+ <entity name="Longrightarrow" value=""/>
+ <entity name="LongRightArrow" value=""/>
+ <entity name="looparrowleft" value="↫"/>
+ <entity name="looparrowright" value="↬"/>
+ <entity name="lopar" value="〘"/>
+ <entity name="lopf" value="𝕝"/>
+ <entity name="Lopf" value="𝕃"/>
+ <entity name="loplus" value="⨭"/>
+ <entity name="lotimes" value="⨴"/>
+ <entity name="lowast" value="∗"/>
+ <entity name="lowbar" value="_"/>
+ <entity name="LowerLeftArrow" value="↙"/>
+ <entity name="LowerRightArrow" value="↘"/>
+ <entity name="loz" value="◊"/>
+ <entity name="lozenge" value="◊"/>
+ <entity name="lozf" value="⧫"/>
+ <entity name="lpar" value="("/>
+ <entity name="lparlt" value="⦓"/>
+ <entity name="lrarr" value="⇆"/>
+ <entity name="lrcorner" value="⌟"/>
+ <entity name="lrhar" value="⇋"/>
+ <entity name="lrhard" value="⥭"/>
+ <entity name="lrtri" value="⊿"/>
+ <entity name="lscr" value="ℓ"/>
+ <entity name="Lscr" value="ℒ"/>
+ <entity name="lsh" value="↰"/>
+ <entity name="Lsh" value="↰"/>
+ <entity name="lsim" value="≲"/>
+ <entity name="lsime" value="⪍"/>
+ <entity name="lsimg" value="⪏"/>
+ <entity name="lsqb" value="["/>
+ <entity name="lsquo" value="‘"/>
+ <entity name="lsquor" value="‚"/>
+ <entity name="lstrok" value="ł"/>
+ <entity name="Lstrok" value="Ł"/>
+ <entity name="lt" value="<"/>
+ <entity name="Lt" value="≪"/>
+ <entity name="ltcc" value="⪦"/>
+ <entity name="ltcir" value="⩹"/>
+ <entity name="ltdot" value="⋖"/>
+ <entity name="lthree" value="⋋"/>
+ <entity name="ltimes" value="⋉"/>
+ <entity name="ltlarr" value="⥶"/>
+ <entity name="ltquest" value="⩻"/>
+ <entity name="ltri" value="◃"/>
+ <entity name="ltrie" value="⊴"/>
+ <entity name="ltrif" value="◂"/>
+ <entity name="ltrPar" value="⦖"/>
+ <entity name="lurdshar" value="⥊"/>
+ <entity name="luruhar" value="⥦"/>
+ <entity name="lvertneqq" value="≨︀"/>
+ <entity name="lvnE" value="≨︀"/>
+ <entity name="macr" value="¯"/>
+ <entity name="male" value="♂"/>
+ <entity name="malt" value="✠"/>
+ <entity name="maltese" value="✠"/>
+ <entity name="map" value="↦"/>
+ <entity name="Map" value="⤅"/>
+ <entity name="mapsto" value="↦"/>
+ <entity name="mapstodown" value="↧"/>
+ <entity name="mapstoleft" value="↤"/>
+ <entity name="mapstoup" value="↥"/>
+ <entity name="marker" value="▮"/>
+ <entity name="mcomma" value="⨩"/>
+ <entity name="mcy" value="м"/>
+ <entity name="Mcy" value="М"/>
+ <entity name="mdash" value="—"/>
+ <entity name="mDDot" value="∺"/>
+ <entity name="measuredangle" value="∡"/>
+ <entity name="MediumSpace" value=" "/>
+ <entity name="Mellintrf" value="ℳ"/>
+ <entity name="mfr" value="𝔪"/>
+ <entity name="Mfr" value="𝔐"/>
+ <entity name="mho" value="℧"/>
+ <entity name="micro" value="µ"/>
+ <entity name="mid" value="∣"/>
+ <entity name="midast" value="*"/>
+ <entity name="midcir" value="⫰"/>
+ <entity name="middot" value="·"/>
+ <entity name="minus" value="−"/>
+ <entity name="minusb" value="⊟"/>
+ <entity name="minusd" value="∸"/>
+ <entity name="minusdu" value="⨪"/>
+ <entity name="MinusPlus" value="∓"/>
+ <entity name="mlcp" value="⫛"/>
+ <entity name="mldr" value="…"/>
+ <entity name="mnplus" value="∓"/>
+ <entity name="models" value="⊧"/>
+ <entity name="mopf" value="𝕞"/>
+ <entity name="Mopf" value="𝕄"/>
+ <entity name="mp" value="∓"/>
+ <entity name="mscr" value="𝓂"/>
+ <entity name="Mscr" value="ℳ"/>
+ <entity name="mstpos" value="∾"/>
+ <entity name="mu" value="μ"/>
+ <entity name="multimap" value="⊸"/>
+ <entity name="mumap" value="⊸"/>
+ <entity name="nabla" value="∇"/>
+ <entity name="nacute" value="ń"/>
+ <entity name="Nacute" value="Ń"/>
+ <entity name="nang" value="∠̸"/>
+ <entity name="nap" value="≉"/>
+ <entity name="napE" value="⩰̸"/>
+ <entity name="napid" value="≋̸"/>
+ <entity name="napos" value="ʼn"/>
+ <entity name="napprox" value="≉"/>
+ <entity name="natur" value="♮"/>
+ <entity name="natural" value="♮"/>
+ <entity name="naturals" value="ℕ"/>
+ <entity name="nbsp" value=" "/>
+ <entity name="nbump" value="≎̸"/>
+ <entity name="nbumpe" value="≏̸"/>
+ <entity name="ncap" value="⩃"/>
+ <entity name="ncaron" value="ň"/>
+ <entity name="Ncaron" value="Ň"/>
+ <entity name="ncedil" value="ņ"/>
+ <entity name="Ncedil" value="Ņ"/>
+ <entity name="ncong" value="≇"/>
+ <entity name="ncongdot" value="⩭̸"/>
+ <entity name="ncup" value="⩂"/>
+ <entity name="ncy" value="н"/>
+ <entity name="Ncy" value="Н"/>
+ <entity name="ndash" value="–"/>
+ <entity name="ne" value="≠"/>
+ <entity name="nearhk" value="⤤"/>
+ <entity name="nearr" value="↗"/>
+ <entity name="neArr" value="⇗"/>
+ <entity name="nearrow" value="↗"/>
+ <entity name="nedot" value="≠︀"/>
+ <entity name="NegativeMediumSpace" value=" ︀"/>
+ <entity name="NegativeThickSpace" value=" ︀"/>
+ <entity name="NegativeThinSpace" value=" ︀"/>
+ <entity name="NegativeVeryThinSpace" value=" ︀"/>
+ <entity name="nequiv" value="≢"/>
+ <entity name="nesear" value="⤨"/>
+ <entity name="nesim" value="≂̸"/>
+ <entity name="NestedGreaterGreater" value="≫"/>
+ <entity name="NestedLessLess" value="≪"/>
+ <entity name="NewLine" value="
"/>
+ <entity name="nexist" value="∄"/>
+ <entity name="nexists" value="∄"/>
+ <entity name="nfr" value="𝔫"/>
+ <entity name="Nfr" value="𝔑"/>
+ <entity name="nge" value="≱⃥"/>
+ <entity name="ngE" value="≱"/>
+ <entity name="ngeq" value="≱⃥"/>
+ <entity name="ngeqq" value="≱"/>
+ <entity name="ngeqslant" value="≱"/>
+ <entity name="nges" value="≱"/>
+ <entity name="nGg" value="⋙̸"/>
+ <entity name="ngsim" value="≵"/>
+ <entity name="ngt" value="≯"/>
+ <entity name="nGt" value="≫̸"/>
+ <entity name="ngtr" value="≯"/>
+ <entity name="nGtv" value="≫̸︀"/>
+ <entity name="nharr" value="↮"/>
+ <entity name="nhArr" value="⇎"/>
+ <entity name="nhpar" value="⫲"/>
+ <entity name="ni" value="∋"/>
+ <entity name="nis" value="⋼"/>
+ <entity name="nisd" value="⋺"/>
+ <entity name="niv" value="∋"/>
+ <entity name="njcy" value="њ"/>
+ <entity name="NJcy" value="Њ"/>
+ <entity name="nlarr" value="↚"/>
+ <entity name="nlArr" value="⇍"/>
+ <entity name="nldr" value="‥"/>
+ <entity name="nle" value="≰⃥"/>
+ <entity name="nlE" value="≰"/>
+ <entity name="nleftarrow" value="↚"/>
+ <entity name="nLeftarrow" value="⇍"/>
+ <entity name="nleftrightarrow" value="↮"/>
+ <entity name="nLeftrightarrow" value="⇎"/>
+ <entity name="nleq" value="≰⃥"/>
+ <entity name="nleqq" value="≰"/>
+ <entity name="nleqslant" value="≰"/>
+ <entity name="nles" value="≰"/>
+ <entity name="nless" value="≮"/>
+ <entity name="nLl" value="⋘̸"/>
+ <entity name="nlsim" value="≴"/>
+ <entity name="nlt" value="≮"/>
+ <entity name="nLt" value="≪̸"/>
+ <entity name="nltri" value="⋪"/>
+ <entity name="nltrie" value="⋬"/>
+ <entity name="nLtv" value="≪̸︀"/>
+ <entity name="nmid" value="∤"/>
+ <entity name="NoBreak" value=""/>
+ <entity name="NonBreakingSpace" value=" "/>
+ <entity name="nopf" value="𝕟"/>
+ <entity name="Nopf" value="ℕ"/>
+ <entity name="not" value="¬"/>
+ <entity name="Not" value="⫬"/>
+ <entity name="NotCongruent" value="≢"/>
+ <entity name="NotCupCap" value="≭"/>
+ <entity name="NotDoubleVerticalBar" value="∦"/>
+ <entity name="NotElement" value="∉"/>
+ <entity name="NotEqual" value="≠"/>
+ <entity name="NotEqualTilde" value="≂̸"/>
+ <entity name="NotExists" value="∄"/>
+ <entity name="NotGreater" value="≯"/>
+ <entity name="NotGreaterEqual" value="≱⃥"/>
+ <entity name="NotGreaterFullEqual" value="≰"/>
+ <entity name="NotGreaterGreater" value="≫̸︀"/>
+ <entity name="NotGreaterLess" value="≹"/>
+ <entity name="NotGreaterSlantEqual" value="≱"/>
+ <entity name="NotGreaterTilde" value="≵"/>
+ <entity name="NotHumpDownHump" value="≎̸"/>
+ <entity name="NotHumpEqual" value="≏̸"/>
+ <entity name="notin" value="∉"/>
+ <entity name="notindot" value="⋶︀"/>
+ <entity name="notinva" value="∉̸"/>
+ <entity name="notinvb" value="⋷"/>
+ <entity name="notinvc" value="⋶"/>
+ <entity name="NotLeftTriangle" value="⋪"/>
+ <entity name="NotLeftTriangleBar" value="⧏̸"/>
+ <entity name="NotLeftTriangleEqual" value="⋬"/>
+ <entity name="NotLess" value="≮"/>
+ <entity name="NotLessEqual" value="≰⃥"/>
+ <entity name="NotLessGreater" value="≸"/>
+ <entity name="NotLessLess" value="≪̸︀"/>
+ <entity name="NotLessSlantEqual" value="≰"/>
+ <entity name="NotLessTilde" value="≴"/>
+ <entity name="NotNestedGreaterGreater" value="⒢̸"/>
+ <entity name="NotNestedLessLess" value="⒡̸"/>
+ <entity name="notni" value="∌"/>
+ <entity name="notniva" value="∌"/>
+ <entity name="notnivb" value="⋾"/>
+ <entity name="notnivc" value="⋽"/>
+ <entity name="NotPrecedes" value="⊀"/>
+ <entity name="NotPrecedesEqual" value="⪯̸"/>
+ <entity name="NotPrecedesSlantEqual" value="⋠"/>
+ <entity name="NotReverseElement" value="∌"/>
+ <entity name="NotRightTriangle" value="⋫"/>
+ <entity name="NotRightTriangleBar" value="⧐̸"/>
+ <entity name="NotRightTriangleEqual" value="⋭"/>
+ <entity name="NotSquareSubset" value="⊏̸"/>
+ <entity name="NotSquareSubsetEqual" value="⋢"/>
+ <entity name="NotSquareSuperset" value="⊐̸"/>
+ <entity name="NotSquareSupersetEqual" value="⋣"/>
+ <entity name="NotSubset" value="⊄"/>
+ <entity name="NotSubsetEqual" value="⊈"/>
+ <entity name="NotSucceeds" value="⊁"/>
+ <entity name="NotSucceedsEqual" value="⪰̸"/>
+ <entity name="NotSucceedsSlantEqual" value="⋡"/>
+ <entity name="NotSucceedsTilde" value="≿̸"/>
+ <entity name="NotSuperset" value="⊅"/>
+ <entity name="NotSupersetEqual" value="⊉"/>
+ <entity name="NotTilde" value="≁"/>
+ <entity name="NotTildeEqual" value="≄"/>
+ <entity name="NotTildeFullEqual" value="≇"/>
+ <entity name="NotTildeTilde" value="≉"/>
+ <entity name="NotVerticalBar" value="∤"/>
+ <entity name="npar" value="∦"/>
+ <entity name="nparallel" value="∦"/>
+ <entity name="nparsl" value="∥︀⃥"/>
+ <entity name="npart" value="∂̸"/>
+ <entity name="npolint" value="⨔"/>
+ <entity name="npr" value="⊀"/>
+ <entity name="nprcue" value="⋠"/>
+ <entity name="npre" value="⪯̸"/>
+ <entity name="nprec" value="⊀"/>
+ <entity name="npreceq" value="⪯̸"/>
+ <entity name="nrarr" value="↛"/>
+ <entity name="nrArr" value="⇏"/>
+ <entity name="nrarrc" value="⤳̸"/>
+ <entity name="nrarrw" value="↝̸"/>
+ <entity name="nrightarrow" value="↛"/>
+ <entity name="nRightarrow" value="⇏"/>
+ <entity name="nrtri" value="⋫"/>
+ <entity name="nrtrie" value="⋭"/>
+ <entity name="nsc" value="⊁"/>
+ <entity name="nsccue" value="⋡"/>
+ <entity name="nsce" value="⪰̸"/>
+ <entity name="nscr" value="𝓃"/>
+ <entity name="Nscr" value="𝒩"/>
+ <entity name="nshortmid" value="∤︀"/>
+ <entity name="nshortparallel" value="∦︀"/>
+ <entity name="nsim" value="≁"/>
+ <entity name="nsime" value="≄"/>
+ <entity name="nsimeq" value="≄"/>
+ <entity name="nsmid" value="∤︀"/>
+ <entity name="nspar" value="∦︀"/>
+ <entity name="nsqsube" value="⋢"/>
+ <entity name="nsqsupe" value="⋣"/>
+ <entity name="nsub" value="⊄"/>
+ <entity name="nsube" value="⊈"/>
+ <entity name="nsubE" value="⊈"/>
+ <entity name="nsubset" value="⊄"/>
+ <entity name="nsubseteq" value="⊈"/>
+ <entity name="nsubseteqq" value="⊈"/>
+ <entity name="nsucc" value="⊁"/>
+ <entity name="nsucceq" value="⪰̸"/>
+ <entity name="nsup" value="⊅"/>
+ <entity name="nsupe" value="⊉"/>
+ <entity name="nsupE" value="⊉"/>
+ <entity name="nsupset" value="⊅"/>
+ <entity name="nsupseteq" value="⊉"/>
+ <entity name="nsupseteqq" value="⊉"/>
+ <entity name="ntgl" value="≹"/>
+ <entity name="ntilde" value="ñ"/>
+ <entity name="Ntilde" value="Ñ"/>
+ <entity name="ntlg" value="≸"/>
+ <entity name="ntriangleleft" value="⋪"/>
+ <entity name="ntrianglelefteq" value="⋬"/>
+ <entity name="ntriangleright" value="⋫"/>
+ <entity name="ntrianglerighteq" value="⋭"/>
+ <entity name="nu" value="ν"/>
+ <entity name="num" value="#"/>
+ <entity name="numero" value="№"/>
+ <entity name="numsp" value=" "/>
+ <entity name="nvap" value="≉̸"/>
+ <entity name="nvdash" value="⊬"/>
+ <entity name="nvDash" value="⊭"/>
+ <entity name="nVdash" value="⊮"/>
+ <entity name="nVDash" value="⊯"/>
+ <entity name="nvge" value="≱"/>
+ <entity name="nvgt" value="≯"/>
+ <entity name="nvHarr" value="⇎"/>
+ <entity name="nvinfin" value="⧞"/>
+ <entity name="nvlArr" value="⇍"/>
+ <entity name="nvle" value="≰"/>
+ <entity name="nvlt" value="≮"/>
+ <entity name="nvltrie" value="⋬̸"/>
+ <entity name="nvrArr" value="⇏"/>
+ <entity name="nvrtrie" value="⋭̸"/>
+ <entity name="nvsim" value="≁̸"/>
+ <entity name="nwarhk" value="⤣"/>
+ <entity name="nwarr" value="↖"/>
+ <entity name="nwArr" value="⇖"/>
+ <entity name="nwarrow" value="↖"/>
+ <entity name="nwnear" value="⤧"/>
+ <entity name="oacute" value="ó"/>
+ <entity name="Oacute" value="Ó"/>
+ <entity name="oast" value="⊛"/>
+ <entity name="ocir" value="⊚"/>
+ <entity name="ocirc" value="ô"/>
+ <entity name="Ocirc" value="Ô"/>
+ <entity name="ocy" value="о"/>
+ <entity name="Ocy" value="О"/>
+ <entity name="odash" value="⊝"/>
+ <entity name="odblac" value="ő"/>
+ <entity name="Odblac" value="Ő"/>
+ <entity name="odiv" value="⨸"/>
+ <entity name="odot" value="⊙"/>
+ <entity name="odsold" value="⦼"/>
+ <entity name="oelig" value="œ"/>
+ <entity name="OElig" value="Œ"/>
+ <entity name="ofcir" value="⦿"/>
+ <entity name="ofr" value="𝔬"/>
+ <entity name="Ofr" value="𝔒"/>
+ <entity name="ogon" value="˛"/>
+ <entity name="ograve" value="ò"/>
+ <entity name="Ograve" value="Ò"/>
+ <entity name="ogt" value="⧁"/>
+ <entity name="ohbar" value="⦵"/>
+ <entity name="ohm" value="Ω"/>
+ <entity name="oint" value="∮"/>
+ <entity name="olarr" value="↺"/>
+ <entity name="olcir" value="⦾"/>
+ <entity name="olcross" value="⦻"/>
+ <entity name="olt" value="⧀"/>
+ <entity name="omacr" value="ō"/>
+ <entity name="Omacr" value="Ō"/>
+ <entity name="omega" value="ω"/>
+ <entity name="Omega" value="Ω"/>
+ <entity name="omid" value="⦶"/>
+ <entity name="ominus" value="⊖"/>
+ <entity name="oopf" value="𝕠"/>
+ <entity name="Oopf" value="𝕆"/>
+ <entity name="opar" value="⦷"/>
+ <entity name="OpenCurlyDoubleQuote" value="“"/>
+ <entity name="OpenCurlyQuote" value="‘"/>
+ <entity name="operp" value="⦹"/>
+ <entity name="oplus" value="⊕"/>
+ <entity name="or" value="∨"/>
+ <entity name="Or" value="⩔"/>
+ <entity name="orarr" value="↻"/>
+ <entity name="ord" value="⩝"/>
+ <entity name="order" value="ℴ"/>
+ <entity name="orderof" value="ℴ"/>
+ <entity name="ordf" value="ª"/>
+ <entity name="ordm" value="º"/>
+ <entity name="origof" value="⊶"/>
+ <entity name="oror" value="⩖"/>
+ <entity name="orslope" value="⩗"/>
+ <entity name="orv" value="⩛"/>
+ <entity name="oS" value="Ⓢ"/>
+ <entity name="oscr" value="ℴ"/>
+ <entity name="Oscr" value="𝒪"/>
+ <entity name="oslash" value="ø"/>
+ <entity name="Oslash" value="Ø"/>
+ <entity name="osol" value="⊘"/>
+ <entity name="otilde" value="õ"/>
+ <entity name="Otilde" value="Õ"/>
+ <entity name="otimes" value="⊗"/>
+ <entity name="Otimes" value="⨷"/>
+ <entity name="otimesas" value="⨶"/>
+ <entity name="ouml" value="ö"/>
+ <entity name="Ouml" value="Ö"/>
+ <entity name="ovbar" value="⌽"/>
+ <entity name="OverBar" value="¯"/>
+ <entity name="OverBrace" value="︷"/>
+ <entity name="OverBracket" value="⎴"/>
+ <entity name="OverParenthesis" value="︵"/>
+ <entity name="par" value="∥"/>
+ <entity name="para" value="¶"/>
+ <entity name="parallel" value="∥"/>
+ <entity name="parsim" value="⫳"/>
+ <entity name="parsl" value="∥︀"/>
+ <entity name="part" value="∂"/>
+ <entity name="PartialD" value="∂"/>
+ <entity name="pcy" value="п"/>
+ <entity name="Pcy" value="П"/>
+ <entity name="percnt" value="%"/>
+ <entity name="period" value="."/>
+ <entity name="permil" value="‰"/>
+ <entity name="perp" value="⊥"/>
+ <entity name="pertenk" value="‱"/>
+ <entity name="pfr" value="𝔭"/>
+ <entity name="Pfr" value="𝔓"/>
+ <entity name="phi" value="φ"/>
+ <entity name="Phi" value="Φ"/>
+ <entity name="phiv" value="ϕ"/>
+ <entity name="phmmat" value="ℳ"/>
+ <entity name="phone" value="☎"/>
+ <entity name="pi" value="π"/>
+ <entity name="Pi" value="Π"/>
+ <entity name="pitchfork" value="⋔"/>
+ <entity name="piv" value="ϖ"/>
+ <entity name="planck" value="ℏ︀"/>
+ <entity name="planckh" value="ℎ"/>
+ <entity name="plankv" value="ℏ"/>
+ <entity name="plus" value="+"/>
+ <entity name="plusacir" value="⨣"/>
+ <entity name="plusb" value="⊞"/>
+ <entity name="pluscir" value="⨢"/>
+ <entity name="plusdo" value="∔"/>
+ <entity name="plusdu" value="⨥"/>
+ <entity name="pluse" value="⩲"/>
+ <entity name="PlusMinus" value="±"/>
+ <entity name="plusmn" value="±"/>
+ <entity name="plussim" value="⨦"/>
+ <entity name="plustwo" value="⨧"/>
+ <entity name="pm" value="±"/>
+ <entity name="Poincareplane" value="ℌ"/>
+ <entity name="pointint" value="⨕"/>
+ <entity name="popf" value="𝕡"/>
+ <entity name="Popf" value="ℙ"/>
+ <entity name="pound" value="£"/>
+ <entity name="pr" value="≺"/>
+ <entity name="Pr" value="⪻"/>
+ <entity name="prap" value="≾"/>
+ <entity name="prcue" value="≼"/>
+ <entity name="pre" value="⪯"/>
+ <entity name="prE" value="⪯"/>
+ <entity name="prec" value="≺"/>
+ <entity name="precapprox" value="≾"/>
+ <entity name="preccurlyeq" value="≼"/>
+ <entity name="Precedes" value="≺"/>
+ <entity name="PrecedesEqual" value="⪯"/>
+ <entity name="PrecedesSlantEqual" value="≼"/>
+ <entity name="PrecedesTilde" value="≾"/>
+ <entity name="preceq" value="⪯"/>
+ <entity name="precnapprox" value="⋨"/>
+ <entity name="precneqq" value="⪵"/>
+ <entity name="precnsim" value="⋨"/>
+ <entity name="precsim" value="≾"/>
+ <entity name="prime" value="′"/>
+ <entity name="Prime" value="″"/>
+ <entity name="primes" value="ℙ"/>
+ <entity name="prnap" value="⋨"/>
+ <entity name="prnE" value="⪵"/>
+ <entity name="prnsim" value="⋨"/>
+ <entity name="prod" value="∏"/>
+ <entity name="Product" value="∏"/>
+ <entity name="profalar" value="⌮"/>
+ <entity name="profline" value="⌒"/>
+ <entity name="profsurf" value="⌓"/>
+ <entity name="prop" value="∝"/>
+ <entity name="Proportion" value="∷"/>
+ <entity name="Proportional" value="∝"/>
+ <entity name="propto" value="∝"/>
+ <entity name="prsim" value="≾"/>
+ <entity name="prurel" value="⊰"/>
+ <entity name="pscr" value="𝓅"/>
+ <entity name="Pscr" value="𝒫"/>
+ <entity name="psi" value="ψ"/>
+ <entity name="Psi" value="Ψ"/>
+ <entity name="puncsp" value=" "/>
+ <entity name="qfr" value="𝔮"/>
+ <entity name="Qfr" value="𝔔"/>
+ <entity name="qint" value="⨌"/>
+ <entity name="qopf" value="𝕢"/>
+ <entity name="Qopf" value="ℚ"/>
+ <entity name="qprime" value="⁗"/>
+ <entity name="qscr" value="𝓆"/>
+ <entity name="Qscr" value="𝒬"/>
+ <entity name="quaternions" value="ℍ"/>
+ <entity name="quatint" value="⨖"/>
+ <entity name="quest" value="?"/>
+ <entity name="questeq" value="≟"/>
+ <entity name="quot" value="""/>
+ <entity name="rAarr" value="⇛"/>
+ <entity name="race" value="⧚"/>
+ <entity name="racute" value="ŕ"/>
+ <entity name="Racute" value="Ŕ"/>
+ <entity name="radic" value="√"/>
+ <entity name="raemptyv" value="⦳"/>
+ <entity name="rang" value="〉"/>
+ <entity name="Rang" value="》"/>
+ <entity name="rangd" value="⦒"/>
+ <entity name="range" value="⦥"/>
+ <entity name="rangle" value="〉"/>
+ <entity name="raquo" value="»"/>
+ <entity name="rarr" value="→"/>
+ <entity name="rArr" value="⇒"/>
+ <entity name="Rarr" value="↠"/>
+ <entity name="rarrap" value="⥵"/>
+ <entity name="rarrb" value="⇥"/>
+ <entity name="rarrbfs" value="⤠"/>
+ <entity name="rarrc" value="⤳"/>
+ <entity name="rarrfs" value="⤞"/>
+ <entity name="rarrhk" value="↪"/>
+ <entity name="rarrlp" value="↬"/>
+ <entity name="rarrpl" value="⥅"/>
+ <entity name="rarrsim" value="⥴"/>
+ <entity name="rarrtl" value="↣"/>
+ <entity name="Rarrtl" value="⤖"/>
+ <entity name="rarrw" value="↝"/>
+ <entity name="ratail" value="↣"/>
+ <entity name="rAtail" value="⤜"/>
+ <entity name="ratio" value="∶"/>
+ <entity name="rationals" value="ℚ"/>
+ <entity name="rbarr" value="⤍"/>
+ <entity name="rBarr" value="⤏"/>
+ <entity name="RBarr" value="⤐"/>
+ <entity name="rbbrk" value="〕"/>
+ <entity name="rbrace" value="}"/>
+ <entity name="rbrack" value="]"/>
+ <entity name="rbrke" value="⦌"/>
+ <entity name="rbrksld" value="⦎"/>
+ <entity name="rbrkslu" value="⦐"/>
+ <entity name="rcaron" value="ř"/>
+ <entity name="Rcaron" value="Ř"/>
+ <entity name="rcedil" value="ŗ"/>
+ <entity name="Rcedil" value="Ŗ"/>
+ <entity name="rceil" value="⌉"/>
+ <entity name="rcub" value="}"/>
+ <entity name="rcy" value="р"/>
+ <entity name="Rcy" value="Р"/>
+ <entity name="rdca" value="⤷"/>
+ <entity name="rdldhar" value="⥩"/>
+ <entity name="rdquo" value="”"/>
+ <entity name="rdquor" value="”"/>
+ <entity name="rdsh" value="↳"/>
+ <entity name="Re" value="ℜ"/>
+ <entity name="real" value="ℜ"/>
+ <entity name="realine" value="ℛ"/>
+ <entity name="realpart" value="ℜ"/>
+ <entity name="reals" value="ℝ"/>
+ <entity name="rect" value="▭"/>
+ <entity name="reg" value="®"/>
+ <entity name="ReverseElement" value="∋"/>
+ <entity name="ReverseEquilibrium" value="⇋"/>
+ <entity name="ReverseUpEquilibrium" value="⥯"/>
+ <entity name="rfisht" value="⥽"/>
+ <entity name="rfloor" value="⌋"/>
+ <entity name="rfr" value="𝔯"/>
+ <entity name="Rfr" value="ℜ"/>
+ <entity name="rHar" value="⥤"/>
+ <entity name="rhard" value="⇁"/>
+ <entity name="rharu" value="⇀"/>
+ <entity name="rharul" value="⥬"/>
+ <entity name="rho" value="ρ"/>
+ <entity name="rhov" value="ϱ"/>
+ <entity name="RightAngleBracket" value="〉"/>
+ <entity name="rightarrow" value="→"/>
+ <entity name="Rightarrow" value="⇒"/>
+ <entity name="RightArrow" value="→"/>
+ <entity name="RightArrowBar" value="⇥"/>
+ <entity name="RightArrowLeftArrow" value="⇄"/>
+ <entity name="rightarrowtail" value="↣"/>
+ <entity name="RightCeiling" value="⌉"/>
+ <entity name="RightDoubleBracket" value="〛"/>
+ <entity name="RightDownTeeVector" value="⥝"/>
+ <entity name="RightDownVector" value="⇂"/>
+ <entity name="RightDownVectorBar" value="⥕"/>
+ <entity name="RightFloor" value="⌋"/>
+ <entity name="rightharpoondown" value="⇁"/>
+ <entity name="rightharpoonup" value="⇀"/>
+ <entity name="rightleftarrows" value="⇄"/>
+ <entity name="rightleftharpoons" value="⇌"/>
+ <entity name="rightrightarrows" value="⇉"/>
+ <entity name="rightsquigarrow" value="↝"/>
+ <entity name="RightTee" value="⊢"/>
+ <entity name="RightTeeArrow" value="↦"/>
+ <entity name="RightTeeVector" value="⥛"/>
+ <entity name="rightthreetimes" value="⋌"/>
+ <entity name="RightTriangle" value="⊳"/>
+ <entity name="RightTriangleBar" value="⧐"/>
+ <entity name="RightTriangleEqual" value="⊵"/>
+ <entity name="RightUpDownVector" value="⥏"/>
+ <entity name="RightUpTeeVector" value="⥜"/>
+ <entity name="RightUpVector" value="↾"/>
+ <entity name="RightUpVectorBar" value="⥔"/>
+ <entity name="RightVector" value="⇀"/>
+ <entity name="RightVectorBar" value="⥓"/>
+ <entity name="ring" value="˚"/>
+ <entity name="risingdotseq" value="≓"/>
+ <entity name="rlarr" value="⇄"/>
+ <entity name="rlhar" value="⇌"/>
+ <entity name="rmoust" value="⎱"/>
+ <entity name="rmoustache" value="⎱"/>
+ <entity name="rnmid" value="⫮"/>
+ <entity name="roang" value=""/>
+ <entity name="roarr" value="⇾"/>
+ <entity name="robrk" value="〛"/>
+ <entity name="ropar" value="〙"/>
+ <entity name="ropf" value="𝕣"/>
+ <entity name="Ropf" value="ℝ"/>
+ <entity name="roplus" value="⨮"/>
+ <entity name="rotimes" value="⨵"/>
+ <entity name="RoundImplies" value="⥰"/>
+ <entity name="rpar" value=")"/>
+ <entity name="rpargt" value="⦔"/>
+ <entity name="rppolint" value="⨒"/>
+ <entity name="rrarr" value="⇉"/>
+ <entity name="Rrightarrow" value="⇛"/>
+ <entity name="rscr" value="𝓇"/>
+ <entity name="Rscr" value="ℛ"/>
+ <entity name="rsh" value="↱"/>
+ <entity name="Rsh" value="↱"/>
+ <entity name="rsqb" value="]"/>
+ <entity name="rsquo" value="’"/>
+ <entity name="rsquor" value="’"/>
+ <entity name="rthree" value="⋌"/>
+ <entity name="rtimes" value="⋊"/>
+ <entity name="rtri" value="▹"/>
+ <entity name="rtrie" value="⊵"/>
+ <entity name="rtrif" value="▸"/>
+ <entity name="rtriltri" value="⧎"/>
+ <entity name="RuleDelayed" value="⧴"/>
+ <entity name="ruluhar" value="⥨"/>
+ <entity name="rx" value="℞"/>
+ <entity name="sacute" value="ś"/>
+ <entity name="Sacute" value="Ś"/>
+ <entity name="sc" value="≻"/>
+ <entity name="Sc" value="⪼"/>
+ <entity name="scap" value="≿"/>
+ <entity name="scaron" value="š"/>
+ <entity name="Scaron" value="Š"/>
+ <entity name="sccue" value="≽"/>
+ <entity name="sce" value="≽"/>
+ <entity name="scE" value="≾"/>
+ <entity name="scedil" value="ş"/>
+ <entity name="Scedil" value="Ş"/>
+ <entity name="scirc" value="ŝ"/>
+ <entity name="Scirc" value="Ŝ"/>
+ <entity name="scnap" value="⋩"/>
+ <entity name="scnE" value="⪶"/>
+ <entity name="scnsim" value="⋩"/>
+ <entity name="scpolint" value="⨓"/>
+ <entity name="scsim" value="≿"/>
+ <entity name="scy" value="с"/>
+ <entity name="Scy" value="С"/>
+ <entity name="sdot" value="⋅"/>
+ <entity name="sdotb" value="⊡"/>
+ <entity name="sdote" value="⩦"/>
+ <entity name="searhk" value="⤥"/>
+ <entity name="searr" value="↘"/>
+ <entity name="seArr" value="⇘"/>
+ <entity name="searrow" value="↘"/>
+ <entity name="sect" value="§"/>
+ <entity name="semi" value=";"/>
+ <entity name="seswar" value="⤩"/>
+ <entity name="setminus" value="∖"/>
+ <entity name="setmn" value="∖"/>
+ <entity name="sext" value="✶"/>
+ <entity name="sfr" value="𝔰"/>
+ <entity name="Sfr" value="𝔖"/>
+ <entity name="sharp" value="♯"/>
+ <entity name="shchcy" value="щ"/>
+ <entity name="SHCHcy" value="Щ"/>
+ <entity name="shcy" value="ш"/>
+ <entity name="SHcy" value="Ш"/>
+ <entity name="ShortDownArrow" value="⌄︀"/>
+ <entity name="ShortLeftArrow" value="←︀"/>
+ <entity name="shortmid" value="∣︀"/>
+ <entity name="shortparallel" value="∥︀"/>
+ <entity name="ShortRightArrow" value="→︀"/>
+ <entity name="ShortUpArrow" value="⌃︀"/>
+ <entity name="shy" value="­"/>
+ <entity name="sigma" value="σ"/>
+ <entity name="Sigma" value="Σ"/>
+ <entity name="sigmav" value="ς"/>
+ <entity name="sim" value="∼"/>
+ <entity name="simdot" value="⩪"/>
+ <entity name="sime" value="≃"/>
+ <entity name="simeq" value="≃"/>
+ <entity name="simg" value="⪞"/>
+ <entity name="simgE" value="⪠"/>
+ <entity name="siml" value="⪝"/>
+ <entity name="simlE" value="⪟"/>
+ <entity name="simne" value="≆"/>
+ <entity name="simplus" value="⨤"/>
+ <entity name="simrarr" value="⥲"/>
+ <entity name="slarr" value="←︀"/>
+ <entity name="SmallCircle" value="∘"/>
+ <entity name="smallsetminus" value="∖︀"/>
+ <entity name="smashp" value="⨳"/>
+ <entity name="smeparsl" value="⧤"/>
+ <entity name="smid" value="∣︀"/>
+ <entity name="smile" value="⌣"/>
+ <entity name="smt" value="⪪"/>
+ <entity name="smte" value="⪬"/>
+ <entity name="smtes" value="⪬︀"/>
+ <entity name="softcy" value="ь"/>
+ <entity name="SOFTcy" value="Ь"/>
+ <entity name="sol" value="/"/>
+ <entity name="solb" value="⧄"/>
+ <entity name="solbar" value="⌿"/>
+ <entity name="sopf" value="𝕤"/>
+ <entity name="Sopf" value="𝕊"/>
+ <entity name="spades" value="♠"/>
+ <entity name="spadesuit" value="♠"/>
+ <entity name="spar" value="∥︀"/>
+ <entity name="sqcap" value="⊓"/>
+ <entity name="sqcaps" value="⊓︀"/>
+ <entity name="sqcup" value="⊔"/>
+ <entity name="sqcups" value="⊔︀"/>
+ <entity name="Sqrt" value="√"/>
+ <entity name="sqsub" value="⊏"/>
+ <entity name="sqsube" value="⊑"/>
+ <entity name="sqsubset" value="⊏"/>
+ <entity name="sqsubseteq" value="⊑"/>
+ <entity name="sqsup" value="⊐"/>
+ <entity name="sqsupe" value="⊒"/>
+ <entity name="sqsupset" value="⊐"/>
+ <entity name="sqsupseteq" value="⊒"/>
+ <entity name="squ" value="□"/>
+ <entity name="square" value="□"/>
+ <entity name="Square" value="□"/>
+ <entity name="SquareIntersection" value="⊓"/>
+ <entity name="SquareSubset" value="⊏"/>
+ <entity name="SquareSubsetEqual" value="⊑"/>
+ <entity name="SquareSuperset" value="⊐"/>
+ <entity name="SquareSupersetEqual" value="⊒"/>
+ <entity name="SquareUnion" value="⊔"/>
+ <entity name="squarf" value="▪"/>
+ <entity name="squf" value="▪"/>
+ <entity name="srarr" value="→︀"/>
+ <entity name="sscr" value="𝓈"/>
+ <entity name="Sscr" value="𝒮"/>
+ <entity name="ssetmn" value="∖︀"/>
+ <entity name="sstarf" value="⋆"/>
+ <entity name="star" value="⋆"/>
+ <entity name="Star" value="⋆"/>
+ <entity name="starf" value="★"/>
+ <entity name="straightepsilon" value="ε"/>
+ <entity name="straightphi" value="φ"/>
+ <entity name="Sub" value="⋐"/>
+ <entity name="subdot" value="⪽"/>
+ <entity name="sube" value="⊆"/>
+ <entity name="subE" value="⊆"/>
+ <entity name="subedot" value="⫃"/>
+ <entity name="submult" value="⫁"/>
+ <entity name="subne" value="⊊"/>
+ <entity name="subnE" value="⊊"/>
+ <entity name="subplus" value="⪿"/>
+ <entity name="subrarr" value="⥹"/>
+ <entity name="subset" value="⊂"/>
+ <entity name="Subset" value="⋐"/>
+ <entity name="subseteq" value="⊆"/>
+ <entity name="subseteqq" value="⊆"/>
+ <entity name="SubsetEqual" value="⊆"/>
+ <entity name="subsetneq" value="⊊"/>
+ <entity name="subsetneqq" value="⊊"/>
+ <entity name="subsim" value="⫇"/>
+ <entity name="subsub" value="⫕"/>
+ <entity name="subsup" value="⫓"/>
+ <entity name="succ" value="≻"/>
+ <entity name="succapprox" value="≿"/>
+ <entity name="succcurlyeq" value="≽"/>
+ <entity name="Succeeds" value="≻"/>
+ <entity name="SucceedsEqual" value="≽"/>
+ <entity name="SucceedsSlantEqual" value="≽"/>
+ <entity name="SucceedsTilde" value="≿"/>
+ <entity name="succeq" value="≽"/>
+ <entity name="succnapprox" value="⋩"/>
+ <entity name="succneqq" value="⪶"/>
+ <entity name="succnsim" value="⋩"/>
+ <entity name="succsim" value="≿"/>
+ <entity name="SuchThat" value="∋"/>
+ <entity name="sum" value="∑"/>
+ <entity name="Sum" value="∑"/>
+ <entity name="sung" value="♪"/>
+ <entity name="Sup" value="⋑"/>
+ <entity name="sup1" value="¹"/>
+ <entity name="sup2" value="²"/>
+ <entity name="sup3" value="³"/>
+ <entity name="supdot" value="⪾"/>
+ <entity name="supdsub" value="⫘"/>
+ <entity name="supe" value="⊇"/>
+ <entity name="supE" value="⊇"/>
+ <entity name="supedot" value="⫄"/>
+ <entity name="Superset" value="⊃"/>
+ <entity name="SupersetEqual" value="⊇"/>
+ <entity name="suphsol" value="⊃/"/>
+ <entity name="suphsub" value="⫗"/>
+ <entity name="suplarr" value="⥻"/>
+ <entity name="supmult" value="⫂"/>
+ <entity name="supne" value="⊋"/>
+ <entity name="supnE" value="⊋"/>
+ <entity name="supplus" value="⫀"/>
+ <entity name="supset" value="⊃"/>
+ <entity name="Supset" value="⋑"/>
+ <entity name="supseteq" value="⊇"/>
+ <entity name="supseteqq" value="⊇"/>
+ <entity name="supsetneq" value="⊋"/>
+ <entity name="supsetneqq" value="⊋"/>
+ <entity name="supsim" value="⫈"/>
+ <entity name="supsub" value="⫔"/>
+ <entity name="supsup" value="⫖"/>
+ <entity name="swarhk" value="⤦"/>
+ <entity name="swarr" value="↙"/>
+ <entity name="swArr" value="⇙"/>
+ <entity name="swarrow" value="↙"/>
+ <entity name="swnwar" value="⤪"/>
+ <entity name="szlig" value="ß"/>
+ <entity name="Tab" value="	"/>
+ <entity name="target" value="⌖"/>
+ <entity name="tau" value="τ"/>
+ <entity name="tbrk" value="⎴"/>
+ <entity name="tcaron" value="ť"/>
+ <entity name="Tcaron" value="Ť"/>
+ <entity name="tcedil" value="ţ"/>
+ <entity name="Tcedil" value="Ţ"/>
+ <entity name="tcy" value="т"/>
+ <entity name="Tcy" value="Т"/>
+ <entity name="tdot" value="⃛"/>
+ <entity name="telrec" value="⌕"/>
+ <entity name="tfr" value="𝔱"/>
+ <entity name="Tfr" value="𝔗"/>
+ <entity name="there4" value="∴"/>
+ <entity name="therefore" value="∴"/>
+ <entity name="Therefore" value="∴"/>
+ <entity name="theta" value="θ"/>
+ <entity name="Theta" value="Θ"/>
+ <entity name="thetav" value="ϑ"/>
+ <entity name="thickapprox" value="≈︀"/>
+ <entity name="thicksim" value="∼︀"/>
+ <entity name="ThickSpace" value="   "/>
+ <entity name="thinsp" value=" "/>
+ <entity name="ThinSpace" value=" "/>
+ <entity name="thkap" value="≈︀"/>
+ <entity name="thksim" value="∼︀"/>
+ <entity name="thorn" value="þ"/>
+ <entity name="THORN" value="Þ"/>
+ <entity name="tilde" value="˜"/>
+ <entity name="Tilde" value="∼"/>
+ <entity name="TildeEqual" value="≃"/>
+ <entity name="TildeFullEqual" value="≅"/>
+ <entity name="TildeTilde" value="≈"/>
+ <entity name="times" value="×"/>
+ <entity name="timesb" value="⊠"/>
+ <entity name="timesbar" value="⨱"/>
+ <entity name="timesd" value="⨰"/>
+ <entity name="tint" value="∭"/>
+ <entity name="toea" value="⤨"/>
+ <entity name="top" value="⊤"/>
+ <entity name="topbot" value="⌶"/>
+ <entity name="topcir" value="⫱"/>
+ <entity name="topf" value="𝕥"/>
+ <entity name="Topf" value="𝕋"/>
+ <entity name="topfork" value="⫚"/>
+ <entity name="tosa" value="⤩"/>
+ <entity name="tprime" value="‴"/>
+ <entity name="trade" value="™"/>
+ <entity name="triangle" value="▵"/>
+ <entity name="triangledown" value="▿"/>
+ <entity name="triangleleft" value="◃"/>
+ <entity name="trianglelefteq" value="⊴"/>
+ <entity name="triangleq" value="≜"/>
+ <entity name="triangleright" value="▹"/>
+ <entity name="trianglerighteq" value="⊵"/>
+ <entity name="tridot" value="◬"/>
+ <entity name="trie" value="≜"/>
+ <entity name="triminus" value="⨺"/>
+ <entity name="TripleDot" value="⃛"/>
+ <entity name="triplus" value="⨹"/>
+ <entity name="trisb" value="⧍"/>
+ <entity name="tritime" value="⨻"/>
+ <entity name="tscr" value="𝓉"/>
+ <entity name="Tscr" value="𝒯"/>
+ <entity name="tscy" value="ц"/>
+ <entity name="TScy" value="Ц"/>
+ <entity name="tshcy" value="ћ"/>
+ <entity name="TSHcy" value="Ћ"/>
+ <entity name="tstrok" value="ŧ"/>
+ <entity name="Tstrok" value="Ŧ"/>
+ <entity name="twixt" value="≬"/>
+ <entity name="twoheadleftarrow" value="↞"/>
+ <entity name="twoheadrightarrow" value="↠"/>
+ <entity name="uacute" value="ú"/>
+ <entity name="Uacute" value="Ú"/>
+ <entity name="uarr" value="↑"/>
+ <entity name="uArr" value="⇑"/>
+ <entity name="Uarr" value="↟"/>
+ <entity name="Uarrocir" value="⥉"/>
+ <entity name="ubrcy" value="ў"/>
+ <entity name="Ubrcy" value="Ў"/>
+ <entity name="ubreve" value="ŭ"/>
+ <entity name="Ubreve" value="Ŭ"/>
+ <entity name="ucirc" value="û"/>
+ <entity name="Ucirc" value="Û"/>
+ <entity name="ucy" value="у"/>
+ <entity name="Ucy" value="У"/>
+ <entity name="udarr" value="⇅"/>
+ <entity name="udblac" value="ű"/>
+ <entity name="Udblac" value="Ű"/>
+ <entity name="udhar" value="⥮"/>
+ <entity name="ufisht" value="⥾"/>
+ <entity name="ufr" value="𝔲"/>
+ <entity name="Ufr" value="𝔘"/>
+ <entity name="ugrave" value="ù"/>
+ <entity name="Ugrave" value="Ù"/>
+ <entity name="uHar" value="⥣"/>
+ <entity name="uharl" value="↿"/>
+ <entity name="uharr" value="↾"/>
+ <entity name="uhblk" value="▀"/>
+ <entity name="ulcorn" value="⌜"/>
+ <entity name="ulcorner" value="⌜"/>
+ <entity name="ulcrop" value="⌏"/>
+ <entity name="ultri" value="◸"/>
+ <entity name="umacr" value="ū"/>
+ <entity name="Umacr" value="Ū"/>
+ <entity name="uml" value="¨"/>
+ <entity name="UnderBar" value="̲"/>
+ <entity name="UnderBrace" value="︸"/>
+ <entity name="UnderBracket" value="⎵"/>
+ <entity name="UnderParenthesis" value="︶"/>
+ <entity name="Union" value="⋃"/>
+ <entity name="UnionPlus" value="⊎"/>
+ <entity name="uogon" value="ų"/>
+ <entity name="Uogon" value="Ų"/>
+ <entity name="uopf" value="𝕦"/>
+ <entity name="Uopf" value="𝕌"/>
+ <entity name="uparrow" value="↑"/>
+ <entity name="Uparrow" value="⇑"/>
+ <entity name="UpArrow" value="↑"/>
+ <entity name="UpArrowBar" value="⤒"/>
+ <entity name="UpArrowDownArrow" value="⇅"/>
+ <entity name="updownarrow" value="↕"/>
+ <entity name="Updownarrow" value="⇕"/>
+ <entity name="UpDownArrow" value="↕"/>
+ <entity name="UpEquilibrium" value="⥮"/>
+ <entity name="upharpoonleft" value="↿"/>
+ <entity name="upharpoonright" value="↾"/>
+ <entity name="uplus" value="⊎"/>
+ <entity name="UpperLeftArrow" value="↖"/>
+ <entity name="UpperRightArrow" value="↗"/>
+ <entity name="upsi" value="υ"/>
+ <entity name="Upsi" value="ϒ"/>
+ <entity name="upsilon" value="υ"/>
+ <entity name="Upsilon" value="ϒ"/>
+ <entity name="UpTee" value="⊥"/>
+ <entity name="UpTeeArrow" value="↥"/>
+ <entity name="upuparrows" value="⇈"/>
+ <entity name="urcorn" value="⌝"/>
+ <entity name="urcorner" value="⌝"/>
+ <entity name="urcrop" value="⌎"/>
+ <entity name="uring" value="ů"/>
+ <entity name="Uring" value="Ů"/>
+ <entity name="urtri" value="◹"/>
+ <entity name="uscr" value="𝓊"/>
+ <entity name="Uscr" value="𝒰"/>
+ <entity name="utdot" value="⋰"/>
+ <entity name="utilde" value="ũ"/>
+ <entity name="Utilde" value="Ũ"/>
+ <entity name="utri" value="▵"/>
+ <entity name="utrif" value="▴"/>
+ <entity name="uuarr" value="⇈"/>
+ <entity name="uuml" value="ü"/>
+ <entity name="Uuml" value="Ü"/>
+ <entity name="uwangle" value="⦧"/>
+ <entity name="vangrt" value="⊾"/>
+ <entity name="varepsilon" value="ɛ"/>
+ <entity name="varkappa" value="ϰ"/>
+ <entity name="varnothing" value="∅"/>
+ <entity name="varphi" value="ϕ"/>
+ <entity name="varpi" value="ϖ"/>
+ <entity name="varpropto" value="∝"/>
+ <entity name="varr" value="↕"/>
+ <entity name="vArr" value="⇕"/>
+ <entity name="varrho" value="ϱ"/>
+ <entity name="varsigma" value="ς"/>
+ <entity name="varsubsetneq" value="⊊︀"/>
+ <entity name="varsubsetneqq" value="⊊︀"/>
+ <entity name="varsupsetneq" value="⊋︀"/>
+ <entity name="varsupsetneqq" value="⊋︀"/>
+ <entity name="vartheta" value="ϑ"/>
+ <entity name="vartriangleleft" value="⊲"/>
+ <entity name="vartriangleright" value="⊳"/>
+ <entity name="vBar" value="⫨"/>
+ <entity name="Vbar" value="⫫"/>
+ <entity name="vBarv" value="⫩"/>
+ <entity name="vcy" value="в"/>
+ <entity name="Vcy" value="В"/>
+ <entity name="vdash" value="⊢"/>
+ <entity name="vDash" value="⊨"/>
+ <entity name="Vdash" value="⊩"/>
+ <entity name="VDash" value="⊫"/>
+ <entity name="Vdashl" value="⫦"/>
+ <entity name="vee" value="∨"/>
+ <entity name="Vee" value="⋁"/>
+ <entity name="veebar" value="⊻"/>
+ <entity name="veeeq" value="≚"/>
+ <entity name="vellip" value="⋮"/>
+ <entity name="verbar" value="|"/>
+ <entity name="Verbar" value="‖"/>
+ <entity name="vert" value="|"/>
+ <entity name="Vert" value="‖"/>
+ <entity name="VerticalBar" value="∣"/>
+ <entity name="VerticalLine" value="|"/>
+ <entity name="VerticalSeparator" value="❘"/>
+ <entity name="VerticalTilde" value="≀"/>
+ <entity name="VeryThinSpace" value=" "/>
+ <entity name="vfr" value="𝔳"/>
+ <entity name="Vfr" value="𝔙"/>
+ <entity name="vltri" value="⊲"/>
+ <entity name="vnsub" value="⊄"/>
+ <entity name="vnsup" value="⊅"/>
+ <entity name="vopf" value="𝕧"/>
+ <entity name="Vopf" value="𝕍"/>
+ <entity name="vprop" value="∝"/>
+ <entity name="vrtri" value="⊳"/>
+ <entity name="vscr" value="𝓋"/>
+ <entity name="Vscr" value="𝒱"/>
+ <entity name="vsubne" value="⊊︀"/>
+ <entity name="vsubnE" value="⊊︀"/>
+ <entity name="vsupne" value="⊋︀"/>
+ <entity name="vsupnE" value="⊋︀"/>
+ <entity name="Vvdash" value="⊪"/>
+ <entity name="vzigzag" value="⦚"/>
+ <entity name="wcirc" value="ŵ"/>
+ <entity name="Wcirc" value="Ŵ"/>
+ <entity name="wedbar" value="⩟"/>
+ <entity name="wedge" value="∧"/>
+ <entity name="Wedge" value="⋀"/>
+ <entity name="wedgeq" value="≙"/>
+ <entity name="weierp" value="℘"/>
+ <entity name="wfr" value="𝔴"/>
+ <entity name="Wfr" value="𝔚"/>
+ <entity name="wopf" value="𝕨"/>
+ <entity name="Wopf" value="𝕎"/>
+ <entity name="wp" value="℘"/>
+ <entity name="wr" value="≀"/>
+ <entity name="wreath" value="≀"/>
+ <entity name="wscr" value="𝓌"/>
+ <entity name="Wscr" value="𝒲"/>
+ <entity name="xcap" value="⋂"/>
+ <entity name="xcirc" value="◯"/>
+ <entity name="xcup" value="⋃"/>
+ <entity name="xdtri" value="▽"/>
+ <entity name="xfr" value="𝔵"/>
+ <entity name="Xfr" value="𝔛"/>
+ <entity name="xharr" value=""/>
+ <entity name="xhArr" value=""/>
+ <entity name="xi" value="ξ"/>
+ <entity name="Xi" value="Ξ"/>
+ <entity name="xlarr" value=""/>
+ <entity name="xlArr" value=""/>
+ <entity name="xmap" value=""/>
+ <entity name="xnis" value="⋻"/>
+ <entity name="xodot" value="⊙"/>
+ <entity name="xopf" value="𝕩"/>
+ <entity name="Xopf" value="𝕏"/>
+ <entity name="xoplus" value="⊕"/>
+ <entity name="xotime" value="⊗"/>
+ <entity name="xrarr" value=""/>
+ <entity name="xrArr" value=""/>
+ <entity name="xscr" value="𝓍"/>
+ <entity name="Xscr" value="𝒳"/>
+ <entity name="xsqcup" value="⊔"/>
+ <entity name="xuplus" value="⊎"/>
+ <entity name="xutri" value="△"/>
+ <entity name="xvee" value="⋁"/>
+ <entity name="xwedge" value="⋀"/>
+ <entity name="yacute" value="ý"/>
+ <entity name="Yacute" value="Ý"/>
+ <entity name="yacy" value="я"/>
+ <entity name="YAcy" value="Я"/>
+ <entity name="ycirc" value="ŷ"/>
+ <entity name="Ycirc" value="Ŷ"/>
+ <entity name="ycy" value="ы"/>
+ <entity name="Ycy" value="Ы"/>
+ <entity name="yen" value="¥"/>
+ <entity name="yfr" value="𝔶"/>
+ <entity name="Yfr" value="𝔜"/>
+ <entity name="yicy" value="ї"/>
+ <entity name="YIcy" value="Ї"/>
+ <entity name="yopf" value="𝕪"/>
+ <entity name="Yopf" value="𝕐"/>
+ <entity name="yscr" value="𝓎"/>
+ <entity name="Yscr" value="𝒴"/>
+ <entity name="yucy" value="ю"/>
+ <entity name="YUcy" value="Ю"/>
+ <entity name="yuml" value="ÿ"/>
+ <entity name="Yuml" value="Ÿ"/>
+ <entity name="zacute" value="ź"/>
+ <entity name="Zacute" value="Ź"/>
+ <entity name="zcaron" value="ž"/>
+ <entity name="Zcaron" value="Ž"/>
+ <entity name="zcy" value="з"/>
+ <entity name="Zcy" value="З"/>
+ <entity name="zdot" value="ż"/>
+ <entity name="Zdot" value="Ż"/>
+ <entity name="zeetrf" value="ℨ"/>
+ <entity name="ZeroWidthSpace" value="​"/>
+ <entity name="zeta" value="ζ"/>
+ <entity name="zfr" value="𝔷"/>
+ <entity name="Zfr" value="ℨ"/>
+ <entity name="zhcy" value="ж"/>
+ <entity name="ZHcy" value="Ж"/>
+ <entity name="zigrarr" value="⇝"/>
+ <entity name="zopf" value="𝕫"/>
+ <entity name="Zopf" value="ℤ"/>
+ <entity name="zscr" value="𝓏"/>
+ <entity name="Zscr" value="𝒵"/>
+</entities-table>
diff --git a/helm/ocaml/utf8_macros/data/extra-entities.xml b/helm/ocaml/utf8_macros/data/extra-entities.xml
new file mode 100644
index 000000000..73b12ad5e
--- /dev/null
+++ b/helm/ocaml/utf8_macros/data/extra-entities.xml
@@ -0,0 +1,16 @@
+<?xml version="1.0"?>
+
+<entities-table>
+ <entity name="def" value="≝"/> <!-- â -->
+ <entity name="neq" value="≠"/> <!-- â -->
+ <entity name="leq" value="≤"/> <!-- ⤠-->
+ <entity name="geq" value="≥"/> <!-- ⥠-->
+ <entity name="nleq" value="≰"/> <!-- â° -->
+ <entity name="ngeq" value="≱"/> <!-- â± -->
+ <entity name="to" value="→"/> <!-- â -->
+ <entity name="divides" value="∣"/> <!-- ⣠-->
+ <entity name="ndivides" value="∤"/> <!-- ⤠-->
+ <entity name="circ" value="∘"/> <!-- ⤠-->
+</entities-table>
+
+<!-- vim: set encoding=utf8: -->
diff --git a/helm/ocaml/utf8_macros/make_table.ml b/helm/ocaml/utf8_macros/make_table.ml
new file mode 100644
index 000000000..4722af1e1
--- /dev/null
+++ b/helm/ocaml/utf8_macros/make_table.ml
@@ -0,0 +1,102 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+let debug = false
+let debug_print s = if debug then prerr_endline (Lazy.force s)
+
+ (* source files for tables xml parsing (if unmarshall=false) *)
+let xml_tables = [
+(*
+ `Entities, "/usr/share/gtkmathview/entities-table.xml";
+ `Dictionary, "/usr/share/editex/dictionary-tex.xml"
+*)
+ `Entities, "data/entities-table.xml";
+ `Dictionary, "data/dictionary-tex.xml";
+ `Entities, "data/extra-entities.xml";
+ (** extra-entities.xml should be the last one since it is used to override
+ * previous mappings. Add there overrides as needed. *)
+]
+
+let iter_gen record_tag name_field value_field f fname =
+ let start_element tag attrs =
+ if tag = record_tag then
+ try
+ let name = List.assoc name_field attrs in
+ let value = List.assoc value_field attrs in
+ f name value
+ with Not_found -> ()
+ in
+ let callbacks = {
+ XmlPushParser.default_callbacks with
+ XmlPushParser.start_element = Some start_element
+ } in
+ let xml_parser = XmlPushParser.create_parser callbacks in
+ XmlPushParser.parse xml_parser (`File fname)
+
+let iter_entities_file = iter_gen "entity" "name" "value"
+let iter_dictionary_file = iter_gen "entry" "name" "val"
+
+let parse_from_xml () =
+ let (macro2utf8, utf82macro) = (Hashtbl.create 2000, Hashtbl.create 2000) in
+ let add_macro macro utf8 =
+ debug_print (lazy (sprintf "Adding macro %s = '%s'" macro utf8));
+ Hashtbl.replace macro2utf8 macro utf8;
+ Hashtbl.replace utf82macro utf8 macro
+ in
+ let fill_table () =
+ List.iter
+ (fun (typ, fname) ->
+ match typ with
+ | `Entities -> iter_entities_file add_macro fname
+ | `Dictionary -> iter_dictionary_file add_macro fname)
+ xml_tables
+ in
+ fill_table ();
+ macro2utf8, utf82macro
+
+let main () =
+ let oc = open_out Sys.argv.(1) in
+ output_string oc "(* GENERATED by make_table: DO NOT EDIT! *)\n";
+ output_string oc "let macro2utf8 = Hashtbl.create 2000\n";
+ output_string oc "let utf82macro = Hashtbl.create 2000\n";
+ let macro2utf8, utf82macro = parse_from_xml () in
+ Hashtbl.iter
+ (fun macro utf8 ->
+ fprintf oc "let _ = Hashtbl.replace macro2utf8 \"%s\" \"%s\"\n"
+ macro (String.escaped utf8))
+ macro2utf8;
+ Hashtbl.iter
+ (fun utf8 macro ->
+ fprintf oc "let _ = Hashtbl.replace utf82macro \"%s\" \"%s\"\n"
+ (String.escaped utf8) macro)
+ utf82macro;
+ close_out oc
+
+let _ = main ()
+
diff --git a/helm/ocaml/utf8_macros/pa_unicode_macro.ml b/helm/ocaml/utf8_macros/pa_unicode_macro.ml
new file mode 100644
index 000000000..dda7d4cab
--- /dev/null
+++ b/helm/ocaml/utf8_macros/pa_unicode_macro.ml
@@ -0,0 +1,67 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let debug = false
+let debug_print s = if debug then prerr_endline (Lazy.force s)
+
+let loc =
+ let dummy_pos =
+ { Lexing.pos_fname = ""; Lexing.pos_lnum = -1; Lexing.pos_bol = -1;
+ Lexing.pos_cnum = -1 }
+ in
+ (dummy_pos, dummy_pos)
+
+let expand_unicode_macro macro =
+ debug_print (lazy (Printf.sprintf "Expanding macro '%s' ..." macro));
+ let expansion = Utf8Macro.expand macro in
+ <:expr< $str:expansion$ >>
+
+let _ =
+ Quotation.add "unicode"
+ (Quotation.ExAst (expand_unicode_macro, (fun _ -> assert false)))
+
+open Pa_extend
+
+EXTEND
+ symbol: FIRST
+ [
+ [ x = UIDENT; q = QUOTATION ->
+ let (quotation, arg) =
+ let pos = String.index q ':' in
+ (String.sub q 0 pos,
+ String.sub q (pos + 1) (String.length q - pos - 1))
+ in
+ debug_print (lazy (Printf.sprintf "QUOTATION = %s; ARG = %s" quotation arg));
+ if quotation = "unicode" then
+ let text = TXtok (loc, x, expand_unicode_macro arg) in
+ {used = []; text = text; styp = STlid (loc, "string")}
+ else
+ assert false
+ ]
+ ];
+END
+
diff --git a/helm/ocaml/utf8_macros/test.ml b/helm/ocaml/utf8_macros/test.ml
new file mode 100644
index 000000000..8f98bfd44
--- /dev/null
+++ b/helm/ocaml/utf8_macros/test.ml
@@ -0,0 +1,3 @@
+(* $Id$ *)
+
+prerr_endline <:unicode<lambda>>
diff --git a/helm/ocaml/utf8_macros/utf8Macro.ml b/helm/ocaml/utf8_macros/utf8Macro.ml
new file mode 100644
index 000000000..e5fca10c4
--- /dev/null
+++ b/helm/ocaml/utf8_macros/utf8Macro.ml
@@ -0,0 +1,47 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+exception Macro_not_found of string
+exception Utf8_not_found of string
+
+let expand macro =
+ try
+ Hashtbl.find Utf8MacroTable.macro2utf8 macro
+ with Not_found -> raise (Macro_not_found macro)
+
+let unicode_of_tex s =
+ try
+ if s.[0] = '\\' then
+ expand (String.sub s 1 (String.length s - 1))
+ else s
+ with Macro_not_found _ -> s
+
+let tex_of_unicode s =
+ try
+ "\\" ^ Hashtbl.find Utf8MacroTable.utf82macro s
+ with Not_found -> s
+
diff --git a/helm/ocaml/utf8_macros/utf8Macro.mli b/helm/ocaml/utf8_macros/utf8Macro.mli
new file mode 100644
index 000000000..d92f60b37
--- /dev/null
+++ b/helm/ocaml/utf8_macros/utf8Macro.mli
@@ -0,0 +1,40 @@
+(* Copyright (C) 2004, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+exception Macro_not_found of string
+exception Utf8_not_found of string
+
+ (** @param macro name
+ @return utf8 string *)
+val expand: string -> string
+
+ (** @param tex TeX like command (e.g. \forall, \lnot, ...)
+ * @return unicode character corresponding to the command if it exists, or the
+ * unchanged command if not *)
+val unicode_of_tex: string -> string
+
+ (** ... the other way round *)
+val tex_of_unicode: string -> string
+
diff --git a/helm/ocaml/utf8_macros/utf8MacroTable.ml b/helm/ocaml/utf8_macros/utf8MacroTable.ml
new file mode 100644
index 000000000..8b4a02e47
--- /dev/null
+++ b/helm/ocaml/utf8_macros/utf8MacroTable.ml
@@ -0,0 +1,3625 @@
+(* GENERATED by make_table: DO NOT EDIT! *)
+let macro2utf8 = Hashtbl.create 2000
+let utf82macro = Hashtbl.create 2000
+let _ = Hashtbl.replace macro2utf8 "nscr" "\240\157\147\131"
+let _ = Hashtbl.replace macro2utf8 "LJcy" "\208\137"
+let _ = Hashtbl.replace macro2utf8 "dd" "\226\133\134"
+let _ = Hashtbl.replace macro2utf8 "Omacr" "\197\140"
+let _ = Hashtbl.replace macro2utf8 "npreceq" "\226\170\175\204\184"
+let _ = Hashtbl.replace macro2utf8 "Gcirc" "\196\156"
+let _ = Hashtbl.replace macro2utf8 "utilde" "\197\169"
+let _ = Hashtbl.replace macro2utf8 "rdca" "\226\164\183"
+let _ = Hashtbl.replace macro2utf8 "racute" "\197\149"
+let _ = Hashtbl.replace macro2utf8 "mstpos" "\226\136\190"
+let _ = Hashtbl.replace macro2utf8 "supnE" "\226\138\139"
+let _ = Hashtbl.replace macro2utf8 "NotLessLess" "\226\137\170\204\184\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "iiint" "\226\136\173"
+let _ = Hashtbl.replace macro2utf8 "uscr" "\240\157\147\138"
+let _ = Hashtbl.replace macro2utf8 "Sfr" "\240\157\148\150"
+let _ = Hashtbl.replace macro2utf8 "nsupseteqq" "\226\138\137"
+let _ = Hashtbl.replace macro2utf8 "nwarrow" "\226\134\150"
+let _ = Hashtbl.replace macro2utf8 "twoheadrightarrow" "\226\134\160"
+let _ = Hashtbl.replace macro2utf8 "sccue" "\226\137\189"
+let _ = Hashtbl.replace macro2utf8 "NotSquareSuperset" "\226\138\144\204\184"
+let _ = Hashtbl.replace macro2utf8 "ee" "\226\133\135"
+let _ = Hashtbl.replace macro2utf8 "boxbox" "\226\167\137"
+let _ = Hashtbl.replace macro2utf8 "andand" "\226\169\149"
+let _ = Hashtbl.replace macro2utf8 "LeftVectorBar" "\226\165\146"
+let _ = Hashtbl.replace macro2utf8 "eg" "\226\170\154"
+let _ = Hashtbl.replace macro2utf8 "csc" "csc"
+let _ = Hashtbl.replace macro2utf8 "NotRightTriangleEqual" "\226\139\173"
+let _ = Hashtbl.replace macro2utf8 "filig" "\239\172\129"
+let _ = Hashtbl.replace macro2utf8 "atilde" "\195\163"
+let _ = Hashtbl.replace macro2utf8 "ring" "\203\154"
+let _ = Hashtbl.replace macro2utf8 "congdot" "\226\169\173"
+let _ = Hashtbl.replace macro2utf8 "gE" "\226\137\167"
+let _ = Hashtbl.replace macro2utf8 "rcedil" "\197\151"
+let _ = Hashtbl.replace macro2utf8 "el" "\226\170\153"
+let _ = Hashtbl.replace macro2utf8 "HorizontalLine" "\226\148\128"
+let _ = Hashtbl.replace macro2utf8 "incare" "\226\132\133"
+let _ = Hashtbl.replace macro2utf8 "hoarr" "\226\135\191"
+let _ = Hashtbl.replace macro2utf8 "SOFTcy" "\208\172"
+let _ = Hashtbl.replace macro2utf8 "conint" "\226\136\174"
+let _ = Hashtbl.replace macro2utf8 "OverParenthesis" "\239\184\181"
+let _ = Hashtbl.replace macro2utf8 "Uogon" "\197\178"
+let _ = Hashtbl.replace macro2utf8 "supne" "\226\138\139"
+let _ = Hashtbl.replace macro2utf8 "num" "#"
+let _ = Hashtbl.replace macro2utf8 "zcy" "\208\183"
+let _ = Hashtbl.replace macro2utf8 "Hfr" "\226\132\140"
+let _ = Hashtbl.replace macro2utf8 "dtri" "\226\150\191"
+let _ = Hashtbl.replace macro2utf8 "FilledSmallSquare" "\226\151\190"
+let _ = Hashtbl.replace macro2utf8 "SucceedsEqual" "\226\137\189"
+let _ = Hashtbl.replace macro2utf8 "leftthreetimes" "\226\139\139"
+let _ = Hashtbl.replace macro2utf8 "ycirc" "\197\183"
+let _ = Hashtbl.replace macro2utf8 "sqcup" "\226\138\148"
+let _ = Hashtbl.replace macro2utf8 "DoubleLeftArrow" "\226\135\144"
+let _ = Hashtbl.replace macro2utf8 "gtrless" "\226\137\183"
+let _ = Hashtbl.replace macro2utf8 "ge" "\226\137\165"
+let _ = Hashtbl.replace macro2utf8 "Product" "\226\136\143"
+let _ = Hashtbl.replace macro2utf8 "NotExists" "\226\136\132"
+let _ = Hashtbl.replace macro2utf8 "gg" "\226\137\171"
+let _ = Hashtbl.replace macro2utf8 "curlyvee" "\226\139\142"
+let _ = Hashtbl.replace macro2utf8 "ntrianglerighteq" "\226\139\173"
+let _ = Hashtbl.replace macro2utf8 "Colon" "\226\136\183"
+let _ = Hashtbl.replace macro2utf8 "rbrke" "\226\166\140"
+let _ = Hashtbl.replace macro2utf8 "LeftDownVector" "\226\135\131"
+let _ = Hashtbl.replace macro2utf8 "gl" "\226\137\183"
+let _ = Hashtbl.replace macro2utf8 "lrcorner" "\226\140\159"
+let _ = Hashtbl.replace macro2utf8 "mapstodown" "\226\134\167"
+let _ = Hashtbl.replace macro2utf8 "excl" "!"
+let _ = Hashtbl.replace macro2utf8 "cdots" "\226\139\175"
+let _ = Hashtbl.replace macro2utf8 "larr" "\226\134\144"
+let _ = Hashtbl.replace macro2utf8 "dtdot" "\226\139\177"
+let _ = Hashtbl.replace macro2utf8 "kgreen" "\196\184"
+let _ = Hashtbl.replace macro2utf8 "rtri" "\226\150\185"
+let _ = Hashtbl.replace macro2utf8 "rbarr" "\226\164\141"
+let _ = Hashtbl.replace macro2utf8 "ocy" "\208\190"
+let _ = Hashtbl.replace macro2utf8 "gt" ">"
+let _ = Hashtbl.replace macro2utf8 "DownLeftRightVector" "\226\165\144"
+let _ = Hashtbl.replace macro2utf8 "cup" "\226\136\170"
+let _ = Hashtbl.replace macro2utf8 "updownarrow" "\226\134\149"
+let _ = Hashtbl.replace macro2utf8 "Imacr" "\196\170"
+let _ = Hashtbl.replace macro2utf8 "cross" "\226\156\151"
+let _ = Hashtbl.replace macro2utf8 "Acirc" "\195\130"
+let _ = Hashtbl.replace macro2utf8 "lvertneqq" "\226\137\168\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "ccaps" "\226\169\141"
+let _ = Hashtbl.replace macro2utf8 "NotLeftTriangleEqual" "\226\139\172"
+let _ = Hashtbl.replace macro2utf8 "IJlig" "\196\178"
+let _ = Hashtbl.replace macro2utf8 "boxplus" "\226\138\158"
+let _ = Hashtbl.replace macro2utf8 "epsilon" "\207\181"
+let _ = Hashtbl.replace macro2utf8 "zfr" "\240\157\148\183"
+let _ = Hashtbl.replace macro2utf8 "late" "\226\170\173"
+let _ = Hashtbl.replace macro2utf8 "ic" "\226\128\139"
+let _ = Hashtbl.replace macro2utf8 "lrhar" "\226\135\139"
+let _ = Hashtbl.replace macro2utf8 "gsim" "\226\137\179"
+let _ = Hashtbl.replace macro2utf8 "inf" "inf"
+let _ = Hashtbl.replace macro2utf8 "top" "\226\138\164"
+let _ = Hashtbl.replace macro2utf8 "odsold" "\226\166\188"
+let _ = Hashtbl.replace macro2utf8 "circlearrowright" "\226\134\187"
+let _ = Hashtbl.replace macro2utf8 "rtimes" "\226\139\138"
+let _ = Hashtbl.replace macro2utf8 "ii" "\226\133\136"
+let _ = Hashtbl.replace macro2utf8 "DoubleRightTee" "\226\138\168"
+let _ = Hashtbl.replace macro2utf8 "dcy" "\208\180"
+let _ = Hashtbl.replace macro2utf8 "boxdL" "\226\149\149"
+let _ = Hashtbl.replace macro2utf8 "duhar" "\226\165\175"
+let _ = Hashtbl.replace macro2utf8 "vert" "|"
+let _ = Hashtbl.replace macro2utf8 "sacute" "\197\155"
+let _ = Hashtbl.replace macro2utf8 "in" "\226\136\136"
+let _ = Hashtbl.replace macro2utf8 "Assign" "\226\137\148"
+let _ = Hashtbl.replace macro2utf8 "nsim" "\226\137\129"
+let _ = Hashtbl.replace macro2utf8 "boxdR" "\226\149\146"
+let _ = Hashtbl.replace macro2utf8 "o" "\206\191"
+let _ = Hashtbl.replace macro2utf8 "radic" "\226\136\154"
+let _ = Hashtbl.replace macro2utf8 "it" "\226\129\162"
+let _ = Hashtbl.replace macro2utf8 "int" "\226\136\171"
+let _ = Hashtbl.replace macro2utf8 "cwint" "\226\136\177"
+let _ = Hashtbl.replace macro2utf8 "ForAll" "\226\136\128"
+let _ = Hashtbl.replace macro2utf8 "simplus" "\226\168\164"
+let _ = Hashtbl.replace macro2utf8 "isindot" "\226\139\181"
+let _ = Hashtbl.replace macro2utf8 "rightthreetimes" "\226\139\140"
+let _ = Hashtbl.replace macro2utf8 "supseteqq" "\226\138\135"
+let _ = Hashtbl.replace macro2utf8 "bnot" "\226\140\144"
+let _ = Hashtbl.replace macro2utf8 "rppolint" "\226\168\146"
+let _ = Hashtbl.replace macro2utf8 "def" "\226\137\157"
+let _ = Hashtbl.replace macro2utf8 "TScy" "\208\166"
+let _ = Hashtbl.replace macro2utf8 "lE" "\226\137\166"
+let _ = Hashtbl.replace macro2utf8 "ffilig" "\239\172\131"
+let _ = Hashtbl.replace macro2utf8 "deg" "deg"
+let _ = Hashtbl.replace macro2utf8 "{" "{"
+let _ = Hashtbl.replace macro2utf8 "RightVector" "\226\135\128"
+let _ = Hashtbl.replace macro2utf8 "ofr" "\240\157\148\172"
+let _ = Hashtbl.replace macro2utf8 "|" "|"
+let _ = Hashtbl.replace macro2utf8 "liminf" "liminf"
+let _ = Hashtbl.replace macro2utf8 "}" "}"
+let _ = Hashtbl.replace macro2utf8 "LeftUpTeeVector" "\226\165\160"
+let _ = Hashtbl.replace macro2utf8 "scirc" "\197\157"
+let _ = Hashtbl.replace macro2utf8 "scedil" "\197\159"
+let _ = Hashtbl.replace macro2utf8 "ufisht" "\226\165\190"
+let _ = Hashtbl.replace macro2utf8 "LeftUpDownVector" "\226\165\145"
+let _ = Hashtbl.replace macro2utf8 "questeq" "\226\137\159"
+let _ = Hashtbl.replace macro2utf8 "leftarrow" "\226\134\144"
+let _ = Hashtbl.replace macro2utf8 "Ycy" "\208\171"
+let _ = Hashtbl.replace macro2utf8 "Coproduct" "\226\136\144"
+let _ = Hashtbl.replace macro2utf8 "det" "det"
+let _ = Hashtbl.replace macro2utf8 "boxdl" "\226\148\144"
+let _ = Hashtbl.replace macro2utf8 "Aopf" "\240\157\148\184"
+let _ = Hashtbl.replace macro2utf8 "srarr" "\226\134\146\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "lbrke" "\226\166\139"
+let _ = Hashtbl.replace macro2utf8 "boxdr" "\226\148\140"
+let _ = Hashtbl.replace macro2utf8 "Ntilde" "\195\145"
+let _ = Hashtbl.replace macro2utf8 "gnap" "\226\170\138"
+let _ = Hashtbl.replace macro2utf8 "Cap" "\226\139\146"
+let _ = Hashtbl.replace macro2utf8 "swarhk" "\226\164\166"
+let _ = Hashtbl.replace macro2utf8 "ogt" "\226\167\129"
+let _ = Hashtbl.replace macro2utf8 "emptyset" "\226\136\133\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "harrw" "\226\134\173"
+let _ = Hashtbl.replace macro2utf8 "lbarr" "\226\164\140"
+let _ = Hashtbl.replace macro2utf8 "Tilde" "\226\136\188"
+let _ = Hashtbl.replace macro2utf8 "delta" "\206\180"
+let _ = Hashtbl.replace macro2utf8 "Hopf" "\226\132\141"
+let _ = Hashtbl.replace macro2utf8 "dfr" "\240\157\148\161"
+let _ = Hashtbl.replace macro2utf8 "le" "\226\137\164"
+let _ = Hashtbl.replace macro2utf8 "lg" "lg"
+let _ = Hashtbl.replace macro2utf8 "ohm" "\226\132\166"
+let _ = Hashtbl.replace macro2utf8 "Jsercy" "\208\136"
+let _ = Hashtbl.replace macro2utf8 "quaternions" "\226\132\141"
+let _ = Hashtbl.replace macro2utf8 "DoubleLongLeftArrow" "\239\149\185"
+let _ = Hashtbl.replace macro2utf8 "Ncy" "\208\157"
+let _ = Hashtbl.replace macro2utf8 "nabla" "\226\136\135"
+let _ = Hashtbl.replace macro2utf8 "ltcir" "\226\169\185"
+let _ = Hashtbl.replace macro2utf8 "ll" "\226\137\170"
+let _ = Hashtbl.replace macro2utf8 "ln" "ln"
+let _ = Hashtbl.replace macro2utf8 "rmoust" "\226\142\177"
+let _ = Hashtbl.replace macro2utf8 "Oopf" "\240\157\149\134"
+let _ = Hashtbl.replace macro2utf8 "nbsp" "\194\160"
+let _ = Hashtbl.replace macro2utf8 "Kcedil" "\196\182"
+let _ = Hashtbl.replace macro2utf8 "vdots" "\226\139\174"
+let _ = Hashtbl.replace macro2utf8 "NotLessTilde" "\226\137\180"
+let _ = Hashtbl.replace macro2utf8 "lt" "<"
+let _ = Hashtbl.replace macro2utf8 "djcy" "\209\146"
+let _ = Hashtbl.replace macro2utf8 "DownRightTeeVector" "\226\165\159"
+let _ = Hashtbl.replace macro2utf8 "Ograve" "\195\146"
+let _ = Hashtbl.replace macro2utf8 "boxhD" "\226\149\165"
+let _ = Hashtbl.replace macro2utf8 "nsime" "\226\137\132"
+let _ = Hashtbl.replace macro2utf8 "egsdot" "\226\170\152"
+let _ = Hashtbl.replace macro2utf8 "mDDot" "\226\136\186"
+let _ = Hashtbl.replace macro2utf8 "bigodot" "\226\138\153"
+let _ = Hashtbl.replace macro2utf8 "Vopf" "\240\157\149\141"
+let _ = Hashtbl.replace macro2utf8 "looparrowright" "\226\134\172"
+let _ = Hashtbl.replace macro2utf8 "yucy" "\209\142"
+let _ = Hashtbl.replace macro2utf8 "trade" "\226\132\162"
+let _ = Hashtbl.replace macro2utf8 "Yfr" "\240\157\148\156"
+let _ = Hashtbl.replace macro2utf8 "kjcy" "\209\156"
+let _ = Hashtbl.replace macro2utf8 "mp" "\226\136\147"
+let _ = Hashtbl.replace macro2utf8 "leftrightarrows" "\226\135\134"
+let _ = Hashtbl.replace macro2utf8 "uharl" "\226\134\191"
+let _ = Hashtbl.replace macro2utf8 "ncap" "\226\169\131"
+let _ = Hashtbl.replace macro2utf8 "Iogon" "\196\174"
+let _ = Hashtbl.replace macro2utf8 "NotSubset" "\226\138\132"
+let _ = Hashtbl.replace macro2utf8 "Bumpeq" "\226\137\142"
+let _ = Hashtbl.replace macro2utf8 "mu" "\206\188"
+let _ = Hashtbl.replace macro2utf8 "FilledVerySmallSquare" "\239\150\155"
+let _ = Hashtbl.replace macro2utf8 "breve" "\203\152"
+let _ = Hashtbl.replace macro2utf8 "boxhU" "\226\149\168"
+let _ = Hashtbl.replace macro2utf8 "Sigma" "\206\163"
+let _ = Hashtbl.replace macro2utf8 "uharr" "\226\134\190"
+let _ = Hashtbl.replace macro2utf8 "xrArr" "\239\149\186"
+let _ = Hashtbl.replace macro2utf8 "ne" "\226\137\160"
+let _ = Hashtbl.replace macro2utf8 "oS" "\226\147\136"
+let _ = Hashtbl.replace macro2utf8 "xodot" "\226\138\153"
+let _ = Hashtbl.replace macro2utf8 "ni" "\226\136\139"
+let _ = Hashtbl.replace macro2utf8 "mdash" "\226\128\148"
+let _ = Hashtbl.replace macro2utf8 "Verbar" "\226\128\150"
+let _ = Hashtbl.replace macro2utf8 "die" "\194\168"
+let _ = Hashtbl.replace macro2utf8 "veebar" "\226\138\187"
+let _ = Hashtbl.replace macro2utf8 "UpArrowBar" "\226\164\146"
+let _ = Hashtbl.replace macro2utf8 "Ncaron" "\197\135"
+let _ = Hashtbl.replace macro2utf8 "RightArrowBar" "\226\135\165"
+let _ = Hashtbl.replace macro2utf8 "LongLeftArrow" "\239\149\182"
+let _ = Hashtbl.replace macro2utf8 "rceil" "\226\140\137"
+let _ = Hashtbl.replace macro2utf8 "LeftDownVectorBar" "\226\165\153"
+let _ = Hashtbl.replace macro2utf8 "umacr" "\197\171"
+let _ = Hashtbl.replace macro2utf8 "Hacek" "\203\135"
+let _ = Hashtbl.replace macro2utf8 "odblac" "\197\145"
+let _ = Hashtbl.replace macro2utf8 "lmidot" "\197\128"
+let _ = Hashtbl.replace macro2utf8 "dopf" "\240\157\149\149"
+let _ = Hashtbl.replace macro2utf8 "boxhd" "\226\148\172"
+let _ = Hashtbl.replace macro2utf8 "dim" "dim"
+let _ = Hashtbl.replace macro2utf8 "vnsub" "\226\138\132"
+let _ = Hashtbl.replace macro2utf8 "Bscr" "\226\132\172"
+let _ = Hashtbl.replace macro2utf8 "plussim" "\226\168\166"
+let _ = Hashtbl.replace macro2utf8 "doublebarwedge" "\226\140\134"
+let _ = Hashtbl.replace macro2utf8 "nu" "\206\189"
+let _ = Hashtbl.replace macro2utf8 "eqcolon" "\226\137\149"
+let _ = Hashtbl.replace macro2utf8 "luruhar" "\226\165\166"
+let _ = Hashtbl.replace macro2utf8 "Nfr" "\240\157\148\145"
+let _ = Hashtbl.replace macro2utf8 "preceq" "\226\170\175"
+let _ = Hashtbl.replace macro2utf8 "LeftTee" "\226\138\163"
+let _ = Hashtbl.replace macro2utf8 "div" "\195\183"
+let _ = Hashtbl.replace macro2utf8 "nVDash" "\226\138\175"
+let _ = Hashtbl.replace macro2utf8 "kopf" "\240\157\149\156"
+let _ = Hashtbl.replace macro2utf8 "Iscr" "\226\132\144"
+let _ = Hashtbl.replace macro2utf8 "vnsup" "\226\138\133"
+let _ = Hashtbl.replace macro2utf8 "gneq" "\226\137\169"
+let _ = Hashtbl.replace macro2utf8 "backepsilon" "\207\182"
+let _ = Hashtbl.replace macro2utf8 "boxhu" "\226\148\180"
+let _ = Hashtbl.replace macro2utf8 "ominus" "\226\138\150"
+let _ = Hashtbl.replace macro2utf8 "or" "\226\136\168"
+let _ = Hashtbl.replace macro2utf8 "lesdot" "\226\169\191"
+let _ = Hashtbl.replace macro2utf8 "RightVectorBar" "\226\165\147"
+let _ = Hashtbl.replace macro2utf8 "tcedil" "\197\163"
+let _ = Hashtbl.replace macro2utf8 "hstrok" "\196\167"
+let _ = Hashtbl.replace macro2utf8 "nrarrc" "\226\164\179\204\184"
+let _ = Hashtbl.replace macro2utf8 "ropf" "\240\157\149\163"
+let _ = Hashtbl.replace macro2utf8 "diamond" "\226\139\132"
+let _ = Hashtbl.replace macro2utf8 "smid" "\226\136\163\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "nltri" "\226\139\170"
+let _ = Hashtbl.replace macro2utf8 "Pscr" "\240\157\146\171"
+let _ = Hashtbl.replace macro2utf8 "vartheta" "\207\145"
+let _ = Hashtbl.replace macro2utf8 "therefore" "\226\136\180"
+let _ = Hashtbl.replace macro2utf8 "pi" "\207\128"
+let _ = Hashtbl.replace macro2utf8 "ntrianglelefteq" "\226\139\172"
+let _ = Hashtbl.replace macro2utf8 "nearrow" "\226\134\151"
+let _ = Hashtbl.replace macro2utf8 "pm" "\194\177"
+let _ = Hashtbl.replace macro2utf8 "natural" "\226\153\174"
+let _ = Hashtbl.replace macro2utf8 "ucy" "\209\131"
+let _ = Hashtbl.replace macro2utf8 "olt" "\226\167\128"
+let _ = Hashtbl.replace macro2utf8 "Cfr" "\226\132\173"
+let _ = Hashtbl.replace macro2utf8 "yopf" "\240\157\149\170"
+let _ = Hashtbl.replace macro2utf8 "Otilde" "\195\149"
+let _ = Hashtbl.replace macro2utf8 "ntriangleleft" "\226\139\170"
+let _ = Hashtbl.replace macro2utf8 "pr" "\226\137\186"
+let _ = Hashtbl.replace macro2utf8 "Wscr" "\240\157\146\178"
+let _ = Hashtbl.replace macro2utf8 "midcir" "\226\171\176"
+let _ = Hashtbl.replace macro2utf8 "Lacute" "\196\185"
+let _ = Hashtbl.replace macro2utf8 "DoubleDot" "\194\168"
+let _ = Hashtbl.replace macro2utf8 "Tstrok" "\197\166"
+let _ = Hashtbl.replace macro2utf8 "nrarrw" "\226\134\157\204\184"
+let _ = Hashtbl.replace macro2utf8 "uArr" "\226\135\145"
+let _ = Hashtbl.replace macro2utf8 "nLtv" "\226\137\170\204\184\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "rangle" "\226\140\170"
+let _ = Hashtbl.replace macro2utf8 "olcir" "\226\166\190"
+let _ = Hashtbl.replace macro2utf8 "Auml" "\195\132"
+let _ = Hashtbl.replace macro2utf8 "Succeeds" "\226\137\187"
+let _ = Hashtbl.replace macro2utf8 "DoubleLongLeftRightArrow" "\239\149\187"
+let _ = Hashtbl.replace macro2utf8 "TSHcy" "\208\139"
+let _ = Hashtbl.replace macro2utf8 "gammad" "\207\156"
+let _ = Hashtbl.replace macro2utf8 "epsiv" "\201\155"
+let _ = Hashtbl.replace macro2utf8 "notinva" "\226\136\137\204\184"
+let _ = Hashtbl.replace macro2utf8 "notinvb" "\226\139\183"
+let _ = Hashtbl.replace macro2utf8 "eqvparsl" "\226\167\165"
+let _ = Hashtbl.replace macro2utf8 "notinvc" "\226\139\182"
+let _ = Hashtbl.replace macro2utf8 "nsubE" "\226\138\136"
+let _ = Hashtbl.replace macro2utf8 "supplus" "\226\171\128"
+let _ = Hashtbl.replace macro2utf8 "RightUpDownVector" "\226\165\143"
+let _ = Hashtbl.replace macro2utf8 "Tab" "\t"
+let _ = Hashtbl.replace macro2utf8 "Lcedil" "\196\187"
+let _ = Hashtbl.replace macro2utf8 "backslash" "\\"
+let _ = Hashtbl.replace macro2utf8 "pointint" "\226\168\149"
+let _ = Hashtbl.replace macro2utf8 "jcy" "\208\185"
+let _ = Hashtbl.replace macro2utf8 "iocy" "\209\145"
+let _ = Hashtbl.replace macro2utf8 "escr" "\226\132\175"
+let _ = Hashtbl.replace macro2utf8 "submult" "\226\171\129"
+let _ = Hashtbl.replace macro2utf8 "iiota" "\226\132\169"
+let _ = Hashtbl.replace macro2utf8 "lceil" "\226\140\136"
+let _ = Hashtbl.replace macro2utf8 "omacr" "\197\141"
+let _ = Hashtbl.replace macro2utf8 "gneqq" "\226\137\169"
+let _ = Hashtbl.replace macro2utf8 "gcirc" "\196\157"
+let _ = Hashtbl.replace macro2utf8 "dotsquare" "\226\138\161"
+let _ = Hashtbl.replace macro2utf8 "ccaron" "\196\141"
+let _ = Hashtbl.replace macro2utf8 "Square" "\226\150\161"
+let _ = Hashtbl.replace macro2utf8 "RightDownTeeVector" "\226\165\157"
+let _ = Hashtbl.replace macro2utf8 "Ouml" "\195\150"
+let _ = Hashtbl.replace macro2utf8 "lurdshar" "\226\165\138"
+let _ = Hashtbl.replace macro2utf8 "SuchThat" "\226\136\139"
+let _ = Hashtbl.replace macro2utf8 "setminus" "\226\136\150"
+let _ = Hashtbl.replace macro2utf8 "lscr" "\226\132\147"
+let _ = Hashtbl.replace macro2utf8 "LessLess" "\226\170\161"
+let _ = Hashtbl.replace macro2utf8 "Sub" "\226\139\144"
+let _ = Hashtbl.replace macro2utf8 "sc" "\226\137\187"
+let _ = Hashtbl.replace macro2utf8 "rx" "\226\132\158"
+let _ = Hashtbl.replace macro2utf8 "RightFloor" "\226\140\139"
+let _ = Hashtbl.replace macro2utf8 "blacksquare" "\226\150\170"
+let _ = Hashtbl.replace macro2utf8 "ufr" "\240\157\148\178"
+let _ = Hashtbl.replace macro2utf8 "block" "\226\150\136"
+let _ = Hashtbl.replace macro2utf8 "dots" "\226\128\166"
+let _ = Hashtbl.replace macro2utf8 "nvsim" "\226\137\129\204\184"
+let _ = Hashtbl.replace macro2utf8 "caret" "\226\129\129"
+let _ = Hashtbl.replace macro2utf8 "demptyv" "\226\166\177"
+let _ = Hashtbl.replace macro2utf8 "Sum" "\226\136\145"
+let _ = Hashtbl.replace macro2utf8 "sscr" "\240\157\147\136"
+let _ = Hashtbl.replace macro2utf8 "nsube" "\226\138\136"
+let _ = Hashtbl.replace macro2utf8 "Sup" "\226\139\145"
+let _ = Hashtbl.replace macro2utf8 "ccupssm" "\226\169\144"
+let _ = Hashtbl.replace macro2utf8 "Because" "\226\136\181"
+let _ = Hashtbl.replace macro2utf8 "harrcir" "\226\165\136"
+let _ = Hashtbl.replace macro2utf8 "capbrcup" "\226\169\137"
+let _ = Hashtbl.replace macro2utf8 "RightUpVectorBar" "\226\165\148"
+let _ = Hashtbl.replace macro2utf8 "caps" "\226\136\169\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "ohbar" "\226\166\181"
+let _ = Hashtbl.replace macro2utf8 "laemptyv" "\226\166\180"
+let _ = Hashtbl.replace macro2utf8 "uacute" "\195\186"
+let _ = Hashtbl.replace macro2utf8 "straightphi" "\207\134"
+let _ = Hashtbl.replace macro2utf8 "RightDoubleBracket" "\227\128\155"
+let _ = Hashtbl.replace macro2utf8 "zscr" "\240\157\147\143"
+let _ = Hashtbl.replace macro2utf8 "uogon" "\197\179"
+let _ = Hashtbl.replace macro2utf8 "Uarr" "\226\134\159"
+let _ = Hashtbl.replace macro2utf8 "nsucc" "\226\138\129"
+let _ = Hashtbl.replace macro2utf8 "RBarr" "\226\164\144"
+let _ = Hashtbl.replace macro2utf8 "NotRightTriangleBar" "\226\167\144\204\184"
+let _ = Hashtbl.replace macro2utf8 "to" "\226\134\146"
+let _ = Hashtbl.replace macro2utf8 "rpar" ")"
+let _ = Hashtbl.replace macro2utf8 "rdsh" "\226\134\179"
+let _ = Hashtbl.replace macro2utf8 "jfr" "\240\157\148\167"
+let _ = Hashtbl.replace macro2utf8 "ldquor" "\226\128\158"
+let _ = Hashtbl.replace macro2utf8 "bsime" "\226\139\141"
+let _ = Hashtbl.replace macro2utf8 "lAtail" "\226\164\155"
+let _ = Hashtbl.replace macro2utf8 "Hcirc" "\196\164"
+let _ = Hashtbl.replace macro2utf8 "aacute" "\195\161"
+let _ = Hashtbl.replace macro2utf8 "dot" "\203\153"
+let _ = Hashtbl.replace macro2utf8 "Tcy" "\208\162"
+let _ = Hashtbl.replace macro2utf8 "nsub" "\226\138\132"
+let _ = Hashtbl.replace macro2utf8 "kappa" "\206\186"
+let _ = Hashtbl.replace macro2utf8 "ovbar" "\226\140\189"
+let _ = Hashtbl.replace macro2utf8 "shcy" "\209\136"
+let _ = Hashtbl.replace macro2utf8 "kappav" "\207\176"
+let _ = Hashtbl.replace macro2utf8 "ropar" "\227\128\153"
+let _ = Hashtbl.replace macro2utf8 "gtcc" "\226\170\167"
+let _ = Hashtbl.replace macro2utf8 "ecolon" "\226\137\149"
+let _ = Hashtbl.replace macro2utf8 "circledast" "\226\138\155"
+let _ = Hashtbl.replace macro2utf8 "colon" ":"
+let _ = Hashtbl.replace macro2utf8 "timesbar" "\226\168\177"
+let _ = Hashtbl.replace macro2utf8 "precnsim" "\226\139\168"
+let _ = Hashtbl.replace macro2utf8 "ord" "\226\169\157"
+let _ = Hashtbl.replace macro2utf8 "real" "\226\132\156"
+let _ = Hashtbl.replace macro2utf8 "nexists" "\226\136\132"
+let _ = Hashtbl.replace macro2utf8 "nsup" "\226\138\133"
+let _ = Hashtbl.replace macro2utf8 "zhcy" "\208\182"
+let _ = Hashtbl.replace macro2utf8 "imacr" "\196\171"
+let _ = Hashtbl.replace macro2utf8 "egrave" "\195\168"
+let _ = Hashtbl.replace macro2utf8 "acirc" "\195\162"
+let _ = Hashtbl.replace macro2utf8 "grave" "`"
+let _ = Hashtbl.replace macro2utf8 "biguplus" "\226\138\142"
+let _ = Hashtbl.replace macro2utf8 "HumpEqual" "\226\137\143"
+let _ = Hashtbl.replace macro2utf8 "GreaterSlantEqual" "\226\169\190"
+let _ = Hashtbl.replace macro2utf8 "capand" "\226\169\132"
+let _ = Hashtbl.replace macro2utf8 "yuml" "\195\191"
+let _ = Hashtbl.replace macro2utf8 "orv" "\226\169\155"
+let _ = Hashtbl.replace macro2utf8 "Icy" "\208\152"
+let _ = Hashtbl.replace macro2utf8 "rightharpoondown" "\226\135\129"
+let _ = Hashtbl.replace macro2utf8 "upsilon" "\207\133"
+let _ = Hashtbl.replace macro2utf8 "preccurlyeq" "\226\137\188"
+let _ = Hashtbl.replace macro2utf8 "ShortUpArrow" "\226\140\131\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "searhk" "\226\164\165"
+let _ = Hashtbl.replace macro2utf8 "commat" "@"
+let _ = Hashtbl.replace macro2utf8 "Sqrt" "\226\136\154"
+let _ = Hashtbl.replace macro2utf8 "wp" "\226\132\152"
+let _ = Hashtbl.replace macro2utf8 "succnapprox" "\226\139\169"
+let _ = Hashtbl.replace macro2utf8 "wr" "\226\137\128"
+let _ = Hashtbl.replace macro2utf8 "NotTildeTilde" "\226\137\137"
+let _ = Hashtbl.replace macro2utf8 "dcaron" "\196\143"
+let _ = Hashtbl.replace macro2utf8 "Tfr" "\240\157\148\151"
+let _ = Hashtbl.replace macro2utf8 "bigwedge" "\226\139\128"
+let _ = Hashtbl.replace macro2utf8 "DScy" "\208\133"
+let _ = Hashtbl.replace macro2utf8 "nrtrie" "\226\139\173"
+let _ = Hashtbl.replace macro2utf8 "esim" "\226\137\130"
+let _ = Hashtbl.replace macro2utf8 "Not" "\226\171\172"
+let _ = Hashtbl.replace macro2utf8 "xmap" "\239\149\189"
+let _ = Hashtbl.replace macro2utf8 "rect" "\226\150\173"
+let _ = Hashtbl.replace macro2utf8 "Fouriertrf" "\226\132\177"
+let _ = Hashtbl.replace macro2utf8 "xi" "\206\190"
+let _ = Hashtbl.replace macro2utf8 "NotTilde" "\226\137\129"
+let _ = Hashtbl.replace macro2utf8 "gbreve" "\196\159"
+let _ = Hashtbl.replace macro2utf8 "par" "\226\136\165"
+let _ = Hashtbl.replace macro2utf8 "ddots" "\226\139\177"
+let _ = Hashtbl.replace macro2utf8 "nhArr" "\226\135\142"
+let _ = Hashtbl.replace macro2utf8 "lsim" "\226\137\178"
+let _ = Hashtbl.replace macro2utf8 "RightCeiling" "\226\140\137"
+let _ = Hashtbl.replace macro2utf8 "nedot" "\226\137\160\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "thksim" "\226\136\188\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "lEg" "\226\139\154"
+let _ = Hashtbl.replace macro2utf8 "Ifr" "\226\132\145"
+let _ = Hashtbl.replace macro2utf8 "emsp" "\226\128\131"
+let _ = Hashtbl.replace macro2utf8 "lopar" "\227\128\152"
+let _ = Hashtbl.replace macro2utf8 "iiiint" "\226\168\140"
+let _ = Hashtbl.replace macro2utf8 "straightepsilon" "\206\181"
+let _ = Hashtbl.replace macro2utf8 "intlarhk" "\226\168\151"
+let _ = Hashtbl.replace macro2utf8 "image" "\226\132\145"
+let _ = Hashtbl.replace macro2utf8 "sqsubseteq" "\226\138\145"
+let _ = Hashtbl.replace macro2utf8 "lnapprox" "\226\170\137"
+let _ = Hashtbl.replace macro2utf8 "Leftrightarrow" "\226\135\148"
+let _ = Hashtbl.replace macro2utf8 "cemptyv" "\226\166\178"
+let _ = Hashtbl.replace macro2utf8 "alpha" "\206\177"
+let _ = Hashtbl.replace macro2utf8 "uml" "\194\168"
+let _ = Hashtbl.replace macro2utf8 "barwedge" "\226\138\188"
+let _ = Hashtbl.replace macro2utf8 "KHcy" "\208\165"
+let _ = Hashtbl.replace macro2utf8 "tilde" "\203\156"
+let _ = Hashtbl.replace macro2utf8 "Superset" "\226\138\131"
+let _ = Hashtbl.replace macro2utf8 "gesles" "\226\170\148"
+let _ = Hashtbl.replace macro2utf8 "bigoplus" "\226\138\149"
+let _ = Hashtbl.replace macro2utf8 "boxuL" "\226\149\155"
+let _ = Hashtbl.replace macro2utf8 "rbbrk" "\227\128\149"
+let _ = Hashtbl.replace macro2utf8 "nrightarrow" "\226\134\155"
+let _ = Hashtbl.replace macro2utf8 "hkswarow" "\226\164\166"
+let _ = Hashtbl.replace macro2utf8 "DiacriticalDoubleAcute" "\203\157"
+let _ = Hashtbl.replace macro2utf8 "nbumpe" "\226\137\143\204\184"
+let _ = Hashtbl.replace macro2utf8 "uhblk" "\226\150\128"
+let _ = Hashtbl.replace macro2utf8 "NotSupersetEqual" "\226\138\137"
+let _ = Hashtbl.replace macro2utf8 "ntgl" "\226\137\185"
+let _ = Hashtbl.replace macro2utf8 "Fopf" "\240\157\148\189"
+let _ = Hashtbl.replace macro2utf8 "boxuR" "\226\149\152"
+let _ = Hashtbl.replace macro2utf8 "swarr" "\226\134\153"
+let _ = Hashtbl.replace macro2utf8 "nsqsube" "\226\139\162"
+let _ = Hashtbl.replace macro2utf8 "pluscir" "\226\168\162"
+let _ = Hashtbl.replace macro2utf8 "pcy" "\208\191"
+let _ = Hashtbl.replace macro2utf8 "leqslant" "\226\169\189"
+let _ = Hashtbl.replace macro2utf8 "lnap" "\226\170\137"
+let _ = Hashtbl.replace macro2utf8 "lthree" "\226\139\139"
+let _ = Hashtbl.replace macro2utf8 "smte" "\226\170\172"
+let _ = Hashtbl.replace macro2utf8 "olcross" "\226\166\187"
+let _ = Hashtbl.replace macro2utf8 "nvrArr" "\226\135\143"
+let _ = Hashtbl.replace macro2utf8 "andslope" "\226\169\152"
+let _ = Hashtbl.replace macro2utf8 "MediumSpace" "\226\129\159"
+let _ = Hashtbl.replace macro2utf8 "boxvH" "\226\149\170"
+let _ = Hashtbl.replace macro2utf8 "Nacute" "\197\131"
+let _ = Hashtbl.replace macro2utf8 "nGtv" "\226\137\171\204\184\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "Mopf" "\240\157\149\132"
+let _ = Hashtbl.replace macro2utf8 "dfisht" "\226\165\191"
+let _ = Hashtbl.replace macro2utf8 "boxvL" "\226\149\161"
+let _ = Hashtbl.replace macro2utf8 "pertenk" "\226\128\177"
+let _ = Hashtbl.replace macro2utf8 "NotPrecedes" "\226\138\128"
+let _ = Hashtbl.replace macro2utf8 "profalar" "\226\140\174"
+let _ = Hashtbl.replace macro2utf8 "roplus" "\226\168\174"
+let _ = Hashtbl.replace macro2utf8 "boxvR" "\226\149\158"
+let _ = Hashtbl.replace macro2utf8 "utrif" "\226\150\180"
+let _ = Hashtbl.replace macro2utf8 "uHar" "\226\165\163"
+let _ = Hashtbl.replace macro2utf8 "nltrie" "\226\139\172"
+let _ = Hashtbl.replace macro2utf8 "NotNestedGreaterGreater" "\226\146\162\204\184"
+let _ = Hashtbl.replace macro2utf8 "smtes" "\226\170\172\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "LeftAngleBracket" "\226\140\169"
+let _ = Hashtbl.replace macro2utf8 "iogon" "\196\175"
+let _ = Hashtbl.replace macro2utf8 "ExponentialE" "\226\133\135"
+let _ = Hashtbl.replace macro2utf8 "Topf" "\240\157\149\139"
+let _ = Hashtbl.replace macro2utf8 "GreaterEqual" "\226\137\165"
+let _ = Hashtbl.replace macro2utf8 "DownTee" "\226\138\164"
+let _ = Hashtbl.replace macro2utf8 "boxul" "\226\148\152"
+let _ = Hashtbl.replace macro2utf8 "wreath" "\226\137\128"
+let _ = Hashtbl.replace macro2utf8 "sigma" "\207\131"
+let _ = Hashtbl.replace macro2utf8 "ENG" "\197\138"
+let _ = Hashtbl.replace macro2utf8 "Ncedil" "\197\133"
+let _ = Hashtbl.replace macro2utf8 "ecy" "\209\141"
+let _ = Hashtbl.replace macro2utf8 "nsubset" "\226\138\132"
+let _ = Hashtbl.replace macro2utf8 "LessFullEqual" "\226\137\166"
+let _ = Hashtbl.replace macro2utf8 "bsolb" "\226\167\133"
+let _ = Hashtbl.replace macro2utf8 "boxur" "\226\148\148"
+let _ = Hashtbl.replace macro2utf8 "ThinSpace" "\226\128\137"
+let _ = Hashtbl.replace macro2utf8 "supdsub" "\226\171\152"
+let _ = Hashtbl.replace macro2utf8 "colone" "\226\137\148"
+let _ = Hashtbl.replace macro2utf8 "curren" "\194\164"
+let _ = Hashtbl.replace macro2utf8 "boxvh" "\226\148\188"
+let _ = Hashtbl.replace macro2utf8 "ecaron" "\196\155"
+let _ = Hashtbl.replace macro2utf8 "UnderBrace" "\239\184\184"
+let _ = Hashtbl.replace macro2utf8 "caron" "\203\135"
+let _ = Hashtbl.replace macro2utf8 "ultri" "\226\151\184"
+let _ = Hashtbl.replace macro2utf8 "boxvl" "\226\148\164"
+let _ = Hashtbl.replace macro2utf8 "scap" "\226\137\191"
+let _ = Hashtbl.replace macro2utf8 "boxvr" "\226\148\156"
+let _ = Hashtbl.replace macro2utf8 "bopf" "\240\157\149\147"
+let _ = Hashtbl.replace macro2utf8 "pfr" "\240\157\148\173"
+let _ = Hashtbl.replace macro2utf8 "nspar" "\226\136\166\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "NegativeMediumSpace" "\226\129\159\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "simgE" "\226\170\160"
+let _ = Hashtbl.replace macro2utf8 "nvDash" "\226\138\173"
+let _ = Hashtbl.replace macro2utf8 "NotGreaterFullEqual" "\226\137\176"
+let _ = Hashtbl.replace macro2utf8 "uparrow" "\226\134\145"
+let _ = Hashtbl.replace macro2utf8 "nsupset" "\226\138\133"
+let _ = Hashtbl.replace macro2utf8 "simeq" "\226\137\131"
+let _ = Hashtbl.replace macro2utf8 "Zcy" "\208\151"
+let _ = Hashtbl.replace macro2utf8 "RightTriangle" "\226\138\179"
+let _ = Hashtbl.replace macro2utf8 "Lang" "\227\128\138"
+let _ = Hashtbl.replace macro2utf8 "Ucirc" "\195\155"
+let _ = Hashtbl.replace macro2utf8 "iopf" "\240\157\149\154"
+let _ = Hashtbl.replace macro2utf8 "leftrightsquigarrow" "\226\134\173"
+let _ = Hashtbl.replace macro2utf8 "Gscr" "\240\157\146\162"
+let _ = Hashtbl.replace macro2utf8 "lfloor" "\226\140\138"
+let _ = Hashtbl.replace macro2utf8 "lbbrk" "\227\128\148"
+let _ = Hashtbl.replace macro2utf8 "bigvee" "\226\139\129"
+let _ = Hashtbl.replace macro2utf8 "ordf" "\194\170"
+let _ = Hashtbl.replace macro2utf8 "rsquo" "\226\128\153"
+let _ = Hashtbl.replace macro2utf8 "parallel" "\226\136\165"
+let _ = Hashtbl.replace macro2utf8 "half" "\194\189"
+let _ = Hashtbl.replace macro2utf8 "supseteq" "\226\138\135"
+let _ = Hashtbl.replace macro2utf8 "ngeqq" "\226\137\177"
+let _ = Hashtbl.replace macro2utf8 "popf" "\240\157\149\161"
+let _ = Hashtbl.replace macro2utf8 "NonBreakingSpace" "\194\160"
+let _ = Hashtbl.replace macro2utf8 "softcy" "\209\140"
+let _ = Hashtbl.replace macro2utf8 "ordm" "\194\186"
+let _ = Hashtbl.replace macro2utf8 "Nscr" "\240\157\146\169"
+let _ = Hashtbl.replace macro2utf8 "owns" "\226\136\139"
+let _ = Hashtbl.replace macro2utf8 "phi" "\207\149"
+let _ = Hashtbl.replace macro2utf8 "efr" "\240\157\148\162"
+let _ = Hashtbl.replace macro2utf8 "nesear" "\226\164\168"
+let _ = Hashtbl.replace macro2utf8 "marker" "\226\150\174"
+let _ = Hashtbl.replace macro2utf8 "lneq" "\226\137\168"
+let _ = Hashtbl.replace macro2utf8 "parallet" "????"
+let _ = Hashtbl.replace macro2utf8 "ndash" "\226\128\147"
+let _ = Hashtbl.replace macro2utf8 "DoubleLeftTee" "\226\171\164"
+let _ = Hashtbl.replace macro2utf8 "lArr" "\226\135\144"
+let _ = Hashtbl.replace macro2utf8 "becaus" "\226\136\181"
+let _ = Hashtbl.replace macro2utf8 "RightTee" "\226\138\162"
+let _ = Hashtbl.replace macro2utf8 "Ocy" "\208\158"
+let _ = Hashtbl.replace macro2utf8 "ntlg" "\226\137\184"
+let _ = Hashtbl.replace macro2utf8 "cacute" "\196\135"
+let _ = Hashtbl.replace macro2utf8 "wopf" "\240\157\149\168"
+let _ = Hashtbl.replace macro2utf8 "Cup" "\226\139\147"
+let _ = Hashtbl.replace macro2utf8 "Uscr" "\240\157\146\176"
+let _ = Hashtbl.replace macro2utf8 "NotHumpEqual" "\226\137\143\204\184"
+let _ = Hashtbl.replace macro2utf8 "rnmid" "\226\171\174"
+let _ = Hashtbl.replace macro2utf8 "nsupE" "\226\138\137"
+let _ = Hashtbl.replace macro2utf8 "bemptyv" "\226\166\176"
+let _ = Hashtbl.replace macro2utf8 "lsqb" "["
+let _ = Hashtbl.replace macro2utf8 "nrarr" "\226\134\155"
+let _ = Hashtbl.replace macro2utf8 "egs" "\226\139\157"
+let _ = Hashtbl.replace macro2utf8 "reals" "\226\132\157"
+let _ = Hashtbl.replace macro2utf8 "CupCap" "\226\137\141"
+let _ = Hashtbl.replace macro2utf8 "Oacute" "\195\147"
+let _ = Hashtbl.replace macro2utf8 "Zfr" "\226\132\168"
+let _ = Hashtbl.replace macro2utf8 "ReverseEquilibrium" "\226\135\139"
+let _ = Hashtbl.replace macro2utf8 "ccedil" "\195\167"
+let _ = Hashtbl.replace macro2utf8 "bigtriangleup" "\226\150\179"
+let _ = Hashtbl.replace macro2utf8 "piv" "\207\150"
+let _ = Hashtbl.replace macro2utf8 "cirscir" "\226\167\130"
+let _ = Hashtbl.replace macro2utf8 "exists" "\226\136\131"
+let _ = Hashtbl.replace macro2utf8 "Uarrocir" "\226\165\137"
+let _ = Hashtbl.replace macro2utf8 "Dcy" "\208\148"
+let _ = Hashtbl.replace macro2utf8 "cscr" "\240\157\146\184"
+let _ = Hashtbl.replace macro2utf8 "zcaron" "\197\190"
+let _ = Hashtbl.replace macro2utf8 "isinE" "\226\139\185"
+let _ = Hashtbl.replace macro2utf8 "gtcir" "\226\169\186"
+let _ = Hashtbl.replace macro2utf8 "hookrightarrow" "\226\134\170"
+let _ = Hashtbl.replace macro2utf8 "Int" "\226\136\172"
+let _ = Hashtbl.replace macro2utf8 "nsupe" "\226\138\137"
+let _ = Hashtbl.replace macro2utf8 "dotplus" "\226\136\148"
+let _ = Hashtbl.replace macro2utf8 "ncup" "\226\169\130"
+let _ = Hashtbl.replace macro2utf8 "jscr" "\240\157\146\191"
+let _ = Hashtbl.replace macro2utf8 "angmsdaa" "\226\166\168"
+let _ = Hashtbl.replace macro2utf8 "Iukcy" "\208\134"
+let _ = Hashtbl.replace macro2utf8 "flat" "\226\153\173"
+let _ = Hashtbl.replace macro2utf8 "bNot" "\226\171\173"
+let _ = Hashtbl.replace macro2utf8 "angmsdab" "\226\166\169"
+let _ = Hashtbl.replace macro2utf8 "angmsdac" "\226\166\170"
+let _ = Hashtbl.replace macro2utf8 "xdtri" "\226\150\189"
+let _ = Hashtbl.replace macro2utf8 "iota" "\206\185"
+let _ = Hashtbl.replace macro2utf8 "angmsdad" "\226\166\171"
+let _ = Hashtbl.replace macro2utf8 "angmsdae" "\226\166\172"
+let _ = Hashtbl.replace macro2utf8 "rightarrowtail" "\226\134\163"
+let _ = Hashtbl.replace macro2utf8 "angmsdaf" "\226\166\173"
+let _ = Hashtbl.replace macro2utf8 "Ocirc" "\195\148"
+let _ = Hashtbl.replace macro2utf8 "angmsdag" "\226\166\174"
+let _ = Hashtbl.replace macro2utf8 "Ofr" "\240\157\148\146"
+let _ = Hashtbl.replace macro2utf8 "maltese" "\226\156\160"
+let _ = Hashtbl.replace macro2utf8 "angmsdah" "\226\166\175"
+let _ = Hashtbl.replace macro2utf8 "Del" "\226\136\135"
+let _ = Hashtbl.replace macro2utf8 "Barwed" "\226\140\134"
+let _ = Hashtbl.replace macro2utf8 "drbkarow" "\226\164\144"
+let _ = Hashtbl.replace macro2utf8 "qscr" "\240\157\147\134"
+let _ = Hashtbl.replace macro2utf8 "ETH" "\195\144"
+let _ = Hashtbl.replace macro2utf8 "operp" "\226\166\185"
+let _ = Hashtbl.replace macro2utf8 "daleth" "\226\132\184"
+let _ = Hashtbl.replace macro2utf8 "bull" "\226\128\162"
+let _ = Hashtbl.replace macro2utf8 "simlE" "\226\170\159"
+let _ = Hashtbl.replace macro2utf8 "lsquo" "\226\128\152"
+let _ = Hashtbl.replace macro2utf8 "Larr" "\226\134\158"
+let _ = Hashtbl.replace macro2utf8 "curarr" "\226\134\183"
+let _ = Hashtbl.replace macro2utf8 "blacktriangleleft" "\226\151\130"
+let _ = Hashtbl.replace macro2utf8 "hellip" "\226\128\166"
+let _ = Hashtbl.replace macro2utf8 "DoubleVerticalBar" "\226\136\165"
+let _ = Hashtbl.replace macro2utf8 "rBarr" "\226\164\143"
+let _ = Hashtbl.replace macro2utf8 "chcy" "\209\135"
+let _ = Hashtbl.replace macro2utf8 "varpi" "\207\150"
+let _ = Hashtbl.replace macro2utf8 "Cconint" "\226\136\176"
+let _ = Hashtbl.replace macro2utf8 "xlarr" "\239\149\182"
+let _ = Hashtbl.replace macro2utf8 "xscr" "\240\157\147\141"
+let _ = Hashtbl.replace macro2utf8 "DoubleLongRightArrow" "\239\149\186"
+let _ = Hashtbl.replace macro2utf8 "CounterClockwiseContourIntegral" "\226\136\179"
+let _ = Hashtbl.replace macro2utf8 "urcrop" "\226\140\142"
+let _ = Hashtbl.replace macro2utf8 "RightAngleBracket" "\226\140\170"
+let _ = Hashtbl.replace macro2utf8 "Rcaron" "\197\152"
+let _ = Hashtbl.replace macro2utf8 "latail" "\226\164\153"
+let _ = Hashtbl.replace macro2utf8 "pitchfork" "\226\139\148"
+let _ = Hashtbl.replace macro2utf8 "nvinfin" "\226\167\158"
+let _ = Hashtbl.replace macro2utf8 "hcirc" "\196\165"
+let _ = Hashtbl.replace macro2utf8 "nexist" "\226\136\132"
+let _ = Hashtbl.replace macro2utf8 "checkmark" "\226\156\147"
+let _ = Hashtbl.replace macro2utf8 "tridot" "\226\151\172"
+let _ = Hashtbl.replace macro2utf8 "vcy" "\208\178"
+let _ = Hashtbl.replace macro2utf8 "isins" "\226\139\180"
+let _ = Hashtbl.replace macro2utf8 "fllig" "\239\172\130"
+let _ = Hashtbl.replace macro2utf8 "Dfr" "\240\157\148\135"
+let _ = Hashtbl.replace macro2utf8 "hercon" "\226\138\185"
+let _ = Hashtbl.replace macro2utf8 "gEl" "\226\139\155"
+let _ = Hashtbl.replace macro2utf8 "bump" "\226\137\142"
+let _ = Hashtbl.replace macro2utf8 "aleph" "\226\132\181"
+let _ = Hashtbl.replace macro2utf8 "Ubreve" "\197\172"
+let _ = Hashtbl.replace macro2utf8 "isinv" "\226\136\136"
+let _ = Hashtbl.replace macro2utf8 "smile" "\226\140\163"
+let _ = Hashtbl.replace macro2utf8 "llcorner" "\226\140\158"
+let _ = Hashtbl.replace macro2utf8 "boxH" "\226\149\144"
+let _ = Hashtbl.replace macro2utf8 "ecir" "\226\137\150"
+let _ = Hashtbl.replace macro2utf8 "varnothing" "\226\136\133"
+let _ = Hashtbl.replace macro2utf8 "iuml" "\195\175"
+let _ = Hashtbl.replace macro2utf8 "mlcp" "\226\171\155"
+let _ = Hashtbl.replace macro2utf8 "leftrightharpoons" "\226\135\139"
+let _ = Hashtbl.replace macro2utf8 "ncong" "\226\137\135"
+let _ = Hashtbl.replace macro2utf8 "Vert" "\226\128\150"
+let _ = Hashtbl.replace macro2utf8 "vee" "\226\136\168"
+let _ = Hashtbl.replace macro2utf8 "star" "\226\139\134"
+let _ = Hashtbl.replace macro2utf8 "boxV" "\226\149\145"
+let _ = Hashtbl.replace macro2utf8 "LeftRightArrow" "\226\134\148"
+let _ = Hashtbl.replace macro2utf8 "leftrightarrow" "\226\134\148"
+let _ = Hashtbl.replace macro2utf8 "lstrok" "\197\130"
+let _ = Hashtbl.replace macro2utf8 "ell" "\226\132\147"
+let _ = Hashtbl.replace macro2utf8 "VerticalSeparator" "\226\157\152"
+let _ = Hashtbl.replace macro2utf8 "Ubrcy" "\208\142"
+let _ = Hashtbl.replace macro2utf8 "NotGreater" "\226\137\175"
+let _ = Hashtbl.replace macro2utf8 "Abreve" "\196\130"
+let _ = Hashtbl.replace macro2utf8 "TildeTilde" "\226\137\136"
+let _ = Hashtbl.replace macro2utf8 "CircleTimes" "\226\138\151"
+let _ = Hashtbl.replace macro2utf8 "subsetneq" "\226\138\138"
+let _ = Hashtbl.replace macro2utf8 "ltcc" "\226\170\166"
+let _ = Hashtbl.replace macro2utf8 "els" "\226\139\156"
+let _ = Hashtbl.replace macro2utf8 "succneqq" "\226\170\182"
+let _ = Hashtbl.replace macro2utf8 "kcy" "\208\186"
+let _ = Hashtbl.replace macro2utf8 "nshortmid" "\226\136\164\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "mldr" "\226\128\166"
+let _ = Hashtbl.replace macro2utf8 "harr" "\226\134\148"
+let _ = Hashtbl.replace macro2utf8 "gimel" "\226\132\183"
+let _ = Hashtbl.replace macro2utf8 "Otimes" "\226\168\183"
+let _ = Hashtbl.replace macro2utf8 "vsubnE" "\226\138\138\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "ltdot" "\226\139\150"
+let _ = Hashtbl.replace macro2utf8 "boxh" "\226\148\128"
+let _ = Hashtbl.replace macro2utf8 "notin" "\226\136\137"
+let _ = Hashtbl.replace macro2utf8 "RuleDelayed" "\226\167\180"
+let _ = Hashtbl.replace macro2utf8 "sqsube" "\226\138\145"
+let _ = Hashtbl.replace macro2utf8 "macr" "\194\175"
+let _ = Hashtbl.replace macro2utf8 "Icirc" "\195\142"
+let _ = Hashtbl.replace macro2utf8 "comma" ","
+let _ = Hashtbl.replace macro2utf8 "Cayleys" "\226\132\173"
+let _ = Hashtbl.replace macro2utf8 "rightleftharpoons" "\226\135\140"
+let _ = Hashtbl.replace macro2utf8 "Rarrtl" "\226\164\150"
+let _ = Hashtbl.replace macro2utf8 "SquareSubsetEqual" "\226\138\145"
+let _ = Hashtbl.replace macro2utf8 "NotGreaterEqual" "\226\137\177\226\131\165"
+let _ = Hashtbl.replace macro2utf8 "vfr" "\240\157\148\179"
+let _ = Hashtbl.replace macro2utf8 "utri" "\226\150\181"
+let _ = Hashtbl.replace macro2utf8 "simne" "\226\137\134"
+let _ = Hashtbl.replace macro2utf8 "LeftUpVectorBar" "\226\165\152"
+let _ = Hashtbl.replace macro2utf8 "hksearow" "\226\164\165"
+let _ = Hashtbl.replace macro2utf8 "boxv" "\226\148\130"
+let _ = Hashtbl.replace macro2utf8 "curvearrowleft" "\226\134\182"
+let _ = Hashtbl.replace macro2utf8 "eng" "\197\139"
+let _ = Hashtbl.replace macro2utf8 "gtrarr" "\226\165\184"
+let _ = Hashtbl.replace macro2utf8 "iecy" "\208\181"
+let _ = Hashtbl.replace macro2utf8 "varr" "\226\134\149"
+let _ = Hashtbl.replace macro2utf8 "lBarr" "\226\164\142"
+let _ = Hashtbl.replace macro2utf8 "ker" "ker"
+let _ = Hashtbl.replace macro2utf8 "imath" "\196\177"
+let _ = Hashtbl.replace macro2utf8 "Dstrok" "\196\144"
+let _ = Hashtbl.replace macro2utf8 "rlarr" "\226\135\132"
+let _ = Hashtbl.replace macro2utf8 "leftleftarrows" "\226\135\135"
+let _ = Hashtbl.replace macro2utf8 "DifferentialD" "\226\133\134"
+let _ = Hashtbl.replace macro2utf8 "because" "\226\136\181"
+let _ = Hashtbl.replace macro2utf8 "ulcrop" "\226\140\143"
+let _ = Hashtbl.replace macro2utf8 "prE" "\226\170\175"
+let _ = Hashtbl.replace macro2utf8 "oast" "\226\138\155"
+let _ = Hashtbl.replace macro2utf8 "DotEqual" "\226\137\144"
+let _ = Hashtbl.replace macro2utf8 "vsubne" "\226\138\138\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "hbar" "\226\132\143\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "subset" "\226\138\130"
+let _ = Hashtbl.replace macro2utf8 "UpTeeArrow" "\226\134\165"
+let _ = Hashtbl.replace macro2utf8 "LeftFloor" "\226\140\138"
+let _ = Hashtbl.replace macro2utf8 "kfr" "\240\157\148\168"
+let _ = Hashtbl.replace macro2utf8 "nisd" "\226\139\186"
+let _ = Hashtbl.replace macro2utf8 "scnE" "\226\170\182"
+let _ = Hashtbl.replace macro2utf8 "Ucy" "\208\163"
+let _ = Hashtbl.replace macro2utf8 "nprec" "\226\138\128"
+let _ = Hashtbl.replace macro2utf8 "ltrPar" "\226\166\150"
+let _ = Hashtbl.replace macro2utf8 "Scaron" "\197\160"
+let _ = Hashtbl.replace macro2utf8 "InvisibleComma" "\226\128\139"
+let _ = Hashtbl.replace macro2utf8 "SquareUnion" "\226\138\148"
+let _ = Hashtbl.replace macro2utf8 "ffllig" "\239\172\132"
+let _ = Hashtbl.replace macro2utf8 "approxeq" "\226\137\138"
+let _ = Hashtbl.replace macro2utf8 "yacute" "\195\189"
+let _ = Hashtbl.replace macro2utf8 "pre" "\226\170\175"
+let _ = Hashtbl.replace macro2utf8 "nsqsupe" "\226\139\163"
+let _ = Hashtbl.replace macro2utf8 "supset" "\226\138\131"
+let _ = Hashtbl.replace macro2utf8 "bsolhsub" "\\\226\138\130"
+let _ = Hashtbl.replace macro2utf8 "nshortparallel" "\226\136\166\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "lozenge" "\226\151\138"
+let _ = Hashtbl.replace macro2utf8 "lnot" "\194\172"
+let _ = Hashtbl.replace macro2utf8 "Dopf" "\240\157\148\187"
+let _ = Hashtbl.replace macro2utf8 "leftharpoonup" "\226\134\188"
+let _ = Hashtbl.replace macro2utf8 "Jcy" "\208\153"
+let _ = Hashtbl.replace macro2utf8 "rightarrow" "\226\134\146"
+let _ = Hashtbl.replace macro2utf8 "ntriangleright" "\226\139\171"
+let _ = Hashtbl.replace macro2utf8 "Ccirc" "\196\136"
+let _ = Hashtbl.replace macro2utf8 "eacute" "\195\169"
+let _ = Hashtbl.replace macro2utf8 "acute" "\194\180"
+let _ = Hashtbl.replace macro2utf8 "Precedes" "\226\137\186"
+let _ = Hashtbl.replace macro2utf8 "middot" "\194\183"
+let _ = Hashtbl.replace macro2utf8 "lHar" "\226\165\162"
+let _ = Hashtbl.replace macro2utf8 "eparsl" "\226\167\163"
+let _ = Hashtbl.replace macro2utf8 "psi" "\207\136"
+let _ = Hashtbl.replace macro2utf8 "parsl" "\226\136\165\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "UpperLeftArrow" "\226\134\150"
+let _ = Hashtbl.replace macro2utf8 "oror" "\226\169\150"
+let _ = Hashtbl.replace macro2utf8 "Kopf" "\240\157\149\130"
+let _ = Hashtbl.replace macro2utf8 "apacir" "\226\169\175"
+let _ = Hashtbl.replace macro2utf8 "dharl" "\226\135\131"
+let _ = Hashtbl.replace macro2utf8 "nequiv" "\226\137\162"
+let _ = Hashtbl.replace macro2utf8 "rightleftarrows" "\226\135\132"
+let _ = Hashtbl.replace macro2utf8 "UnderParenthesis" "\239\184\182"
+let _ = Hashtbl.replace macro2utf8 "notni" "\226\136\140"
+let _ = Hashtbl.replace macro2utf8 "dagger" "\226\128\160"
+let _ = Hashtbl.replace macro2utf8 "dharr" "\226\135\130"
+let _ = Hashtbl.replace macro2utf8 "twoheadleftarrow" "\226\134\158"
+let _ = Hashtbl.replace macro2utf8 "frac12" "\194\189"
+let _ = Hashtbl.replace macro2utf8 "varsubsetneqq" "\226\138\138\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "frac13" "\226\133\147"
+let _ = Hashtbl.replace macro2utf8 "Ufr" "\240\157\148\152"
+let _ = Hashtbl.replace macro2utf8 "NestedLessLess" "\226\137\170"
+let _ = Hashtbl.replace macro2utf8 "llarr" "\226\135\135"
+let _ = Hashtbl.replace macro2utf8 "frac14" "\194\188"
+let _ = Hashtbl.replace macro2utf8 "frac15" "\226\133\149"
+let _ = Hashtbl.replace macro2utf8 "Ropf" "\226\132\157"
+let _ = Hashtbl.replace macro2utf8 "frac16" "\226\133\153"
+let _ = Hashtbl.replace macro2utf8 "lrtri" "\226\138\191"
+let _ = Hashtbl.replace macro2utf8 "frac18" "\226\133\155"
+let _ = Hashtbl.replace macro2utf8 "cedil" "\194\184"
+let _ = Hashtbl.replace macro2utf8 "subsim" "\226\171\135"
+let _ = Hashtbl.replace macro2utf8 "PrecedesTilde" "\226\137\190"
+let _ = Hashtbl.replace macro2utf8 "igrave" "\195\172"
+let _ = Hashtbl.replace macro2utf8 "gjcy" "\209\147"
+let _ = Hashtbl.replace macro2utf8 "LeftVector" "\226\134\188"
+let _ = Hashtbl.replace macro2utf8 "notniva" "\226\136\140"
+let _ = Hashtbl.replace macro2utf8 "notnivb" "\226\139\190"
+let _ = Hashtbl.replace macro2utf8 "ogon" "\203\155"
+let _ = Hashtbl.replace macro2utf8 "notnivc" "\226\139\189"
+let _ = Hashtbl.replace macro2utf8 "Yopf" "\240\157\149\144"
+let _ = Hashtbl.replace macro2utf8 "there4" "\226\136\180"
+let _ = Hashtbl.replace macro2utf8 "udarr" "\226\135\133"
+let _ = Hashtbl.replace macro2utf8 "bkarow" "\226\164\141"
+let _ = Hashtbl.replace macro2utf8 "frac23" "\226\133\148"
+let _ = Hashtbl.replace macro2utf8 "frac25" "\226\133\150"
+let _ = Hashtbl.replace macro2utf8 "njcy" "\209\154"
+let _ = Hashtbl.replace macro2utf8 "Dashv" "\226\171\164"
+let _ = Hashtbl.replace macro2utf8 "eta" "\206\183"
+let _ = Hashtbl.replace macro2utf8 "bcong" "\226\137\140"
+let _ = Hashtbl.replace macro2utf8 "Ugrave" "\195\153"
+let _ = Hashtbl.replace macro2utf8 "csube" "\226\171\145"
+let _ = Hashtbl.replace macro2utf8 "clubs" "\226\153\163"
+let _ = Hashtbl.replace macro2utf8 "supmult" "\226\171\130"
+let _ = Hashtbl.replace macro2utf8 "MinusPlus" "\226\136\147"
+let _ = Hashtbl.replace macro2utf8 "Jfr" "\240\157\148\141"
+let _ = Hashtbl.replace macro2utf8 "ensp" "\226\128\130"
+let _ = Hashtbl.replace macro2utf8 "ucirc" "\195\187"
+let _ = Hashtbl.replace macro2utf8 "supsim" "\226\171\136"
+let _ = Hashtbl.replace macro2utf8 "eth" "\195\176"
+let _ = Hashtbl.replace macro2utf8 "OverBrace" "\239\184\183"
+let _ = Hashtbl.replace macro2utf8 "Dot" "\194\168"
+let _ = Hashtbl.replace macro2utf8 "xcap" "\226\139\130"
+let _ = Hashtbl.replace macro2utf8 "vangrt" "\226\138\190"
+let _ = Hashtbl.replace macro2utf8 "NotSubsetEqual" "\226\138\136"
+let _ = Hashtbl.replace macro2utf8 "frac34" "\194\190"
+let _ = Hashtbl.replace macro2utf8 "frac35" "\226\133\151"
+let _ = Hashtbl.replace macro2utf8 "planck" "\226\132\143\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "lnsim" "\226\139\166"
+let _ = Hashtbl.replace macro2utf8 "gopf" "\240\157\149\152"
+let _ = Hashtbl.replace macro2utf8 "frac38" "\226\133\156"
+let _ = Hashtbl.replace macro2utf8 "DotDot" "\226\131\156"
+let _ = Hashtbl.replace macro2utf8 "mapstoup" "\226\134\165"
+let _ = Hashtbl.replace macro2utf8 "Escr" "\226\132\176"
+let _ = Hashtbl.replace macro2utf8 "Integral" "\226\136\171"
+let _ = Hashtbl.replace macro2utf8 "Agrave" "\195\128"
+let _ = Hashtbl.replace macro2utf8 "longleftarrow" "????;"
+let _ = Hashtbl.replace macro2utf8 "Tcaron" "\197\164"
+let _ = Hashtbl.replace macro2utf8 "nopf" "\240\157\149\159"
+let _ = Hashtbl.replace macro2utf8 "LongLeftRightArrow" "\239\149\184"
+let _ = Hashtbl.replace macro2utf8 "Emacr" "\196\146"
+let _ = Hashtbl.replace macro2utf8 "omid" "\226\166\182"
+let _ = Hashtbl.replace macro2utf8 "spades" "\226\153\160"
+let _ = Hashtbl.replace macro2utf8 "naturals" "\226\132\149"
+let _ = Hashtbl.replace macro2utf8 "Lscr" "\226\132\146"
+let _ = Hashtbl.replace macro2utf8 "udblac" "\197\177"
+let _ = Hashtbl.replace macro2utf8 "SucceedsTilde" "\226\137\191"
+let _ = Hashtbl.replace macro2utf8 "frac45" "\226\133\152"
+let _ = Hashtbl.replace macro2utf8 "clubsuit" "\226\153\163"
+let _ = Hashtbl.replace macro2utf8 "mumap" "\226\138\184"
+let _ = Hashtbl.replace macro2utf8 "vltri" "\226\138\178"
+let _ = Hashtbl.replace macro2utf8 "LeftArrowBar" "\226\135\164"
+let _ = Hashtbl.replace macro2utf8 "zacute" "\197\186"
+let _ = Hashtbl.replace macro2utf8 "szlig" "\195\159"
+let _ = Hashtbl.replace macro2utf8 "suplarr" "\226\165\187"
+let _ = Hashtbl.replace macro2utf8 "RightDownVector" "\226\135\130"
+let _ = Hashtbl.replace macro2utf8 "male" "\226\153\130"
+let _ = Hashtbl.replace macro2utf8 "RightDownVectorBar" "\226\165\149"
+let _ = Hashtbl.replace macro2utf8 "gdot" "\196\161"
+let _ = Hashtbl.replace macro2utf8 "nleqq" "\226\137\176"
+let _ = Hashtbl.replace macro2utf8 "uopf" "\240\157\149\166"
+let _ = Hashtbl.replace macro2utf8 "YIcy" "\208\135"
+let _ = Hashtbl.replace macro2utf8 "Sscr" "\240\157\146\174"
+let _ = Hashtbl.replace macro2utf8 "empty" "\226\136\133\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "Vdash" "\226\138\169"
+let _ = Hashtbl.replace macro2utf8 "sqsubset" "\226\138\143"
+let _ = Hashtbl.replace macro2utf8 "efDot" "\226\137\146"
+let _ = Hashtbl.replace macro2utf8 "times" "\195\151"
+let _ = Hashtbl.replace macro2utf8 "Oslash" "\195\152"
+let _ = Hashtbl.replace macro2utf8 "itilde" "\196\169"
+let _ = Hashtbl.replace macro2utf8 "frac56" "\226\133\154"
+let _ = Hashtbl.replace macro2utf8 "numero" "\226\132\150"
+let _ = Hashtbl.replace macro2utf8 "malt" "\226\156\160"
+let _ = Hashtbl.replace macro2utf8 "npart" "\226\136\130\204\184"
+let _ = Hashtbl.replace macro2utf8 "frac58" "\226\133\157"
+let _ = Hashtbl.replace macro2utf8 "Zscr" "\240\157\146\181"
+let _ = Hashtbl.replace macro2utf8 "integers" "\226\132\164"
+let _ = Hashtbl.replace macro2utf8 "CloseCurlyQuote" "\226\128\153"
+let _ = Hashtbl.replace macro2utf8 "NewLine" "\n"
+let _ = Hashtbl.replace macro2utf8 "fcy" "\209\132"
+let _ = Hashtbl.replace macro2utf8 "nwarr" "\226\134\150"
+let _ = Hashtbl.replace macro2utf8 "thicksim" "\226\136\188\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "nprcue" "\226\139\160"
+let _ = Hashtbl.replace macro2utf8 "lcub" "{"
+let _ = Hashtbl.replace macro2utf8 "forall" "\226\136\128"
+let _ = Hashtbl.replace macro2utf8 "plusacir" "\226\168\163"
+let _ = Hashtbl.replace macro2utf8 "ascr" "\240\157\146\182"
+let _ = Hashtbl.replace macro2utf8 "plustwo" "\226\168\167"
+let _ = Hashtbl.replace macro2utf8 "Utilde" "\197\168"
+let _ = Hashtbl.replace macro2utf8 "lambda" "\206\187"
+let _ = Hashtbl.replace macro2utf8 "odash" "\226\138\157"
+let _ = Hashtbl.replace macro2utf8 "iukcy" "\209\150"
+let _ = Hashtbl.replace macro2utf8 "sqsupset" "\226\138\144"
+let _ = Hashtbl.replace macro2utf8 "Racute" "\197\148"
+let _ = Hashtbl.replace macro2utf8 "Longleftarrow" "????"
+let _ = Hashtbl.replace macro2utf8 "capcap" "\226\169\139"
+let _ = Hashtbl.replace macro2utf8 "ocirc" "\195\180"
+let _ = Hashtbl.replace macro2utf8 "nless" "\226\137\174"
+let _ = Hashtbl.replace macro2utf8 "Wedge" "\226\139\128"
+let _ = Hashtbl.replace macro2utf8 "qfr" "\240\157\148\174"
+let _ = Hashtbl.replace macro2utf8 "natur" "\226\153\174"
+let _ = Hashtbl.replace macro2utf8 "hscr" "\240\157\146\189"
+let _ = Hashtbl.replace macro2utf8 "ldca" "\226\164\182"
+let _ = Hashtbl.replace macro2utf8 "ClockwiseContourIntegral" "\226\136\178"
+let _ = Hashtbl.replace macro2utf8 "exp" "exp"
+let _ = Hashtbl.replace macro2utf8 "RightTeeArrow" "\226\134\166"
+let _ = Hashtbl.replace macro2utf8 "orarr" "\226\134\187"
+let _ = Hashtbl.replace macro2utf8 "tanh" "tanh"
+let _ = Hashtbl.replace macro2utf8 "frac78" "\226\133\158"
+let _ = Hashtbl.replace macro2utf8 "Atilde" "\195\131"
+let _ = Hashtbl.replace macro2utf8 "arcsin" "arcsin"
+let _ = Hashtbl.replace macro2utf8 "Rcedil" "\197\150"
+let _ = Hashtbl.replace macro2utf8 "oscr" "\226\132\180"
+let _ = Hashtbl.replace macro2utf8 "InvisibleTimes" "\226\129\162"
+let _ = Hashtbl.replace macro2utf8 "sime" "\226\137\131"
+let _ = Hashtbl.replace macro2utf8 "simg" "\226\170\158"
+let _ = Hashtbl.replace macro2utf8 "Conint" "\226\136\175"
+let _ = Hashtbl.replace macro2utf8 "Yuml" "\197\184"
+let _ = Hashtbl.replace macro2utf8 "rlhar" "\226\135\140"
+let _ = Hashtbl.replace macro2utf8 "rarrbfs" "\226\164\160"
+let _ = Hashtbl.replace macro2utf8 "siml" "\226\170\157"
+let _ = Hashtbl.replace macro2utf8 "DownRightVectorBar" "\226\165\151"
+let _ = Hashtbl.replace macro2utf8 "vscr" "\240\157\147\139"
+let _ = Hashtbl.replace macro2utf8 "divide" "\195\183"
+let _ = Hashtbl.replace macro2utf8 "PlusMinus" "\194\177"
+let _ = Hashtbl.replace macro2utf8 "ffr" "\240\157\148\163"
+let _ = Hashtbl.replace macro2utf8 "DownLeftTeeVector" "\226\165\158"
+let _ = Hashtbl.replace macro2utf8 "EmptySmallSquare" "\226\151\189"
+let _ = Hashtbl.replace macro2utf8 "SHCHcy" "\208\169"
+let _ = Hashtbl.replace macro2utf8 "cirmid" "\226\171\175"
+let _ = Hashtbl.replace macro2utf8 "sigmav" "\207\130"
+let _ = Hashtbl.replace macro2utf8 "csub" "\226\171\143"
+let _ = Hashtbl.replace macro2utf8 "npar" "\226\136\166"
+let _ = Hashtbl.replace macro2utf8 "bsemi" "\226\129\143"
+let _ = Hashtbl.replace macro2utf8 "swArr" "\226\135\153"
+let _ = Hashtbl.replace macro2utf8 "Pcy" "\208\159"
+let _ = Hashtbl.replace macro2utf8 "sinh" "sinh"
+let _ = Hashtbl.replace macro2utf8 "lharul" "\226\165\170"
+let _ = Hashtbl.replace macro2utf8 "Jukcy" "\208\132"
+let _ = Hashtbl.replace macro2utf8 "permil" "\226\128\176"
+let _ = Hashtbl.replace macro2utf8 "ndivides" "\226\136\164"
+let _ = Hashtbl.replace macro2utf8 "Aring" "\195\133"
+let _ = Hashtbl.replace macro2utf8 "longmapsto" "????"
+let _ = Hashtbl.replace macro2utf8 "Esim" "\226\169\179"
+let _ = Hashtbl.replace macro2utf8 "csup" "\226\171\144"
+let _ = Hashtbl.replace macro2utf8 "trie" "\226\137\156"
+let _ = Hashtbl.replace macro2utf8 "ubrcy" "\209\158"
+let _ = Hashtbl.replace macro2utf8 "NotEqualTilde" "\226\137\130\204\184"
+let _ = Hashtbl.replace macro2utf8 "dotminus" "\226\136\184"
+let _ = Hashtbl.replace macro2utf8 "diamondsuit" "\226\153\162"
+let _ = Hashtbl.replace macro2utf8 "xnis" "\226\139\187"
+let _ = Hashtbl.replace macro2utf8 "Eogon" "\196\152"
+let _ = Hashtbl.replace macro2utf8 "cuvee" "\226\139\142"
+let _ = Hashtbl.replace macro2utf8 "DZcy" "\208\143"
+let _ = Hashtbl.replace macro2utf8 "nRightarrow" "\226\135\143"
+let _ = Hashtbl.replace macro2utf8 "sqsupe" "\226\138\146"
+let _ = Hashtbl.replace macro2utf8 "nsccue" "\226\139\161"
+let _ = Hashtbl.replace macro2utf8 "drcrop" "\226\140\140"
+let _ = Hashtbl.replace macro2utf8 "DownBreve" "\204\145"
+let _ = Hashtbl.replace macro2utf8 "Ecy" "\208\173"
+let _ = Hashtbl.replace macro2utf8 "rdquor" "\226\128\157"
+let _ = Hashtbl.replace macro2utf8 "rAtail" "\226\164\156"
+let _ = Hashtbl.replace macro2utf8 "icirc" "\195\174"
+let _ = Hashtbl.replace macro2utf8 "gacute" "\199\181"
+let _ = Hashtbl.replace macro2utf8 "hyphen" "\226\128\144"
+let _ = Hashtbl.replace macro2utf8 "uuml" "\195\188"
+let _ = Hashtbl.replace macro2utf8 "thorn" "\195\190"
+let _ = Hashtbl.replace macro2utf8 "ltri" "\226\151\131"
+let _ = Hashtbl.replace macro2utf8 "eqslantgtr" "\226\139\157"
+let _ = Hashtbl.replace macro2utf8 "DoubleContourIntegral" "\226\136\175"
+let _ = Hashtbl.replace macro2utf8 "lescc" "\226\170\168"
+let _ = Hashtbl.replace macro2utf8 "DiacriticalGrave" "`"
+let _ = Hashtbl.replace macro2utf8 "NotPrecedesEqual" "\226\170\175\204\184"
+let _ = Hashtbl.replace macro2utf8 "RightArrow" "\226\134\146"
+let _ = Hashtbl.replace macro2utf8 "race" "\226\167\154"
+let _ = Hashtbl.replace macro2utf8 "topbot" "\226\140\182"
+let _ = Hashtbl.replace macro2utf8 "Pfr" "\240\157\148\147"
+let _ = Hashtbl.replace macro2utf8 "napprox" "\226\137\137"
+let _ = Hashtbl.replace macro2utf8 "Sacute" "\197\154"
+let _ = Hashtbl.replace macro2utf8 "cupor" "\226\169\133"
+let _ = Hashtbl.replace macro2utf8 "OverBar" "\194\175"
+let _ = Hashtbl.replace macro2utf8 "bepsi" "\207\182"
+let _ = Hashtbl.replace macro2utf8 "plankv" "\226\132\143"
+let _ = Hashtbl.replace macro2utf8 "lap" "\226\137\178"
+let _ = Hashtbl.replace macro2utf8 "orslope" "\226\169\151"
+let _ = Hashtbl.replace macro2utf8 "beta" "\206\178"
+let _ = Hashtbl.replace macro2utf8 "ShortDownArrow" "\226\140\132\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "perp" "\226\138\165"
+let _ = Hashtbl.replace macro2utf8 "lat" "\226\170\171"
+let _ = Hashtbl.replace macro2utf8 "CenterDot" "\194\183"
+let _ = Hashtbl.replace macro2utf8 "urcorner" "\226\140\157"
+let _ = Hashtbl.replace macro2utf8 "models" "\226\138\167"
+let _ = Hashtbl.replace macro2utf8 "beth" "\226\132\182"
+let _ = Hashtbl.replace macro2utf8 "subE" "\226\138\134"
+let _ = Hashtbl.replace macro2utf8 "subnE" "\226\138\138"
+let _ = Hashtbl.replace macro2utf8 "ldots" "\226\128\166"
+let _ = Hashtbl.replace macro2utf8 "yacy" "\209\143"
+let _ = Hashtbl.replace macro2utf8 "udhar" "\226\165\174"
+let _ = Hashtbl.replace macro2utf8 "Scedil" "\197\158"
+let _ = Hashtbl.replace macro2utf8 "subsub" "\226\171\149"
+let _ = Hashtbl.replace macro2utf8 "nvrtrie" "\226\139\173\204\184"
+let _ = Hashtbl.replace macro2utf8 "Phi" "\206\166"
+let _ = Hashtbl.replace macro2utf8 "Efr" "\240\157\148\136"
+let _ = Hashtbl.replace macro2utf8 "larrfs" "\226\164\157"
+let _ = Hashtbl.replace macro2utf8 "angle" "\226\136\160"
+let _ = Hashtbl.replace macro2utf8 "TildeFullEqual" "\226\137\133"
+let _ = Hashtbl.replace macro2utf8 "Jcirc" "\196\180"
+let _ = Hashtbl.replace macro2utf8 "THORN" "\195\158"
+let _ = Hashtbl.replace macro2utf8 "acE" "\226\167\155"
+let _ = Hashtbl.replace macro2utf8 "Longleftrightarrow" "????"
+let _ = Hashtbl.replace macro2utf8 "xuplus" "\226\138\142"
+let _ = Hashtbl.replace macro2utf8 "searr" "\226\134\152"
+let _ = Hashtbl.replace macro2utf8 "gvertneqq" "\226\137\169\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "subsup" "\226\171\147"
+let _ = Hashtbl.replace macro2utf8 "NotSucceedsEqual" "\226\170\176\204\184"
+let _ = Hashtbl.replace macro2utf8 "gtrsim" "\226\137\179"
+let _ = Hashtbl.replace macro2utf8 "nrArr" "\226\135\143"
+let _ = Hashtbl.replace macro2utf8 "NotSquareSupersetEqual" "\226\139\163"
+let _ = Hashtbl.replace macro2utf8 "notindot" "\226\139\182\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "HARDcy" "\208\170"
+let _ = Hashtbl.replace macro2utf8 "jmath" "j\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "aelig" "\195\166"
+let _ = Hashtbl.replace macro2utf8 "slarr" "\226\134\144\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "dlcrop" "\226\140\141"
+let _ = Hashtbl.replace macro2utf8 "sube" "\226\138\134"
+let _ = Hashtbl.replace macro2utf8 "cuepr" "\226\139\158"
+let _ = Hashtbl.replace macro2utf8 "supsub" "\226\171\148"
+let _ = Hashtbl.replace macro2utf8 "trianglelefteq" "\226\138\180"
+let _ = Hashtbl.replace macro2utf8 "subne" "\226\138\138"
+let _ = Hashtbl.replace macro2utf8 "between" "\226\137\172"
+let _ = Hashtbl.replace macro2utf8 "measuredangle" "\226\136\161"
+let _ = Hashtbl.replace macro2utf8 "swnwar" "\226\164\170"
+let _ = Hashtbl.replace macro2utf8 "lcy" "\208\187"
+let _ = Hashtbl.replace macro2utf8 "ccirc" "\196\137"
+let _ = Hashtbl.replace macro2utf8 "larrhk" "\226\134\169"
+let _ = Hashtbl.replace macro2utf8 "DiacriticalTilde" "\203\156"
+let _ = Hashtbl.replace macro2utf8 "brvbar" "\194\166"
+let _ = Hashtbl.replace macro2utf8 "triangledown" "\226\150\191"
+let _ = Hashtbl.replace macro2utf8 "dtrif" "\226\150\190"
+let _ = Hashtbl.replace macro2utf8 "Bopf" "\240\157\148\185"
+let _ = Hashtbl.replace macro2utf8 "xwedge" "\226\139\128"
+let _ = Hashtbl.replace macro2utf8 "rightsquigarrow" "\226\134\157"
+let _ = Hashtbl.replace macro2utf8 "acd" "\226\136\191"
+let _ = Hashtbl.replace macro2utf8 "supsup" "\226\171\150"
+let _ = Hashtbl.replace macro2utf8 "UpEquilibrium" "\226\165\174"
+let _ = Hashtbl.replace macro2utf8 "succ" "\226\137\187"
+let _ = Hashtbl.replace macro2utf8 "eqslantless" "\226\139\156"
+let _ = Hashtbl.replace macro2utf8 "coprod" "\226\136\144"
+let _ = Hashtbl.replace macro2utf8 "OpenCurlyDoubleQuote" "\226\128\156"
+let _ = Hashtbl.replace macro2utf8 "NotGreaterSlantEqual" "\226\137\177"
+let _ = Hashtbl.replace macro2utf8 "solb" "\226\167\132"
+let _ = Hashtbl.replace macro2utf8 "HumpDownHump" "\226\137\142"
+let _ = Hashtbl.replace macro2utf8 "gtrapprox" "\226\137\179"
+let _ = Hashtbl.replace macro2utf8 "Iopf" "\240\157\149\128"
+let _ = Hashtbl.replace macro2utf8 "leg" "\226\139\154"
+let _ = Hashtbl.replace macro2utf8 "wfr" "\240\157\148\180"
+let _ = Hashtbl.replace macro2utf8 "mapstoleft" "\226\134\164"
+let _ = Hashtbl.replace macro2utf8 "gnapprox" "\226\170\138"
+let _ = Hashtbl.replace macro2utf8 "lgE" "\226\170\145"
+let _ = Hashtbl.replace macro2utf8 "CloseCurlyDoubleQuote" "\226\128\157"
+let _ = Hashtbl.replace macro2utf8 "NotNestedLessLess" "\226\146\161\204\184"
+let _ = Hashtbl.replace macro2utf8 "acy" "\208\176"
+let _ = Hashtbl.replace macro2utf8 "leq" "\226\137\164"
+let _ = Hashtbl.replace macro2utf8 "Popf" "\226\132\153"
+let _ = Hashtbl.replace macro2utf8 "les" "\226\169\189"
+let _ = Hashtbl.replace macro2utf8 "succcurlyeq" "\226\137\189"
+let _ = Hashtbl.replace macro2utf8 "heartsuit" "\226\153\161"
+let _ = Hashtbl.replace macro2utf8 "angmsd" "\226\136\161"
+let _ = Hashtbl.replace macro2utf8 "cuesc" "\226\139\159"
+let _ = Hashtbl.replace macro2utf8 "lesseqgtr" "\226\139\154"
+let _ = Hashtbl.replace macro2utf8 "vartriangleright" "\226\138\179"
+let _ = Hashtbl.replace macro2utf8 "csupe" "\226\171\146"
+let _ = Hashtbl.replace macro2utf8 "rthree" "\226\139\140"
+let _ = Hashtbl.replace macro2utf8 "Idot" "\196\176"
+let _ = Hashtbl.replace macro2utf8 "gtdot" "\226\139\151"
+let _ = Hashtbl.replace macro2utf8 "dashv" "\226\138\163"
+let _ = Hashtbl.replace macro2utf8 "Odblac" "\197\144"
+let _ = Hashtbl.replace macro2utf8 "Lmidot" "\196\191"
+let _ = Hashtbl.replace macro2utf8 "andd" "\226\169\156"
+let _ = Hashtbl.replace macro2utf8 "Wopf" "\240\157\149\142"
+let _ = Hashtbl.replace macro2utf8 "nvltrie" "\226\139\172\204\184"
+let _ = Hashtbl.replace macro2utf8 "nhpar" "\226\171\178"
+let _ = Hashtbl.replace macro2utf8 "geqslant" "\226\169\190"
+let _ = Hashtbl.replace macro2utf8 "xlArr" "\239\149\185"
+let _ = Hashtbl.replace macro2utf8 "SquareSubset" "\226\138\143"
+let _ = Hashtbl.replace macro2utf8 "intcal" "\226\138\186"
+let _ = Hashtbl.replace macro2utf8 "ljcy" "\209\153"
+let _ = Hashtbl.replace macro2utf8 "lfr" "\240\157\148\169"
+let _ = Hashtbl.replace macro2utf8 "gtlPar" "\226\166\149"
+let _ = Hashtbl.replace macro2utf8 "zigrarr" "\226\135\157"
+let _ = Hashtbl.replace macro2utf8 "nvap" "\226\137\137\204\184"
+let _ = Hashtbl.replace macro2utf8 "boxtimes" "\226\138\160"
+let _ = Hashtbl.replace macro2utf8 "raquo" "\194\187"
+let _ = Hashtbl.replace macro2utf8 "CircleMinus" "\226\138\150"
+let _ = Hashtbl.replace macro2utf8 "centerdot" "\194\183"
+let _ = Hashtbl.replace macro2utf8 "xoplus" "\226\138\149"
+let _ = Hashtbl.replace macro2utf8 "simdot" "\226\169\170"
+let _ = Hashtbl.replace macro2utf8 "Vcy" "\208\146"
+let _ = Hashtbl.replace macro2utf8 "profline" "\226\140\146"
+let _ = Hashtbl.replace macro2utf8 "ltquest" "\226\169\187"
+let _ = Hashtbl.replace macro2utf8 "andv" "\226\169\154"
+let _ = Hashtbl.replace macro2utf8 "lessgtr" "\226\137\182"
+let _ = Hashtbl.replace macro2utf8 "lesdoto" "\226\170\129"
+let _ = Hashtbl.replace macro2utf8 "NotSquareSubset" "\226\138\143\204\184"
+let _ = Hashtbl.replace macro2utf8 "bullet" "\226\128\162"
+let _ = Hashtbl.replace macro2utf8 "rarrsim" "\226\165\180"
+let _ = Hashtbl.replace macro2utf8 "Tcedil" "\197\162"
+let _ = Hashtbl.replace macro2utf8 "Hstrok" "\196\166"
+let _ = Hashtbl.replace macro2utf8 "eopf" "\240\157\149\150"
+let _ = Hashtbl.replace macro2utf8 "Theta" "\206\152"
+let _ = Hashtbl.replace macro2utf8 "Cscr" "\240\157\146\158"
+let _ = Hashtbl.replace macro2utf8 "emacr" "\196\147"
+let _ = Hashtbl.replace macro2utf8 "UnionPlus" "\226\138\142"
+let _ = Hashtbl.replace macro2utf8 "Vee" "\226\139\129"
+let _ = Hashtbl.replace macro2utf8 "arctan" "arctan"
+let _ = Hashtbl.replace macro2utf8 "afr" "\240\157\148\158"
+let _ = Hashtbl.replace macro2utf8 "thinsp" "\226\128\137"
+let _ = Hashtbl.replace macro2utf8 "bottom" "\226\138\165"
+let _ = Hashtbl.replace macro2utf8 "lopf" "\240\157\149\157"
+let _ = Hashtbl.replace macro2utf8 "larrlp" "\226\134\171"
+let _ = Hashtbl.replace macro2utf8 "lbrace" "{"
+let _ = Hashtbl.replace macro2utf8 "Jscr" "\240\157\146\165"
+let _ = Hashtbl.replace macro2utf8 "Kcy" "\208\154"
+let _ = Hashtbl.replace macro2utf8 "shortparallel" "\226\136\165\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "hairsp" "\226\128\138"
+let _ = Hashtbl.replace macro2utf8 "osol" "\226\138\152"
+let _ = Hashtbl.replace macro2utf8 "lbrack" "["
+let _ = Hashtbl.replace macro2utf8 "hArr" "\226\135\148"
+let _ = Hashtbl.replace macro2utf8 "vdash" "\226\138\162"
+let _ = Hashtbl.replace macro2utf8 "UpDownArrow" "\226\134\149"
+let _ = Hashtbl.replace macro2utf8 "edot" "\196\151"
+let _ = Hashtbl.replace macro2utf8 "vzigzag" "\226\166\154"
+let _ = Hashtbl.replace macro2utf8 "sopf" "\240\157\149\164"
+let _ = Hashtbl.replace macro2utf8 "NotLessGreater" "\226\137\184"
+let _ = Hashtbl.replace macro2utf8 "Qscr" "\240\157\146\172"
+let _ = Hashtbl.replace macro2utf8 "Gammad" "\207\156"
+let _ = Hashtbl.replace macro2utf8 "SubsetEqual" "\226\138\134"
+let _ = Hashtbl.replace macro2utf8 "uplus" "\226\138\142"
+let _ = Hashtbl.replace macro2utf8 "LeftTriangle" "\226\138\178"
+let _ = Hashtbl.replace macro2utf8 "ange" "\226\166\164"
+let _ = Hashtbl.replace macro2utf8 "lim" "lim"
+let _ = Hashtbl.replace macro2utf8 "triangleright" "\226\150\185"
+let _ = Hashtbl.replace macro2utf8 "angrt" "\226\136\159"
+let _ = Hashtbl.replace macro2utf8 "rfloor" "\226\140\139"
+let _ = Hashtbl.replace macro2utf8 "bigtriangledown" "\226\150\189"
+let _ = Hashtbl.replace macro2utf8 "ofcir" "\226\166\191"
+let _ = Hashtbl.replace macro2utf8 "Vfr" "\240\157\148\153"
+let _ = Hashtbl.replace macro2utf8 "zopf" "\240\157\149\171"
+let _ = Hashtbl.replace macro2utf8 "UpArrowDownArrow" "\226\135\133"
+let _ = Hashtbl.replace macro2utf8 "Xscr" "\240\157\146\179"
+let _ = Hashtbl.replace macro2utf8 "digamma" "\207\156"
+let _ = Hashtbl.replace macro2utf8 "SmallCircle" "\226\136\152"
+let _ = Hashtbl.replace macro2utf8 "vArr" "\226\135\149"
+let _ = Hashtbl.replace macro2utf8 "eqsim" "\226\137\130"
+let _ = Hashtbl.replace macro2utf8 "downharpoonright" "\226\135\130"
+let _ = Hashtbl.replace macro2utf8 "Ccaron" "\196\140"
+let _ = Hashtbl.replace macro2utf8 "sdot" "\226\139\133"
+let _ = Hashtbl.replace macro2utf8 "frown" "\226\140\162"
+let _ = Hashtbl.replace macro2utf8 "angst" "\226\132\171"
+let _ = Hashtbl.replace macro2utf8 "lesges" "\226\170\147"
+let _ = Hashtbl.replace macro2utf8 "iacute" "\195\173"
+let _ = Hashtbl.replace macro2utf8 "wedge" "\226\136\167"
+let _ = Hashtbl.replace macro2utf8 "ssetmn" "\226\136\150\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "rotimes" "\226\168\181"
+let _ = Hashtbl.replace macro2utf8 "laquo" "\194\171"
+let _ = Hashtbl.replace macro2utf8 "bigstar" "\226\152\133"
+let _ = Hashtbl.replace macro2utf8 "Rrightarrow" "\226\135\155"
+let _ = Hashtbl.replace macro2utf8 "erDot" "\226\137\147"
+let _ = Hashtbl.replace macro2utf8 "subseteq" "\226\138\134"
+let _ = Hashtbl.replace macro2utf8 "leftharpoondown" "\226\134\189"
+let _ = Hashtbl.replace macro2utf8 "infin" "\226\136\158"
+let _ = Hashtbl.replace macro2utf8 "zdot" "\197\188"
+let _ = Hashtbl.replace macro2utf8 "solbar" "\226\140\191"
+let _ = Hashtbl.replace macro2utf8 "Iuml" "\195\143"
+let _ = Hashtbl.replace macro2utf8 "Kfr" "\240\157\148\142"
+let _ = Hashtbl.replace macro2utf8 "fscr" "\240\157\146\187"
+let _ = Hashtbl.replace macro2utf8 "DJcy" "\208\130"
+let _ = Hashtbl.replace macro2utf8 "veeeq" "\226\137\154"
+let _ = Hashtbl.replace macro2utf8 "Star" "\226\139\134"
+let _ = Hashtbl.replace macro2utf8 "lsquor" "\226\128\154"
+let _ = Hashtbl.replace macro2utf8 "Uacute" "\195\154"
+let _ = Hashtbl.replace macro2utf8 "weierp" "\226\132\152"
+let _ = Hashtbl.replace macro2utf8 "rang" "\226\140\170"
+let _ = Hashtbl.replace macro2utf8 "hamilt" "\226\132\139"
+let _ = Hashtbl.replace macro2utf8 "angsph" "\226\136\162"
+let _ = Hashtbl.replace macro2utf8 "YUcy" "\208\174"
+let _ = Hashtbl.replace macro2utf8 "Wcirc" "\197\180"
+let _ = Hashtbl.replace macro2utf8 "supsetneq" "\226\138\139"
+let _ = Hashtbl.replace macro2utf8 "gap" "\226\137\179"
+let _ = Hashtbl.replace macro2utf8 "mscr" "\240\157\147\130"
+let _ = Hashtbl.replace macro2utf8 "KJcy" "\208\140"
+let _ = Hashtbl.replace macro2utf8 "qprime" "\226\129\151"
+let _ = Hashtbl.replace macro2utf8 "EqualTilde" "\226\137\130"
+let _ = Hashtbl.replace macro2utf8 "vBar" "\226\171\168"
+let _ = Hashtbl.replace macro2utf8 "larrpl" "\226\164\185"
+let _ = Hashtbl.replace macro2utf8 "nvge" "\226\137\177"
+let _ = Hashtbl.replace macro2utf8 "approx" "\226\137\136"
+let _ = Hashtbl.replace macro2utf8 "lnE" "\226\137\168"
+let _ = Hashtbl.replace macro2utf8 "NotGreaterLess" "\226\137\185"
+let _ = Hashtbl.replace macro2utf8 "epar" "\226\139\149"
+let _ = Hashtbl.replace macro2utf8 "bigotimes" "\226\138\151"
+let _ = Hashtbl.replace macro2utf8 "xharr" "\239\149\184"
+let _ = Hashtbl.replace macro2utf8 "roang" "\239\149\153"
+let _ = Hashtbl.replace macro2utf8 "xcup" "\226\139\131"
+let _ = Hashtbl.replace macro2utf8 "tscr" "\240\157\147\137"
+let _ = Hashtbl.replace macro2utf8 "thkap" "\226\137\136\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "Aacute" "\195\129"
+let _ = Hashtbl.replace macro2utf8 "rcy" "\209\128"
+let _ = Hashtbl.replace macro2utf8 "jukcy" "\209\148"
+let _ = Hashtbl.replace macro2utf8 "hookleftarrow" "\226\134\169"
+let _ = Hashtbl.replace macro2utf8 "napid" "\226\137\139\204\184"
+let _ = Hashtbl.replace macro2utf8 "tscy" "\209\134"
+let _ = Hashtbl.replace macro2utf8 "nvgt" "\226\137\175"
+let _ = Hashtbl.replace macro2utf8 "lpar" "("
+let _ = Hashtbl.replace macro2utf8 "ldsh" "\226\134\178"
+let _ = Hashtbl.replace macro2utf8 "aring" "\195\165"
+let _ = Hashtbl.replace macro2utf8 "nGg" "\226\139\153\204\184"
+let _ = Hashtbl.replace macro2utf8 "LessEqualGreater" "\226\139\154"
+let _ = Hashtbl.replace macro2utf8 "gcd" "gcd"
+let _ = Hashtbl.replace macro2utf8 "oplus" "\226\138\149"
+let _ = Hashtbl.replace macro2utf8 "lcaron" "\196\190"
+let _ = Hashtbl.replace macro2utf8 "DownArrow" "\226\134\147"
+let _ = Hashtbl.replace macro2utf8 "xutri" "\226\150\179"
+let _ = Hashtbl.replace macro2utf8 "Psi" "\206\168"
+let _ = Hashtbl.replace macro2utf8 "lesssim" "\226\137\178"
+let _ = Hashtbl.replace macro2utf8 "topcir" "\226\171\177"
+let _ = Hashtbl.replace macro2utf8 "puncsp" "\226\128\136"
+let _ = Hashtbl.replace macro2utf8 "origof" "\226\138\182"
+let _ = Hashtbl.replace macro2utf8 "gnsim" "\226\139\167"
+let _ = Hashtbl.replace macro2utf8 "eogon" "\196\153"
+let _ = Hashtbl.replace macro2utf8 "spar" "\226\136\165\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "LowerRightArrow" "\226\134\152"
+let _ = Hashtbl.replace macro2utf8 "Lleftarrow" "\226\135\154"
+let _ = Hashtbl.replace macro2utf8 "nGt" "\226\137\171\204\184"
+let _ = Hashtbl.replace macro2utf8 "euml" "\195\171"
+let _ = Hashtbl.replace macro2utf8 "reg" "\194\174"
+let _ = Hashtbl.replace macro2utf8 "exponentiale" "\226\133\135"
+let _ = Hashtbl.replace macro2utf8 "qint" "\226\168\140"
+let _ = Hashtbl.replace macro2utf8 "sqcups" "\226\138\148\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "lne" "\226\137\168"
+let _ = Hashtbl.replace macro2utf8 "LessSlantEqual" "\226\169\189"
+let _ = Hashtbl.replace macro2utf8 "Egrave" "\195\136"
+let _ = Hashtbl.replace macro2utf8 "orderof" "\226\132\180"
+let _ = Hashtbl.replace macro2utf8 "cirE" "\226\167\131"
+let _ = Hashtbl.replace macro2utf8 "nleqslant" "\226\137\176"
+let _ = Hashtbl.replace macro2utf8 "gcy" "\208\179"
+let _ = Hashtbl.replace macro2utf8 "curvearrowright" "\226\134\183"
+let _ = Hashtbl.replace macro2utf8 "ratail" "\226\134\163"
+let _ = Hashtbl.replace macro2utf8 "emsp13" "\226\128\132"
+let _ = Hashtbl.replace macro2utf8 "sdotb" "\226\138\161"
+let _ = Hashtbl.replace macro2utf8 "horbar" "\226\128\149"
+let _ = Hashtbl.replace macro2utf8 "emsp14" "\226\128\133"
+let _ = Hashtbl.replace macro2utf8 "npre" "\226\170\175\204\184"
+let _ = Hashtbl.replace macro2utf8 "rbrksld" "\226\166\142"
+let _ = Hashtbl.replace macro2utf8 "sdote" "\226\169\166"
+let _ = Hashtbl.replace macro2utf8 "varsupsetneqq" "\226\138\139\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "VeryThinSpace" "\226\128\138"
+let _ = Hashtbl.replace macro2utf8 "DownArrowBar" "\226\164\147"
+let _ = Hashtbl.replace macro2utf8 "Rightarrow" "\226\135\146"
+let _ = Hashtbl.replace macro2utf8 "ocir" "\226\138\154"
+let _ = Hashtbl.replace macro2utf8 "NotHumpDownHump" "\226\137\142\204\184"
+let _ = Hashtbl.replace macro2utf8 "darr" "\226\134\147"
+let _ = Hashtbl.replace macro2utf8 "geqq" "\226\137\167"
+let _ = Hashtbl.replace macro2utf8 "sup1" "\194\185"
+let _ = Hashtbl.replace macro2utf8 "log" "log"
+let _ = Hashtbl.replace macro2utf8 "sup2" "\194\178"
+let _ = Hashtbl.replace macro2utf8 "micro" "\194\181"
+let _ = Hashtbl.replace macro2utf8 "amp" "&"
+let _ = Hashtbl.replace macro2utf8 "arccos" "arccos"
+let _ = Hashtbl.replace macro2utf8 "sup3" "\194\179"
+let _ = Hashtbl.replace macro2utf8 "GreaterTilde" "\226\137\179"
+let _ = Hashtbl.replace macro2utf8 "circeq" "\226\137\151"
+let _ = Hashtbl.replace macro2utf8 "rfr" "\240\157\148\175"
+let _ = Hashtbl.replace macro2utf8 "dash" "\226\128\144"
+let _ = Hashtbl.replace macro2utf8 "rbrkslu" "\226\166\144"
+let _ = Hashtbl.replace macro2utf8 "Dcaron" "\196\142"
+let _ = Hashtbl.replace macro2utf8 "and" "\226\136\167"
+let _ = Hashtbl.replace macro2utf8 "Vbar" "\226\171\171"
+let _ = Hashtbl.replace macro2utf8 "angzarr" "\226\141\188"
+let _ = Hashtbl.replace macro2utf8 "gel" "\226\139\155"
+let _ = Hashtbl.replace macro2utf8 "ang" "\226\136\160"
+let _ = Hashtbl.replace macro2utf8 "lor" "\226\136\168"
+let _ = Hashtbl.replace macro2utf8 "circ" "\226\136\152"
+let _ = Hashtbl.replace macro2utf8 "upharpoonright" "\226\134\190"
+let _ = Hashtbl.replace macro2utf8 "dblac" "\203\157"
+let _ = Hashtbl.replace macro2utf8 "subsetneqq" "\226\138\138"
+let _ = Hashtbl.replace macro2utf8 "rhard" "\226\135\129"
+let _ = Hashtbl.replace macro2utf8 "Intersection" "\226\139\130"
+let _ = Hashtbl.replace macro2utf8 "cire" "\226\137\151"
+let _ = Hashtbl.replace macro2utf8 "apE" "\226\137\138"
+let _ = Hashtbl.replace macro2utf8 "sung" "\226\153\170"
+let _ = Hashtbl.replace macro2utf8 "geq" "\226\137\165"
+let _ = Hashtbl.replace macro2utf8 "succsim" "\226\137\191"
+let _ = Hashtbl.replace macro2utf8 "ges" "\226\169\190"
+let _ = Hashtbl.replace macro2utf8 "Gbreve" "\196\158"
+let _ = Hashtbl.replace macro2utf8 "intercal" "\226\138\186"
+let _ = Hashtbl.replace macro2utf8 "supE" "\226\138\135"
+let _ = Hashtbl.replace macro2utf8 "NotCupCap" "\226\137\173"
+let _ = Hashtbl.replace macro2utf8 "loz" "\226\151\138"
+let _ = Hashtbl.replace macro2utf8 "capcup" "\226\169\135"
+let _ = Hashtbl.replace macro2utf8 "larrtl" "\226\134\162"
+let _ = Hashtbl.replace macro2utf8 "AElig" "\195\134"
+let _ = Hashtbl.replace macro2utf8 "rarr" "\226\134\146"
+let _ = Hashtbl.replace macro2utf8 "varkappa" "\207\176"
+let _ = Hashtbl.replace macro2utf8 "upsi" "\207\133"
+let _ = Hashtbl.replace macro2utf8 "loang" "\239\149\152"
+let _ = Hashtbl.replace macro2utf8 "looparrowleft" "\226\134\171"
+let _ = Hashtbl.replace macro2utf8 "IOcy" "\208\129"
+let _ = Hashtbl.replace macro2utf8 "backprime" "\226\128\181"
+let _ = Hashtbl.replace macro2utf8 "sstarf" "\226\139\134"
+let _ = Hashtbl.replace macro2utf8 "rharu" "\226\135\128"
+let _ = Hashtbl.replace macro2utf8 "gesl" "\226\139\155\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "xotime" "\226\138\151"
+let _ = Hashtbl.replace macro2utf8 "minus" "\226\136\146"
+let _ = Hashtbl.replace macro2utf8 "gvnE" "\226\137\169\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "gfr" "\240\157\148\164"
+let _ = Hashtbl.replace macro2utf8 "lfisht" "\226\165\188"
+let _ = Hashtbl.replace macro2utf8 "jcirc" "\196\181"
+let _ = Hashtbl.replace macro2utf8 "roarr" "\226\135\190"
+let _ = Hashtbl.replace macro2utf8 "rho" "\207\129"
+let _ = Hashtbl.replace macro2utf8 "nvle" "\226\137\176"
+let _ = Hashtbl.replace macro2utf8 "sect" "\194\167"
+let _ = Hashtbl.replace macro2utf8 "ggg" "\226\139\153"
+let _ = Hashtbl.replace macro2utf8 "plusb" "\226\138\158"
+let _ = Hashtbl.replace macro2utf8 "NotTildeFullEqual" "\226\137\135"
+let _ = Hashtbl.replace macro2utf8 "NegativeVeryThinSpace" "\226\128\138\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "ape" "\226\137\138"
+let _ = Hashtbl.replace macro2utf8 "pluse" "\226\169\178"
+let _ = Hashtbl.replace macro2utf8 "dollar" "$"
+let _ = Hashtbl.replace macro2utf8 "divonx" "\226\139\135"
+let _ = Hashtbl.replace macro2utf8 "partial" "\226\136\130"
+let _ = Hashtbl.replace macro2utf8 "DoubleLeftRightArrow" "\226\135\148"
+let _ = Hashtbl.replace macro2utf8 "varepsilon" "\206\181"
+let _ = Hashtbl.replace macro2utf8 "supe" "\226\138\135"
+let _ = Hashtbl.replace macro2utf8 "nvlt" "\226\137\174"
+let _ = Hashtbl.replace macro2utf8 "angrtvb" "\226\166\157\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "gets" "\226\134\144"
+let _ = Hashtbl.replace macro2utf8 "nparallel" "\226\136\166"
+let _ = Hashtbl.replace macro2utf8 "varphi" "\207\134"
+let _ = Hashtbl.replace macro2utf8 "nsupseteq" "\226\138\137"
+let _ = Hashtbl.replace macro2utf8 "circledR" "\194\174"
+let _ = Hashtbl.replace macro2utf8 "circledS" "\226\147\136"
+let _ = Hashtbl.replace macro2utf8 "primes" "\226\132\153"
+let _ = Hashtbl.replace macro2utf8 "cuwed" "\226\139\143"
+let _ = Hashtbl.replace macro2utf8 "cupcap" "\226\169\134"
+let _ = Hashtbl.replace macro2utf8 "nLl" "\226\139\152\204\184"
+let _ = Hashtbl.replace macro2utf8 "lozf" "\226\167\171"
+let _ = Hashtbl.replace macro2utf8 "ShortLeftArrow" "\226\134\144\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "nLt" "\226\137\170\204\184"
+let _ = Hashtbl.replace macro2utf8 "lesdotor" "\226\170\131"
+let _ = Hashtbl.replace macro2utf8 "Fcy" "\208\164"
+let _ = Hashtbl.replace macro2utf8 "scnsim" "\226\139\169"
+let _ = Hashtbl.replace macro2utf8 "VerticalLine" "|"
+let _ = Hashtbl.replace macro2utf8 "nwArr" "\226\135\150"
+let _ = Hashtbl.replace macro2utf8 "LeftTeeArrow" "\226\134\164"
+let _ = Hashtbl.replace macro2utf8 "iprod" "\226\168\188"
+let _ = Hashtbl.replace macro2utf8 "lsh" "\226\134\176"
+let _ = Hashtbl.replace macro2utf8 "Congruent" "\226\137\161"
+let _ = Hashtbl.replace macro2utf8 "NotLeftTriangle" "\226\139\170"
+let _ = Hashtbl.replace macro2utf8 "rdldhar" "\226\165\169"
+let _ = Hashtbl.replace macro2utf8 "varpropto" "\226\136\157"
+let _ = Hashtbl.replace macro2utf8 "nvlArr" "\226\135\141"
+let _ = Hashtbl.replace macro2utf8 "arg" "arg"
+let _ = Hashtbl.replace macro2utf8 "lhard" "\226\134\189"
+let _ = Hashtbl.replace macro2utf8 "surd" "????"
+let _ = Hashtbl.replace macro2utf8 "napos" "\197\137"
+let _ = Hashtbl.replace macro2utf8 "lparlt" "\226\166\147"
+let _ = Hashtbl.replace macro2utf8 "hslash" "\226\132\143"
+let _ = Hashtbl.replace macro2utf8 "Gopf" "\240\157\148\190"
+let _ = Hashtbl.replace macro2utf8 "SHcy" "\208\168"
+let _ = Hashtbl.replace macro2utf8 "triangle" "\226\150\181"
+let _ = Hashtbl.replace macro2utf8 "Qfr" "\240\157\148\148"
+let _ = Hashtbl.replace macro2utf8 "DiacriticalAcute" "\194\180"
+let _ = Hashtbl.replace macro2utf8 "tbrk" "\226\142\180"
+let _ = Hashtbl.replace macro2utf8 "Implies" "\226\135\146"
+let _ = Hashtbl.replace macro2utf8 "comp" "\226\136\129"
+let _ = Hashtbl.replace macro2utf8 "ddarr" "\226\135\138"
+let _ = Hashtbl.replace macro2utf8 "Colone" "\226\169\180"
+let _ = Hashtbl.replace macro2utf8 "smashp" "\226\168\179"
+let _ = Hashtbl.replace macro2utf8 "ccups" "\226\169\140"
+let _ = Hashtbl.replace macro2utf8 "triangleq" "\226\137\156"
+let _ = Hashtbl.replace macro2utf8 "NotSquareSubsetEqual" "\226\139\162"
+let _ = Hashtbl.replace macro2utf8 "Nopf" "\226\132\149"
+let _ = Hashtbl.replace macro2utf8 "ZHcy" "\208\150"
+let _ = Hashtbl.replace macro2utf8 "map" "\226\134\166"
+let _ = Hashtbl.replace macro2utf8 "lharu" "\226\134\188"
+let _ = Hashtbl.replace macro2utf8 "glE" "\226\170\146"
+let _ = Hashtbl.replace macro2utf8 "cong" "\226\137\133"
+let _ = Hashtbl.replace macro2utf8 "Ecaron" "\196\154"
+let _ = Hashtbl.replace macro2utf8 "Uring" "\197\174"
+let _ = Hashtbl.replace macro2utf8 "blacktriangleright" "\226\150\184"
+let _ = Hashtbl.replace macro2utf8 "ntilde" "\195\177"
+let _ = Hashtbl.replace macro2utf8 "max" "max"
+let _ = Hashtbl.replace macro2utf8 "loarr" "\226\135\189"
+let _ = Hashtbl.replace macro2utf8 "LeftArrow" "\226\134\144"
+let _ = Hashtbl.replace macro2utf8 "Gdot" "\196\160"
+let _ = Hashtbl.replace macro2utf8 "Uopf" "\240\157\149\140"
+let _ = Hashtbl.replace macro2utf8 "bigsqcup" "\226\138\148"
+let _ = Hashtbl.replace macro2utf8 "wedgeq" "\226\137\153"
+let _ = Hashtbl.replace macro2utf8 "RoundImplies" "\226\165\176"
+let _ = Hashtbl.replace macro2utf8 "prap" "\226\137\190"
+let _ = Hashtbl.replace macro2utf8 "gescc" "\226\170\169"
+let _ = Hashtbl.replace macro2utf8 "realine" "\226\132\155"
+let _ = Hashtbl.replace macro2utf8 "ast" "*"
+let _ = Hashtbl.replace macro2utf8 "subedot" "\226\171\131"
+let _ = Hashtbl.replace macro2utf8 "LeftTeeVector" "\226\165\154"
+let _ = Hashtbl.replace macro2utf8 "female" "\226\153\128"
+let _ = Hashtbl.replace macro2utf8 "circlearrowleft" "\226\134\186"
+let _ = Hashtbl.replace macro2utf8 "Ffr" "\240\157\148\137"
+let _ = Hashtbl.replace macro2utf8 "VDash" "\226\138\171"
+let _ = Hashtbl.replace macro2utf8 "jsercy" "\209\152"
+let _ = Hashtbl.replace macro2utf8 "Proportional" "\226\136\157"
+let _ = Hashtbl.replace macro2utf8 "OverBracket" "\226\142\180"
+let _ = Hashtbl.replace macro2utf8 "gla" "\226\170\165"
+let _ = Hashtbl.replace macro2utf8 "NotElement" "\226\136\137"
+let _ = Hashtbl.replace macro2utf8 "theta" "\206\184"
+let _ = Hashtbl.replace macro2utf8 "kcedil" "\196\183"
+let _ = Hashtbl.replace macro2utf8 "smeparsl" "\226\167\164"
+let _ = Hashtbl.replace macro2utf8 "rarrb" "\226\135\165"
+let _ = Hashtbl.replace macro2utf8 "rarrc" "\226\164\179"
+let _ = Hashtbl.replace macro2utf8 "ograve" "\195\178"
+let _ = Hashtbl.replace macro2utf8 "glj" "\226\170\164"
+let _ = Hashtbl.replace macro2utf8 "infty" "\226\136\158"
+let _ = Hashtbl.replace macro2utf8 "gnE" "\226\137\169"
+let _ = Hashtbl.replace macro2utf8 "copf" "\240\157\149\148"
+let _ = Hashtbl.replace macro2utf8 "LeftArrowRightArrow" "\226\135\134"
+let _ = Hashtbl.replace macro2utf8 "cwconint" "\226\136\178"
+let _ = Hashtbl.replace macro2utf8 "Ascr" "\240\157\146\156"
+let _ = Hashtbl.replace macro2utf8 "NegativeThinSpace" "\226\128\137\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "varsubsetneq" "\226\138\138\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "trisb" "\226\167\141"
+let _ = Hashtbl.replace macro2utf8 "rightharpoonup" "\226\135\128"
+let _ = Hashtbl.replace macro2utf8 "imagline" "\226\132\144"
+let _ = Hashtbl.replace macro2utf8 "mcy" "\208\188"
+let _ = Hashtbl.replace macro2utf8 "Cacute" "\196\134"
+let _ = Hashtbl.replace macro2utf8 "bumpeq" "\226\137\143"
+let _ = Hashtbl.replace macro2utf8 "jopf" "\240\157\149\155"
+let _ = Hashtbl.replace macro2utf8 "shchcy" "\209\137"
+let _ = Hashtbl.replace macro2utf8 "rarrw" "\226\134\157"
+let _ = Hashtbl.replace macro2utf8 "uuarr" "\226\135\136"
+let _ = Hashtbl.replace macro2utf8 "doteq" "\226\137\144"
+let _ = Hashtbl.replace macro2utf8 "cudarrl" "\226\164\184"
+let _ = Hashtbl.replace macro2utf8 "varsigma" "\207\130"
+let _ = Hashtbl.replace macro2utf8 "Hscr" "\226\132\139"
+let _ = Hashtbl.replace macro2utf8 "DownArrowUpArrow" "\226\135\181"
+let _ = Hashtbl.replace macro2utf8 "Ecirc" "\195\138"
+let _ = Hashtbl.replace macro2utf8 "DD" "\226\133\133"
+let _ = Hashtbl.replace macro2utf8 "copy" "\194\169"
+let _ = Hashtbl.replace macro2utf8 "SquareIntersection" "\226\138\147"
+let _ = Hashtbl.replace macro2utf8 "RightUpVector" "\226\134\190"
+let _ = Hashtbl.replace macro2utf8 "NotSucceedsSlantEqual" "\226\139\161"
+let _ = Hashtbl.replace macro2utf8 "cudarrr" "\226\164\181"
+let _ = Hashtbl.replace macro2utf8 "verbar" "|"
+let _ = Hashtbl.replace macro2utf8 "ncaron" "\197\136"
+let _ = Hashtbl.replace macro2utf8 "prurel" "\226\138\176"
+let _ = Hashtbl.replace macro2utf8 "nearr" "\226\134\151"
+let _ = Hashtbl.replace macro2utf8 "cdot" "\196\139"
+let _ = Hashtbl.replace macro2utf8 "qopf" "\240\157\149\162"
+let _ = Hashtbl.replace macro2utf8 "SucceedsSlantEqual" "\226\137\189"
+let _ = Hashtbl.replace macro2utf8 "Oscr" "\240\157\146\170"
+let _ = Hashtbl.replace macro2utf8 "xfr" "\240\157\148\181"
+let _ = Hashtbl.replace macro2utf8 "gne" "\226\137\169"
+let _ = Hashtbl.replace macro2utf8 "Ccedil" "\195\135"
+let _ = Hashtbl.replace macro2utf8 "nlarr" "\226\134\154"
+let _ = Hashtbl.replace macro2utf8 "inodot" "\196\177"
+let _ = Hashtbl.replace macro2utf8 "prec" "\226\137\186"
+let _ = Hashtbl.replace macro2utf8 "percnt" "%"
+let _ = Hashtbl.replace macro2utf8 "Exists" "\226\136\131"
+let _ = Hashtbl.replace macro2utf8 "bcy" "\208\177"
+let _ = Hashtbl.replace macro2utf8 "xopf" "\240\157\149\169"
+let _ = Hashtbl.replace macro2utf8 "nsimeq" "\226\137\132"
+let _ = Hashtbl.replace macro2utf8 "nrtri" "\226\139\171"
+let _ = Hashtbl.replace macro2utf8 "barvee" "\226\138\189"
+let _ = Hashtbl.replace macro2utf8 "Vscr" "\240\157\146\177"
+let _ = Hashtbl.replace macro2utf8 "Zcaron" "\197\189"
+let _ = Hashtbl.replace macro2utf8 "ReverseElement" "\226\136\139"
+let _ = Hashtbl.replace macro2utf8 "npolint" "\226\168\148"
+let _ = Hashtbl.replace macro2utf8 "NotGreaterTilde" "\226\137\181"
+let _ = Hashtbl.replace macro2utf8 "lmoustache" "\226\142\176"
+let _ = Hashtbl.replace macro2utf8 "forkv" "\226\171\153"
+let _ = Hashtbl.replace macro2utf8 "rmoustache" "\226\142\177"
+let _ = Hashtbl.replace macro2utf8 "DownLeftVectorBar" "\226\165\150"
+let _ = Hashtbl.replace macro2utf8 "cosh" "cosh"
+let _ = Hashtbl.replace macro2utf8 "mfr" "\240\157\148\170"
+let _ = Hashtbl.replace macro2utf8 "LessGreater" "\226\137\182"
+let _ = Hashtbl.replace macro2utf8 "zeetrf" "\226\132\168"
+let _ = Hashtbl.replace macro2utf8 "DiacriticalDot" "\203\153"
+let _ = Hashtbl.replace macro2utf8 "Poincareplane" "\226\132\140"
+let _ = Hashtbl.replace macro2utf8 "curlyeqsucc" "\226\139\159"
+let _ = Hashtbl.replace macro2utf8 "Equal" "\226\169\181"
+let _ = Hashtbl.replace macro2utf8 "divides" "\226\136\163"
+let _ = Hashtbl.replace macro2utf8 "scpolint" "\226\168\147"
+let _ = Hashtbl.replace macro2utf8 "ngsim" "\226\137\181"
+let _ = Hashtbl.replace macro2utf8 "larrbfs" "\226\164\159"
+let _ = Hashtbl.replace macro2utf8 "HilbertSpace" "\226\132\139"
+let _ = Hashtbl.replace macro2utf8 "otilde" "\195\181"
+let _ = Hashtbl.replace macro2utf8 "larrb" "\226\135\164"
+let _ = Hashtbl.replace macro2utf8 "wcirc" "\197\181"
+let _ = Hashtbl.replace macro2utf8 "dscr" "\240\157\146\185"
+let _ = Hashtbl.replace macro2utf8 "phmmat" "\226\132\179"
+let _ = Hashtbl.replace macro2utf8 "lacute" "\196\186"
+let _ = Hashtbl.replace macro2utf8 "tstrok" "\197\167"
+let _ = Hashtbl.replace macro2utf8 "NotDoubleVerticalBar" "\226\136\166"
+let _ = Hashtbl.replace macro2utf8 "lagran" "\226\132\146"
+let _ = Hashtbl.replace macro2utf8 "NotRightTriangle" "\226\139\171"
+let _ = Hashtbl.replace macro2utf8 "dscy" "\209\149"
+let _ = Hashtbl.replace macro2utf8 "rightrightarrows" "\226\135\137"
+let _ = Hashtbl.replace macro2utf8 "seArr" "\226\135\152"
+let _ = Hashtbl.replace macro2utf8 "RightTriangleBar" "\226\167\144"
+let _ = Hashtbl.replace macro2utf8 "coth" "coth"
+let _ = Hashtbl.replace macro2utf8 "swarrow" "\226\134\153"
+let _ = Hashtbl.replace macro2utf8 "semi" ";"
+let _ = Hashtbl.replace macro2utf8 "kscr" "\240\157\147\128"
+let _ = Hashtbl.replace macro2utf8 "NotLessEqual" "\226\137\176\226\131\165"
+let _ = Hashtbl.replace macro2utf8 "cularr" "\226\134\182"
+let _ = Hashtbl.replace macro2utf8 "blacklozenge" "\226\167\171"
+let _ = Hashtbl.replace macro2utf8 "realpart" "\226\132\156"
+let _ = Hashtbl.replace macro2utf8 "LeftTriangleEqual" "\226\138\180"
+let _ = Hashtbl.replace macro2utf8 "bfr" "\240\157\148\159"
+let _ = Hashtbl.replace macro2utf8 "Uuml" "\195\156"
+let _ = Hashtbl.replace macro2utf8 "longleftrightarrow" "????"
+let _ = Hashtbl.replace macro2utf8 "lcedil" "\196\188"
+let _ = Hashtbl.replace macro2utf8 "complement" "\226\136\129"
+let _ = Hashtbl.replace macro2utf8 "rscr" "\240\157\147\135"
+let _ = Hashtbl.replace macro2utf8 "mho" "\226\132\167"
+let _ = Hashtbl.replace macro2utf8 "mcomma" "\226\168\169"
+let _ = Hashtbl.replace macro2utf8 "wedbar" "\226\169\159"
+let _ = Hashtbl.replace macro2utf8 "NotVerticalBar" "\226\136\164"
+let _ = Hashtbl.replace macro2utf8 "Lcy" "\208\155"
+let _ = Hashtbl.replace macro2utf8 "tprime" "\226\128\180"
+let _ = Hashtbl.replace macro2utf8 "precneqq" "\226\170\181"
+let _ = Hashtbl.replace macro2utf8 "Downarrow" "\226\135\147"
+let _ = Hashtbl.replace macro2utf8 "rsh" "\226\134\177"
+let _ = Hashtbl.replace macro2utf8 "mid" "\226\136\163"
+let _ = Hashtbl.replace macro2utf8 "blank" "\226\144\163"
+let _ = Hashtbl.replace macro2utf8 "square" "\226\150\161"
+let _ = Hashtbl.replace macro2utf8 "squarf" "\226\150\170"
+let _ = Hashtbl.replace macro2utf8 "fflig" "\239\172\128"
+let _ = Hashtbl.replace macro2utf8 "downdownarrows" "\226\135\138"
+let _ = Hashtbl.replace macro2utf8 "yscr" "\240\157\147\142"
+let _ = Hashtbl.replace macro2utf8 "subdot" "\226\170\189"
+let _ = Hashtbl.replace macro2utf8 "ShortRightArrow" "\226\134\146\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "NotCongruent" "\226\137\162"
+let _ = Hashtbl.replace macro2utf8 "Gg" "\226\139\153"
+let _ = Hashtbl.replace macro2utf8 "Lstrok" "\197\129"
+let _ = Hashtbl.replace macro2utf8 "min" "max"
+let _ = Hashtbl.replace macro2utf8 "Laplacetrf" "\226\132\146"
+let _ = Hashtbl.replace macro2utf8 "rarrap" "\226\165\181"
+let _ = Hashtbl.replace macro2utf8 "NotLessSlantEqual" "\226\137\176"
+let _ = Hashtbl.replace macro2utf8 "DoubleRightArrow" "\226\135\146"
+let _ = Hashtbl.replace macro2utf8 "Wfr" "\240\157\148\154"
+let _ = Hashtbl.replace macro2utf8 "subrarr" "\226\165\185"
+let _ = Hashtbl.replace macro2utf8 "numsp" "\226\128\135"
+let _ = Hashtbl.replace macro2utf8 "khcy" "\209\133"
+let _ = Hashtbl.replace macro2utf8 "oint" "\226\136\174"
+let _ = Hashtbl.replace macro2utf8 "vprop" "\226\136\157"
+let _ = Hashtbl.replace macro2utf8 "hardcy" "\209\138"
+let _ = Hashtbl.replace macro2utf8 "boxminus" "\226\138\159"
+let _ = Hashtbl.replace macro2utf8 "GreaterLess" "\226\137\183"
+let _ = Hashtbl.replace macro2utf8 "thetav" "\207\145"
+let _ = Hashtbl.replace macro2utf8 "scE" "\226\137\190"
+let _ = Hashtbl.replace macro2utf8 "Gt" "\226\137\171"
+let _ = Hashtbl.replace macro2utf8 "Acy" "\208\144"
+let _ = Hashtbl.replace macro2utf8 "backcong" "\226\137\140"
+let _ = Hashtbl.replace macro2utf8 "gtquest" "\226\169\188"
+let _ = Hashtbl.replace macro2utf8 "awint" "\226\168\145"
+let _ = Hashtbl.replace macro2utf8 "profsurf" "\226\140\147"
+let _ = Hashtbl.replace macro2utf8 "capdot" "\226\169\128"
+let _ = Hashtbl.replace macro2utf8 "supdot" "\226\170\190"
+let _ = Hashtbl.replace macro2utf8 "oelig" "\197\147"
+let _ = Hashtbl.replace macro2utf8 "doteqdot" "\226\137\145"
+let _ = Hashtbl.replace macro2utf8 "rharul" "\226\165\172"
+let _ = Hashtbl.replace macro2utf8 "cylcty" "\226\140\173"
+let _ = Hashtbl.replace macro2utf8 "epsi" "\206\181"
+let _ = Hashtbl.replace macro2utf8 "eqcirc" "\226\137\150"
+let _ = Hashtbl.replace macro2utf8 "nLeftarrow" "\226\135\141"
+let _ = Hashtbl.replace macro2utf8 "rtrie" "\226\138\181"
+let _ = Hashtbl.replace macro2utf8 "para" "\194\182"
+let _ = Hashtbl.replace macro2utf8 "Lfr" "\240\157\148\143"
+let _ = Hashtbl.replace macro2utf8 "rtrif" "\226\150\184"
+let _ = Hashtbl.replace macro2utf8 "NotReverseElement" "\226\136\140"
+let _ = Hashtbl.replace macro2utf8 "emptyv" "\226\136\133"
+let _ = Hashtbl.replace macro2utf8 "nldr" "\226\128\165"
+let _ = Hashtbl.replace macro2utf8 "leqq" "\226\137\166"
+let _ = Hashtbl.replace macro2utf8 "CapitalDifferentialD" "\226\133\133"
+let _ = Hashtbl.replace macro2utf8 "supsetneqq" "\226\138\139"
+let _ = Hashtbl.replace macro2utf8 "boxDL" "\226\149\151"
+let _ = Hashtbl.replace macro2utf8 "Im" "\226\132\145"
+let _ = Hashtbl.replace macro2utf8 "sce" "\226\137\189"
+let _ = Hashtbl.replace macro2utf8 "prsim" "\226\137\190"
+let _ = Hashtbl.replace macro2utf8 "diams" "\226\153\166"
+let _ = Hashtbl.replace macro2utf8 "gtreqqless" "\226\139\155"
+let _ = Hashtbl.replace macro2utf8 "boxDR" "\226\149\148"
+let _ = Hashtbl.replace macro2utf8 "vartriangleleft" "\226\138\178"
+let _ = Hashtbl.replace macro2utf8 "SupersetEqual" "\226\138\135"
+let _ = Hashtbl.replace macro2utf8 "Omega" "\206\169"
+let _ = Hashtbl.replace macro2utf8 "nsubseteqq" "\226\138\136"
+let _ = Hashtbl.replace macro2utf8 "Subset" "\226\139\144"
+let _ = Hashtbl.replace macro2utf8 "ncongdot" "\226\169\173\204\184"
+let _ = Hashtbl.replace macro2utf8 "minusb" "\226\138\159"
+let _ = Hashtbl.replace macro2utf8 "ltimes" "\226\139\137"
+let _ = Hashtbl.replace macro2utf8 "seswar" "\226\164\169"
+let _ = Hashtbl.replace macro2utf8 "part" "\226\136\130"
+let _ = Hashtbl.replace macro2utf8 "bumpE" "\226\170\174"
+let _ = Hashtbl.replace macro2utf8 "minusd" "\226\136\184"
+let _ = Hashtbl.replace macro2utf8 "Amacr" "\196\128"
+let _ = Hashtbl.replace macro2utf8 "nleq" "\226\137\176"
+let _ = Hashtbl.replace macro2utf8 "nles" "\226\137\176"
+let _ = Hashtbl.replace macro2utf8 "NotLess" "\226\137\174"
+let _ = Hashtbl.replace macro2utf8 "scy" "\209\129"
+let _ = Hashtbl.replace macro2utf8 "iinfin" "\226\167\156"
+let _ = Hashtbl.replace macro2utf8 "Afr" "\240\157\148\132"
+let _ = Hashtbl.replace macro2utf8 "isinsv" "\226\139\179"
+let _ = Hashtbl.replace macro2utf8 "prnE" "\226\170\181"
+let _ = Hashtbl.replace macro2utf8 "lesg" "\226\139\154\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "cups" "\226\136\170\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "thickapprox" "\226\137\136\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "RightTeeVector" "\226\165\155"
+let _ = Hashtbl.replace macro2utf8 "LowerLeftArrow" "\226\134\153"
+let _ = Hashtbl.replace macro2utf8 "utdot" "\226\139\176"
+let _ = Hashtbl.replace macro2utf8 "homtht" "\226\136\187"
+let _ = Hashtbl.replace macro2utf8 "ddotseq" "\226\169\183"
+let _ = Hashtbl.replace macro2utf8 "bowtie" "\226\139\136"
+let _ = Hashtbl.replace macro2utf8 "succnsim" "\226\139\169"
+let _ = Hashtbl.replace macro2utf8 "boxDl" "\226\149\150"
+let _ = Hashtbl.replace macro2utf8 "quot" "\""
+let _ = Hashtbl.replace macro2utf8 "lvnE" "\226\137\168\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "CircleDot" "\226\138\153"
+let _ = Hashtbl.replace macro2utf8 "lsime" "\226\170\141"
+let _ = Hashtbl.replace macro2utf8 "Yacute" "\195\157"
+let _ = Hashtbl.replace macro2utf8 "esdot" "\226\137\144"
+let _ = Hashtbl.replace macro2utf8 "Supset" "\226\139\145"
+let _ = Hashtbl.replace macro2utf8 "lsimg" "\226\170\143"
+let _ = Hashtbl.replace macro2utf8 "eDot" "\226\137\145"
+let _ = Hashtbl.replace macro2utf8 "sec" "sec"
+let _ = Hashtbl.replace macro2utf8 "boxDr" "\226\149\147"
+let _ = Hashtbl.replace macro2utf8 "plus" "+"
+let _ = Hashtbl.replace macro2utf8 "ddagger" "\226\128\161"
+let _ = Hashtbl.replace macro2utf8 "Vdashl" "\226\171\166"
+let _ = Hashtbl.replace macro2utf8 "equest" "\226\137\159"
+let _ = Hashtbl.replace macro2utf8 "quest" "?"
+let _ = Hashtbl.replace macro2utf8 "divideontimes" "\226\139\135"
+let _ = Hashtbl.replace macro2utf8 "nsmid" "\226\136\164\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "fnof" "\198\146"
+let _ = Hashtbl.replace macro2utf8 "bumpe" "\226\137\143"
+let _ = Hashtbl.replace macro2utf8 "lhblk" "\226\150\132"
+let _ = Hashtbl.replace macro2utf8 "prnap" "\226\139\168"
+let _ = Hashtbl.replace macro2utf8 "compfn" "\226\136\152"
+let _ = Hashtbl.replace macro2utf8 "nsucceq" "\226\170\176\204\184"
+let _ = Hashtbl.replace macro2utf8 "RightArrowLeftArrow" "\226\135\132"
+let _ = Hashtbl.replace macro2utf8 "sharp" "\226\153\175"
+let _ = Hashtbl.replace macro2utf8 "CHcy" "\208\167"
+let _ = Hashtbl.replace macro2utf8 "dwangle" "\226\166\166"
+let _ = Hashtbl.replace macro2utf8 "angrtvbd" "\226\166\157"
+let _ = Hashtbl.replace macro2utf8 "period" "."
+let _ = Hashtbl.replace macro2utf8 "phone" "\226\152\142"
+let _ = Hashtbl.replace macro2utf8 "Eacute" "\195\137"
+let _ = Hashtbl.replace macro2utf8 "dzigrarr" "\239\150\162"
+let _ = Hashtbl.replace macro2utf8 "Ll" "\226\139\152"
+let _ = Hashtbl.replace macro2utf8 "succapprox" "\226\137\191"
+let _ = Hashtbl.replace macro2utf8 "rarrfs" "\226\164\158"
+let _ = Hashtbl.replace macro2utf8 "dbkarow" "\226\164\143"
+let _ = Hashtbl.replace macro2utf8 "zeta" "\206\182"
+let _ = Hashtbl.replace macro2utf8 "Lt" "\226\137\170"
+let _ = Hashtbl.replace macro2utf8 "triminus" "\226\168\186"
+let _ = Hashtbl.replace macro2utf8 "odiv" "\226\168\184"
+let _ = Hashtbl.replace macro2utf8 "ltrie" "\226\138\180"
+let _ = Hashtbl.replace macro2utf8 "Dagger" "\226\128\161"
+let _ = Hashtbl.replace macro2utf8 "ltrif" "\226\151\130"
+let _ = Hashtbl.replace macro2utf8 "boxHD" "\226\149\166"
+let _ = Hashtbl.replace macro2utf8 "timesb" "\226\138\160"
+let _ = Hashtbl.replace macro2utf8 "check" "\226\156\147"
+let _ = Hashtbl.replace macro2utf8 "urcorn" "\226\140\157"
+let _ = Hashtbl.replace macro2utf8 "timesd" "\226\168\176"
+let _ = Hashtbl.replace macro2utf8 "tshcy" "\209\155"
+let _ = Hashtbl.replace macro2utf8 "sfr" "\240\157\148\176"
+let _ = Hashtbl.replace macro2utf8 "lmoust" "\226\142\176"
+let _ = Hashtbl.replace macro2utf8 "ruluhar" "\226\165\168"
+let _ = Hashtbl.replace macro2utf8 "bne" "=\226\131\165"
+let _ = Hashtbl.replace macro2utf8 "prod" "\226\136\143"
+let _ = Hashtbl.replace macro2utf8 "Eopf" "\240\157\148\188"
+let _ = Hashtbl.replace macro2utf8 "scsim" "\226\137\191"
+let _ = Hashtbl.replace macro2utf8 "GreaterEqualLess" "\226\139\155"
+let _ = Hashtbl.replace macro2utf8 "Igrave" "\195\140"
+let _ = Hashtbl.replace macro2utf8 "Longrightarrow" "\226\135\146"
+let _ = Hashtbl.replace macro2utf8 "bigcap" "\226\139\130"
+let _ = Hashtbl.replace macro2utf8 "boxHU" "\226\149\169"
+let _ = Hashtbl.replace macro2utf8 "uring" "\197\175"
+let _ = Hashtbl.replace macro2utf8 "equivDD" "\226\169\184"
+let _ = Hashtbl.replace macro2utf8 "prop" "\226\136\157"
+let _ = Hashtbl.replace macro2utf8 "Lopf" "\240\157\149\131"
+let _ = Hashtbl.replace macro2utf8 "ldrushar" "\226\165\139"
+let _ = Hashtbl.replace macro2utf8 "rarrhk" "\226\134\170"
+let _ = Hashtbl.replace macro2utf8 "Leftarrow" "\226\135\144"
+let _ = Hashtbl.replace macro2utf8 "lltri" "\226\151\186"
+let _ = Hashtbl.replace macro2utf8 "NestedGreaterGreater" "\226\137\171"
+let _ = Hashtbl.replace macro2utf8 "GreaterFullEqual" "\226\137\167"
+let _ = Hashtbl.replace macro2utf8 "robrk" "\227\128\155"
+let _ = Hashtbl.replace macro2utf8 "larrsim" "\226\165\179"
+let _ = Hashtbl.replace macro2utf8 "boxHd" "\226\149\164"
+let _ = Hashtbl.replace macro2utf8 "vDash" "\226\138\168"
+let _ = Hashtbl.replace macro2utf8 "hfr" "\240\157\148\165"
+let _ = Hashtbl.replace macro2utf8 "Edot" "\196\150"
+let _ = Hashtbl.replace macro2utf8 "Vvdash" "\226\138\170"
+let _ = Hashtbl.replace macro2utf8 "Sopf" "\240\157\149\138"
+let _ = Hashtbl.replace macro2utf8 "upuparrows" "\226\135\136"
+let _ = Hashtbl.replace macro2utf8 "RightUpTeeVector" "\226\165\156"
+let _ = Hashtbl.replace macro2utf8 "DownLeftVector" "\226\134\189"
+let _ = Hashtbl.replace macro2utf8 "xhArr" "\239\149\187"
+let _ = Hashtbl.replace macro2utf8 "triplus" "\226\168\185"
+let _ = Hashtbl.replace macro2utf8 "bot" "\226\138\165"
+let _ = Hashtbl.replace macro2utf8 "Rcy" "\208\160"
+let _ = Hashtbl.replace macro2utf8 "eDDot" "\226\169\183"
+let _ = Hashtbl.replace macro2utf8 "subseteqq" "\226\138\134"
+let _ = Hashtbl.replace macro2utf8 "cirfnint" "\226\168\144"
+let _ = Hashtbl.replace macro2utf8 "spadesuit" "\226\153\160"
+let _ = Hashtbl.replace macro2utf8 "nacute" "\197\132"
+let _ = Hashtbl.replace macro2utf8 "Zopf" "\226\132\164"
+let _ = Hashtbl.replace macro2utf8 "upharpoonleft" "\226\134\191"
+let _ = Hashtbl.replace macro2utf8 "shy" "\194\173"
+let _ = Hashtbl.replace macro2utf8 "nparsl" "\226\136\165\239\184\128\226\131\165"
+let _ = Hashtbl.replace macro2utf8 "boxHu" "\226\149\167"
+let _ = Hashtbl.replace macro2utf8 "ThickSpace" "\226\128\137\226\128\138\226\128\138"
+let _ = Hashtbl.replace macro2utf8 "Or" "\226\169\148"
+let _ = Hashtbl.replace macro2utf8 "raemptyv" "\226\166\179"
+let _ = Hashtbl.replace macro2utf8 "Aogon" "\196\132"
+let _ = Hashtbl.replace macro2utf8 "IEcy" "\208\149"
+let _ = Hashtbl.replace macro2utf8 "sim" "\226\136\188"
+let _ = Hashtbl.replace macro2utf8 "sin" "sin"
+let _ = Hashtbl.replace macro2utf8 "copysr" "\226\132\151"
+let _ = Hashtbl.replace macro2utf8 "scnap" "\226\139\169"
+let _ = Hashtbl.replace macro2utf8 "rdquo" "\226\128\157"
+let _ = Hashtbl.replace macro2utf8 "aopf" "\240\157\149\146"
+let _ = Hashtbl.replace macro2utf8 "Pi" "\206\160"
+let _ = Hashtbl.replace macro2utf8 "Udblac" "\197\176"
+let _ = Hashtbl.replace macro2utf8 "expectation" "\226\132\176"
+let _ = Hashtbl.replace macro2utf8 "Zacute" "\197\185"
+let _ = Hashtbl.replace macro2utf8 "urtri" "\226\151\185"
+let _ = Hashtbl.replace macro2utf8 "NotTildeEqual" "\226\137\132"
+let _ = Hashtbl.replace macro2utf8 "ncedil" "\197\134"
+let _ = Hashtbl.replace macro2utf8 "Gamma" "\206\147"
+let _ = Hashtbl.replace macro2utf8 "ecirc" "\195\170"
+let _ = Hashtbl.replace macro2utf8 "dsol" "\226\167\182"
+let _ = Hashtbl.replace macro2utf8 "Gcy" "\208\147"
+let _ = Hashtbl.replace macro2utf8 "Pr" "Pr"
+let _ = Hashtbl.replace macro2utf8 "Zdot" "\197\187"
+let _ = Hashtbl.replace macro2utf8 "mnplus" "\226\136\147"
+let _ = Hashtbl.replace macro2utf8 "hopf" "\240\157\149\153"
+let _ = Hashtbl.replace macro2utf8 "blacktriangledown" "\226\150\190"
+let _ = Hashtbl.replace macro2utf8 "LeftCeiling" "\226\140\136"
+let _ = Hashtbl.replace macro2utf8 "ulcorn" "\226\140\156"
+let _ = Hashtbl.replace macro2utf8 "searrow" "\226\134\152"
+let _ = Hashtbl.replace macro2utf8 "GreaterGreater" "\226\170\162"
+let _ = Hashtbl.replace macro2utf8 "Fscr" "\226\132\177"
+let _ = Hashtbl.replace macro2utf8 "cupcup" "\226\169\138"
+let _ = Hashtbl.replace macro2utf8 "NotEqual" "\226\137\160"
+let _ = Hashtbl.replace macro2utf8 "sext" "\226\156\182"
+let _ = Hashtbl.replace macro2utf8 "CirclePlus" "\226\138\149"
+let _ = Hashtbl.replace macro2utf8 "erarr" "\226\165\177"
+let _ = Hashtbl.replace macro2utf8 "dArr" "\226\135\147"
+let _ = Hashtbl.replace macro2utf8 "PrecedesSlantEqual" "\226\137\188"
+let _ = Hashtbl.replace macro2utf8 "Itilde" "\196\168"
+let _ = Hashtbl.replace macro2utf8 "gesdoto" "\226\170\130"
+let _ = Hashtbl.replace macro2utf8 "Rang" "\227\128\139"
+let _ = Hashtbl.replace macro2utf8 "nwarhk" "\226\164\163"
+let _ = Hashtbl.replace macro2utf8 "minusdu" "\226\168\170"
+let _ = Hashtbl.replace macro2utf8 "oopf" "\240\157\149\160"
+let _ = Hashtbl.replace macro2utf8 "Mscr" "\226\132\179"
+let _ = Hashtbl.replace macro2utf8 "Rfr" "\226\132\156"
+let _ = Hashtbl.replace macro2utf8 "langle" "\226\140\169"
+let _ = Hashtbl.replace macro2utf8 "And" "\226\169\147"
+let _ = Hashtbl.replace macro2utf8 "bprime" "\226\128\181"
+let _ = Hashtbl.replace macro2utf8 "nLeftrightarrow" "\226\135\142"
+let _ = Hashtbl.replace macro2utf8 "Re" "\226\132\156"
+let _ = Hashtbl.replace macro2utf8 "OpenCurlyQuote" "\226\128\152"
+let _ = Hashtbl.replace macro2utf8 "vopf" "\240\157\149\167"
+let _ = Hashtbl.replace macro2utf8 "ulcorner" "\226\140\156"
+let _ = Hashtbl.replace macro2utf8 "nap" "\226\137\137"
+let _ = Hashtbl.replace macro2utf8 "Tscr" "\240\157\146\175"
+let _ = Hashtbl.replace macro2utf8 "gtreqless" "\226\139\155"
+let _ = Hashtbl.replace macro2utf8 "rarrlp" "\226\134\172"
+let _ = Hashtbl.replace macro2utf8 "Lambda" "\206\155"
+let _ = Hashtbl.replace macro2utf8 "lobrk" "\227\128\154"
+let _ = Hashtbl.replace macro2utf8 "rbrace" "}"
+let _ = Hashtbl.replace macro2utf8 "rArr" "\226\135\146"
+let _ = Hashtbl.replace macro2utf8 "coloneq" "\226\137\148"
+let _ = Hashtbl.replace macro2utf8 "UpArrow" "\226\134\145"
+let _ = Hashtbl.replace macro2utf8 "odot" "\226\138\153"
+let _ = Hashtbl.replace macro2utf8 "LeftDownTeeVector" "\226\165\161"
+let _ = Hashtbl.replace macro2utf8 "complexes" "\226\132\130"
+let _ = Hashtbl.replace macro2utf8 "rbrack" "]"
+let _ = Hashtbl.replace macro2utf8 "DownTeeArrow" "\226\134\167"
+let _ = Hashtbl.replace macro2utf8 "sqcap" "\226\138\147"
+let _ = Hashtbl.replace macro2utf8 "Sc" "\226\170\188"
+let _ = Hashtbl.replace macro2utf8 "ycy" "\209\139"
+let _ = Hashtbl.replace macro2utf8 "Prime" "\226\128\179"
+let _ = Hashtbl.replace macro2utf8 "Gfr" "\240\157\148\138"
+let _ = Hashtbl.replace macro2utf8 "trianglerighteq" "\226\138\181"
+let _ = Hashtbl.replace macro2utf8 "rangd" "\226\166\146"
+let _ = Hashtbl.replace macro2utf8 "gtrdot" "\226\139\151"
+let _ = Hashtbl.replace macro2utf8 "range" "\226\166\165"
+let _ = Hashtbl.replace macro2utf8 "rsqb" "]"
+let _ = Hashtbl.replace macro2utf8 "Euml" "\195\139"
+let _ = Hashtbl.replace macro2utf8 "Therefore" "\226\136\180"
+let _ = Hashtbl.replace macro2utf8 "nesim" "\226\137\130\204\184"
+let _ = Hashtbl.replace macro2utf8 "order" "\226\132\180"
+let _ = Hashtbl.replace macro2utf8 "vsupnE" "\226\138\139\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "awconint" "\226\136\179"
+let _ = Hashtbl.replace macro2utf8 "bscr" "\240\157\146\183"
+let _ = Hashtbl.replace macro2utf8 "lesseqqgtr" "\226\139\154"
+let _ = Hashtbl.replace macro2utf8 "cap" "\226\136\169"
+let _ = Hashtbl.replace macro2utf8 "ldquo" "\226\128\156"
+let _ = Hashtbl.replace macro2utf8 "nsubseteq" "\226\138\136"
+let _ = Hashtbl.replace macro2utf8 "rhov" "\207\177"
+let _ = Hashtbl.replace macro2utf8 "xvee" "\226\139\129"
+let _ = Hashtbl.replace macro2utf8 "olarr" "\226\134\186"
+let _ = Hashtbl.replace macro2utf8 "nang" "\226\136\160\204\184"
+let _ = Hashtbl.replace macro2utf8 "uwangle" "\226\166\167"
+let _ = Hashtbl.replace macro2utf8 "nlsim" "\226\137\180"
+let _ = Hashtbl.replace macro2utf8 "smt" "\226\170\170"
+let _ = Hashtbl.replace macro2utf8 "nVdash" "\226\138\174"
+let _ = Hashtbl.replace macro2utf8 "napE" "\226\169\176\204\184"
+let _ = Hashtbl.replace macro2utf8 "ngeq" "\226\137\177"
+let _ = Hashtbl.replace macro2utf8 "iscr" "\240\157\146\190"
+let _ = Hashtbl.replace macro2utf8 "GJcy" "\208\131"
+let _ = Hashtbl.replace macro2utf8 "nges" "\226\137\177"
+let _ = Hashtbl.replace macro2utf8 "exist" "\226\136\131"
+let _ = Hashtbl.replace macro2utf8 "cent" "\194\162"
+let _ = Hashtbl.replace macro2utf8 "oacute" "\195\179"
+let _ = Hashtbl.replace macro2utf8 "Darr" "\226\134\161"
+let _ = Hashtbl.replace macro2utf8 "yen" "\194\165"
+let _ = Hashtbl.replace macro2utf8 "bigcirc" "\226\151\175"
+let _ = Hashtbl.replace macro2utf8 "ncy" "\208\189"
+let _ = Hashtbl.replace macro2utf8 "midast" "*"
+let _ = Hashtbl.replace macro2utf8 "UpperRightArrow" "\226\134\151"
+let _ = Hashtbl.replace macro2utf8 "precnapprox" "\226\139\168"
+let _ = Hashtbl.replace macro2utf8 "OElig" "\197\146"
+let _ = Hashtbl.replace macro2utf8 "hybull" "\226\129\131"
+let _ = Hashtbl.replace macro2utf8 "cupbrcap" "\226\169\136"
+let _ = Hashtbl.replace macro2utf8 "rationals" "\226\132\154"
+let _ = Hashtbl.replace macro2utf8 "VerticalTilde" "\226\137\128"
+let _ = Hashtbl.replace macro2utf8 "pscr" "\240\157\147\133"
+let _ = Hashtbl.replace macro2utf8 "NJcy" "\208\138"
+let _ = Hashtbl.replace macro2utf8 "NotSucceedsTilde" "\226\137\191\204\184"
+let _ = Hashtbl.replace macro2utf8 "vsupne" "\226\138\139\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "Updownarrow" "\226\135\149"
+let _ = Hashtbl.replace macro2utf8 "Lsh" "\226\134\176"
+let _ = Hashtbl.replace macro2utf8 "rAarr" "\226\135\155"
+let _ = Hashtbl.replace macro2utf8 "precapprox" "\226\137\190"
+let _ = Hashtbl.replace macro2utf8 "rsquor" "\226\128\153"
+let _ = Hashtbl.replace macro2utf8 "pound" "\194\163"
+let _ = Hashtbl.replace macro2utf8 "lbrksld" "\226\166\143"
+let _ = Hashtbl.replace macro2utf8 "gesdot" "\226\170\128"
+let _ = Hashtbl.replace macro2utf8 "Element" "\226\136\136"
+let _ = Hashtbl.replace macro2utf8 "xcirc" "\226\151\175"
+let _ = Hashtbl.replace macro2utf8 "wscr" "\240\157\147\140"
+let _ = Hashtbl.replace macro2utf8 "toea" "\226\164\168"
+let _ = Hashtbl.replace macro2utf8 "setmn" "\226\136\150"
+let _ = Hashtbl.replace macro2utf8 "neg" "\194\172"
+let _ = Hashtbl.replace macro2utf8 "sol" "/"
+let _ = Hashtbl.replace macro2utf8 "yfr" "\240\157\148\182"
+let _ = Hashtbl.replace macro2utf8 "DoubleDownArrow" "\226\135\147"
+let _ = Hashtbl.replace macro2utf8 "Rarr" "\226\134\160"
+let _ = Hashtbl.replace macro2utf8 "ngE" "\226\137\177"
+let _ = Hashtbl.replace macro2utf8 "Upsi" "\207\146"
+let _ = Hashtbl.replace macro2utf8 "opar" "\226\166\183"
+let _ = Hashtbl.replace macro2utf8 "rarrpl" "\226\165\133"
+let _ = Hashtbl.replace macro2utf8 "auml" "\195\164"
+let _ = Hashtbl.replace macro2utf8 "bmod" "mod"
+let _ = Hashtbl.replace macro2utf8 "SquareSuperset" "\226\138\144"
+let _ = Hashtbl.replace macro2utf8 "neq" "\226\137\160"
+let _ = Hashtbl.replace macro2utf8 "circleddash" "\226\138\157"
+let _ = Hashtbl.replace macro2utf8 "xrarr" "\239\149\183"
+let _ = Hashtbl.replace macro2utf8 "barwed" "\226\138\188"
+let _ = Hashtbl.replace macro2utf8 "lbrkslu" "\226\166\141"
+let _ = Hashtbl.replace macro2utf8 "planckh" "\226\132\142"
+let _ = Hashtbl.replace macro2utf8 "ldrdhar" "\226\165\167"
+let _ = Hashtbl.replace macro2utf8 "circledcirc" "\226\138\154"
+let _ = Hashtbl.replace macro2utf8 "ctdot" "\226\139\175"
+let _ = Hashtbl.replace macro2utf8 "fallingdotseq" "\226\137\146"
+let _ = Hashtbl.replace macro2utf8 "Map" "\226\164\133"
+let _ = Hashtbl.replace macro2utf8 "VerticalBar" "\226\136\163"
+let _ = Hashtbl.replace macro2utf8 "succeq" "\226\137\189"
+let _ = Hashtbl.replace macro2utf8 "tint" "\226\136\173"
+let _ = Hashtbl.replace macro2utf8 "imof" "\226\138\183"
+let _ = Hashtbl.replace macro2utf8 "diam" "\226\139\132"
+let _ = Hashtbl.replace macro2utf8 "twixt" "\226\137\172"
+let _ = Hashtbl.replace macro2utf8 "NoBreak" "\239\187\191"
+let _ = Hashtbl.replace macro2utf8 "langd" "\226\166\145"
+let _ = Hashtbl.replace macro2utf8 "Bernoullis" "\226\132\172"
+let _ = Hashtbl.replace macro2utf8 "rcaron" "\197\153"
+let _ = Hashtbl.replace macro2utf8 "hom" "hom"
+let _ = Hashtbl.replace macro2utf8 "nfr" "\240\157\148\171"
+let _ = Hashtbl.replace macro2utf8 "backsimeq" "\226\139\141"
+let _ = Hashtbl.replace macro2utf8 "target" "\226\140\150"
+let _ = Hashtbl.replace macro2utf8 "ouml" "\195\182"
+let _ = Hashtbl.replace macro2utf8 "nge" "\226\137\177\226\131\165"
+let _ = Hashtbl.replace macro2utf8 "LeftTriangleBar" "\226\167\143"
+let _ = Hashtbl.replace macro2utf8 "subplus" "\226\170\191"
+let _ = Hashtbl.replace macro2utf8 "parsim" "\226\171\179"
+let _ = Hashtbl.replace macro2utf8 "Gcedil" "\196\162"
+let _ = Hashtbl.replace macro2utf8 "bnequiv" "\226\137\161\226\131\165"
+let _ = Hashtbl.replace macro2utf8 "ubreve" "\197\173"
+let _ = Hashtbl.replace macro2utf8 "iexcl" "\194\161"
+let _ = Hashtbl.replace macro2utf8 "Xi" "\206\158"
+let _ = Hashtbl.replace macro2utf8 "omega" "\207\137"
+let _ = Hashtbl.replace macro2utf8 "elsdot" "\226\170\151"
+let _ = Hashtbl.replace macro2utf8 "propto" "\226\136\157"
+let _ = Hashtbl.replace macro2utf8 "squ" "\226\150\161"
+let _ = Hashtbl.replace macro2utf8 "Ycirc" "\197\182"
+let _ = Hashtbl.replace macro2utf8 "amacr" "\196\129"
+let _ = Hashtbl.replace macro2utf8 "curlyeqprec" "\226\139\158"
+let _ = Hashtbl.replace macro2utf8 "ngt" "\226\137\175"
+let _ = Hashtbl.replace macro2utf8 "plusdo" "\226\136\148"
+let _ = Hashtbl.replace macro2utf8 "ngeqslant" "\226\137\177"
+let _ = Hashtbl.replace macro2utf8 "LongRightArrow" "\239\149\183"
+let _ = Hashtbl.replace macro2utf8 "LeftUpVector" "\226\134\191"
+let _ = Hashtbl.replace macro2utf8 "asymp" "\226\137\141"
+let _ = Hashtbl.replace macro2utf8 "imped" "\240\157\149\131"
+let _ = Hashtbl.replace macro2utf8 "tritime" "\226\168\187"
+let _ = Hashtbl.replace macro2utf8 "rpargt" "\226\166\148"
+let _ = Hashtbl.replace macro2utf8 "DDotrahd" "\226\164\145"
+let _ = Hashtbl.replace macro2utf8 "prnsim" "\226\139\168"
+let _ = Hashtbl.replace macro2utf8 "plusdu" "\226\168\165"
+let _ = Hashtbl.replace macro2utf8 "cfr" "\240\157\148\160"
+let _ = Hashtbl.replace macro2utf8 "abreve" "\196\131"
+let _ = Hashtbl.replace macro2utf8 "suphsol" "\226\138\131/"
+let _ = Hashtbl.replace macro2utf8 "NegativeThickSpace" "\226\128\133\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "Mcy" "\208\156"
+let _ = Hashtbl.replace macro2utf8 "uarr" "\226\134\145"
+let _ = Hashtbl.replace macro2utf8 "LeftRightVector" "\226\165\142"
+let _ = Hashtbl.replace macro2utf8 "lAarr" "\226\135\154"
+let _ = Hashtbl.replace macro2utf8 "bsim" "\226\136\189"
+let _ = Hashtbl.replace macro2utf8 "simrarr" "\226\165\178"
+let _ = Hashtbl.replace macro2utf8 "otimes" "\226\138\151"
+let _ = Hashtbl.replace macro2utf8 "NotSucceeds" "\226\138\129"
+let _ = Hashtbl.replace macro2utf8 "Cross" "\226\168\175"
+let _ = Hashtbl.replace macro2utf8 "downarrow" "\226\134\147"
+let _ = Hashtbl.replace macro2utf8 "blacktriangle" "\226\150\180"
+let _ = Hashtbl.replace macro2utf8 "TripleDot" "\226\131\155"
+let _ = Hashtbl.replace macro2utf8 "smallsetminus" "\226\136\150\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "supedot" "\226\171\132"
+let _ = Hashtbl.replace macro2utf8 "NotPrecedesSlantEqual" "\226\139\160"
+let _ = Hashtbl.replace macro2utf8 "neArr" "\226\135\151"
+let _ = Hashtbl.replace macro2utf8 "rarrtl" "\226\134\163"
+let _ = Hashtbl.replace macro2utf8 "isin" "\226\136\136"
+let _ = Hashtbl.replace macro2utf8 "rrarr" "\226\135\137"
+let _ = Hashtbl.replace macro2utf8 "Upsilon" "\207\146"
+let _ = Hashtbl.replace macro2utf8 "sqsub" "\226\138\143"
+let _ = Hashtbl.replace macro2utf8 "boxUL" "\226\149\157"
+let _ = Hashtbl.replace macro2utf8 "LessTilde" "\226\137\178"
+let _ = Hashtbl.replace macro2utf8 "Xfr" "\240\157\148\155"
+let _ = Hashtbl.replace macro2utf8 "nis" "\226\139\188"
+let _ = Hashtbl.replace macro2utf8 "chi" "\207\135"
+let _ = Hashtbl.replace macro2utf8 "DownRightVector" "\226\135\129"
+let _ = Hashtbl.replace macro2utf8 "niv" "\226\136\139"
+let _ = Hashtbl.replace macro2utf8 "boxUR" "\226\149\154"
+let _ = Hashtbl.replace macro2utf8 "nlArr" "\226\135\141"
+let _ = Hashtbl.replace macro2utf8 "Bcy" "\208\145"
+let _ = Hashtbl.replace macro2utf8 "tan" "tan"
+let _ = Hashtbl.replace macro2utf8 "EmptyVerySmallSquare" "\239\150\156"
+let _ = Hashtbl.replace macro2utf8 "dstrok" "\196\145"
+let _ = Hashtbl.replace macro2utf8 "rfisht" "\226\165\189"
+let _ = Hashtbl.replace macro2utf8 "easter" "\226\137\155"
+let _ = Hashtbl.replace macro2utf8 "nlE" "\226\137\176"
+let _ = Hashtbl.replace macro2utf8 "Mellintrf" "\226\132\179"
+let _ = Hashtbl.replace macro2utf8 "lotimes" "\226\168\180"
+let _ = Hashtbl.replace macro2utf8 "sqsup" "\226\138\144"
+let _ = Hashtbl.replace macro2utf8 "boxVH" "\226\149\172"
+let _ = Hashtbl.replace macro2utf8 "bbrk" "\226\142\181"
+let _ = Hashtbl.replace macro2utf8 "tau" "\207\132"
+let _ = Hashtbl.replace macro2utf8 "UpTee" "\226\138\165"
+let _ = Hashtbl.replace macro2utf8 "NotLeftTriangleBar" "\226\167\143\204\184"
+let _ = Hashtbl.replace macro2utf8 "boxVL" "\226\149\163"
+let _ = Hashtbl.replace macro2utf8 "Proportion" "\226\136\183"
+let _ = Hashtbl.replace macro2utf8 "equiv" "\226\137\161"
+let _ = Hashtbl.replace macro2utf8 "blk12" "\226\150\146"
+let _ = Hashtbl.replace macro2utf8 "blk14" "\226\150\145"
+let _ = Hashtbl.replace macro2utf8 "fpartint" "\226\168\141"
+let _ = Hashtbl.replace macro2utf8 "boxVR" "\226\149\160"
+let _ = Hashtbl.replace macro2utf8 "starf" "\226\152\133"
+let _ = Hashtbl.replace macro2utf8 "risingdotseq" "\226\137\147"
+let _ = Hashtbl.replace macro2utf8 "Equilibrium" "\226\135\140"
+let _ = Hashtbl.replace macro2utf8 "ijlig" "\196\179"
+let _ = Hashtbl.replace macro2utf8 "yicy" "\209\151"
+let _ = Hashtbl.replace macro2utf8 "sum" "\226\136\145"
+let _ = Hashtbl.replace macro2utf8 "cir" "\226\151\139"
+let _ = Hashtbl.replace macro2utf8 "telrec" "\226\140\149"
+let _ = Hashtbl.replace macro2utf8 "Mfr" "\240\157\148\144"
+let _ = Hashtbl.replace macro2utf8 "dHar" "\226\165\165"
+let _ = Hashtbl.replace macro2utf8 "boxUl" "\226\149\156"
+let _ = Hashtbl.replace macro2utf8 "apid" "\226\137\139"
+let _ = Hashtbl.replace macro2utf8 "nleftarrow" "\226\134\154"
+let _ = Hashtbl.replace macro2utf8 "curarrm" "\226\164\188"
+let _ = Hashtbl.replace macro2utf8 "Scirc" "\197\156"
+let _ = Hashtbl.replace macro2utf8 "Copf" "\226\132\130"
+let _ = Hashtbl.replace macro2utf8 "RightTriangleEqual" "\226\138\181"
+let _ = Hashtbl.replace macro2utf8 "boxUr" "\226\149\153"
+let _ = Hashtbl.replace macro2utf8 "loplus" "\226\168\173"
+let _ = Hashtbl.replace macro2utf8 "varsupsetneq" "\226\138\139\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "scaron" "\197\161"
+let _ = Hashtbl.replace macro2utf8 "Diamond" "\226\139\132"
+let _ = Hashtbl.replace macro2utf8 "lowast" "\226\136\151"
+let _ = Hashtbl.replace macro2utf8 "nle" "\226\137\176\226\131\165"
+let _ = Hashtbl.replace macro2utf8 "phiv" "\207\149"
+let _ = Hashtbl.replace macro2utf8 "gesdotol" "\226\170\132"
+let _ = Hashtbl.replace macro2utf8 "boxVh" "\226\149\171"
+let _ = Hashtbl.replace macro2utf8 "nleftrightarrow" "\226\134\174"
+let _ = Hashtbl.replace macro2utf8 "Jopf" "\240\157\149\129"
+let _ = Hashtbl.replace macro2utf8 "boxVl" "\226\149\162"
+let _ = Hashtbl.replace macro2utf8 "nearhk" "\226\164\164"
+let _ = Hashtbl.replace macro2utf8 "vBarv" "\226\171\169"
+let _ = Hashtbl.replace macro2utf8 "rHar" "\226\165\164"
+let _ = Hashtbl.replace macro2utf8 "boxVr" "\226\149\159"
+let _ = Hashtbl.replace macro2utf8 "lessdot" "\226\139\150"
+let _ = Hashtbl.replace macro2utf8 "LeftDoubleBracket" "\227\128\154"
+let _ = Hashtbl.replace macro2utf8 "Delta" "\206\148"
+let _ = Hashtbl.replace macro2utf8 "limsup" "limsup"
+let _ = Hashtbl.replace macro2utf8 "tcy" "\209\130"
+let _ = Hashtbl.replace macro2utf8 "nlt" "\226\137\174"
+let _ = Hashtbl.replace macro2utf8 "Cdot" "\196\138"
+let _ = Hashtbl.replace macro2utf8 "blk34" "\226\150\147"
+let _ = Hashtbl.replace macro2utf8 "Bfr" "\240\157\148\133"
+let _ = Hashtbl.replace macro2utf8 "lowbar" "_"
+let _ = Hashtbl.replace macro2utf8 "lneqq" "\226\137\168"
+let _ = Hashtbl.replace macro2utf8 "TildeEqual" "\226\137\131"
+let _ = Hashtbl.replace macro2utf8 "shortmid" "\226\136\163\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "Qopf" "\226\132\154"
+let _ = Hashtbl.replace macro2utf8 "drcorn" "\226\140\159"
+let _ = Hashtbl.replace macro2utf8 "ZeroWidthSpace" "\226\128\139"
+let _ = Hashtbl.replace macro2utf8 "aogon" "\196\133"
+let _ = Hashtbl.replace macro2utf8 "Rsh" "\226\134\177"
+let _ = Hashtbl.replace macro2utf8 "lrarr" "\226\135\134"
+let _ = Hashtbl.replace macro2utf8 "cupdot" "\226\138\141"
+let _ = Hashtbl.replace macro2utf8 "Xopf" "\240\157\149\143"
+let _ = Hashtbl.replace macro2utf8 "Backslash" "\226\136\150"
+let _ = Hashtbl.replace macro2utf8 "Union" "\226\139\131"
+let _ = Hashtbl.replace macro2utf8 "ratio" "\226\136\182"
+let _ = Hashtbl.replace macro2utf8 "duarr" "\226\135\181"
+let _ = Hashtbl.replace macro2utf8 "lates" "\226\170\173\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "suphsub" "\226\171\151"
+let _ = Hashtbl.replace macro2utf8 "squf" "\226\150\170"
+let _ = Hashtbl.replace macro2utf8 "gamma" "\206\179"
+let _ = Hashtbl.replace macro2utf8 "lrhard" "\226\165\173"
+let _ = Hashtbl.replace macro2utf8 "intprod" "\226\168\188"
+let _ = Hashtbl.replace macro2utf8 "ReverseUpEquilibrium" "\226\165\175"
+let _ = Hashtbl.replace macro2utf8 "icy" "\208\184"
+let _ = Hashtbl.replace macro2utf8 "quatint" "\226\168\150"
+let _ = Hashtbl.replace macro2utf8 "nbump" "\226\137\142\204\184"
+let _ = Hashtbl.replace macro2utf8 "downharpoonleft" "\226\135\131"
+let _ = Hashtbl.replace macro2utf8 "otimesas" "\226\168\182"
+let _ = Hashtbl.replace macro2utf8 "nvHarr" "\226\135\142"
+let _ = Hashtbl.replace macro2utf8 "ContourIntegral" "\226\136\174"
+let _ = Hashtbl.replace macro2utf8 "bsol" "\\"
+let _ = Hashtbl.replace macro2utf8 "DoubleUpDownArrow" "\226\135\149"
+let _ = Hashtbl.replace macro2utf8 "disin" "\226\139\178"
+let _ = Hashtbl.replace macro2utf8 "Breve" "\203\152"
+let _ = Hashtbl.replace macro2utf8 "YAcy" "\208\175"
+let _ = Hashtbl.replace macro2utf8 "precsim" "\226\137\190"
+let _ = Hashtbl.replace macro2utf8 "NotGreaterGreater" "\226\137\171\204\184\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "fopf" "\240\157\149\151"
+let _ = Hashtbl.replace macro2utf8 "SquareSupersetEqual" "\226\138\146"
+let _ = Hashtbl.replace macro2utf8 "Dscr" "\240\157\146\159"
+let _ = Hashtbl.replace macro2utf8 "gsime" "\226\170\142"
+let _ = Hashtbl.replace macro2utf8 "PartialD" "\226\136\130"
+let _ = Hashtbl.replace macro2utf8 "Umacr" "\197\170"
+let _ = Hashtbl.replace macro2utf8 "tfr" "\240\157\148\177"
+let _ = Hashtbl.replace macro2utf8 "cularrp" "\226\164\189"
+let _ = Hashtbl.replace macro2utf8 "UnderBracket" "\226\142\181"
+let _ = Hashtbl.replace macro2utf8 "ugrave" "\195\185"
+let _ = Hashtbl.replace macro2utf8 "mopf" "\240\157\149\158"
+let _ = Hashtbl.replace macro2utf8 "gsiml" "\226\170\144"
+let _ = Hashtbl.replace macro2utf8 "iquest" "\194\191"
+let _ = Hashtbl.replace macro2utf8 "nmid" "\226\136\164"
+let _ = Hashtbl.replace macro2utf8 "leftarrowtail" "\226\134\162"
+let _ = Hashtbl.replace macro2utf8 "not" "\194\172"
+let _ = Hashtbl.replace macro2utf8 "Kscr" "\240\157\146\166"
+let _ = Hashtbl.replace macro2utf8 "xsqcup" "\226\138\148"
+let _ = Hashtbl.replace macro2utf8 "triangleleft" "\226\151\131"
+let _ = Hashtbl.replace macro2utf8 "amalg" "\226\168\191"
+let _ = Hashtbl.replace macro2utf8 "prcue" "\226\137\188"
+let _ = Hashtbl.replace macro2utf8 "ac" "\226\164\143"
+let _ = Hashtbl.replace macro2utf8 "nharr" "\226\134\174"
+let _ = Hashtbl.replace macro2utf8 "dzcy" "\209\159"
+let _ = Hashtbl.replace macro2utf8 "topf" "\240\157\149\165"
+let _ = Hashtbl.replace macro2utf8 "iff" "\226\135\148"
+let _ = Hashtbl.replace macro2utf8 "af" "\226\129\161"
+let _ = Hashtbl.replace macro2utf8 "Uparrow" "\226\135\145"
+let _ = Hashtbl.replace macro2utf8 "Iacute" "\195\141"
+let _ = Hashtbl.replace macro2utf8 "Rscr" "\226\132\155"
+let _ = Hashtbl.replace macro2utf8 "vrtri" "\226\138\179"
+let _ = Hashtbl.replace macro2utf8 "multimap" "\226\138\184"
+let _ = Hashtbl.replace macro2utf8 "Hat" "\204\130"
+let _ = Hashtbl.replace macro2utf8 "rtriltri" "\226\167\142"
+let _ = Hashtbl.replace macro2utf8 "npr" "\226\138\128"
+let _ = Hashtbl.replace macro2utf8 "agrave" "\195\160"
+let _ = Hashtbl.replace macro2utf8 "UnderBar" "\204\178"
+let _ = Hashtbl.replace macro2utf8 "prime" "\226\128\178"
+let _ = Hashtbl.replace macro2utf8 "plusmn" "\194\177"
+let _ = Hashtbl.replace macro2utf8 "eplus" "\226\169\177"
+let _ = Hashtbl.replace macro2utf8 "ap" "\226\137\136"
+let _ = Hashtbl.replace macro2utf8 "dlcorn" "\226\140\158"
+let _ = Hashtbl.replace macro2utf8 "backsim" "\226\136\189"
+let _ = Hashtbl.replace macro2utf8 "ifr" "\240\157\148\166"
+let _ = Hashtbl.replace macro2utf8 "bigcup" "\226\139\131"
+let _ = Hashtbl.replace macro2utf8 "tcaron" "\197\165"
+let _ = Hashtbl.replace macro2utf8 "sqcaps" "\226\138\147\239\184\128"
+let _ = Hashtbl.replace macro2utf8 "equals" "="
+let _ = Hashtbl.replace macro2utf8 "curlywedge" "\226\139\143"
+let _ = Hashtbl.replace macro2utf8 "Yscr" "\240\157\146\180"
+let _ = Hashtbl.replace macro2utf8 "longrightarrow" "????"
+let _ = Hashtbl.replace macro2utf8 "fork" "\226\139\148"
+let _ = Hashtbl.replace macro2utf8 "cos" "cos"
+let _ = Hashtbl.replace macro2utf8 "cot" "cot"
+let _ = Hashtbl.replace macro2utf8 "ImaginaryI" "\226\133\136"
+let _ = Hashtbl.replace macro2utf8 "Scy" "\208\161"
+let _ = Hashtbl.replace macro2utf8 "mapsto" "\226\134\166"
+let _ = Hashtbl.replace macro2utf8 "tdot" "\226\131\155"
+let _ = Hashtbl.replace macro2utf8 "vellip" "\226\139\174"
+let _ = Hashtbl.replace macro2utf8 "sqsupseteq" "\226\138\146"
+let _ = Hashtbl.replace macro2utf8 "nvdash" "\226\138\172"
+let _ = Hashtbl.replace macro2utf8 "NotSuperset" "\226\138\133"
+let _ = Hashtbl.replace macro2utf8 "DoubleUpArrow" "\226\135\145"
+let _ = Hashtbl.replace macro2utf8 "land" "\226\136\167"
+let _ = Hashtbl.replace macro2utf8 "topfork" "\226\171\154"
+let _ = Hashtbl.replace macro2utf8 "llhard" "\226\165\171"
+let _ = Hashtbl.replace macro2utf8 "apos" "'"
+let _ = Hashtbl.replace macro2utf8 "oslash" "\195\184"
+let _ = Hashtbl.replace macro2utf8 "lang" "\226\140\169"
+let _ = Hashtbl.replace macro2utf8 "bernou" "\226\132\172"
+let _ = Hashtbl.replace macro2utf8 "varrho" "\207\177"
+let _ = Hashtbl.replace macro2utf8 "rcub" "}"
+let _ = Hashtbl.replace macro2utf8 "Cedilla" "\194\184"
+let _ = Hashtbl.replace macro2utf8 "ApplyFunction" "\226\129\161"
+let _ = Hashtbl.replace macro2utf8 "nsce" "\226\170\176\204\184"
+let _ = Hashtbl.replace macro2utf8 "gscr" "\226\132\138"
+let _ = Hashtbl.replace macro2utf8 "imagpart" "\226\132\145"
+let _ = Hashtbl.replace macro2utf8 "ngtr" "\226\137\175"
+let _ = Hashtbl.replace macro2utf8 "nsc" "\226\138\129"
+let _ = Hashtbl.replace macro2utf8 "Barv" "\226\171\167"
+let _ = Hashtbl.replace macro2utf8 "tosa" "\226\164\169"
+let _ = Hashtbl.replace macro2utf8 "nwnear" "\226\164\167"
+let _ = Hashtbl.replace macro2utf8 "ltlarr" "\226\165\182"
+let _ = Hashtbl.replace macro2utf8 "PrecedesEqual" "\226\170\175"
+let _ = Hashtbl.replace macro2utf8 "lessapprox" "\226\137\178"
+let _ = Hashtbl.replace macro2utf8 "Lcaron" "\196\189"
+let _ = Hashtbl.replace utf82macro "\204\130" "Hat"
+let _ = Hashtbl.replace utf82macro "\t" "Tab"
+let _ = Hashtbl.replace utf82macro "\203\152" "Breve"
+let _ = Hashtbl.replace utf82macro "\n" "NewLine"
+let _ = Hashtbl.replace utf82macro "\203\153" "dot"
+let _ = Hashtbl.replace utf82macro "\203\154" "ring"
+let _ = Hashtbl.replace utf82macro "\203\155" "ogon"
+let _ = Hashtbl.replace utf82macro "\203\156" "tilde"
+let _ = Hashtbl.replace utf82macro "\203\157" "DiacriticalDoubleAcute"
+let _ = Hashtbl.replace utf82macro "\226\137\171\204\184" "nGt"
+let _ = Hashtbl.replace utf82macro "\204\145" "DownBreve"
+let _ = Hashtbl.replace utf82macro "csc" "csc"
+let _ = Hashtbl.replace utf82macro "\239\187\191" "NoBreak"
+let _ = Hashtbl.replace utf82macro "!" "excl"
+let _ = Hashtbl.replace utf82macro "\"" "quot"
+let _ = Hashtbl.replace utf82macro "#" "num"
+let _ = Hashtbl.replace utf82macro "$" "dollar"
+let _ = Hashtbl.replace utf82macro "%" "percnt"
+let _ = Hashtbl.replace utf82macro "&" "amp"
+let _ = Hashtbl.replace utf82macro "'" "apos"
+let _ = Hashtbl.replace utf82macro "(" "lpar"
+let _ = Hashtbl.replace utf82macro ")" "rpar"
+let _ = Hashtbl.replace utf82macro "\226\139\155\239\184\128" "gesl"
+let _ = Hashtbl.replace utf82macro "*" "ast"
+let _ = Hashtbl.replace utf82macro "+" "plus"
+let _ = Hashtbl.replace utf82macro "\226\167\144\204\184" "NotRightTriangleBar"
+let _ = Hashtbl.replace utf82macro "," "comma"
+let _ = Hashtbl.replace utf82macro "." "period"
+let _ = Hashtbl.replace utf82macro "/" "sol"
+let _ = Hashtbl.replace utf82macro "\204\178" "UnderBar"
+let _ = Hashtbl.replace utf82macro ":" "colon"
+let _ = Hashtbl.replace utf82macro ";" "semi"
+let _ = Hashtbl.replace utf82macro "<" "lt"
+let _ = Hashtbl.replace utf82macro "\207\128" "pi"
+let _ = Hashtbl.replace utf82macro "\206\147" "Gamma"
+let _ = Hashtbl.replace utf82macro "=" "equals"
+let _ = Hashtbl.replace utf82macro "\207\129" "rho"
+let _ = Hashtbl.replace utf82macro ">" "gt"
+let _ = Hashtbl.replace utf82macro "\206\148" "Delta"
+let _ = Hashtbl.replace utf82macro "\207\130" "varsigma"
+let _ = Hashtbl.replace utf82macro "?" "quest"
+let _ = Hashtbl.replace utf82macro "\207\131" "sigma"
+let _ = Hashtbl.replace utf82macro "@" "commat"
+let _ = Hashtbl.replace utf82macro "\207\132" "tau"
+let _ = Hashtbl.replace utf82macro "\207\133" "upsilon"
+let _ = Hashtbl.replace utf82macro "\206\152" "Theta"
+let _ = Hashtbl.replace utf82macro "\207\134" "varphi"
+let _ = Hashtbl.replace utf82macro "\207\135" "chi"
+let _ = Hashtbl.replace utf82macro "\207\136" "psi"
+let _ = Hashtbl.replace utf82macro "\206\155" "Lambda"
+let _ = Hashtbl.replace utf82macro "\207\137" "omega"
+let _ = Hashtbl.replace utf82macro "\206\158" "Xi"
+let _ = Hashtbl.replace utf82macro "\206\160" "Pi"
+let _ = Hashtbl.replace utf82macro "\206\163" "Sigma"
+let _ = Hashtbl.replace utf82macro "\207\145" "vartheta"
+let _ = Hashtbl.replace utf82macro "\207\146" "Upsilon"
+let _ = Hashtbl.replace utf82macro "\206\166" "Phi"
+let _ = Hashtbl.replace utf82macro "\208\129" "IOcy"
+let _ = Hashtbl.replace utf82macro "\206\168" "Psi"
+let _ = Hashtbl.replace utf82macro "\207\149" "phi"
+let _ = Hashtbl.replace utf82macro "\208\130" "DJcy"
+let _ = Hashtbl.replace utf82macro "\207\150" "varpi"
+let _ = Hashtbl.replace utf82macro "\206\169" "Omega"
+let _ = Hashtbl.replace utf82macro "\208\131" "GJcy"
+let _ = Hashtbl.replace utf82macro "\208\132" "Jukcy"
+let _ = Hashtbl.replace utf82macro "\208\133" "DScy"
+let _ = Hashtbl.replace utf82macro "\208\134" "Iukcy"
+let _ = Hashtbl.replace utf82macro "\208\135" "YIcy"
+let _ = Hashtbl.replace utf82macro "\208\136" "Jsercy"
+let _ = Hashtbl.replace utf82macro "\208\137" "LJcy"
+let _ = Hashtbl.replace utf82macro "\207\156" "Gammad"
+let _ = Hashtbl.replace utf82macro "\208\138" "NJcy"
+let _ = Hashtbl.replace utf82macro "\208\139" "TSHcy"
+let _ = Hashtbl.replace utf82macro "[" "lbrack"
+let _ = Hashtbl.replace utf82macro "\206\177" "alpha"
+let _ = Hashtbl.replace utf82macro "\208\140" "KJcy"
+let _ = Hashtbl.replace utf82macro "\\" "backslash"
+let _ = Hashtbl.replace utf82macro "\206\178" "beta"
+let _ = Hashtbl.replace utf82macro "]" "rbrack"
+let _ = Hashtbl.replace utf82macro "\206\179" "gamma"
+let _ = Hashtbl.replace utf82macro "\208\142" "Ubrcy"
+let _ = Hashtbl.replace utf82macro "\206\180" "delta"
+let _ = Hashtbl.replace utf82macro "^" "circ"
+let _ = Hashtbl.replace utf82macro "_" "lowbar"
+let _ = Hashtbl.replace utf82macro "\206\181" "varepsilon"
+let _ = Hashtbl.replace utf82macro "\208\143" "DZcy"
+let _ = Hashtbl.replace utf82macro "\206\182" "zeta"
+let _ = Hashtbl.replace utf82macro "`" "grave"
+let _ = Hashtbl.replace utf82macro "\208\144" "Acy"
+let _ = Hashtbl.replace utf82macro "inf" "inf"
+let _ = Hashtbl.replace utf82macro "\206\183" "eta"
+let _ = Hashtbl.replace utf82macro "\208\145" "Bcy"
+let _ = Hashtbl.replace utf82macro "\208\146" "Vcy"
+let _ = Hashtbl.replace utf82macro "\206\184" "theta"
+let _ = Hashtbl.replace utf82macro "\209\128" "rcy"
+let _ = Hashtbl.replace utf82macro "\226\139\172\204\184" "nvltrie"
+let _ = Hashtbl.replace utf82macro "\206\185" "iota"
+let _ = Hashtbl.replace utf82macro "\208\147" "Gcy"
+let _ = Hashtbl.replace utf82macro "\209\129" "scy"
+let _ = Hashtbl.replace utf82macro "\206\186" "kappa"
+let _ = Hashtbl.replace utf82macro "\208\148" "Dcy"
+let _ = Hashtbl.replace utf82macro "\209\130" "tcy"
+let _ = Hashtbl.replace utf82macro "\226\164\179\204\184" "nrarrc"
+let _ = Hashtbl.replace utf82macro "\206\187" "lambda"
+let _ = Hashtbl.replace utf82macro "\208\149" "IEcy"
+let _ = Hashtbl.replace utf82macro "\208\150" "ZHcy"
+let _ = Hashtbl.replace utf82macro "\209\131" "ucy"
+let _ = Hashtbl.replace utf82macro "\206\188" "mu"
+let _ = Hashtbl.replace utf82macro "\208\151" "Zcy"
+let _ = Hashtbl.replace utf82macro "\206\189" "nu"
+let _ = Hashtbl.replace utf82macro "\209\132" "fcy"
+let _ = Hashtbl.replace utf82macro "\206\190" "xi"
+let _ = Hashtbl.replace utf82macro "\209\133" "khcy"
+let _ = Hashtbl.replace utf82macro "\208\152" "Icy"
+let _ = Hashtbl.replace utf82macro "\206\191" "o"
+let _ = Hashtbl.replace utf82macro "\209\134" "tscy"
+let _ = Hashtbl.replace utf82macro "\208\153" "Jcy"
+let _ = Hashtbl.replace utf82macro "\208\154" "Kcy"
+let _ = Hashtbl.replace utf82macro "\209\135" "chcy"
+let _ = Hashtbl.replace utf82macro "\209\136" "shcy"
+let _ = Hashtbl.replace utf82macro "\208\155" "Lcy"
+let _ = Hashtbl.replace utf82macro "\209\137" "shchcy"
+let _ = Hashtbl.replace utf82macro "\208\156" "Mcy"
+let _ = Hashtbl.replace utf82macro "\208\157" "Ncy"
+let _ = Hashtbl.replace utf82macro "\207\176" "varkappa"
+let _ = Hashtbl.replace utf82macro "\209\138" "hardcy"
+let _ = Hashtbl.replace utf82macro "\209\139" "ycy"
+let _ = Hashtbl.replace utf82macro "\207\177" "varrho"
+let _ = Hashtbl.replace utf82macro "\208\158" "Ocy"
+let _ = Hashtbl.replace utf82macro "\209\140" "softcy"
+let _ = Hashtbl.replace utf82macro "\208\159" "Pcy"
+let _ = Hashtbl.replace utf82macro "\208\160" "Rcy"
+let _ = Hashtbl.replace utf82macro "\209\141" "ecy"
+let _ = Hashtbl.replace utf82macro "\209\142" "yucy"
+let _ = Hashtbl.replace utf82macro "\208\161" "Scy"
+let _ = Hashtbl.replace utf82macro "\207\181" "epsilon"
+let _ = Hashtbl.replace utf82macro "\209\143" "yacy"
+let _ = Hashtbl.replace utf82macro "\208\162" "Tcy"
+let _ = Hashtbl.replace utf82macro "\208\163" "Ucy"
+let _ = Hashtbl.replace utf82macro "\207\182" "bepsi"
+let _ = Hashtbl.replace utf82macro "\209\145" "iocy"
+let _ = Hashtbl.replace utf82macro "\208\164" "Fcy"
+let _ = Hashtbl.replace utf82macro "\208\165" "KHcy"
+let _ = Hashtbl.replace utf82macro "\209\146" "djcy"
+let _ = Hashtbl.replace utf82macro "\208\166" "TScy"
+let _ = Hashtbl.replace utf82macro "\209\147" "gjcy"
+let _ = Hashtbl.replace utf82macro "\209\148" "jukcy"
+let _ = Hashtbl.replace utf82macro "\208\167" "CHcy"
+let _ = Hashtbl.replace utf82macro "????" "longmapsto"
+let _ = Hashtbl.replace utf82macro "\208\168" "SHcy"
+let _ = Hashtbl.replace utf82macro "\209\149" "dscy"
+let _ = Hashtbl.replace utf82macro "\208\169" "SHCHcy"
+let _ = Hashtbl.replace utf82macro "\209\150" "iukcy"
+let _ = Hashtbl.replace utf82macro "deg" "deg"
+let _ = Hashtbl.replace utf82macro "\209\151" "yicy"
+let _ = Hashtbl.replace utf82macro "\208\170" "HARDcy"
+let _ = Hashtbl.replace utf82macro "\208\171" "Ycy"
+let _ = Hashtbl.replace utf82macro "{" "{"
+let _ = Hashtbl.replace utf82macro "\209\152" "jsercy"
+let _ = Hashtbl.replace utf82macro "|" "vert"
+let _ = Hashtbl.replace utf82macro "\208\172" "SOFTcy"
+let _ = Hashtbl.replace utf82macro "\209\153" "ljcy"
+let _ = Hashtbl.replace utf82macro "liminf" "liminf"
+let _ = Hashtbl.replace utf82macro "}" "}"
+let _ = Hashtbl.replace utf82macro "\209\154" "njcy"
+let _ = Hashtbl.replace utf82macro "\208\173" "Ecy"
+let _ = Hashtbl.replace utf82macro "\208\174" "YUcy"
+let _ = Hashtbl.replace utf82macro "\209\155" "tshcy"
+let _ = Hashtbl.replace utf82macro "\208\175" "YAcy"
+let _ = Hashtbl.replace utf82macro "\209\156" "kjcy"
+let _ = Hashtbl.replace utf82macro "\208\176" "acy"
+let _ = Hashtbl.replace utf82macro "\209\158" "ubrcy"
+let _ = Hashtbl.replace utf82macro "\208\177" "bcy"
+let _ = Hashtbl.replace utf82macro "\208\178" "vcy"
+let _ = Hashtbl.replace utf82macro "\209\159" "dzcy"
+let _ = Hashtbl.replace utf82macro "\208\179" "gcy"
+let _ = Hashtbl.replace utf82macro "\208\180" "dcy"
+let _ = Hashtbl.replace utf82macro "\208\181" "iecy"
+let _ = Hashtbl.replace utf82macro "\208\182" "zhcy"
+let _ = Hashtbl.replace utf82macro "det" "det"
+let _ = Hashtbl.replace utf82macro "\208\183" "zcy"
+let _ = Hashtbl.replace utf82macro "\208\184" "icy"
+let _ = Hashtbl.replace utf82macro "\208\185" "jcy"
+let _ = Hashtbl.replace utf82macro "\208\186" "kcy"
+let _ = Hashtbl.replace utf82macro "\208\187" "lcy"
+let _ = Hashtbl.replace utf82macro "\208\188" "mcy"
+let _ = Hashtbl.replace utf82macro "\226\146\161\204\184" "NotNestedLessLess"
+let _ = Hashtbl.replace utf82macro "\208\189" "ncy"
+let _ = Hashtbl.replace utf82macro "\208\190" "ocy"
+let _ = Hashtbl.replace utf82macro "\208\191" "pcy"
+let _ = Hashtbl.replace utf82macro "\226\128\130" "ensp"
+let _ = Hashtbl.replace utf82macro "\226\128\131" "emsp"
+let _ = Hashtbl.replace utf82macro "\226\128\132" "emsp13"
+let _ = Hashtbl.replace utf82macro "\226\128\133" "emsp14"
+let _ = Hashtbl.replace utf82macro "\226\128\135" "numsp"
+let _ = Hashtbl.replace utf82macro "\226\128\136" "puncsp"
+let _ = Hashtbl.replace utf82macro "lg" "lg"
+let _ = Hashtbl.replace utf82macro "\226\128\137" "ThinSpace"
+let _ = Hashtbl.replace utf82macro "\226\128\138" "VeryThinSpace"
+let _ = Hashtbl.replace utf82macro "\226\128\139" "ZeroWidthSpace"
+let _ = Hashtbl.replace utf82macro "ln" "ln"
+let _ = Hashtbl.replace utf82macro "\226\128\144" "hyphen"
+let _ = Hashtbl.replace utf82macro "\226\128\147" "ndash"
+let _ = Hashtbl.replace utf82macro "\226\128\148" "mdash"
+let _ = Hashtbl.replace utf82macro "\226\129\129" "caret"
+let _ = Hashtbl.replace utf82macro "\226\128\149" "horbar"
+let _ = Hashtbl.replace utf82macro "\226\128\150" "Vert"
+let _ = Hashtbl.replace utf82macro "\226\129\131" "hybull"
+let _ = Hashtbl.replace utf82macro "\226\128\152" "OpenCurlyQuote"
+let _ = Hashtbl.replace utf82macro "\226\128\153" "rsquor"
+let _ = Hashtbl.replace utf82macro "\226\170\176\204\184" "nsucceq"
+let _ = Hashtbl.replace utf82macro "\226\128\154" "lsquor"
+let _ = Hashtbl.replace utf82macro "\226\128\156" "OpenCurlyDoubleQuote"
+let _ = Hashtbl.replace utf82macro "\226\128\157" "rdquor"
+let _ = Hashtbl.replace utf82macro "\226\128\158" "ldquor"
+let _ = Hashtbl.replace utf82macro "\226\128\160" "dagger"
+let _ = Hashtbl.replace utf82macro "\226\128\161" "ddagger"
+let _ = Hashtbl.replace utf82macro "\226\136\133\239\184\128" "emptyset"
+let _ = Hashtbl.replace utf82macro "\226\128\162" "bullet"
+let _ = Hashtbl.replace utf82macro "\226\129\143" "bsemi"
+let _ = Hashtbl.replace utf82macro "\226\128\165" "nldr"
+let _ = Hashtbl.replace utf82macro "\226\128\166" "ldots"
+let _ = Hashtbl.replace utf82macro "\226\129\151" "qprime"
+let _ = Hashtbl.replace utf82macro "\226\128\176" "permil"
+let _ = Hashtbl.replace utf82macro "\226\128\177" "pertenk"
+let _ = Hashtbl.replace utf82macro "\226\128\178" "prime"
+let _ = Hashtbl.replace utf82macro "\226\129\159" "MediumSpace"
+let _ = Hashtbl.replace utf82macro "\226\128\179" "Prime"
+let _ = Hashtbl.replace utf82macro "\226\128\180" "tprime"
+let _ = Hashtbl.replace utf82macro "\226\129\161" "ApplyFunction"
+let _ = Hashtbl.replace utf82macro "\226\129\162" "it"
+let _ = Hashtbl.replace utf82macro "\226\128\181" "bprime"
+let _ = Hashtbl.replace utf82macro "dim" "dim"
+let _ = Hashtbl.replace utf82macro "\226\132\130" "Copf"
+let _ = Hashtbl.replace utf82macro "\226\132\133" "incare"
+let _ = Hashtbl.replace utf82macro "\226\131\155" "TripleDot"
+let _ = Hashtbl.replace utf82macro "\226\169\173\204\184" "ncongdot"
+let _ = Hashtbl.replace utf82macro "\226\131\156" "DotDot"
+let _ = Hashtbl.replace utf82macro "\226\132\138" "gscr"
+let _ = Hashtbl.replace utf82macro "\226\132\139" "Hscr"
+let _ = Hashtbl.replace utf82macro "\226\132\140" "Poincareplane"
+let _ = Hashtbl.replace utf82macro "\226\132\141" "quaternions"
+let _ = Hashtbl.replace utf82macro "\226\132\142" "planckh"
+let _ = Hashtbl.replace utf82macro "\226\132\143" "plankv"
+let _ = Hashtbl.replace utf82macro "\226\132\144" "Iscr"
+let _ = Hashtbl.replace utf82macro "\226\132\145" "Im"
+let _ = Hashtbl.replace utf82macro "\226\132\146" "Lscr"
+let _ = Hashtbl.replace utf82macro "\226\132\147" "ell"
+let _ = Hashtbl.replace utf82macro "\226\132\149" "Nopf"
+let _ = Hashtbl.replace utf82macro "\226\132\150" "numero"
+let _ = Hashtbl.replace utf82macro "\226\132\151" "copysr"
+let _ = Hashtbl.replace utf82macro "\226\132\152" "wp"
+let _ = Hashtbl.replace utf82macro "\226\133\133" "DD"
+let _ = Hashtbl.replace utf82macro "\226\132\153" "primes"
+let _ = Hashtbl.replace utf82macro "\226\133\134" "DifferentialD"
+let _ = Hashtbl.replace utf82macro "\226\132\154" "rationals"
+let _ = Hashtbl.replace utf82macro "\226\133\135" "ExponentialE"
+let _ = Hashtbl.replace utf82macro "\226\132\155" "Rscr"
+let _ = Hashtbl.replace utf82macro "\226\133\136" "ImaginaryI"
+let _ = Hashtbl.replace utf82macro "\226\132\156" "Re"
+let _ = Hashtbl.replace utf82macro "\226\132\157" "Ropf"
+let _ = Hashtbl.replace utf82macro "\226\132\158" "rx"
+let _ = Hashtbl.replace utf82macro "\226\132\162" "trade"
+let _ = Hashtbl.replace utf82macro "\226\132\164" "Zopf"
+let _ = Hashtbl.replace utf82macro "\226\132\166" "ohm"
+let _ = Hashtbl.replace utf82macro "\226\133\147" "frac13"
+let _ = Hashtbl.replace utf82macro "\226\132\167" "mho"
+let _ = Hashtbl.replace utf82macro "\226\133\148" "frac23"
+let _ = Hashtbl.replace utf82macro "\226\132\168" "Zfr"
+let _ = Hashtbl.replace utf82macro "\226\133\149" "frac15"
+let _ = Hashtbl.replace utf82macro "\226\132\169" "iiota"
+let _ = Hashtbl.replace utf82macro "\226\133\150" "frac25"
+let _ = Hashtbl.replace utf82macro "\226\133\151" "frac35"
+let _ = Hashtbl.replace utf82macro "\226\133\152" "frac45"
+let _ = Hashtbl.replace utf82macro "\226\132\171" "angst"
+let _ = Hashtbl.replace utf82macro "\226\133\153" "frac16"
+let _ = Hashtbl.replace utf82macro "\226\132\172" "Bscr"
+let _ = Hashtbl.replace utf82macro "\226\129\159\239\184\128" "NegativeMediumSpace"
+let _ = Hashtbl.replace utf82macro "\226\133\154" "frac56"
+let _ = Hashtbl.replace utf82macro "\226\132\173" "Cfr"
+let _ = Hashtbl.replace utf82macro "\226\133\155" "frac18"
+let _ = Hashtbl.replace utf82macro "\226\133\156" "frac38"
+let _ = Hashtbl.replace utf82macro "\226\132\175" "escr"
+let _ = Hashtbl.replace utf82macro "\226\133\157" "frac58"
+let _ = Hashtbl.replace utf82macro "\226\132\176" "expectation"
+let _ = Hashtbl.replace utf82macro "\226\133\158" "frac78"
+let _ = Hashtbl.replace utf82macro "\226\132\177" "Fscr"
+let _ = Hashtbl.replace utf82macro "\226\132\179" "phmmat"
+let _ = Hashtbl.replace utf82macro "\226\132\180" "oscr"
+let _ = Hashtbl.replace utf82macro "\226\132\181" "aleph"
+let _ = Hashtbl.replace utf82macro "\226\134\144" "gets"
+let _ = Hashtbl.replace utf82macro "\226\132\182" "beth"
+let _ = Hashtbl.replace utf82macro "\226\134\145" "uparrow"
+let _ = Hashtbl.replace utf82macro "\226\132\183" "gimel"
+let _ = Hashtbl.replace utf82macro "\226\134\146" "to"
+let _ = Hashtbl.replace utf82macro "\226\132\184" "daleth"
+let _ = Hashtbl.replace utf82macro "\226\135\128" "RightVector"
+let _ = Hashtbl.replace utf82macro "\226\134\147" "downarrow"
+let _ = Hashtbl.replace utf82macro "\226\134\148" "leftrightarrow"
+let _ = Hashtbl.replace utf82macro "\226\135\129" "rightharpoondown"
+let _ = Hashtbl.replace utf82macro "\226\134\149" "updownarrow"
+let _ = Hashtbl.replace utf82macro "\226\135\130" "RightDownVector"
+let _ = Hashtbl.replace utf82macro "\226\134\150" "nwarrow"
+let _ = Hashtbl.replace utf82macro "\226\135\131" "LeftDownVector"
+let _ = Hashtbl.replace utf82macro "\226\135\132" "rlarr"
+let _ = Hashtbl.replace utf82macro "\226\134\151" "nearrow"
+let _ = Hashtbl.replace utf82macro "\226\135\133" "UpArrowDownArrow"
+let _ = Hashtbl.replace utf82macro "\226\134\152" "searrow"
+let _ = Hashtbl.replace utf82macro "\226\134\153" "swarrow"
+let _ = Hashtbl.replace utf82macro "\226\135\134" "lrarr"
+let _ = Hashtbl.replace utf82macro "\226\134\154" "nleftarrow"
+let _ = Hashtbl.replace utf82macro "\226\135\135" "llarr"
+let _ = Hashtbl.replace utf82macro "\226\135\136" "uuarr"
+let _ = Hashtbl.replace utf82macro "\226\134\155" "nrightarrow"
+let _ = Hashtbl.replace utf82macro "\226\135\137" "rrarr"
+let _ = Hashtbl.replace utf82macro "\226\134\157" "rightsquigarrow"
+let _ = Hashtbl.replace utf82macro "\226\135\138" "downdownarrows"
+let _ = Hashtbl.replace utf82macro "\226\135\139" "ReverseEquilibrium"
+let _ = Hashtbl.replace utf82macro "\226\134\158" "twoheadleftarrow"
+let _ = Hashtbl.replace utf82macro "\226\134\159" "Uarr"
+let _ = Hashtbl.replace utf82macro "\226\135\140" "rlhar"
+let _ = Hashtbl.replace utf82macro "\226\134\160" "twoheadrightarrow"
+let _ = Hashtbl.replace utf82macro "\226\135\141" "nvlArr"
+let _ = Hashtbl.replace utf82macro "\226\135\142" "nvHarr"
+let _ = Hashtbl.replace utf82macro "\226\134\161" "Darr"
+let _ = Hashtbl.replace utf82macro "\226\135\143" "nvrArr"
+let _ = Hashtbl.replace utf82macro "\226\134\162" "leftarrowtail"
+let _ = Hashtbl.replace utf82macro "\226\134\163" "rightarrowtail"
+let _ = Hashtbl.replace utf82macro "\226\135\144" "Leftarrow"
+let _ = Hashtbl.replace utf82macro "\226\134\164" "mapstoleft"
+let _ = Hashtbl.replace utf82macro "\226\135\145" "Uparrow"
+let _ = Hashtbl.replace utf82macro "\226\134\165" "UpTeeArrow"
+let _ = Hashtbl.replace utf82macro "\226\135\146" "Longrightarrow"
+let _ = Hashtbl.replace utf82macro "\226\134\166" "mapsto"
+let _ = Hashtbl.replace utf82macro "\226\136\128" "forall"
+let _ = Hashtbl.replace utf82macro "\226\135\147" "Downarrow"
+let _ = Hashtbl.replace utf82macro "\226\134\167" "mapstodown"
+let _ = Hashtbl.replace utf82macro "\226\135\148" "Leftrightarrow"
+let _ = Hashtbl.replace utf82macro "\226\136\129" "complement"
+let _ = Hashtbl.replace utf82macro "\226\136\130" "partial"
+let _ = Hashtbl.replace utf82macro "\226\135\149" "vArr"
+let _ = Hashtbl.replace utf82macro "\226\135\150" "nwArr"
+let _ = Hashtbl.replace utf82macro "\226\134\169" "hookleftarrow"
+let _ = Hashtbl.replace utf82macro "\226\136\131" "exists"
+let _ = Hashtbl.replace utf82macro "\226\136\132" "NotExists"
+let _ = Hashtbl.replace utf82macro "\226\135\151" "neArr"
+let _ = Hashtbl.replace utf82macro "\226\134\170" "hookrightarrow"
+let _ = Hashtbl.replace utf82macro "\226\135\152" "seArr"
+let _ = Hashtbl.replace utf82macro "\226\134\171" "looparrowleft"
+let _ = Hashtbl.replace utf82macro "\226\136\133" "varnothing"
+let _ = Hashtbl.replace utf82macro "\226\135\153" "swArr"
+let _ = Hashtbl.replace utf82macro "\226\134\172" "rarrlp"
+let _ = Hashtbl.replace utf82macro "\226\135\154" "Lleftarrow"
+let _ = Hashtbl.replace utf82macro "\226\134\173" "leftrightsquigarrow"
+let _ = Hashtbl.replace utf82macro "\226\136\135" "nabla"
+let _ = Hashtbl.replace utf82macro "\226\135\155" "Rrightarrow"
+let _ = Hashtbl.replace utf82macro "\226\134\174" "nleftrightarrow"
+let _ = Hashtbl.replace utf82macro "\226\136\136" "in"
+let _ = Hashtbl.replace utf82macro "\226\136\137" "notin"
+let _ = Hashtbl.replace utf82macro "\226\135\157" "zigrarr"
+let _ = Hashtbl.replace utf82macro "\226\134\176" "Lsh"
+let _ = Hashtbl.replace utf82macro "\226\134\177" "Rsh"
+let _ = Hashtbl.replace utf82macro "\226\136\139" "owns"
+let _ = Hashtbl.replace utf82macro "\226\136\140" "NotReverseElement"
+let _ = Hashtbl.replace utf82macro "\226\134\178" "ldsh"
+let _ = Hashtbl.replace utf82macro "\226\134\179" "rdsh"
+let _ = Hashtbl.replace utf82macro "\226\136\143" "prod"
+let _ = Hashtbl.replace utf82macro "\226\134\182" "curvearrowleft"
+let _ = Hashtbl.replace utf82macro "\226\136\144" "coprod"
+let _ = Hashtbl.replace utf82macro "\226\136\145" "sum"
+let _ = Hashtbl.replace utf82macro "\226\135\164" "LeftArrowBar"
+let _ = Hashtbl.replace utf82macro "\226\134\183" "curvearrowright"
+let _ = Hashtbl.replace utf82macro "\226\135\165" "RightArrowBar"
+let _ = Hashtbl.replace utf82macro "\226\136\146" "minus"
+let _ = Hashtbl.replace utf82macro "\226\137\128" "wr"
+let _ = Hashtbl.replace utf82macro "\226\136\147" "mp"
+let _ = Hashtbl.replace utf82macro "\226\137\129" "nsim"
+let _ = Hashtbl.replace utf82macro "\226\136\148" "plusdo"
+let _ = Hashtbl.replace utf82macro "\226\134\186" "olarr"
+let _ = Hashtbl.replace utf82macro "\226\137\130" "esim"
+let _ = Hashtbl.replace utf82macro "\226\134\187" "orarr"
+let _ = Hashtbl.replace utf82macro "\226\137\131" "simeq"
+let _ = Hashtbl.replace utf82macro "\226\134\188" "lharu"
+let _ = Hashtbl.replace utf82macro "\226\136\150" "setminus"
+let _ = Hashtbl.replace utf82macro "\226\137\132" "nsimeq"
+let _ = Hashtbl.replace utf82macro "\226\136\151" "lowast"
+let _ = Hashtbl.replace utf82macro "\226\134\189" "lhard"
+let _ = Hashtbl.replace utf82macro "\226\134\190" "upharpoonright"
+let _ = Hashtbl.replace utf82macro "\226\137\133" "cong"
+let _ = Hashtbl.replace utf82macro "\226\136\152" "circ"
+let _ = Hashtbl.replace utf82macro "\226\137\134" "simne"
+let _ = Hashtbl.replace utf82macro "\226\134\191" "upharpoonleft"
+let _ = Hashtbl.replace utf82macro "\226\136\154" "Sqrt"
+let _ = Hashtbl.replace utf82macro "\226\137\135" "NotTildeFullEqual"
+let _ = Hashtbl.replace utf82macro "\226\137\136" "approx"
+let _ = Hashtbl.replace utf82macro "\226\137\137" "NotTildeTilde"
+let _ = Hashtbl.replace utf82macro "\226\136\157" "propto"
+let _ = Hashtbl.replace utf82macro "\226\137\138" "approxeq"
+let _ = Hashtbl.replace utf82macro "\226\136\158" "infty"
+let _ = Hashtbl.replace utf82macro "\226\137\139" "apid"
+let _ = Hashtbl.replace utf82macro "\226\137\140" "bcong"
+let _ = Hashtbl.replace utf82macro "\226\136\159" "angrt"
+let _ = Hashtbl.replace utf82macro "\226\137\141" "asymp"
+let _ = Hashtbl.replace utf82macro "\226\136\160" "angle"
+let _ = Hashtbl.replace utf82macro "\226\137\142" "HumpDownHump"
+let _ = Hashtbl.replace utf82macro "\226\136\161" "measuredangle"
+let _ = Hashtbl.replace utf82macro "\226\135\181" "duarr"
+let _ = Hashtbl.replace utf82macro "\226\137\143" "HumpEqual"
+let _ = Hashtbl.replace utf82macro "\226\136\162" "angsph"
+let _ = Hashtbl.replace utf82macro "\226\136\163" "divides"
+let _ = Hashtbl.replace utf82macro "\226\137\144" "doteq"
+let _ = Hashtbl.replace utf82macro "\226\136\164" "ndivides"
+let _ = Hashtbl.replace utf82macro "\226\137\145" "eDot"
+let _ = Hashtbl.replace utf82macro "\226\137\146" "fallingdotseq"
+let _ = Hashtbl.replace utf82macro "\226\136\165" "parallel"
+let _ = Hashtbl.replace utf82macro "\226\138\128" "nprec"
+let _ = Hashtbl.replace utf82macro "\226\136\166" "nparallel"
+let _ = Hashtbl.replace utf82macro "\226\137\147" "risingdotseq"
+let _ = Hashtbl.replace utf82macro "\226\138\129" "nsucc"
+let _ = Hashtbl.replace utf82macro "\226\137\148" "coloneq"
+let _ = Hashtbl.replace utf82macro "\226\136\167" "land"
+let _ = Hashtbl.replace utf82macro "\226\138\130" "subset"
+let _ = Hashtbl.replace utf82macro "\226\136\168" "lor"
+let _ = Hashtbl.replace utf82macro "\226\137\149" "eqcolon"
+let _ = Hashtbl.replace utf82macro "????;" "longleftarrow"
+let _ = Hashtbl.replace utf82macro "\226\138\131" "supset"
+let _ = Hashtbl.replace utf82macro "\226\137\150" "eqcirc"
+let _ = Hashtbl.replace utf82macro "\226\136\169" "cap"
+let _ = Hashtbl.replace utf82macro "\226\138\132" "vnsub"
+let _ = Hashtbl.replace utf82macro "\226\135\189" "loarr"
+let _ = Hashtbl.replace utf82macro "\226\136\170" "cup"
+let _ = Hashtbl.replace utf82macro "\226\137\151" "cire"
+let _ = Hashtbl.replace utf82macro "\226\135\190" "roarr"
+let _ = Hashtbl.replace utf82macro "\226\138\133" "vnsup"
+let _ = Hashtbl.replace utf82macro "\226\136\171" "int"
+let _ = Hashtbl.replace utf82macro "\226\137\153" "wedgeq"
+let _ = Hashtbl.replace utf82macro "\226\138\134" "subseteq"
+let _ = Hashtbl.replace utf82macro "\226\136\172" "Int"
+let _ = Hashtbl.replace utf82macro "\226\135\191" "hoarr"
+let _ = Hashtbl.replace utf82macro "\226\137\154" "veeeq"
+let _ = Hashtbl.replace utf82macro "\226\138\135" "supseteq"
+let _ = Hashtbl.replace utf82macro "\226\136\173" "tint"
+let _ = Hashtbl.replace utf82macro "\226\138\136" "nsubseteqq"
+let _ = Hashtbl.replace utf82macro "\226\137\155" "easter"
+let _ = Hashtbl.replace utf82macro "\226\136\174" "oint"
+let _ = Hashtbl.replace utf82macro "\226\137\156" "trie"
+let _ = Hashtbl.replace utf82macro "\226\138\137" "nsupseteqq"
+let _ = Hashtbl.replace utf82macro "\226\136\175" "DoubleContourIntegral"
+let _ = Hashtbl.replace utf82macro "\226\137\157" "def"
+let _ = Hashtbl.replace utf82macro "\226\138\138" "subsetneqq"
+let _ = Hashtbl.replace utf82macro "\226\136\176" "Cconint"
+let _ = Hashtbl.replace utf82macro "\226\138\139" "supsetneqq"
+let _ = Hashtbl.replace utf82macro "\226\136\177" "cwint"
+let _ = Hashtbl.replace utf82macro "\226\137\159" "questeq"
+let _ = Hashtbl.replace utf82macro "\226\136\178" "cwconint"
+let _ = Hashtbl.replace utf82macro "\226\137\160" "neq"
+let _ = Hashtbl.replace utf82macro "\226\138\141" "cupdot"
+let _ = Hashtbl.replace utf82macro "\226\136\179" "CounterClockwiseContourIntegral"
+let _ = Hashtbl.replace utf82macro "\226\136\180" "Therefore"
+let _ = Hashtbl.replace utf82macro "\226\137\161" "equiv"
+let _ = Hashtbl.replace utf82macro "\226\138\142" "uplus"
+let _ = Hashtbl.replace utf82macro "\226\138\143" "SquareSubset"
+let _ = Hashtbl.replace utf82macro "\226\137\162" "NotCongruent"
+let _ = Hashtbl.replace utf82macro "\226\136\181" "Because"
+let _ = Hashtbl.replace utf82macro "\226\138\144" "SquareSuperset"
+let _ = Hashtbl.replace utf82macro "\226\136\182" "ratio"
+let _ = Hashtbl.replace utf82macro "\226\138\145" "SquareSubsetEqual"
+let _ = Hashtbl.replace utf82macro "\226\137\164" "leq"
+let _ = Hashtbl.replace utf82macro "\226\136\183" "Proportion"
+let _ = Hashtbl.replace utf82macro "\226\138\146" "sqsupseteq"
+let _ = Hashtbl.replace utf82macro "\226\137\165" "geq"
+let _ = Hashtbl.replace utf82macro "\226\136\184" "minusd"
+let _ = Hashtbl.replace utf82macro "\226\138\147" "sqcap"
+let _ = Hashtbl.replace utf82macro "\226\137\166" "LessFullEqual"
+let _ = Hashtbl.replace utf82macro "\226\139\128" "bigwedge"
+let _ = Hashtbl.replace utf82macro "\226\136\186" "mDDot"
+let _ = Hashtbl.replace utf82macro "\226\137\167" "GreaterFullEqual"
+let _ = Hashtbl.replace utf82macro "\226\139\129" "bigvee"
+let _ = Hashtbl.replace utf82macro "\226\138\148" "sqcup"
+let _ = Hashtbl.replace utf82macro "\226\137\168" "lneqq"
+let _ = Hashtbl.replace utf82macro "\226\136\187" "homtht"
+let _ = Hashtbl.replace utf82macro "\226\138\149" "oplus"
+let _ = Hashtbl.replace utf82macro "\226\139\130" "bigcap"
+let _ = Hashtbl.replace utf82macro "\226\136\188" "sim"
+let _ = Hashtbl.replace utf82macro "\226\137\169" "gneqq"
+let _ = Hashtbl.replace utf82macro "\226\138\150" "ominus"
+let _ = Hashtbl.replace utf82macro "\226\139\131" "bigcup"
+let _ = Hashtbl.replace utf82macro "\226\137\170" "ll"
+let _ = Hashtbl.replace utf82macro "\226\139\132" "diamond"
+let _ = Hashtbl.replace utf82macro "\226\138\151" "otimes"
+let _ = Hashtbl.replace utf82macro "\226\136\189" "bsim"
+let _ = Hashtbl.replace utf82macro "\226\139\133" "sdot"
+let _ = Hashtbl.replace utf82macro "\226\138\152" "osol"
+let _ = Hashtbl.replace utf82macro "\226\136\130\204\184" "npart"
+let _ = Hashtbl.replace utf82macro "\226\136\190" "mstpos"
+let _ = Hashtbl.replace utf82macro "\226\137\171" "gg"
+let _ = Hashtbl.replace utf82macro "\226\139\134" "star"
+let _ = Hashtbl.replace utf82macro "\226\138\153" "odot"
+let _ = Hashtbl.replace utf82macro "\226\137\172" "twixt"
+let _ = Hashtbl.replace utf82macro "\226\136\191" "acd"
+let _ = Hashtbl.replace utf82macro "\226\137\173" "NotCupCap"
+let _ = Hashtbl.replace utf82macro "\226\139\135" "divonx"
+let _ = Hashtbl.replace utf82macro "\226\138\154" "ocir"
+let _ = Hashtbl.replace utf82macro "\226\137\174" "nvlt"
+let _ = Hashtbl.replace utf82macro "\226\138\155" "oast"
+let _ = Hashtbl.replace utf82macro "\226\139\136" "bowtie"
+let _ = Hashtbl.replace utf82macro "\226\137\175" "nvgt"
+let _ = Hashtbl.replace utf82macro "\226\139\137" "ltimes"
+let _ = Hashtbl.replace utf82macro "\226\139\138" "rtimes"
+let _ = Hashtbl.replace utf82macro "\226\137\176" "nleq"
+let _ = Hashtbl.replace utf82macro "\226\138\157" "odash"
+let _ = Hashtbl.replace utf82macro "\226\137\177" "ngeq"
+let _ = Hashtbl.replace utf82macro "\226\139\139" "lthree"
+let _ = Hashtbl.replace utf82macro "\226\138\158" "plusb"
+let _ = Hashtbl.replace utf82macro "\226\139\140" "rthree"
+let _ = Hashtbl.replace utf82macro "\226\137\178" "lsim"
+let _ = Hashtbl.replace utf82macro "\226\138\159" "minusb"
+let _ = Hashtbl.replace utf82macro "\226\137\179" "gtrsim"
+let _ = Hashtbl.replace utf82macro "\226\138\160" "timesb"
+let _ = Hashtbl.replace utf82macro "\226\139\141" "bsime"
+let _ = Hashtbl.replace utf82macro "\226\137\180" "NotLessTilde"
+let _ = Hashtbl.replace utf82macro "\226\138\161" "sdotb"
+let _ = Hashtbl.replace utf82macro "\226\139\142" "cuvee"
+let _ = Hashtbl.replace utf82macro "\226\138\162" "vdash"
+let _ = Hashtbl.replace utf82macro "\226\137\181" "NotGreaterTilde"
+let _ = Hashtbl.replace utf82macro "\226\139\143" "cuwed"
+let _ = Hashtbl.replace utf82macro "\226\139\144" "Subset"
+let _ = Hashtbl.replace utf82macro "\226\137\182" "lg"
+let _ = Hashtbl.replace utf82macro "\226\138\163" "dashv"
+let _ = Hashtbl.replace utf82macro "\226\139\145" "Supset"
+let _ = Hashtbl.replace utf82macro "\226\137\183" "gtrless"
+let _ = Hashtbl.replace utf82macro "\226\138\164" "top"
+let _ = Hashtbl.replace utf82macro "\226\137\184" "ntlg"
+let _ = Hashtbl.replace utf82macro "\226\139\146" "Cap"
+let _ = Hashtbl.replace utf82macro "\226\138\165" "perp"
+let _ = Hashtbl.replace utf82macro "\226\137\185" "ntgl"
+let _ = Hashtbl.replace utf82macro "\226\139\147" "Cup"
+let _ = Hashtbl.replace utf82macro "\226\137\186" "prec"
+let _ = Hashtbl.replace utf82macro "\226\138\167" "models"
+let _ = Hashtbl.replace utf82macro "\226\139\148" "pitchfork"
+let _ = Hashtbl.replace utf82macro "\226\137\187" "succ"
+let _ = Hashtbl.replace utf82macro "\226\139\149" "epar"
+let _ = Hashtbl.replace utf82macro "\226\138\168" "vDash"
+let _ = Hashtbl.replace utf82macro "\226\138\169" "Vdash"
+let _ = Hashtbl.replace utf82macro "\226\137\188" "PrecedesSlantEqual"
+let _ = Hashtbl.replace utf82macro "\226\139\150" "ltdot"
+let _ = Hashtbl.replace utf82macro "\226\138\170" "Vvdash"
+let _ = Hashtbl.replace utf82macro "\226\137\189" "succeq"
+let _ = Hashtbl.replace utf82macro "\226\139\151" "gtrdot"
+let _ = Hashtbl.replace utf82macro "\226\138\171" "VDash"
+let _ = Hashtbl.replace utf82macro "\226\137\190" "scE"
+let _ = Hashtbl.replace utf82macro "\226\139\152" "Ll"
+let _ = Hashtbl.replace utf82macro "\226\137\191" "succsim"
+let _ = Hashtbl.replace utf82macro "\226\138\172" "nvdash"
+let _ = Hashtbl.replace utf82macro "\226\139\153" "ggg"
+let _ = Hashtbl.replace utf82macro "\226\140\134" "doublebarwedge"
+let _ = Hashtbl.replace utf82macro "\226\138\173" "nvDash"
+let _ = Hashtbl.replace utf82macro "\226\139\154" "LessEqualGreater"
+let _ = Hashtbl.replace utf82macro "\226\138\174" "nVdash"
+let _ = Hashtbl.replace utf82macro "\226\140\136" "lceil"
+let _ = Hashtbl.replace utf82macro "\226\139\155" "gtreqqless"
+let _ = Hashtbl.replace utf82macro "\226\140\137" "rceil"
+let _ = Hashtbl.replace utf82macro "\226\138\175" "nVDash"
+let _ = Hashtbl.replace utf82macro "\226\139\156" "eqslantless"
+let _ = Hashtbl.replace utf82macro "\226\138\176" "prurel"
+let _ = Hashtbl.replace utf82macro "\226\140\138" "lfloor"
+let _ = Hashtbl.replace utf82macro "\226\139\157" "eqslantgtr"
+let _ = Hashtbl.replace utf82macro "\226\140\139" "rfloor"
+let _ = Hashtbl.replace utf82macro "\226\139\158" "curlyeqprec"
+let _ = Hashtbl.replace utf82macro "\226\138\178" "vltri"
+let _ = Hashtbl.replace utf82macro "\226\140\140" "drcrop"
+let _ = Hashtbl.replace utf82macro "\226\139\159" "curlyeqsucc"
+let _ = Hashtbl.replace utf82macro "\226\138\179" "vrtri"
+let _ = Hashtbl.replace utf82macro "\226\139\160" "nprcue"
+let _ = Hashtbl.replace utf82macro "\226\140\141" "dlcrop"
+let _ = Hashtbl.replace utf82macro "\226\140\142" "urcrop"
+let _ = Hashtbl.replace utf82macro "\226\139\161" "nsccue"
+let _ = Hashtbl.replace utf82macro "\226\138\180" "trianglelefteq"
+let _ = Hashtbl.replace utf82macro "\226\140\143" "ulcrop"
+let _ = Hashtbl.replace utf82macro "\226\138\181" "trianglerighteq"
+let _ = Hashtbl.replace utf82macro "\226\134\157\204\184" "nrarrw"
+let _ = Hashtbl.replace utf82macro "\226\139\162" "nsqsube"
+let _ = Hashtbl.replace utf82macro "\226\138\182" "origof"
+let _ = Hashtbl.replace utf82macro "\226\139\163" "nsqsupe"
+let _ = Hashtbl.replace utf82macro "\226\140\144" "bnot"
+let _ = Hashtbl.replace utf82macro "\226\138\183" "imof"
+let _ = Hashtbl.replace utf82macro "\226\140\146" "profline"
+let _ = Hashtbl.replace utf82macro "\226\138\184" "mumap"
+let _ = Hashtbl.replace utf82macro "\226\140\147" "profsurf"
+let _ = Hashtbl.replace utf82macro "\226\139\166" "lnsim"
+let _ = Hashtbl.replace utf82macro "\226\138\185" "hercon"
+let _ = Hashtbl.replace utf82macro "\226\138\186" "intercal"
+let _ = Hashtbl.replace utf82macro "\226\139\167" "gnsim"
+let _ = Hashtbl.replace utf82macro "\226\138\187" "veebar"
+let _ = Hashtbl.replace utf82macro "\226\140\149" "telrec"
+let _ = Hashtbl.replace utf82macro "\226\139\168" "prnsim"
+let _ = Hashtbl.replace utf82macro "\226\140\150" "target"
+let _ = Hashtbl.replace utf82macro "\226\139\169" "succnsim"
+let _ = Hashtbl.replace utf82macro "\226\138\188" "barwedge"
+let _ = Hashtbl.replace utf82macro "\226\139\170" "ntriangleleft"
+let _ = Hashtbl.replace utf82macro "\226\138\189" "barvee"
+let _ = Hashtbl.replace utf82macro "\226\138\190" "vangrt"
+let _ = Hashtbl.replace utf82macro "\226\139\171" "ntriangleright"
+let _ = Hashtbl.replace utf82macro "\226\139\172" "ntrianglelefteq"
+let _ = Hashtbl.replace utf82macro "\226\138\191" "lrtri"
+let _ = Hashtbl.replace utf82macro "\226\139\173" "ntrianglerighteq"
+let _ = Hashtbl.replace utf82macro "\226\139\174" "vdots"
+let _ = Hashtbl.replace utf82macro "\226\140\156" "ulcorner"
+let _ = Hashtbl.replace utf82macro "\226\139\175" "cdots"
+let _ = Hashtbl.replace utf82macro "\226\139\176" "utdot"
+let _ = Hashtbl.replace utf82macro "\226\140\157" "urcorner"
+let _ = Hashtbl.replace utf82macro "\226\139\177" "ddots"
+let _ = Hashtbl.replace utf82macro "\226\140\158" "llcorner"
+let _ = Hashtbl.replace utf82macro "\226\140\159" "lrcorner"
+let _ = Hashtbl.replace utf82macro "\226\139\178" "disin"
+let _ = Hashtbl.replace utf82macro "\226\139\179" "isinsv"
+let _ = Hashtbl.replace utf82macro "\226\139\180" "isins"
+let _ = Hashtbl.replace utf82macro "\226\139\181" "isindot"
+let _ = Hashtbl.replace utf82macro "\226\140\162" "frown"
+let _ = Hashtbl.replace utf82macro "\226\140\163" "smile"
+let _ = Hashtbl.replace utf82macro "\226\139\182" "notinvc"
+let _ = Hashtbl.replace utf82macro "\226\139\183" "notinvb"
+let _ = Hashtbl.replace utf82macro "\226\139\185" "isinE"
+let _ = Hashtbl.replace utf82macro "\226\139\186" "nisd"
+let _ = Hashtbl.replace utf82macro "\226\139\187" "xnis"
+let _ = Hashtbl.replace utf82macro "\226\139\188" "nis"
+let _ = Hashtbl.replace utf82macro "\226\140\169" "langle"
+let _ = Hashtbl.replace utf82macro "\226\140\170" "rangle"
+let _ = Hashtbl.replace utf82macro "\226\139\189" "notnivc"
+let _ = Hashtbl.replace utf82macro "\226\139\190" "notnivb"
+let _ = Hashtbl.replace utf82macro "\226\140\173" "cylcty"
+let _ = Hashtbl.replace utf82macro "\226\140\174" "profalar"
+let _ = Hashtbl.replace utf82macro "\226\166\157\239\184\128" "angrtvb"
+let _ = Hashtbl.replace utf82macro "\226\140\182" "topbot"
+let _ = Hashtbl.replace utf82macro "\226\140\189" "ovbar"
+let _ = Hashtbl.replace utf82macro "\226\140\191" "solbar"
+let _ = Hashtbl.replace utf82macro "\226\141\188" "angzarr"
+let _ = Hashtbl.replace utf82macro "\226\139\173\204\184" "nvrtrie"
+let _ = Hashtbl.replace utf82macro "\226\142\176" "lmoustache"
+let _ = Hashtbl.replace utf82macro "\226\142\177" "rmoustache"
+let _ = Hashtbl.replace utf82macro "\226\142\180" "tbrk"
+let _ = Hashtbl.replace utf82macro "\226\142\181" "UnderBracket"
+let _ = Hashtbl.replace utf82macro "\226\137\139\204\184" "napid"
+let _ = Hashtbl.replace utf82macro "\226\144\163" "blank"
+let _ = Hashtbl.replace utf82macro "\226\138\131/" "suphsol"
+let _ = Hashtbl.replace utf82macro "\226\146\162\204\184" "NotNestedGreaterGreater"
+let _ = Hashtbl.replace utf82macro "\226\147\136" "oS"
+let _ = Hashtbl.replace utf82macro "\227\128\138" "Lang"
+let _ = Hashtbl.replace utf82macro "\227\128\139" "Rang"
+let _ = Hashtbl.replace utf82macro "\226\148\128" "HorizontalLine"
+let _ = Hashtbl.replace utf82macro "\226\136\166\239\184\128" "nspar"
+let _ = Hashtbl.replace utf82macro "\227\128\148" "lbbrk"
+let _ = Hashtbl.replace utf82macro "\227\128\149" "rbbrk"
+let _ = Hashtbl.replace utf82macro "\226\148\130" "boxv"
+let _ = Hashtbl.replace utf82macro "\227\128\152" "lopar"
+let _ = Hashtbl.replace utf82macro "\227\128\153" "ropar"
+let _ = Hashtbl.replace utf82macro "\227\128\154" "lobrk"
+let _ = Hashtbl.replace utf82macro "\227\128\155" "robrk"
+let _ = Hashtbl.replace utf82macro "\226\148\140" "boxdr"
+let _ = Hashtbl.replace utf82macro "\226\148\144" "boxdl"
+let _ = Hashtbl.replace utf82macro "\226\148\148" "boxur"
+let _ = Hashtbl.replace utf82macro "\226\148\152" "boxul"
+let _ = Hashtbl.replace utf82macro "\226\148\156" "boxvr"
+let _ = Hashtbl.replace utf82macro "\226\149\144" "boxH"
+let _ = Hashtbl.replace utf82macro "\226\148\164" "boxvl"
+let _ = Hashtbl.replace utf82macro "\226\149\145" "boxV"
+let _ = Hashtbl.replace utf82macro "\226\149\146" "boxdR"
+let _ = Hashtbl.replace utf82macro "\226\150\128" "uhblk"
+let _ = Hashtbl.replace utf82macro "\226\149\147" "boxDr"
+let _ = Hashtbl.replace utf82macro "\226\149\148" "boxDR"
+let _ = Hashtbl.replace utf82macro "\226\137\168\239\184\128" "lvnE"
+let _ = Hashtbl.replace utf82macro "\226\149\149" "boxdL"
+let _ = Hashtbl.replace utf82macro "\226\149\150" "boxDl"
+let _ = Hashtbl.replace utf82macro "\226\150\132" "lhblk"
+let _ = Hashtbl.replace utf82macro "\226\149\151" "boxDL"
+let _ = Hashtbl.replace utf82macro "\226\149\152" "boxuR"
+let _ = Hashtbl.replace utf82macro "\226\149\153" "boxUr"
+let _ = Hashtbl.replace utf82macro "\226\148\172" "boxhd"
+let _ = Hashtbl.replace utf82macro "\226\149\154" "boxUR"
+let _ = Hashtbl.replace utf82macro "\226\149\155" "boxuL"
+let _ = Hashtbl.replace utf82macro "\226\150\136" "block"
+let _ = Hashtbl.replace utf82macro "\226\149\156" "boxUl"
+let _ = Hashtbl.replace utf82macro "\226\149\157" "boxUL"
+let _ = Hashtbl.replace utf82macro "\226\149\158" "boxvR"
+let _ = Hashtbl.replace utf82macro "\226\149\159" "boxVr"
+let _ = Hashtbl.replace utf82macro "\226\149\160" "boxVR"
+let _ = Hashtbl.replace utf82macro "\226\149\161" "boxvL"
+let _ = Hashtbl.replace utf82macro "\226\148\180" "boxhu"
+let _ = Hashtbl.replace utf82macro "\226\149\162" "boxVl"
+let _ = Hashtbl.replace utf82macro "\226\149\163" "boxVL"
+let _ = Hashtbl.replace utf82macro "\226\149\164" "boxHd"
+let _ = Hashtbl.replace utf82macro "\226\150\145" "blk14"
+let _ = Hashtbl.replace utf82macro "\226\149\165" "boxhD"
+let _ = Hashtbl.replace utf82macro "\226\150\146" "blk12"
+let _ = Hashtbl.replace utf82macro "\226\149\166" "boxHD"
+let _ = Hashtbl.replace utf82macro "\226\150\147" "blk34"
+let _ = Hashtbl.replace utf82macro "\226\149\167" "boxHu"
+let _ = Hashtbl.replace utf82macro "\226\149\168" "boxhU"
+let _ = Hashtbl.replace utf82macro "\226\151\130" "ltrif"
+let _ = Hashtbl.replace utf82macro "\226\151\131" "triangleleft"
+let _ = Hashtbl.replace utf82macro "\226\148\188" "boxvh"
+let _ = Hashtbl.replace utf82macro "\226\149\169" "boxHU"
+let _ = Hashtbl.replace utf82macro "\226\149\170" "boxvH"
+let _ = Hashtbl.replace utf82macro "\226\149\171" "boxVh"
+let _ = Hashtbl.replace utf82macro "\226\149\172" "boxVH"
+let _ = Hashtbl.replace utf82macro "\226\151\138" "lozenge"
+let _ = Hashtbl.replace utf82macro "\226\151\139" "cir"
+let _ = Hashtbl.replace utf82macro "\226\170\172\239\184\128" "smtes"
+let _ = Hashtbl.replace utf82macro "\226\150\161" "Square"
+let _ = Hashtbl.replace utf82macro "\226\140\132\239\184\128" "ShortDownArrow"
+let _ = Hashtbl.replace utf82macro "\226\150\170" "squf"
+let _ = Hashtbl.replace utf82macro "\226\152\133" "starf"
+let _ = Hashtbl.replace utf82macro "\226\150\173" "rect"
+let _ = Hashtbl.replace utf82macro "\226\150\174" "marker"
+let _ = Hashtbl.replace utf82macro "\226\150\179" "bigtriangleup"
+let _ = Hashtbl.replace utf82macro "\226\152\142" "phone"
+let _ = Hashtbl.replace utf82macro "\226\150\180" "utrif"
+let _ = Hashtbl.replace utf82macro "\226\150\181" "triangle"
+let _ = Hashtbl.replace utf82macro "\226\150\184" "rtrif"
+let _ = Hashtbl.replace utf82macro "\226\150\185" "triangleright"
+let _ = Hashtbl.replace utf82macro "\226\153\128" "female"
+let _ = Hashtbl.replace utf82macro "\226\153\130" "male"
+let _ = Hashtbl.replace utf82macro "\226\150\189" "bigtriangledown"
+let _ = Hashtbl.replace utf82macro "\226\150\190" "dtrif"
+let _ = Hashtbl.replace utf82macro "\226\151\172" "tridot"
+let _ = Hashtbl.replace utf82macro "\226\128\137\226\128\138\226\128\138" "ThickSpace"
+let _ = Hashtbl.replace utf82macro "\226\150\191" "triangledown"
+let _ = Hashtbl.replace utf82macro "\226\151\175" "bigcirc"
+let _ = Hashtbl.replace utf82macro "\226\137\177\226\131\165" "NotGreaterEqual"
+let _ = Hashtbl.replace utf82macro "\226\151\184" "ultri"
+let _ = Hashtbl.replace utf82macro "=\226\131\165" "bne"
+let _ = Hashtbl.replace utf82macro "\226\151\185" "urtri"
+let _ = Hashtbl.replace utf82macro "\226\151\186" "lltri"
+let _ = Hashtbl.replace utf82macro "\226\151\189" "EmptySmallSquare"
+let _ = Hashtbl.replace utf82macro "\226\151\190" "FilledSmallSquare"
+let _ = Hashtbl.replace utf82macro "\226\153\160" "spadesuit"
+let _ = Hashtbl.replace utf82macro "\226\153\161" "heartsuit"
+let _ = Hashtbl.replace utf82macro "\226\153\162" "diamondsuit"
+let _ = Hashtbl.replace utf82macro "\226\153\163" "clubsuit"
+let _ = Hashtbl.replace utf82macro "\226\153\166" "diams"
+let _ = Hashtbl.replace utf82macro "ker" "ker"
+let _ = Hashtbl.replace utf82macro "\226\153\170" "sung"
+let _ = Hashtbl.replace utf82macro "\226\153\173" "flat"
+let _ = Hashtbl.replace utf82macro "\226\153\174" "natural"
+let _ = Hashtbl.replace utf82macro "\226\153\175" "sharp"
+let _ = Hashtbl.replace utf82macro "\226\156\147" "checkmark"
+let _ = Hashtbl.replace utf82macro "\226\156\151" "cross"
+let _ = Hashtbl.replace utf82macro "\226\134\146\239\184\128" "srarr"
+let _ = Hashtbl.replace utf82macro "\226\156\160" "maltese"
+let _ = Hashtbl.replace utf82macro "\226\157\152" "VerticalSeparator"
+let _ = Hashtbl.replace utf82macro "\226\156\182" "sext"
+let _ = Hashtbl.replace utf82macro "\226\138\143\204\184" "NotSquareSubset"
+let _ = Hashtbl.replace utf82macro "\226\136\150\239\184\128" "ssetmn"
+let _ = Hashtbl.replace utf82macro "\226\136\164\239\184\128" "nsmid"
+let _ = Hashtbl.replace utf82macro "\226\164\133" "Map"
+let _ = Hashtbl.replace utf82macro "\226\164\140" "lbarr"
+let _ = Hashtbl.replace utf82macro "\226\164\141" "rbarr"
+let _ = Hashtbl.replace utf82macro "\226\164\142" "lBarr"
+let _ = Hashtbl.replace utf82macro "\226\164\143" "rBarr"
+let _ = Hashtbl.replace utf82macro "\226\164\144" "RBarr"
+let _ = Hashtbl.replace utf82macro "\226\164\145" "DDotrahd"
+let _ = Hashtbl.replace utf82macro "\226\164\146" "UpArrowBar"
+let _ = Hashtbl.replace utf82macro "\226\138\147\239\184\128" "sqcaps"
+let _ = Hashtbl.replace utf82macro "\226\164\147" "DownArrowBar"
+let _ = Hashtbl.replace utf82macro "\226\164\150" "Rarrtl"
+let _ = Hashtbl.replace utf82macro "exp" "exp"
+let _ = Hashtbl.replace utf82macro "\226\165\133" "rarrpl"
+let _ = Hashtbl.replace utf82macro "tanh" "tanh"
+let _ = Hashtbl.replace utf82macro "\226\164\153" "latail"
+let _ = Hashtbl.replace utf82macro "\226\164\155" "lAtail"
+let _ = Hashtbl.replace utf82macro "\226\165\136" "harrcir"
+let _ = Hashtbl.replace utf82macro "arcsin" "arcsin"
+let _ = Hashtbl.replace utf82macro "\226\165\137" "Uarrocir"
+let _ = Hashtbl.replace utf82macro "\226\164\156" "rAtail"
+let _ = Hashtbl.replace utf82macro "\226\137\129\204\184" "nvsim"
+let _ = Hashtbl.replace utf82macro "\226\165\138" "lurdshar"
+let _ = Hashtbl.replace utf82macro "\226\164\157" "larrfs"
+let _ = Hashtbl.replace utf82macro "\226\164\158" "rarrfs"
+let _ = Hashtbl.replace utf82macro "\226\165\139" "ldrushar"
+let _ = Hashtbl.replace utf82macro "\226\164\159" "larrbfs"
+let _ = Hashtbl.replace utf82macro "\226\164\160" "rarrbfs"
+let _ = Hashtbl.replace utf82macro "\226\165\142" "LeftRightVector"
+let _ = Hashtbl.replace utf82macro "\226\165\143" "RightUpDownVector"
+let _ = Hashtbl.replace utf82macro "\226\164\163" "nwarhk"
+let _ = Hashtbl.replace utf82macro "\226\165\144" "DownLeftRightVector"
+let _ = Hashtbl.replace utf82macro "\226\164\164" "nearhk"
+let _ = Hashtbl.replace utf82macro "\226\165\145" "LeftUpDownVector"
+let _ = Hashtbl.replace utf82macro "\226\165\146" "LeftVectorBar"
+let _ = Hashtbl.replace utf82macro "\226\164\165" "searhk"
+let _ = Hashtbl.replace utf82macro "\226\165\147" "RightVectorBar"
+let _ = Hashtbl.replace utf82macro "\226\164\166" "swarhk"
+let _ = Hashtbl.replace utf82macro "\226\165\148" "RightUpVectorBar"
+let _ = Hashtbl.replace utf82macro "\226\164\167" "nwnear"
+let _ = Hashtbl.replace utf82macro "\226\165\149" "RightDownVectorBar"
+let _ = Hashtbl.replace utf82macro "\226\164\168" "toea"
+let _ = Hashtbl.replace utf82macro "\226\164\169" "tosa"
+let _ = Hashtbl.replace utf82macro "\226\165\150" "DownLeftVectorBar"
+let _ = Hashtbl.replace utf82macro "\226\164\170" "swnwar"
+let _ = Hashtbl.replace utf82macro "\226\165\151" "DownRightVectorBar"
+let _ = Hashtbl.replace utf82macro "\226\165\152" "LeftUpVectorBar"
+let _ = Hashtbl.replace utf82macro "\226\165\153" "LeftDownVectorBar"
+let _ = Hashtbl.replace utf82macro "\226\165\154" "LeftTeeVector"
+let _ = Hashtbl.replace utf82macro "\226\165\155" "RightTeeVector"
+let _ = Hashtbl.replace utf82macro "\226\165\156" "RightUpTeeVector"
+let _ = Hashtbl.replace utf82macro "\226\165\157" "RightDownTeeVector"
+let _ = Hashtbl.replace utf82macro "\226\139\152\204\184" "nLl"
+let _ = Hashtbl.replace utf82macro "\226\166\139" "lbrke"
+let _ = Hashtbl.replace utf82macro "\226\165\158" "DownLeftTeeVector"
+let _ = Hashtbl.replace utf82macro "\226\166\140" "rbrke"
+let _ = Hashtbl.replace utf82macro "\226\165\159" "DownRightTeeVector"
+let _ = Hashtbl.replace utf82macro "\226\164\179" "rarrc"
+let _ = Hashtbl.replace utf82macro "\226\165\160" "LeftUpTeeVector"
+let _ = Hashtbl.replace utf82macro "\226\166\141" "lbrkslu"
+let _ = Hashtbl.replace utf82macro "\226\166\142" "rbrksld"
+let _ = Hashtbl.replace utf82macro "\226\165\161" "LeftDownTeeVector"
+let _ = Hashtbl.replace utf82macro "\226\165\162" "lHar"
+let _ = Hashtbl.replace utf82macro "\226\166\143" "lbrksld"
+let _ = Hashtbl.replace utf82macro "\226\164\181" "cudarrr"
+let _ = Hashtbl.replace utf82macro "sinh" "sinh"
+let _ = Hashtbl.replace utf82macro "\226\165\163" "uHar"
+let _ = Hashtbl.replace utf82macro "\226\166\144" "rbrkslu"
+let _ = Hashtbl.replace utf82macro "\226\164\182" "ldca"
+let _ = Hashtbl.replace utf82macro "\226\165\164" "rHar"
+let _ = Hashtbl.replace utf82macro "\226\164\183" "rdca"
+let _ = Hashtbl.replace utf82macro "\226\166\145" "langd"
+let _ = Hashtbl.replace utf82macro "\226\166\146" "rangd"
+let _ = Hashtbl.replace utf82macro "\226\165\165" "dHar"
+let _ = Hashtbl.replace utf82macro "\226\164\184" "cudarrl"
+let _ = Hashtbl.replace utf82macro "\226\167\128" "olt"
+let _ = Hashtbl.replace utf82macro "\226\136\137\204\184" "notinva"
+let _ = Hashtbl.replace utf82macro "\226\165\166" "luruhar"
+let _ = Hashtbl.replace utf82macro "\226\166\147" "lparlt"
+let _ = Hashtbl.replace utf82macro "\226\164\185" "larrpl"
+let _ = Hashtbl.replace utf82macro "\226\166\148" "rpargt"
+let _ = Hashtbl.replace utf82macro "\226\167\129" "ogt"
+let _ = Hashtbl.replace utf82macro "\226\165\167" "ldrdhar"
+let _ = Hashtbl.replace utf82macro "\226\165\168" "ruluhar"
+let _ = Hashtbl.replace utf82macro "\226\166\149" "gtlPar"
+let _ = Hashtbl.replace utf82macro "\226\167\130" "cirscir"
+let _ = Hashtbl.replace utf82macro "\226\165\169" "rdldhar"
+let _ = Hashtbl.replace utf82macro "\226\166\150" "ltrPar"
+let _ = Hashtbl.replace utf82macro "\226\164\188" "curarrm"
+let _ = Hashtbl.replace utf82macro "\226\167\131" "cirE"
+let _ = Hashtbl.replace utf82macro "\226\137\161\226\131\165" "bnequiv"
+let _ = Hashtbl.replace utf82macro "\226\167\132" "solb"
+let _ = Hashtbl.replace utf82macro "\226\165\170" "lharul"
+let _ = Hashtbl.replace utf82macro "\226\164\189" "cularrp"
+let _ = Hashtbl.replace utf82macro "\226\165\171" "llhard"
+let _ = Hashtbl.replace utf82macro "\226\167\133" "bsolb"
+let _ = Hashtbl.replace utf82macro "\226\165\172" "rharul"
+let _ = Hashtbl.replace utf82macro "\226\166\154" "vzigzag"
+let _ = Hashtbl.replace utf82macro "\226\165\173" "lrhard"
+let _ = Hashtbl.replace utf82macro "\226\165\174" "UpEquilibrium"
+let _ = Hashtbl.replace utf82macro "\226\165\175" "ReverseUpEquilibrium"
+let _ = Hashtbl.replace utf82macro "\226\167\137" "boxbox"
+let _ = Hashtbl.replace utf82macro "\226\165\176" "RoundImplies"
+let _ = Hashtbl.replace utf82macro "\226\166\157" "angrtvbd"
+let _ = Hashtbl.replace utf82macro "\226\165\177" "erarr"
+let _ = Hashtbl.replace utf82macro "\226\165\178" "simrarr"
+let _ = Hashtbl.replace utf82macro "\226\167\141" "trisb"
+let _ = Hashtbl.replace utf82macro "\226\165\179" "larrsim"
+let _ = Hashtbl.replace utf82macro "\226\167\142" "rtriltri"
+let _ = Hashtbl.replace utf82macro "\226\165\180" "rarrsim"
+let _ = Hashtbl.replace utf82macro "\226\165\181" "rarrap"
+let _ = Hashtbl.replace utf82macro "\226\167\143" "LeftTriangleBar"
+let _ = Hashtbl.replace utf82macro "\226\167\144" "RightTriangleBar"
+let _ = Hashtbl.replace utf82macro "\226\165\182" "ltlarr"
+let _ = Hashtbl.replace utf82macro "\226\166\164" "ange"
+let _ = Hashtbl.replace utf82macro "\226\166\165" "range"
+let _ = Hashtbl.replace utf82macro "\226\165\184" "gtrarr"
+let _ = Hashtbl.replace utf82macro "\226\165\185" "subrarr"
+let _ = Hashtbl.replace utf82macro "\226\166\166" "dwangle"
+let _ = Hashtbl.replace utf82macro "\226\166\167" "uwangle"
+let _ = Hashtbl.replace utf82macro "\226\165\187" "suplarr"
+let _ = Hashtbl.replace utf82macro "\226\166\168" "angmsdaa"
+let _ = Hashtbl.replace utf82macro "\226\165\188" "lfisht"
+let _ = Hashtbl.replace utf82macro "\226\166\169" "angmsdab"
+let _ = Hashtbl.replace utf82macro "\226\165\189" "rfisht"
+let _ = Hashtbl.replace utf82macro "\226\166\170" "angmsdac"
+let _ = Hashtbl.replace utf82macro "\226\165\190" "ufisht"
+let _ = Hashtbl.replace utf82macro "\226\166\171" "angmsdad"
+let _ = Hashtbl.replace utf82macro "\226\165\191" "dfisht"
+let _ = Hashtbl.replace utf82macro "\226\166\172" "angmsdae"
+let _ = Hashtbl.replace utf82macro "\226\167\154" "race"
+let _ = Hashtbl.replace utf82macro "\226\166\173" "angmsdaf"
+let _ = Hashtbl.replace utf82macro "\226\166\174" "angmsdag"
+let _ = Hashtbl.replace utf82macro "\226\167\155" "acE"
+let _ = Hashtbl.replace utf82macro "\226\167\156" "iinfin"
+let _ = Hashtbl.replace utf82macro "\226\166\175" "angmsdah"
+let _ = Hashtbl.replace utf82macro "\226\166\176" "bemptyv"
+let _ = Hashtbl.replace utf82macro "\226\167\158" "nvinfin"
+let _ = Hashtbl.replace utf82macro "\226\166\177" "demptyv"
+let _ = Hashtbl.replace utf82macro "\226\168\140" "qint"
+let _ = Hashtbl.replace utf82macro "\226\166\178" "cemptyv"
+let _ = Hashtbl.replace utf82macro "\226\166\179" "raemptyv"
+let _ = Hashtbl.replace utf82macro "\226\168\141" "fpartint"
+let _ = Hashtbl.replace utf82macro "\226\166\180" "laemptyv"
+let _ = Hashtbl.replace utf82macro "\226\166\181" "ohbar"
+let _ = Hashtbl.replace utf82macro "\226\166\182" "omid"
+let _ = Hashtbl.replace utf82macro "\226\167\163" "eparsl"
+let _ = Hashtbl.replace utf82macro "\226\168\144" "cirfnint"
+let _ = Hashtbl.replace utf82macro "\226\167\164" "smeparsl"
+let _ = Hashtbl.replace utf82macro "\226\166\183" "opar"
+let _ = Hashtbl.replace utf82macro "\226\168\145" "awint"
+let _ = Hashtbl.replace utf82macro "\226\168\146" "rppolint"
+let _ = Hashtbl.replace utf82macro "\226\167\165" "eqvparsl"
+let _ = Hashtbl.replace utf82macro "\226\168\147" "scpolint"
+let _ = Hashtbl.replace utf82macro "\226\166\185" "operp"
+let _ = Hashtbl.replace utf82macro "\226\169\128" "capdot"
+let _ = Hashtbl.replace utf82macro "\226\168\148" "npolint"
+let _ = Hashtbl.replace utf82macro "\226\168\149" "pointint"
+let _ = Hashtbl.replace utf82macro "\226\166\187" "olcross"
+let _ = Hashtbl.replace utf82macro "\226\169\130" "ncup"
+let _ = Hashtbl.replace utf82macro "\226\168\150" "quatint"
+let _ = Hashtbl.replace utf82macro "\226\166\188" "odsold"
+let _ = Hashtbl.replace utf82macro "\226\169\131" "ncap"
+let _ = Hashtbl.replace utf82macro "\226\168\151" "intlarhk"
+let _ = Hashtbl.replace utf82macro "\226\169\132" "capand"
+let _ = Hashtbl.replace utf82macro "\226\166\190" "olcir"
+let _ = Hashtbl.replace utf82macro "\226\169\133" "cupor"
+let _ = Hashtbl.replace utf82macro "\226\167\171" "lozf"
+let _ = Hashtbl.replace utf82macro "\226\166\191" "ofcir"
+let _ = Hashtbl.replace utf82macro "\226\169\134" "cupcap"
+let _ = Hashtbl.replace utf82macro "\226\169\135" "capcup"
+let _ = Hashtbl.replace utf82macro "\226\169\136" "cupbrcap"
+let _ = Hashtbl.replace utf82macro "\226\169\137" "capbrcup"
+let _ = Hashtbl.replace utf82macro "\226\169\138" "cupcup"
+let _ = Hashtbl.replace utf82macro "\226\169\139" "capcap"
+let _ = Hashtbl.replace utf82macro "\226\169\140" "ccups"
+let _ = Hashtbl.replace utf82macro "\226\169\141" "ccaps"
+let _ = Hashtbl.replace utf82macro "\226\167\180" "RuleDelayed"
+let _ = Hashtbl.replace utf82macro "\226\168\162" "pluscir"
+let _ = Hashtbl.replace utf82macro "\226\168\163" "plusacir"
+let _ = Hashtbl.replace utf82macro "\226\167\182" "dsol"
+let _ = Hashtbl.replace utf82macro "\226\169\144" "ccupssm"
+let _ = Hashtbl.replace utf82macro "\226\168\164" "simplus"
+let _ = Hashtbl.replace utf82macro "\226\168\165" "plusdu"
+let _ = Hashtbl.replace utf82macro "\226\168\166" "plussim"
+let _ = Hashtbl.replace utf82macro "\226\170\128" "gesdot"
+let _ = Hashtbl.replace utf82macro "\226\169\147" "And"
+let _ = Hashtbl.replace utf82macro "\226\168\167" "plustwo"
+let _ = Hashtbl.replace utf82macro "\226\169\148" "Or"
+let _ = Hashtbl.replace utf82macro "\226\170\129" "lesdoto"
+let _ = Hashtbl.replace utf82macro "\226\170\130" "gesdoto"
+let _ = Hashtbl.replace utf82macro "\226\169\149" "andand"
+let _ = Hashtbl.replace utf82macro "\226\169\150" "oror"
+let _ = Hashtbl.replace utf82macro "\226\168\169" "mcomma"
+let _ = Hashtbl.replace utf82macro "\226\170\131" "lesdotor"
+let _ = Hashtbl.replace utf82macro "\226\169\151" "orslope"
+let _ = Hashtbl.replace utf82macro "\226\168\170" "minusdu"
+let _ = Hashtbl.replace utf82macro "\226\170\132" "gesdotol"
+let _ = Hashtbl.replace utf82macro "\226\169\152" "andslope"
+let _ = Hashtbl.replace utf82macro "\226\168\173" "loplus"
+let _ = Hashtbl.replace utf82macro "\226\169\154" "andv"
+let _ = Hashtbl.replace utf82macro "\226\168\174" "roplus"
+let _ = Hashtbl.replace utf82macro "\226\169\155" "orv"
+let _ = Hashtbl.replace utf82macro "\226\170\137" "lnapprox"
+let _ = Hashtbl.replace utf82macro "\226\168\175" "Cross"
+let _ = Hashtbl.replace utf82macro "\226\169\156" "andd"
+let _ = Hashtbl.replace utf82macro "\226\168\176" "timesd"
+let _ = Hashtbl.replace utf82macro "\226\169\157" "ord"
+let _ = Hashtbl.replace utf82macro "\226\170\138" "gnapprox"
+let _ = Hashtbl.replace utf82macro "\226\168\177" "timesbar"
+let _ = Hashtbl.replace utf82macro "\226\169\159" "wedbar"
+let _ = Hashtbl.replace utf82macro "\226\168\179" "smashp"
+let _ = Hashtbl.replace utf82macro "\226\170\141" "lsime"
+let _ = Hashtbl.replace utf82macro "j\239\184\128" "jmath"
+let _ = Hashtbl.replace utf82macro "\226\168\180" "lotimes"
+let _ = Hashtbl.replace utf82macro "\226\170\142" "gsime"
+let _ = Hashtbl.replace utf82macro "\226\168\181" "rotimes"
+let _ = Hashtbl.replace utf82macro "\226\170\143" "lsimg"
+let _ = Hashtbl.replace utf82macro "\226\168\182" "otimesas"
+let _ = Hashtbl.replace utf82macro "\226\170\144" "gsiml"
+let _ = Hashtbl.replace utf82macro "\226\168\183" "Otimes"
+let _ = Hashtbl.replace utf82macro "\226\170\145" "lgE"
+let _ = Hashtbl.replace utf82macro "\226\168\184" "odiv"
+let _ = Hashtbl.replace utf82macro "\226\170\146" "glE"
+let _ = Hashtbl.replace utf82macro "\226\168\185" "triplus"
+let _ = Hashtbl.replace utf82macro "\226\171\128" "supplus"
+let _ = Hashtbl.replace utf82macro "\226\169\166" "sdote"
+let _ = Hashtbl.replace utf82macro "\226\170\147" "lesges"
+let _ = Hashtbl.replace utf82macro "\226\168\186" "triminus"
+let _ = Hashtbl.replace utf82macro "\226\171\129" "submult"
+let _ = Hashtbl.replace utf82macro "\226\170\148" "gesles"
+let _ = Hashtbl.replace utf82macro "\226\168\187" "tritime"
+let _ = Hashtbl.replace utf82macro "\226\171\130" "supmult"
+let _ = Hashtbl.replace utf82macro "\226\171\131" "subedot"
+let _ = Hashtbl.replace utf82macro "\226\168\188" "iprod"
+let _ = Hashtbl.replace utf82macro "\226\171\132" "supedot"
+let _ = Hashtbl.replace utf82macro "\226\169\170" "simdot"
+let _ = Hashtbl.replace utf82macro "\226\170\151" "elsdot"
+let _ = Hashtbl.replace utf82macro "\226\170\152" "egsdot"
+let _ = Hashtbl.replace utf82macro "\226\170\153" "el"
+let _ = Hashtbl.replace utf82macro "\226\168\191" "amalg"
+let _ = Hashtbl.replace utf82macro "\226\171\135" "subsim"
+let _ = Hashtbl.replace utf82macro "\226\170\154" "eg"
+let _ = Hashtbl.replace utf82macro "\226\169\173" "congdot"
+let _ = Hashtbl.replace utf82macro "\226\171\136" "supsim"
+let _ = Hashtbl.replace utf82macro "\226\169\175" "apacir"
+let _ = Hashtbl.replace utf82macro "\226\170\157" "siml"
+let _ = Hashtbl.replace utf82macro "\226\170\158" "simg"
+let _ = Hashtbl.replace utf82macro "\226\169\177" "eplus"
+let _ = Hashtbl.replace utf82macro "\226\170\159" "simlE"
+let _ = Hashtbl.replace utf82macro "\226\169\178" "pluse"
+let _ = Hashtbl.replace utf82macro "\226\170\160" "simgE"
+let _ = Hashtbl.replace utf82macro "\226\169\179" "Esim"
+let _ = Hashtbl.replace utf82macro "\226\170\161" "LessLess"
+let _ = Hashtbl.replace utf82macro "\226\169\180" "Colone"
+let _ = Hashtbl.replace utf82macro "\226\170\162" "GreaterGreater"
+let _ = Hashtbl.replace utf82macro "\226\169\181" "Equal"
+let _ = Hashtbl.replace utf82macro "\226\171\143" "csub"
+let _ = Hashtbl.replace utf82macro "\226\171\144" "csup"
+let _ = Hashtbl.replace utf82macro "\226\170\164" "glj"
+let _ = Hashtbl.replace utf82macro "\226\169\183" "eDDot"
+let _ = Hashtbl.replace utf82macro "\226\171\145" "csube"
+let _ = Hashtbl.replace utf82macro "\226\170\165" "gla"
+let _ = Hashtbl.replace utf82macro "\226\169\184" "equivDD"
+let _ = Hashtbl.replace utf82macro "\226\171\146" "csupe"
+let _ = Hashtbl.replace utf82macro "\226\171\147" "subsup"
+let _ = Hashtbl.replace utf82macro "\226\169\185" "ltcir"
+let _ = Hashtbl.replace utf82macro "\226\170\166" "ltcc"
+let _ = Hashtbl.replace utf82macro "\226\171\148" "supsub"
+let _ = Hashtbl.replace utf82macro "\226\169\186" "gtcir"
+let _ = Hashtbl.replace utf82macro "\226\170\167" "gtcc"
+let _ = Hashtbl.replace utf82macro "\226\171\149" "subsub"
+let _ = Hashtbl.replace utf82macro "\226\169\187" "ltquest"
+let _ = Hashtbl.replace utf82macro "\226\170\168" "lescc"
+let _ = Hashtbl.replace utf82macro "\226\171\150" "supsup"
+let _ = Hashtbl.replace utf82macro "\226\169\188" "gtquest"
+let _ = Hashtbl.replace utf82macro "\226\170\169" "gescc"
+let _ = Hashtbl.replace utf82macro "\226\171\151" "suphsub"
+let _ = Hashtbl.replace utf82macro "\226\170\170" "smt"
+let _ = Hashtbl.replace utf82macro "\226\169\189" "LessSlantEqual"
+let _ = Hashtbl.replace utf82macro "\226\171\152" "supdsub"
+let _ = Hashtbl.replace utf82macro "\226\134\144\239\184\128" "slarr"
+let _ = Hashtbl.replace utf82macro "\226\170\171" "lat"
+let _ = Hashtbl.replace utf82macro "\226\169\190" "GreaterSlantEqual"
+let _ = Hashtbl.replace utf82macro "\226\170\172" "smte"
+let _ = Hashtbl.replace utf82macro "\226\169\191" "lesdot"
+let _ = Hashtbl.replace utf82macro "\226\171\153" "forkv"
+let _ = Hashtbl.replace utf82macro "\226\171\154" "topfork"
+let _ = Hashtbl.replace utf82macro "\226\170\173" "late"
+let _ = Hashtbl.replace utf82macro "\226\171\155" "mlcp"
+let _ = Hashtbl.replace utf82macro "\226\170\174" "bumpE"
+let _ = Hashtbl.replace utf82macro "\226\170\175" "preceq"
+let _ = Hashtbl.replace utf82macro "\226\170\181" "prnE"
+let _ = Hashtbl.replace utf82macro "\226\170\182" "succneqq"
+let _ = Hashtbl.replace utf82macro "\226\171\164" "DoubleLeftTee"
+let _ = Hashtbl.replace utf82macro "\226\171\166" "Vdashl"
+let _ = Hashtbl.replace utf82macro "\226\171\167" "Barv"
+let _ = Hashtbl.replace utf82macro "\226\171\168" "vBar"
+let _ = Hashtbl.replace utf82macro "\226\170\187" "Pr"
+let _ = Hashtbl.replace utf82macro "\226\171\169" "vBarv"
+let _ = Hashtbl.replace utf82macro "\226\170\188" "Sc"
+let _ = Hashtbl.replace utf82macro "\226\170\189" "subdot"
+let _ = Hashtbl.replace utf82macro "\226\171\171" "Vbar"
+let _ = Hashtbl.replace utf82macro "\226\170\190" "supdot"
+let _ = Hashtbl.replace utf82macro "\226\170\191" "subplus"
+let _ = Hashtbl.replace utf82macro "\226\171\172" "Not"
+let _ = Hashtbl.replace utf82macro "\226\171\173" "bNot"
+let _ = Hashtbl.replace utf82macro "\226\171\174" "rnmid"
+let _ = Hashtbl.replace utf82macro "\226\171\175" "cirmid"
+let _ = Hashtbl.replace utf82macro "\226\171\176" "midcir"
+let _ = Hashtbl.replace utf82macro "\226\171\177" "topcir"
+let _ = Hashtbl.replace utf82macro "\226\171\178" "nhpar"
+let _ = Hashtbl.replace utf82macro "\226\171\179" "parsim"
+let _ = Hashtbl.replace utf82macro "\226\128\137\239\184\128" "NegativeThinSpace"
+let _ = Hashtbl.replace utf82macro "arctan" "arctan"
+let _ = Hashtbl.replace utf82macro "\226\137\136\239\184\128" "thkap"
+let _ = Hashtbl.replace utf82macro "lim" "lim"
+let _ = Hashtbl.replace utf82macro "\226\136\169\239\184\128" "caps"
+let _ = Hashtbl.replace utf82macro "\226\138\138\239\184\128" "vsubnE"
+let _ = Hashtbl.replace utf82macro "\226\137\170\204\184\239\184\128" "NotLessLess"
+let _ = Hashtbl.replace utf82macro "\226\138\144\204\184" "NotSquareSuperset"
+let _ = Hashtbl.replace utf82macro "gcd" "gcd"
+let _ = Hashtbl.replace utf82macro "\226\139\154\239\184\128" "lesg"
+let _ = Hashtbl.replace utf82macro "\226\136\160\204\184" "nang"
+let _ = Hashtbl.replace utf82macro "log" "log"
+let _ = Hashtbl.replace utf82macro "arccos" "arccos"
+let _ = Hashtbl.replace utf82macro "\226\137\130\204\184" "NotEqualTilde"
+let _ = Hashtbl.replace utf82macro "\226\137\171\204\184\239\184\128" "NotGreaterGreater"
+let _ = Hashtbl.replace utf82macro "\226\139\182\239\184\128" "notindot"
+let _ = Hashtbl.replace utf82macro "\226\137\191\204\184" "NotSucceedsTilde"
+let _ = Hashtbl.replace utf82macro "\226\139\153\204\184" "nGg"
+let _ = Hashtbl.replace utf82macro "\239\149\152" "loang"
+let _ = Hashtbl.replace utf82macro "\239\149\153" "roang"
+let _ = Hashtbl.replace utf82macro "\239\150\155" "FilledVerySmallSquare"
+let _ = Hashtbl.replace utf82macro "\239\150\156" "EmptyVerySmallSquare"
+let _ = Hashtbl.replace utf82macro "arg" "arg"
+let _ = Hashtbl.replace utf82macro "\239\150\162" "dzigrarr"
+let _ = Hashtbl.replace utf82macro "\239\149\182" "xlarr"
+let _ = Hashtbl.replace utf82macro "\239\149\183" "xrarr"
+let _ = Hashtbl.replace utf82macro "\239\149\184" "xharr"
+let _ = Hashtbl.replace utf82macro "\239\149\185" "xlArr"
+let _ = Hashtbl.replace utf82macro "\239\149\186" "xrArr"
+let _ = Hashtbl.replace utf82macro "\239\149\187" "xhArr"
+let _ = Hashtbl.replace utf82macro "\239\149\189" "xmap"
+let _ = Hashtbl.replace utf82macro "max" "min"
+let _ = Hashtbl.replace utf82macro "\226\169\176\204\184" "napE"
+let _ = Hashtbl.replace utf82macro "\\\226\138\130" "bsolhsub"
+let _ = Hashtbl.replace utf82macro "\226\136\165\239\184\128\226\131\165" "nparsl"
+let _ = Hashtbl.replace utf82macro "cosh" "cosh"
+let _ = Hashtbl.replace utf82macro "coth" "coth"
+let _ = Hashtbl.replace utf82macro "\226\136\188\239\184\128" "thksim"
+let _ = Hashtbl.replace utf82macro "\226\137\169\239\184\128" "gvnE"
+let _ = Hashtbl.replace utf82macro "\226\170\173\239\184\128" "lates"
+let _ = Hashtbl.replace utf82macro "\226\132\143\239\184\128" "hbar"
+let _ = Hashtbl.replace utf82macro "sec" "sec"
+let _ = Hashtbl.replace utf82macro "\226\137\142\204\184" "NotHumpDownHump"
+let _ = Hashtbl.replace utf82macro "mod" "bmod"
+let _ = Hashtbl.replace utf82macro "\226\128\133\239\184\128" "NegativeThickSpace"
+let _ = Hashtbl.replace utf82macro "sin" "sin"
+let _ = Hashtbl.replace utf82macro "Pr" "Pr"
+let _ = Hashtbl.replace utf82macro "\226\137\170\204\184" "nLt"
+let _ = Hashtbl.replace utf82macro "\226\136\165\239\184\128" "spar"
+let _ = Hashtbl.replace utf82macro "\239\172\128" "fflig"
+let _ = Hashtbl.replace utf82macro "\239\172\129" "filig"
+let _ = Hashtbl.replace utf82macro "\239\172\130" "fllig"
+let _ = Hashtbl.replace utf82macro "\239\172\131" "ffilig"
+let _ = Hashtbl.replace utf82macro "\239\172\132" "ffllig"
+let _ = Hashtbl.replace utf82macro "\226\167\143\204\184" "NotLeftTriangleBar"
+let _ = Hashtbl.replace utf82macro "\226\137\160\239\184\128" "nedot"
+let _ = Hashtbl.replace utf82macro "\226\138\148\239\184\128" "sqcups"
+let _ = Hashtbl.replace utf82macro "\226\140\131\239\184\128" "ShortUpArrow"
+let _ = Hashtbl.replace utf82macro "\226\137\137\204\184" "nvap"
+let _ = Hashtbl.replace utf82macro "\240\157\147\128" "kscr"
+let _ = Hashtbl.replace utf82macro "\240\157\147\130" "mscr"
+let _ = Hashtbl.replace utf82macro "\240\157\147\131" "nscr"
+let _ = Hashtbl.replace utf82macro "hom" "hom"
+let _ = Hashtbl.replace utf82macro "\240\157\147\133" "pscr"
+let _ = Hashtbl.replace utf82macro "\240\157\147\134" "qscr"
+let _ = Hashtbl.replace utf82macro "\240\157\147\135" "rscr"
+let _ = Hashtbl.replace utf82macro "\240\157\147\136" "sscr"
+let _ = Hashtbl.replace utf82macro "\240\157\147\137" "tscr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\156" "Ascr"
+let _ = Hashtbl.replace utf82macro "\240\157\147\138" "uscr"
+let _ = Hashtbl.replace utf82macro "\240\157\147\139" "vscr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\158" "Cscr"
+let _ = Hashtbl.replace utf82macro "\240\157\147\140" "wscr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\159" "Dscr"
+let _ = Hashtbl.replace utf82macro "\240\157\147\141" "xscr"
+let _ = Hashtbl.replace utf82macro "\240\157\147\142" "yscr"
+let _ = Hashtbl.replace utf82macro "\240\157\147\143" "zscr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\162" "Gscr"
+let _ = Hashtbl.replace utf82macro "\226\137\176\226\131\165" "NotLessEqual"
+let _ = Hashtbl.replace utf82macro "\240\157\146\165" "Jscr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\166" "Kscr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\169" "Nscr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\170" "Oscr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\132" "Afr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\171" "Pscr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\133" "Bfr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\172" "Qscr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\135" "Dfr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\174" "Sscr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\136" "Efr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\175" "Tscr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\137" "Ffr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\176" "Uscr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\138" "Gfr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\177" "Vscr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\178" "Wscr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\179" "Xscr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\141" "Jfr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\180" "Yscr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\142" "Kfr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\181" "Zscr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\143" "Lfr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\144" "Mfr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\182" "ascr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\145" "Nfr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\183" "bscr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\146" "Ofr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\184" "cscr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\147" "Pfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\128" "Iopf"
+let _ = Hashtbl.replace utf82macro "\240\157\146\185" "dscr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\148" "Qfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\129" "Jopf"
+let _ = Hashtbl.replace utf82macro "\240\157\149\130" "Kopf"
+let _ = Hashtbl.replace utf82macro "\240\157\146\187" "fscr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\150" "Sfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\131" "Lopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\151" "Tfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\132" "Mopf"
+let _ = Hashtbl.replace utf82macro "\240\157\146\189" "hscr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\152" "Ufr"
+let _ = Hashtbl.replace utf82macro "\240\157\146\190" "iscr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\153" "Vfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\134" "Oopf"
+let _ = Hashtbl.replace utf82macro "\240\157\146\191" "jscr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\154" "Wfr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\155" "Xfr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\156" "Yfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\138" "Sopf"
+let _ = Hashtbl.replace utf82macro "\240\157\149\139" "Topf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\158" "afr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\140" "Uopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\159" "bfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\141" "Vopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\160" "cfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\142" "Wopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\161" "dfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\143" "Xopf"
+let _ = Hashtbl.replace utf82macro "\226\170\175\204\184" "npreceq"
+let _ = Hashtbl.replace utf82macro "\240\157\148\162" "efr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\144" "Yopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\163" "ffr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\164" "gfr"
+let _ = Hashtbl.replace utf82macro "\240\157\148\165" "hfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\146" "aopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\166" "ifr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\147" "bopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\167" "jfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\148" "copf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\168" "kfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\149" "dopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\169" "lfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\150" "eopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\170" "mfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\151" "fopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\171" "nfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\152" "gopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\172" "ofr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\153" "hopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\173" "pfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\154" "iopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\174" "qfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\155" "jopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\175" "rfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\156" "kopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\176" "sfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\157" "lopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\177" "tfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\158" "mopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\178" "ufr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\159" "nopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\179" "vfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\160" "oopf"
+let _ = Hashtbl.replace utf82macro "tan" "tan"
+let _ = Hashtbl.replace utf82macro "\240\157\148\180" "wfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\161" "popf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\181" "xfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\162" "qopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\182" "yfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\163" "ropf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\183" "zfr"
+let _ = Hashtbl.replace utf82macro "\240\157\149\164" "sopf"
+let _ = Hashtbl.replace utf82macro "\240\157\149\165" "topf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\184" "Aopf"
+let _ = Hashtbl.replace utf82macro "\195\128" "Agrave"
+let _ = Hashtbl.replace utf82macro "\240\157\149\166" "uopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\185" "Bopf"
+let _ = Hashtbl.replace utf82macro "\195\129" "Aacute"
+let _ = Hashtbl.replace utf82macro "\240\157\149\167" "vopf"
+let _ = Hashtbl.replace utf82macro "\195\130" "Acirc"
+let _ = Hashtbl.replace utf82macro "\240\157\149\168" "wopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\187" "Dopf"
+let _ = Hashtbl.replace utf82macro "\195\131" "Atilde"
+let _ = Hashtbl.replace utf82macro "\240\157\149\169" "xopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\188" "Eopf"
+let _ = Hashtbl.replace utf82macro "\195\132" "Auml"
+let _ = Hashtbl.replace utf82macro "\240\157\149\170" "yopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\189" "Fopf"
+let _ = Hashtbl.replace utf82macro "\195\133" "Aring"
+let _ = Hashtbl.replace utf82macro "\240\157\149\171" "zopf"
+let _ = Hashtbl.replace utf82macro "\240\157\148\190" "Gopf"
+let _ = Hashtbl.replace utf82macro "\195\134" "AElig"
+let _ = Hashtbl.replace utf82macro "\195\135" "Ccedil"
+let _ = Hashtbl.replace utf82macro "\195\136" "Egrave"
+let _ = Hashtbl.replace utf82macro "\195\137" "Eacute"
+let _ = Hashtbl.replace utf82macro "\195\138" "Ecirc"
+let _ = Hashtbl.replace utf82macro "\195\139" "Euml"
+let _ = Hashtbl.replace utf82macro "\195\140" "Igrave"
+let _ = Hashtbl.replace utf82macro "\194\160" "NonBreakingSpace"
+let _ = Hashtbl.replace utf82macro "\195\141" "Iacute"
+let _ = Hashtbl.replace utf82macro "\194\161" "iexcl"
+let _ = Hashtbl.replace utf82macro "\195\142" "Icirc"
+let _ = Hashtbl.replace utf82macro "\195\143" "Iuml"
+let _ = Hashtbl.replace utf82macro "\194\162" "cent"
+let _ = Hashtbl.replace utf82macro "\194\163" "pound"
+let _ = Hashtbl.replace utf82macro "\195\144" "ETH"
+let _ = Hashtbl.replace utf82macro "\195\145" "Ntilde"
+let _ = Hashtbl.replace utf82macro "\194\164" "curren"
+let _ = Hashtbl.replace utf82macro "\194\165" "yen"
+let _ = Hashtbl.replace utf82macro "\195\146" "Ograve"
+let _ = Hashtbl.replace utf82macro "\195\147" "Oacute"
+let _ = Hashtbl.replace utf82macro "\194\166" "brvbar"
+let _ = Hashtbl.replace utf82macro "\196\128" "Amacr"
+let _ = Hashtbl.replace utf82macro "\194\167" "sect"
+let _ = Hashtbl.replace utf82macro "\195\148" "Ocirc"
+let _ = Hashtbl.replace utf82macro "\196\129" "amacr"
+let _ = Hashtbl.replace utf82macro "\195\149" "Otilde"
+let _ = Hashtbl.replace utf82macro "\194\168" "uml"
+let _ = Hashtbl.replace utf82macro "\196\130" "Abreve"
+let _ = Hashtbl.replace utf82macro "\195\150" "Ouml"
+let _ = Hashtbl.replace utf82macro "\194\169" "copy"
+let _ = Hashtbl.replace utf82macro "\196\131" "abreve"
+let _ = Hashtbl.replace utf82macro "\195\151" "times"
+let _ = Hashtbl.replace utf82macro "\194\170" "ordf"
+let _ = Hashtbl.replace utf82macro "\196\132" "Aogon"
+let _ = Hashtbl.replace utf82macro "\195\152" "Oslash"
+let _ = Hashtbl.replace utf82macro "\194\171" "laquo"
+let _ = Hashtbl.replace utf82macro "\196\133" "aogon"
+let _ = Hashtbl.replace utf82macro "\195\153" "Ugrave"
+let _ = Hashtbl.replace utf82macro "\194\172" "lnot"
+let _ = Hashtbl.replace utf82macro "\196\134" "Cacute"
+let _ = Hashtbl.replace utf82macro "\195\154" "Uacute"
+let _ = Hashtbl.replace utf82macro "\194\173" "shy"
+let _ = Hashtbl.replace utf82macro "\196\135" "cacute"
+let _ = Hashtbl.replace utf82macro "\195\155" "Ucirc"
+let _ = Hashtbl.replace utf82macro "\194\174" "reg"
+let _ = Hashtbl.replace utf82macro "\196\136" "Ccirc"
+let _ = Hashtbl.replace utf82macro "\195\156" "Uuml"
+let _ = Hashtbl.replace utf82macro "\194\175" "OverBar"
+let _ = Hashtbl.replace utf82macro "\196\137" "ccirc"
+let _ = Hashtbl.replace utf82macro "\195\157" "Yacute"
+let _ = Hashtbl.replace utf82macro "\194\176" "deg"
+let _ = Hashtbl.replace utf82macro "\196\138" "Cdot"
+let _ = Hashtbl.replace utf82macro "\195\158" "THORN"
+let _ = Hashtbl.replace utf82macro "\194\177" "pm"
+let _ = Hashtbl.replace utf82macro "\196\139" "cdot"
+let _ = Hashtbl.replace utf82macro "\195\159" "szlig"
+let _ = Hashtbl.replace utf82macro "\194\178" "sup2"
+let _ = Hashtbl.replace utf82macro "\196\140" "Ccaron"
+let _ = Hashtbl.replace utf82macro "\194\179" "sup3"
+let _ = Hashtbl.replace utf82macro "\196\141" "ccaron"
+let _ = Hashtbl.replace utf82macro "\195\160" "agrave"
+let _ = Hashtbl.replace utf82macro "\196\142" "Dcaron"
+let _ = Hashtbl.replace utf82macro "\194\180" "DiacriticalAcute"
+let _ = Hashtbl.replace utf82macro "\195\161" "aacute"
+let _ = Hashtbl.replace utf82macro "\194\181" "micro"
+let _ = Hashtbl.replace utf82macro "\196\143" "dcaron"
+let _ = Hashtbl.replace utf82macro "\195\162" "acirc"
+let _ = Hashtbl.replace utf82macro "\194\182" "para"
+let _ = Hashtbl.replace utf82macro "\196\144" "Dstrok"
+let _ = Hashtbl.replace utf82macro "\195\163" "atilde"
+let _ = Hashtbl.replace utf82macro "\196\145" "dstrok"
+let _ = Hashtbl.replace utf82macro "\194\183" "middot"
+let _ = Hashtbl.replace utf82macro "\195\164" "auml"
+let _ = Hashtbl.replace utf82macro "\196\146" "Emacr"
+let _ = Hashtbl.replace utf82macro "\194\184" "Cedilla"
+let _ = Hashtbl.replace utf82macro "\195\165" "aring"
+let _ = Hashtbl.replace utf82macro "\194\185" "sup1"
+let _ = Hashtbl.replace utf82macro "\197\128" "lmidot"
+let _ = Hashtbl.replace utf82macro "\196\147" "emacr"
+let _ = Hashtbl.replace utf82macro "\195\166" "aelig"
+let _ = Hashtbl.replace utf82macro "\194\186" "ordm"
+let _ = Hashtbl.replace utf82macro "\197\129" "Lstrok"
+let _ = Hashtbl.replace utf82macro "\195\167" "ccedil"
+let _ = Hashtbl.replace utf82macro "\194\187" "raquo"
+let _ = Hashtbl.replace utf82macro "\197\130" "lstrok"
+let _ = Hashtbl.replace utf82macro "\195\168" "egrave"
+let _ = Hashtbl.replace utf82macro "\197\131" "Nacute"
+let _ = Hashtbl.replace utf82macro "\194\188" "frac14"
+let _ = Hashtbl.replace utf82macro "\196\150" "Edot"
+let _ = Hashtbl.replace utf82macro "\195\169" "eacute"
+let _ = Hashtbl.replace utf82macro "\197\132" "nacute"
+let _ = Hashtbl.replace utf82macro "\194\189" "half"
+let _ = Hashtbl.replace utf82macro "\196\151" "edot"
+let _ = Hashtbl.replace utf82macro "\195\170" "ecirc"
+let _ = Hashtbl.replace utf82macro "\197\133" "Ncedil"
+let _ = Hashtbl.replace utf82macro "\194\190" "frac34"
+let _ = Hashtbl.replace utf82macro "\195\171" "euml"
+let _ = Hashtbl.replace utf82macro "\196\152" "Eogon"
+let _ = Hashtbl.replace utf82macro "\197\134" "ncedil"
+let _ = Hashtbl.replace utf82macro "\194\191" "iquest"
+let _ = Hashtbl.replace utf82macro "\195\172" "igrave"
+let _ = Hashtbl.replace utf82macro "\196\153" "eogon"
+let _ = Hashtbl.replace utf82macro "limsup" "limsup"
+let _ = Hashtbl.replace utf82macro "\197\135" "Ncaron"
+let _ = Hashtbl.replace utf82macro "\195\173" "iacute"
+let _ = Hashtbl.replace utf82macro "\196\154" "Ecaron"
+let _ = Hashtbl.replace utf82macro "\197\136" "ncaron"
+let _ = Hashtbl.replace utf82macro "\195\174" "icirc"
+let _ = Hashtbl.replace utf82macro "\196\155" "ecaron"
+let _ = Hashtbl.replace utf82macro "\197\137" "napos"
+let _ = Hashtbl.replace utf82macro "\195\175" "iuml"
+let _ = Hashtbl.replace utf82macro "\196\156" "Gcirc"
+let _ = Hashtbl.replace utf82macro "\196\157" "gcirc"
+let _ = Hashtbl.replace utf82macro "\195\176" "eth"
+let _ = Hashtbl.replace utf82macro "\197\138" "ENG"
+let _ = Hashtbl.replace utf82macro "\195\177" "ntilde"
+let _ = Hashtbl.replace utf82macro "\196\158" "Gbreve"
+let _ = Hashtbl.replace utf82macro "\197\139" "eng"
+let _ = Hashtbl.replace utf82macro "\197\140" "Omacr"
+let _ = Hashtbl.replace utf82macro "\195\178" "ograve"
+let _ = Hashtbl.replace utf82macro "\196\159" "gbreve"
+let _ = Hashtbl.replace utf82macro "\197\141" "omacr"
+let _ = Hashtbl.replace utf82macro "\195\179" "oacute"
+let _ = Hashtbl.replace utf82macro "\196\160" "Gdot"
+let _ = Hashtbl.replace utf82macro "\195\180" "ocirc"
+let _ = Hashtbl.replace utf82macro "\196\161" "gdot"
+let _ = Hashtbl.replace utf82macro "\195\181" "otilde"
+let _ = Hashtbl.replace utf82macro "\196\162" "Gcedil"
+let _ = Hashtbl.replace utf82macro "\195\182" "ouml"
+let _ = Hashtbl.replace utf82macro "\197\144" "Odblac"
+let _ = Hashtbl.replace utf82macro "\197\145" "odblac"
+let _ = Hashtbl.replace utf82macro "\196\164" "Hcirc"
+let _ = Hashtbl.replace utf82macro "\195\183" "div"
+let _ = Hashtbl.replace utf82macro "\195\184" "oslash"
+let _ = Hashtbl.replace utf82macro "\197\146" "OElig"
+let _ = Hashtbl.replace utf82macro "\196\165" "hcirc"
+let _ = Hashtbl.replace utf82macro "\195\185" "ugrave"
+let _ = Hashtbl.replace utf82macro "\197\147" "oelig"
+let _ = Hashtbl.replace utf82macro "\196\166" "Hstrok"
+let _ = Hashtbl.replace utf82macro "\195\186" "uacute"
+let _ = Hashtbl.replace utf82macro "\197\148" "Racute"
+let _ = Hashtbl.replace utf82macro "\196\167" "hstrok"
+let _ = Hashtbl.replace utf82macro "\195\187" "ucirc"
+let _ = Hashtbl.replace utf82macro "\197\149" "racute"
+let _ = Hashtbl.replace utf82macro "\196\168" "Itilde"
+let _ = Hashtbl.replace utf82macro "\195\188" "uuml"
+let _ = Hashtbl.replace utf82macro "\197\150" "Rcedil"
+let _ = Hashtbl.replace utf82macro "\196\169" "itilde"
+let _ = Hashtbl.replace utf82macro "\195\189" "yacute"
+let _ = Hashtbl.replace utf82macro "\197\151" "rcedil"
+let _ = Hashtbl.replace utf82macro "\196\170" "Imacr"
+let _ = Hashtbl.replace utf82macro "\195\190" "thorn"
+let _ = Hashtbl.replace utf82macro "\197\152" "Rcaron"
+let _ = Hashtbl.replace utf82macro "\196\171" "imacr"
+let _ = Hashtbl.replace utf82macro "\195\191" "yuml"
+let _ = Hashtbl.replace utf82macro "\197\153" "rcaron"
+let _ = Hashtbl.replace utf82macro "\197\154" "Sacute"
+let _ = Hashtbl.replace utf82macro "\197\155" "sacute"
+let _ = Hashtbl.replace utf82macro "\196\174" "Iogon"
+let _ = Hashtbl.replace utf82macro "\197\156" "Scirc"
+let _ = Hashtbl.replace utf82macro "\196\175" "iogon"
+let _ = Hashtbl.replace utf82macro "\197\157" "scirc"
+let _ = Hashtbl.replace utf82macro "\196\176" "Idot"
+let _ = Hashtbl.replace utf82macro "\197\158" "Scedil"
+let _ = Hashtbl.replace utf82macro "\196\177" "imath"
+let _ = Hashtbl.replace utf82macro "\197\159" "scedil"
+let _ = Hashtbl.replace utf82macro "\196\178" "IJlig"
+let _ = Hashtbl.replace utf82macro "\197\160" "Scaron"
+let _ = Hashtbl.replace utf82macro "\196\179" "ijlig"
+let _ = Hashtbl.replace utf82macro "\197\161" "scaron"
+let _ = Hashtbl.replace utf82macro "\196\180" "Jcirc"
+let _ = Hashtbl.replace utf82macro "\197\162" "Tcedil"
+let _ = Hashtbl.replace utf82macro "\196\181" "jcirc"
+let _ = Hashtbl.replace utf82macro "\197\163" "tcedil"
+let _ = Hashtbl.replace utf82macro "\196\182" "Kcedil"
+let _ = Hashtbl.replace utf82macro "\197\164" "Tcaron"
+let _ = Hashtbl.replace utf82macro "\226\128\138\239\184\128" "NegativeVeryThinSpace"
+let _ = Hashtbl.replace utf82macro "\196\183" "kcedil"
+let _ = Hashtbl.replace utf82macro "\197\165" "tcaron"
+let _ = Hashtbl.replace utf82macro "\196\184" "kgreen"
+let _ = Hashtbl.replace utf82macro "\198\146" "fnof"
+let _ = Hashtbl.replace utf82macro "\197\166" "Tstrok"
+let _ = Hashtbl.replace utf82macro "\196\185" "Lacute"
+let _ = Hashtbl.replace utf82macro "\197\167" "tstrok"
+let _ = Hashtbl.replace utf82macro "\196\186" "lacute"
+let _ = Hashtbl.replace utf82macro "\197\168" "Utilde"
+let _ = Hashtbl.replace utf82macro "\196\187" "Lcedil"
+let _ = Hashtbl.replace utf82macro "\197\169" "utilde"
+let _ = Hashtbl.replace utf82macro "\226\137\143\204\184" "NotHumpEqual"
+let _ = Hashtbl.replace utf82macro "\196\188" "lcedil"
+let _ = Hashtbl.replace utf82macro "\197\170" "Umacr"
+let _ = Hashtbl.replace utf82macro "\196\189" "Lcaron"
+let _ = Hashtbl.replace utf82macro "\197\171" "umacr"
+let _ = Hashtbl.replace utf82macro "\196\190" "lcaron"
+let _ = Hashtbl.replace utf82macro "\197\172" "Ubreve"
+let _ = Hashtbl.replace utf82macro "\196\191" "Lmidot"
+let _ = Hashtbl.replace utf82macro "\197\173" "ubreve"
+let _ = Hashtbl.replace utf82macro "\197\174" "Uring"
+let _ = Hashtbl.replace utf82macro "\197\175" "uring"
+let _ = Hashtbl.replace utf82macro "\197\176" "Udblac"
+let _ = Hashtbl.replace utf82macro "\197\177" "udblac"
+let _ = Hashtbl.replace utf82macro "\197\178" "Uogon"
+let _ = Hashtbl.replace utf82macro "\197\179" "uogon"
+let _ = Hashtbl.replace utf82macro "\197\180" "Wcirc"
+let _ = Hashtbl.replace utf82macro "\197\181" "wcirc"
+let _ = Hashtbl.replace utf82macro "\197\182" "Ycirc"
+let _ = Hashtbl.replace utf82macro "\197\183" "ycirc"
+let _ = Hashtbl.replace utf82macro "\197\184" "Yuml"
+let _ = Hashtbl.replace utf82macro "\197\185" "Zacute"
+let _ = Hashtbl.replace utf82macro "\197\186" "zacute"
+let _ = Hashtbl.replace utf82macro "\197\187" "Zdot"
+let _ = Hashtbl.replace utf82macro "\197\188" "zdot"
+let _ = Hashtbl.replace utf82macro "\197\189" "Zcaron"
+let _ = Hashtbl.replace utf82macro "\197\190" "zcaron"
+let _ = Hashtbl.replace utf82macro "\226\136\163\239\184\128" "smid"
+let _ = Hashtbl.replace utf82macro "\239\184\181" "OverParenthesis"
+let _ = Hashtbl.replace utf82macro "\239\184\182" "UnderParenthesis"
+let _ = Hashtbl.replace utf82macro "\239\184\183" "OverBrace"
+let _ = Hashtbl.replace utf82macro "\239\184\184" "UnderBrace"
+let _ = Hashtbl.replace utf82macro "\199\181" "gacute"
+let _ = Hashtbl.replace utf82macro "cos" "cos"
+let _ = Hashtbl.replace utf82macro "\226\136\170\239\184\128" "cups"
+let _ = Hashtbl.replace utf82macro "cot" "cot"
+let _ = Hashtbl.replace utf82macro "\201\155" "varepsilon"
+let _ = Hashtbl.replace utf82macro "\226\138\139\239\184\128" "vsupnE"
+let _ = Hashtbl.replace utf82macro "\203\135" "Hacek"
diff --git a/helm/ocaml/whelp/.depend b/helm/ocaml/whelp/.depend
new file mode 100644
index 000000000..39f37dfa9
--- /dev/null
+++ b/helm/ocaml/whelp/.depend
@@ -0,0 +1,4 @@
+whelp.cmo: whelp.cmi
+whelp.cmx: whelp.cmi
+fwdQueries.cmo: fwdQueries.cmi
+fwdQueries.cmx: fwdQueries.cmi
diff --git a/helm/ocaml/whelp/Makefile b/helm/ocaml/whelp/Makefile
new file mode 100644
index 000000000..f43c77fa9
--- /dev/null
+++ b/helm/ocaml/whelp/Makefile
@@ -0,0 +1,10 @@
+PACKAGE = whelp
+
+INTERFACE_FILES = \
+ whelp.mli \
+ fwdQueries.mli \
+ $(NULL)
+
+IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml)
+
+include ../Makefile.common
diff --git a/helm/ocaml/whelp/fwdQueries.ml b/helm/ocaml/whelp/fwdQueries.ml
new file mode 100644
index 000000000..1f4e508fc
--- /dev/null
+++ b/helm/ocaml/whelp/fwdQueries.ml
@@ -0,0 +1,115 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+(* fwd_simpl ****************************************************************)
+
+let rec filter_map_n f n = function
+ | [] -> []
+ | hd :: tl ->
+ match f n hd with
+ | None -> filter_map_n f (succ n) tl
+ | Some hd -> hd :: filter_map_n f (succ n) tl
+
+let get_uri t =
+ let aux = function
+ | Cic.Appl (hd :: tl) -> Some (CicUtil.uri_of_term hd, tl)
+ | hd -> Some (CicUtil.uri_of_term hd, [])
+ in
+ try aux t with
+ | Invalid_argument "uri_of_term" -> None
+
+let get_metadata t =
+ let f n t =
+ match get_uri t with
+ | None -> None
+ | Some (uri, _) -> Some (n, uri)
+ in
+ match get_uri t with
+ | None -> None
+ | Some (uri, args) -> Some (uri, filter_map_n f 1 args)
+
+let debug_metadata = function
+ | None -> ()
+ | Some (outer, inners) ->
+ let f (n, uri) = Printf.eprintf "%s: %i %s\n" "fwd" n (UriManager.string_of_uri uri) in
+ Printf.eprintf "\n%s: %s\n" "fwd" (UriManager.string_of_uri outer);
+ List.iter f inners; prerr_newline ()
+
+let fwd_simpl ~dbd t =
+ let map inners row =
+ match row.(0), row.(1), row.(2) with
+ | Some source, Some inner, Some index ->
+ source,
+ List.mem
+ (int_of_string index, (UriManager.uri_of_string inner)) inners
+ | _ -> "", false
+ in
+ let rec rank ranks (source, ok) =
+ match ranks, ok with
+ | [], false -> [source, 0]
+ | [], true -> [source, 1]
+ | (uri, i) :: tl, false when uri = source -> (uri, 0) :: tl
+ | (uri, 0) :: tl, true when uri = source -> (uri, 0) :: tl
+ | (uri, i) :: tl, true when uri = source -> (uri, succ i) :: tl
+ | hd :: tl, _ -> hd :: rank tl (source, ok)
+ in
+ let compare (_, x) (_, y) = compare x y in
+ let filter n (uri, rank) =
+ if rank > 0 then Some (UriManager.uri_of_string uri) else None
+ in
+ let metadata = get_metadata t in debug_metadata metadata;
+ match metadata with
+ | None -> []
+ | Some (outer, inners) ->
+ let select = "source, h_inner, h_index" in
+ let from = "genLemma" in
+ let where =
+ Printf.sprintf "h_outer = \"%s\""
+ (HMysql.escape (UriManager.string_of_uri outer)) in
+ let query = Printf.sprintf "SELECT %s FROM %s WHERE %s" select from where in
+ let result = HMysql.exec dbd query in
+ let lemmas = HMysql.map ~f:(map inners) result in
+ let ranked = List.fold_left rank [] lemmas in
+ let ordered = List.rev (List.fast_sort compare ranked) in
+ filter_map_n filter 0 ordered
+
+(* get_decomposables ********************************************************)
+
+let decomposables ~dbd =
+ let map row = match row.(0) with
+ | None -> None
+ | Some str ->
+ match CicUtil.term_of_uri (UriManager.uri_of_string str) with
+ | Cic.MutInd (uri, typeno, _) -> Some (uri, typeno)
+ | _ ->
+ raise (UriManager.IllFormedUri str)
+ in
+ let select, from = "source", "decomposables" in
+ let query = Printf.sprintf "SELECT %s FROM %s" select from in
+ let decomposables = HMysql.map ~f:map (HMysql.exec dbd query) in
+ filter_map_n (fun _ x -> x) 0 decomposables
+
diff --git a/helm/ocaml/whelp/fwdQueries.mli b/helm/ocaml/whelp/fwdQueries.mli
new file mode 100644
index 000000000..7f580a541
--- /dev/null
+++ b/helm/ocaml/whelp/fwdQueries.mli
@@ -0,0 +1,28 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val fwd_simpl: dbd:HMysql.dbd -> Cic.term -> UriManager.uri list
+val decomposables: dbd:HMysql.dbd -> (UriManager.uri * int) list
+
diff --git a/helm/ocaml/whelp/whelp.ml b/helm/ocaml/whelp/whelp.ml
new file mode 100644
index 000000000..5e63bcfc4
--- /dev/null
+++ b/helm/ocaml/whelp/whelp.ml
@@ -0,0 +1,215 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+open Printf
+
+let nonvar uri = not (UriManager.uri_is_var uri)
+
+ (** maps a shell like pattern (which uses '*' and '?') to a sql pattern for
+ * the "like" operator (which uses '%' and '_'). Does not support escaping. *)
+let sqlpat_of_shellglob =
+ let star_RE, qmark_RE, percent_RE, uscore_RE =
+ Pcre.regexp "\\*", Pcre.regexp "\\?", Pcre.regexp "%", Pcre.regexp "_"
+ in
+ fun shellglob ->
+ Pcre.replace ~rex:star_RE ~templ:"%"
+ (Pcre.replace ~rex:qmark_RE ~templ:"_"
+ (Pcre.replace ~rex:percent_RE ~templ:"\\%"
+ (Pcre.replace ~rex:uscore_RE ~templ:"\\_"
+ shellglob)))
+
+let locate ~(dbd:HMysql.dbd) ?(vars = false) pat =
+ let sql_pat = sqlpat_of_shellglob pat in
+ let query =
+ sprintf ("SELECT source FROM %s WHERE value LIKE \"%s\" UNION "^^
+ "SELECT source FROM %s WHERE value LIKE \"%s\"")
+ (MetadataTypes.name_tbl ()) sql_pat
+ MetadataTypes.library_name_tbl sql_pat
+ in
+ let result = HMysql.exec dbd query in
+ List.filter nonvar
+ (HMysql.map result
+ (fun cols -> match cols.(0) with Some s -> UriManager.uri_of_string s | _ -> assert false))
+
+let match_term ~(dbd:HMysql.dbd) ty =
+(* debug_print (lazy (CicPp.ppterm ty)); *)
+ let metadata = MetadataExtractor.compute ~body:None ~ty in
+ let constants_no =
+ MetadataConstraints.UriManagerSet.cardinal (MetadataConstraints.constants_of ty)
+ in
+ let full_card, diff =
+ if CicUtil.is_meta_closed ty then
+ Some (MetadataConstraints.Eq constants_no), None
+ else
+ let diff_no =
+ let (hyp_constants, concl_constants) =
+ (* collect different constants in hypotheses and conclusions *)
+ List.fold_left
+ (fun ((hyp, concl) as acc) metadata ->
+ match (metadata: MetadataTypes.metadata) with
+ | `Sort _ | `Rel _ -> acc
+ | `Obj (uri, `InConclusion) | `Obj (uri, `MainConclusion _)
+ when not (List.mem uri concl) -> (hyp, uri :: concl)
+ | `Obj (uri, `InHypothesis) | `Obj (uri, `MainHypothesis _)
+ when not (List.mem uri hyp) -> (uri :: hyp, concl)
+ | `Obj _ -> acc)
+ ([], [])
+ metadata
+ in
+ List.length hyp_constants - List.length concl_constants
+ in
+ let (concl_metas, hyp_metas) = MetadataExtractor.compute_metas ty in
+ let diff =
+ if MetadataExtractor.IntSet.equal concl_metas hyp_metas then
+ Some (MetadataConstraints.Eq diff_no)
+ else if MetadataExtractor.IntSet.subset concl_metas hyp_metas then
+ Some (MetadataConstraints.Gt (diff_no - 1))
+ else if MetadataExtractor.IntSet.subset hyp_metas concl_metas then
+ Some (MetadataConstraints.Lt (diff_no + 1))
+ else
+ None
+ in
+ None, diff
+ in
+ let constraints = List.map MetadataTypes.constr_of_metadata metadata in
+ MetadataConstraints.at_least ~dbd ?full_card ?diff constraints
+
+let fill_with_dummy_constants t =
+ let rec aux i types =
+ function
+ Cic.Lambda (n,s,t) ->
+ let dummy_uri =
+ UriManager.uri_of_string ("cic:/dummy_"^(string_of_int i)^".con") in
+ (aux (i+1) (s::types)
+ (CicSubstitution.subst (Cic.Const(dummy_uri,[])) t))
+ | t -> t,types
+ in
+ let t,types = aux 0 [] t in
+ t, List.rev types
+
+let instance ~dbd t =
+ let t',types = fill_with_dummy_constants t in
+ let metadata = MetadataExtractor.compute ~body:None ~ty:t' in
+(* List.iter
+ (fun x ->
+ debug_print
+ (lazy (MetadataPp.pp_constr (MetadataTypes.constr_of_metadata x))))
+ metadata; *)
+ let no_concl = MetadataDb.count_distinct `Conclusion metadata in
+ let no_hyp = MetadataDb.count_distinct `Hypothesis metadata in
+ let no_full = MetadataDb.count_distinct `Statement metadata in
+ let is_dummy = function
+ | `Obj(s, _) -> (String.sub (UriManager.string_of_uri s) 0 10) <> "cic:/dummy"
+ | _ -> true
+ in
+ let rec look_for_dummy_main = function
+ | [] -> None
+ | `Obj(s,`MainConclusion (Some (MetadataTypes.Eq d)))::_
+ when (String.sub (UriManager.string_of_uri s) 0 10 = "cic:/dummy") ->
+ let s = UriManager.string_of_uri s in
+ let len = String.length s in
+ let dummy_index = int_of_string (String.sub s 11 (len-15)) in
+ let dummy_type = List.nth types dummy_index in
+ Some (d,dummy_type)
+ | _::l -> look_for_dummy_main l
+ in
+ match (look_for_dummy_main metadata) with
+ | None->
+(* debug_print (lazy "Caso None"); *)
+ (* no dummy in main position *)
+ let metadata = List.filter is_dummy metadata in
+ let constraints = List.map MetadataTypes.constr_of_metadata metadata in
+ let concl_card = Some (MetadataConstraints.Eq no_concl) in
+ let full_card = Some (MetadataConstraints.Eq no_full) in
+ let diff = Some (MetadataConstraints.Eq (no_hyp - no_concl)) in
+ MetadataConstraints.at_least ~dbd ?concl_card ?full_card ?diff
+ constraints
+ | Some (depth, dummy_type) ->
+(* debug_print
+ (lazy (sprintf "Caso Some %d %s" depth (CicPp.ppterm dummy_type))); *)
+ (* a dummy in main position *)
+ let metadata_for_dummy_type =
+ MetadataExtractor.compute ~body:None ~ty:dummy_type in
+ (* Let us skip this for the moment
+ let main_of_dummy_type =
+ look_for_dummy_main metadata_for_dummy_type in *)
+ let metadata = List.filter is_dummy metadata in
+ let constraints = List.map MetadataTypes.constr_of_metadata metadata in
+ let metadata_for_dummy_type =
+ List.filter is_dummy metadata_for_dummy_type in
+ let metadata_for_dummy_type, depth' =
+ (* depth' = the depth of the A -> A -> Prop *)
+ List.fold_left (fun (acc,dep) c ->
+ match c with
+ | `Sort (s,`MainConclusion (Some (MetadataTypes.Eq i))) ->
+ (`Sort (s,`MainConclusion (Some (MetadataTypes.Ge i))))::acc, i
+ | `Obj (s,`MainConclusion (Some (MetadataTypes.Eq i))) ->
+ (`Obj (s,`MainConclusion (Some (MetadataTypes.Ge i))))::acc, i
+ | `Rel (`MainConclusion (Some (MetadataTypes.Eq i))) ->
+ (`Rel (`MainConclusion (Some (MetadataTypes.Ge i))))::acc, i
+ | _ -> (c::acc,dep)) ([],0) metadata_for_dummy_type
+ in
+ let constraints_for_dummy_type =
+ List.map MetadataTypes.constr_of_metadata metadata_for_dummy_type in
+ (* start with the dummy constant in main conlusion *)
+ let from = ["refObj as table0"] in
+ let where =
+ [sprintf "table0.h_position = \"%s\"" MetadataTypes.mainconcl_pos;
+ sprintf "table0.h_depth >= %d" depth] in
+ let (n,from,where) =
+ List.fold_left
+ (MetadataConstraints.add_constraint ~start:2)
+ (2,from,where) constraints in
+ let concl_card = Some (MetadataConstraints.Eq no_concl) in
+ let full_card = Some (MetadataConstraints.Eq no_full) in
+ let diff = Some (MetadataConstraints.Eq (no_hyp - no_concl)) in
+ let (n,from,where) =
+ MetadataConstraints.add_all_constr
+ (n,from,where) concl_card full_card diff in
+ (* join with the constraints over the type of the constant *)
+ let where =
+ (sprintf "table0.h_occurrence = table%d.source" n)::where in
+ let where =
+ sprintf "table0.h_depth - table%d.h_depth = %d"
+ n (depth - depth')::where
+ in
+ let (m,from,where) =
+ List.fold_left
+ (MetadataConstraints.add_constraint ~start:n)
+ (n,from,where) constraints_for_dummy_type in
+ MetadataConstraints.exec ~dbd (m,from,where)
+
+let elim ~dbd uri =
+ let constraints =
+ [`Rel [`MainConclusion None];
+ `Sort (Cic.Prop,[`MainHypothesis (Some (MetadataTypes.Ge 1))]);
+ `Obj (uri,[`MainHypothesis (Some (MetadataTypes.Eq 0))]);
+ `Obj (uri,[`InHypothesis]);
+ ]
+ in
+ MetadataConstraints.at_least ~rating:`Hits ~dbd constraints
+
diff --git a/helm/ocaml/whelp/whelp.mli b/helm/ocaml/whelp/whelp.mli
new file mode 100644
index 000000000..9ff03ea20
--- /dev/null
+++ b/helm/ocaml/whelp/whelp.mli
@@ -0,0 +1,30 @@
+(* Copyright (C) 2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+val locate: dbd:HMysql.dbd -> ?vars:bool -> string -> UriManager.uri list
+val elim: dbd:HMysql.dbd -> UriManager.uri -> UriManager.uri list
+val instance: dbd:HMysql.dbd -> Cic.term -> UriManager.uri list
+val match_term: dbd:HMysql.dbd -> Cic.term -> UriManager.uri list
+
diff --git a/helm/ocaml/xml/.depend b/helm/ocaml/xml/.depend
new file mode 100644
index 000000000..5ef59bdc9
--- /dev/null
+++ b/helm/ocaml/xml/.depend
@@ -0,0 +1,4 @@
+xml.cmo: xml.cmi
+xml.cmx: xml.cmi
+xmlPushParser.cmo: xmlPushParser.cmi
+xmlPushParser.cmx: xmlPushParser.cmi
diff --git a/helm/ocaml/xml/Makefile b/helm/ocaml/xml/Makefile
new file mode 100644
index 000000000..6ca7bd944
--- /dev/null
+++ b/helm/ocaml/xml/Makefile
@@ -0,0 +1,11 @@
+PACKAGE = xml
+PREDICATES =
+
+INTERFACE_FILES = \
+ xml.mli \
+ xmlPushParser.mli
+IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml)
+EXTRA_OBJECTS_TO_INSTALL =
+EXTRA_OBJECTS_TO_CLEAN =
+
+include ../Makefile.common
diff --git a/helm/ocaml/xml/test.ml b/helm/ocaml/xml/test.ml
new file mode 100644
index 000000000..84c042e28
--- /dev/null
+++ b/helm/ocaml/xml/test.ml
@@ -0,0 +1,60 @@
+(* $Id$ *)
+
+(* Parsing test:
+ * - XmlPushParser version *)
+open Printf
+open XmlPushParser
+
+let print s = print_endline s; flush stdout
+
+let callbacks =
+ { default_callbacks with
+ start_element =
+ Some (fun tag attrs ->
+ let length = List.length attrs in
+ print (sprintf "opening %s [%s]"
+ tag (String.concat ";" (List.map fst attrs))));
+ end_element = Some (fun tag -> print ("closing " ^ tag));
+ character_data = Some (fun data -> print "character data ...");
+ }
+
+let xml_parser = create_parser callbacks
+
+let is_gzip f =
+ try
+ let len = String.length f in
+ String.sub f (len - 3) 3 = ".gz"
+ with Invalid_argument _ -> false
+
+let _ =
+ let xml_source =
+ if is_gzip Sys.argv.(1) then
+ `Gzip_file Sys.argv.(1)
+ else
+ `File Sys.argv.(1)
+ in
+ parse xml_parser xml_source
+
+(* Parsing test:
+ * - Pure expat version (without XmlPushParser mediation).
+ * Originally written only to test if XmlPushParser mediation caused overhead.
+ * That was not the case. *)
+
+(*let _ =*)
+(* let ic = open_in Sys.argv.(1) in*)
+(* let expat_parser = Expat.parser_create ~encoding:None in*)
+(* Expat.set_start_element_handler expat_parser*)
+(* (fun tag attrs ->*)
+(* let length = List.length attrs in*)
+(* print (sprintf "opening %s [%d attribute%s]"*)
+(* tag length (if length = 1 then "" else "s")));*)
+(* Expat.set_end_element_handler expat_parser*)
+(* (fun tag -> print ("closing " ^ tag));*)
+(* Expat.set_character_data_handler expat_parser*)
+(* (fun data -> print "character data ...");*)
+(* try*)
+(* while true do*)
+(* Expat.parse expat_parser (input_line ic ^ "\n")*)
+(* done*)
+(* with End_of_file -> Expat.final expat_parser*)
+
diff --git a/helm/ocaml/xml/xml.ml b/helm/ocaml/xml/xml.ml
new file mode 100644
index 000000000..f8cc41cbe
--- /dev/null
+++ b/helm/ocaml/xml/xml.ml
@@ -0,0 +1,177 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(******************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* A tactic to print Coq objects in XML *)
+(* *)
+(* Claudio Sacerdoti Coen <sacerdot@cs.unibo.it> *)
+(* 18/10/2000 *)
+(* *)
+(* This module defines a pretty-printer and the stream of commands to the pp *)
+(* *)
+(******************************************************************************)
+
+(* $Id$ *)
+
+
+(* the type token for XML cdata, empty elements and not-empty elements *)
+(* Usage: *)
+(* Str cdata *)
+(* Empty (prefix, element_name, *)
+(* [prefix1, attrname1, value1 ; ... ; prefixn, attrnamen, valuen] *)
+(* NEmpty (prefix, element_name, *)
+(* [prefix1, attrname1, value1 ; ... ; prefixn, attrnamen, valuen], *)
+(* content *)
+type token =
+ Str of string
+ | Empty of string option * string * (string option * string * string) list
+ | NEmpty of string option * string * (string option * string * string) list *
+ token Stream.t
+;;
+
+(* currified versions of the constructors make the code more readable *)
+let xml_empty ?prefix name attrs =
+ [< 'Empty(prefix,name,attrs) >]
+let xml_nempty ?prefix name attrs content =
+ [< 'NEmpty(prefix,name,attrs,content) >]
+let xml_cdata str =
+ [< 'Str str >]
+
+(** low level for other PPs: pretty print each token of strm applying 'f' to a
+canonical string representation of each token *)
+let pp_gen f strm =
+ let pprefix =
+ function
+ None -> ""
+ | Some p -> p ^ ":" in
+ let rec pp_r m =
+ parser
+ | [< 'Str a ; s >] ->
+ print_spaces m ;
+ f (a ^ "\n") ;
+ pp_r m s
+ | [< 'Empty(p,n,l) ; s >] ->
+ print_spaces m ;
+ f ("<" ^ (pprefix p) ^ n) ;
+ List.iter (fun (p,n,v) -> f (" " ^ (pprefix p) ^ n ^ "=\"" ^ v ^ "\"")) l;
+ f "/>\n" ;
+ pp_r m s
+ | [< 'NEmpty(p,n,l,c) ; s >] ->
+ print_spaces m ;
+ f ("<" ^ (pprefix p) ^ n) ;
+ List.iter (fun (p,n,v) -> f (" " ^ (pprefix p) ^ n ^ "=\"" ^ v ^ "\"")) l;
+ f ">\n" ;
+ pp_r (m+1) c ;
+ print_spaces m ;
+ f ("</" ^ (pprefix p) ^ n ^ ">\n") ;
+ pp_r m s
+ | [< >] -> ()
+ and print_spaces m =
+ for i = 1 to m do f " " done
+ in
+ pp_r 0 strm
+;;
+
+(** pretty printer on output channels *)
+let pp_to_outchan strm oc =
+ pp_gen (fun s -> output_string oc s) strm;
+ flush oc
+;;
+
+let pp_to_gzipchan strm oc =
+ pp_gen (fun s -> Gzip.output oc s 0 (String.length s)) strm
+;;
+
+(** pretty printer to string *)
+let pp_to_string strm =
+ let buf = Buffer.create 10240 in
+ pp_gen (Buffer.add_string buf) strm;
+ Buffer.contents buf
+;;
+
+(** pretty printer to file *)
+(* Usage: *)
+(* pp tokens None pretty prints the output on stdout *)
+(* pp tokens (Some filename) pretty prints the output on the file filename *)
+let pp ?(gzip=false) strm fn =
+ if gzip then
+ match fn with
+ | Some filename ->
+ let outchan = Gzip.open_out filename in
+ (try
+ pp_to_gzipchan strm outchan;
+ with e ->
+ Gzip.close_out outchan;
+ raise e);
+ Gzip.close_out outchan
+ | None -> failwith "Can't sent gzipped output to stdout"
+ else
+ match fn with
+ | Some filename ->
+ let outchan = open_out filename in
+ (try
+ pp_to_outchan strm outchan;
+ with e ->
+ close_out outchan;
+ raise e);
+ close_out outchan
+ | None -> pp_to_outchan strm stdout
+;;
+
+let pp =
+ let profiler = HExtlib.profile "Xml.pp" in
+ fun ?gzip strm fn ->
+ profiler.HExtlib.profile (pp ?gzip strm) fn
+;;
+
+let add_xml_declaration stream =
+ let box_prefix = "b" in
+ [<
+ xml_cdata "<?xml version=\"1.0\" ?>\n" ;
+ xml_cdata "\n";
+ xml_nempty ~prefix:box_prefix "box"
+ [ Some "xmlns","m","http://www.w3.org/1998/Math/MathML" ;
+ Some "xmlns","b","http://helm.cs.unibo.it/2003/BoxML" ;
+ Some "xmlns","helm","http://www.cs.unibo.it/helm" ;
+ Some "xmlns","xlink","http://www.w3.org/1999/xlink"
+ ] stream
+ >]
+
+ (* TODO BRRRRR .... *)
+ (** strip first 4 line of a string, used to strip xml declaration and doctype
+ declaration from XML strings generated by Xml.pp_to_string *)
+let strip_xml_headings s =
+ let rec aux n pos =
+ if n = 0
+ then String.sub s pos (String.length s - pos)
+ else aux (n - 1) (String.index_from s pos '\n' + 1)
+ in
+ try
+ aux 4 0
+ with Not_found -> s
+
diff --git a/helm/ocaml/xml/xml.mli b/helm/ocaml/xml/xml.mli
new file mode 100644
index 000000000..4feca7503
--- /dev/null
+++ b/helm/ocaml/xml/xml.mli
@@ -0,0 +1,75 @@
+(* Copyright (C) 2000, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(******************************************************************************)
+(* *)
+(* PROJECT HELM *)
+(* *)
+(* A tactic to print Coq objects in XML *)
+(* *)
+(* Claudio Sacerdoti Coen <sacerdot@cs.unibo.it> *)
+(* 18/10/2000 *)
+(* *)
+(* This module defines a pretty-printer and the stream of commands to the pp *)
+(* *)
+(******************************************************************************)
+
+(* Tokens for XML cdata, empty elements and not-empty elements *)
+(* Usage: *)
+(* Str cdata *)
+(* Empty (prefix, element_name, *)
+(* [prefix1, attrname1, value1 ; ... ; prefixn, attrnamen, valuen] *)
+(* NEmpty (prefix, element_name, *)
+(* [prefix1, attrname1, value1 ; ... ; prefixn, attrnamen, valuen], *)
+(* content *)
+type token =
+ Str of string
+ | Empty of string option * string * (string option * string * string) list
+ | NEmpty of string option * string * (string option * string * string) list *
+ token Stream.t
+;;
+
+(* currified versions of the token constructors make the code more readable *)
+val xml_empty :
+ ?prefix:string -> string -> (string option * string * string) list ->
+ token Stream.t
+val xml_nempty :
+ ?prefix:string -> string -> (string option * string * string) list ->
+ token Stream.t -> token Stream.t
+val xml_cdata : string -> token Stream.t
+
+(* The pretty printer for streams of token *)
+(* Usage: *)
+(* pp tokens None pretty prints the output on stdout *)
+(* pp tokens (Some filename) pretty prints the output on the file filename
+* @param gzip if set to true files are gzipped. Defaults to false *)
+val pp : ?gzip:bool -> token Stream.t -> string option -> unit
+val pp_to_outchan : token Stream.t -> out_channel -> unit
+val pp_to_string : token Stream.t -> string
+
+val add_xml_declaration: token Stream.t -> token Stream.t
+
+val strip_xml_headings: string -> string
+
diff --git a/helm/ocaml/xml/xmlPushParser.ml b/helm/ocaml/xml/xmlPushParser.ml
new file mode 100644
index 000000000..4f57e1242
--- /dev/null
+++ b/helm/ocaml/xml/xmlPushParser.ml
@@ -0,0 +1,118 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(* $Id$ *)
+
+let gzip_bufsize = 10240
+
+type callbacks = {
+ start_element: (string -> (string * string) list -> unit) option;
+ end_element: (string -> unit) option;
+ character_data: (string -> unit) option;
+ processing_instruction: (string -> string -> unit) option;
+ comment: (string -> unit) option;
+}
+
+let default_callbacks = {
+ start_element = None;
+ end_element = None;
+ character_data = None;
+ processing_instruction = None;
+ comment = None;
+}
+
+type xml_source =
+ [ `Channel of in_channel
+ | `File of string
+ | `Gzip_channel of Gzip.in_channel
+ | `Gzip_file of string
+ | `String of string
+ ]
+
+type position = int * int
+
+type xml_parser = Expat.expat_parser
+
+exception Parse_error of string
+
+let create_parser callbacks =
+ let expat_parser = Expat.parser_create ~encoding:None in
+ (match callbacks.start_element with
+ | Some f -> Expat.set_start_element_handler expat_parser f
+ | _ -> ());
+ (match callbacks.end_element with
+ | Some f -> Expat.set_end_element_handler expat_parser f
+ | _ -> ());
+ (match callbacks.character_data with
+ | Some f -> Expat.set_character_data_handler expat_parser f
+ | _ -> ());
+ (match callbacks.processing_instruction with
+ | Some f -> Expat.set_processing_instruction_handler expat_parser f
+ | _ -> ());
+ (match callbacks.comment with
+ | Some f -> Expat.set_comment_handler expat_parser f
+ | _ -> ());
+ expat_parser
+
+let final = Expat.final
+
+let get_position expat_parser =
+ (Expat.get_current_line_number expat_parser,
+ Expat.get_current_column_number expat_parser)
+
+let parse expat_parser =
+ let parse_fun = Expat.parse expat_parser in
+ let rec aux = function
+ | `Channel ic ->
+ (try
+ while true do parse_fun (input_line ic ^ "\n") done
+ with End_of_file -> final expat_parser)
+ | `File fname ->
+ let ic = open_in fname in
+ aux (`Channel ic);
+ close_in ic
+ | `Gzip_channel ic ->
+ let buf = String.create gzip_bufsize in
+ (try
+ while true do
+ let bytes = Gzip.input ic buf 0 gzip_bufsize in
+ if bytes = 0 then raise End_of_file;
+ parse_fun (String.sub buf 0 bytes)
+ done
+ with End_of_file -> final expat_parser)
+ | `Gzip_file fname ->
+ let ic = Gzip.open_in fname in
+ aux (`Gzip_channel ic);
+ Gzip.close_in ic
+ | `String s -> parse_fun s
+ in
+ aux
+
+let parse expat_parser xml_source =
+ try
+ parse expat_parser xml_source
+ with Expat.Expat_error xml_error ->
+ raise (Parse_error (Expat.xml_error_to_string xml_error))
+
diff --git a/helm/ocaml/xml/xmlPushParser.mli b/helm/ocaml/xml/xmlPushParser.mli
new file mode 100644
index 000000000..c13481c91
--- /dev/null
+++ b/helm/ocaml/xml/xmlPushParser.mli
@@ -0,0 +1,78 @@
+(* Copyright (C) 2004-2005, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** {2 XLM push parser generic interface}
+ * Do not depend on CIC *)
+
+ (** callbacks needed to instantiate a parser *)
+type callbacks = {
+ start_element:
+ (string -> (string * string) list -> unit) option; (* tag, attr list *)
+ end_element: (string -> unit) option; (* tag *)
+ character_data: (string -> unit) option; (* data *)
+ processing_instruction:
+ (string -> string -> unit) option; (* target, value *)
+ comment: (string -> unit) option; (* value *)
+}
+
+ (** do nothing callbacks (all set to None) *)
+val default_callbacks: callbacks
+
+ (** source from which parse an XML file *)
+type xml_source =
+ [ `Channel of in_channel
+ | `File of string
+ | `Gzip_channel of Gzip.in_channel
+ | `Gzip_file of string
+ | `String of string
+ ]
+
+ (** source position in a XML source.
+ * A position is a pair <line, column> *)
+type position = int * int
+
+type xml_parser
+
+ (** raised when a parse error occurs, argument is an error message.
+ * This exception carries no position information, but it should be get using
+ * get_position below *)
+exception Parse_error of string
+
+ (** Create a push parser which invokes the given callbacks *)
+val create_parser: callbacks -> xml_parser
+
+ (** Parse XML data from a given source with a given parser
+ * @raise Parse_error *)
+val parse: xml_parser -> xml_source -> unit
+
+ (** Inform the parser that parsing is completed, needed only when source is
+ * `String, for other sources it is automatically invoked when the end of file
+ * is reached
+ * @raise Parse_error *)
+val final: xml_parser -> unit
+
+ (** @return current <line, column> pair *)
+val get_position: xml_parser -> position
+
diff --git a/helm/ocaml/xmldiff/.depend b/helm/ocaml/xmldiff/.depend
new file mode 100644
index 000000000..e2832de33
--- /dev/null
+++ b/helm/ocaml/xmldiff/.depend
@@ -0,0 +1,2 @@
+xmlDiff.cmo: xmlDiff.cmi
+xmlDiff.cmx: xmlDiff.cmi
diff --git a/helm/ocaml/xmldiff/Makefile b/helm/ocaml/xmldiff/Makefile
new file mode 100644
index 000000000..62492069e
--- /dev/null
+++ b/helm/ocaml/xmldiff/Makefile
@@ -0,0 +1,9 @@
+PACKAGE = xmldiff
+PREDICATES =
+
+INTERFACE_FILES = xmlDiff.mli
+IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml)
+EXTRA_OBJECTS_TO_INSTALL =
+EXTRA_OBJECTS_TO_CLEAN =
+
+include ../Makefile.common
diff --git a/helm/ocaml/xmldiff/xmlDiff.ml b/helm/ocaml/xmldiff/xmlDiff.ml
new file mode 100644
index 000000000..6f68438e9
--- /dev/null
+++ b/helm/ocaml/xmldiff/xmlDiff.ml
@@ -0,0 +1,345 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* $Id$ *)
+
+let mathmlns = "http://www.w3.org/1998/Math/MathML";;
+let xmldiffns = "http://helm.cs.unibo.it/XmlDiff";;
+let helmns = "http://www.cs.unibo.it/helm";;
+
+let ds_selection = Gdome.domString "selection";;
+let ds_2 = Gdome.domString "2";;
+let ds_mathmlns = Gdome.domString mathmlns;;
+let ds_m_style = Gdome.domString "m:mstyle";;
+let ds_mathbackground = Gdome.domString "mathbackground";;
+let ds_xmldiffns = Gdome.domString xmldiffns;;
+let ds_xmldiff_type = Gdome.domString "xmldiff:type";;
+let ds_fake = Gdome.domString "fake";;
+let ds_helmns = Gdome.domString helmns;;
+let ds_xref = Gdome.domString "xref";;
+let ds_type = Gdome.domString "type";;
+let ds_yellow = Gdome.domString "yellow";;
+let ds_green = Gdome.domString "#00ff00";;
+let ds_maction = Gdome.domString "maction";;
+let ds_mtr = Gdome.domString "mtr";;
+let ds_mtd = Gdome.domString "mtd";;
+
+type highlighted_nodes = Gdome.node list;;
+
+let rec make_visible (n: Gdome.node) =
+ match n#get_parentNode with
+ None -> ()
+ | Some p ->
+ match p#get_namespaceURI, p#get_localName with
+ Some nu, Some ln when
+ nu#equals ds_mathmlns && ln#equals ds_maction ->
+ (new Gdome.element_of_node p)#setAttribute
+ ~name:ds_selection
+ ~value:ds_2 ;
+ make_visible p
+ | _,_ -> make_visible p
+;;
+
+let highlight_node_total_time = ref 0.0;;
+
+let highlight_node ?(color=ds_yellow) (doc: Gdome.document) (n: Gdome.node) =
+ let highlight (n: Gdome.node) =
+ let highlighter =
+ doc#createElementNS
+ ~namespaceURI:(Some ds_mathmlns)
+ ~qualifiedName:ds_m_style
+ in
+ highlighter#setAttribute ~name:ds_mathbackground ~value:color ;
+ highlighter#setAttributeNS
+ ~namespaceURI:(Some ds_xmldiffns)
+ ~qualifiedName:ds_xmldiff_type
+ ~value:ds_fake ;
+ let parent =
+ match n#get_parentNode with
+ None -> assert false
+ | Some p -> p
+ in
+ ignore
+ (parent#replaceChild ~oldChild:n ~newChild:(highlighter :> Gdome.node)) ;
+ ignore (highlighter#appendChild n) ;
+ (highlighter :> Gdome.node)
+ in
+ let rec find_mstylable_node n =
+ match n#get_namespaceURI, n#get_localName with
+ Some nu, Some ln when
+ nu#equals ds_mathmlns &&
+ (not (ln#equals ds_mtr)) && (not (ln#equals ds_mtd)) -> n
+ | Some nu, Some ln when
+ nu#equals ds_mathmlns &&
+ ln#equals ds_mtr || ln#equals ds_mtd ->
+ let true_child =
+ match n#get_firstChild with
+ None -> assert false
+ | Some n -> n
+ in
+ find_mstylable_node true_child
+ | _,_ ->
+ match n#get_parentNode with
+ None -> assert false
+ | Some p -> find_mstylable_node p
+ in
+ let highlighter = highlight (find_mstylable_node n) in
+ make_visible highlighter ;
+ highlighter
+;;
+
+let iter_children ~f (n:Gdome.node) =
+ let rec aux =
+ function
+ None -> ()
+ | Some n ->
+ let sibling = n#get_nextSibling in
+ (f n) ;
+ aux sibling
+ in
+ aux n#get_firstChild
+;;
+
+let highlight_nodes ~xrefs (doc:Gdome.document) =
+ let highlighted = ref [] in
+ let rec aux (n:Gdome.element) =
+ let attributeNS =
+ (n#getAttributeNS ~namespaceURI:ds_helmns
+ ~localName:ds_xref)#to_string in
+ if List.mem attributeNS xrefs then
+ highlighted :=
+ (highlight_node ~color:ds_green doc (n :> Gdome.node))::
+ !highlighted ;
+ iter_children (n :> Gdome.node)
+ ~f:(function n ->
+ if n#get_nodeType = GdomeNodeTypeT.ELEMENT_NODE then
+ aux (new Gdome.element_of_node n))
+ in
+ aux doc#get_documentElement ;
+ !highlighted
+;;
+
+let dim_nodes =
+ List.iter
+ (function (n : Gdome.node) ->
+ assert
+ (n#get_nodeType = GdomeNodeTypeT.ELEMENT_NODE &&
+ ((new Gdome.element_of_node n)#getAttributeNS
+ ~namespaceURI:ds_xmldiffns
+ ~localName:ds_type)#equals ds_fake) ;
+ let true_child =
+ match n#get_firstChild with
+ None -> assert false
+ | Some n -> n in
+ let p =
+ match n#get_parentNode with
+ None -> assert false
+ | Some n -> n
+ in
+ ignore (p#replaceChild ~oldChild:n ~newChild:true_child)
+ )
+;;
+
+let update_dom ~(from : Gdome.document) (d : Gdome.document) =
+ let rec aux (p: Gdome.node) (f: Gdome.node) (t: Gdome.node) =
+ let replace t1 =
+ if
+ t1 = GdomeNodeTypeT.ELEMENT_NODE &&
+ ((new Gdome.element_of_node f)#getAttributeNS
+ ~namespaceURI:ds_xmldiffns
+ ~localName:ds_type)#equals ds_fake
+ then
+ let true_child =
+ match f#get_firstChild with
+ None -> assert false
+ | Some n -> n
+ in
+ begin
+ ignore (p#replaceChild ~oldChild:f ~newChild:true_child) ;
+ aux p true_child t
+ end
+ else
+ let t' = from#importNode t true in
+ ignore (p#replaceChild ~newChild:t' ~oldChild:f) ;
+ (* ignore (highlight_node from t') *)
+ in
+ match
+ f#get_nodeType,t#get_nodeType
+ with
+ GdomeNodeTypeT.TEXT_NODE,GdomeNodeTypeT.TEXT_NODE ->
+ (match f#get_nodeValue, t#get_nodeValue with
+ Some v, Some v' when v#equals v' -> ()
+ | Some _, (Some _ as v') -> f#set_nodeValue v'
+ | _,_ -> assert false)
+ | GdomeNodeTypeT.ELEMENT_NODE as t1,GdomeNodeTypeT.ELEMENT_NODE ->
+ (match
+ f#get_namespaceURI,t#get_namespaceURI,f#get_localName,t#get_localName
+ with
+ Some nu, Some nu', Some ln, Some ln' when
+ ln#equals ln' && nu#equals nu' ->
+ begin
+ match f#get_attributes, t#get_attributes with
+ Some fattrs, Some tattrs ->
+ let flen = fattrs#get_length in
+ let tlen = tattrs#get_length in
+ let processed = ref [] in
+ for i = 0 to flen -1 do
+ match fattrs#item i with
+ None -> () (* CSC: sigh, togliere un nodo rompe fa decrescere la lunghezza ==> passare a un while *)
+ | Some attr ->
+ match attr#get_namespaceURI with
+ None ->
+ (* Back to DOM Level 1 ;-( *)
+ begin
+ let name = attr#get_nodeName in
+ match tattrs#getNamedItem ~name with
+ None ->
+ ignore (fattrs#removeNamedItem ~name)
+ | Some attr' ->
+ processed :=
+ (None,Some name)::!processed ;
+ match attr#get_nodeValue, attr'#get_nodeValue with
+ Some v1, Some v2 when
+ v1#equals v2
+ || (name#equals ds_selection &&
+ nu#equals ds_mathmlns &&
+ ln#equals ds_maction)
+ ->
+ ()
+ | Some v1, Some v2 ->
+ let attr'' = from#importNode attr' true in
+ ignore (fattrs#setNamedItem attr'')
+ | _,_ -> assert false
+ end
+ | Some namespaceURI ->
+ let localName =
+ match attr#get_localName with
+ Some v -> v
+ | None -> assert false
+ in
+ match
+ tattrs#getNamedItemNS ~namespaceURI ~localName
+ with
+ None ->
+ ignore
+ (fattrs#removeNamedItemNS
+ ~namespaceURI ~localName)
+ | Some attr' ->
+ processed :=
+ (Some namespaceURI,Some localName)::!processed ;
+ match attr#get_nodeValue, attr'#get_nodeValue with
+ Some v1, Some v2 when
+ v1#equals v2 ->
+ ()
+ | Some _, Some _ ->
+ let attr'' = from#importNode attr' true in
+ ignore (fattrs#setNamedItem attr'')
+ | _,_ -> assert false
+ done ;
+ for i = 0 to tlen -1 do
+ match tattrs#item i with
+ None -> assert false
+ | Some attr ->
+ let namespaceURI,localName =
+ match attr#get_namespaceURI with
+ None ->
+ None,attr#get_nodeName
+ | Some namespaceURI as v ->
+ v, match attr#get_localName with
+ None -> assert false
+ | Some v -> v
+ in
+ if
+ not
+ (List.exists
+ (function
+ None,Some localName' ->
+ (match namespaceURI with
+ None ->
+ localName#equals localName'
+ | Some _ -> false)
+ | Some namespaceURI', Some localName' ->
+ (match namespaceURI with
+ None -> false
+ | Some namespaceURI ->
+ localName#equals localName' &&
+ namespaceURI#equals namespaceURI'
+ )
+ | _,_ -> assert false
+ ) !processed)
+ then
+ let attr' = from#importNode attr false in
+ ignore (fattrs#setNamedItem attr')
+ done
+ | _,_ -> assert false
+ end ;
+ let rec dumb_diff =
+ function
+ [],[] -> ()
+ | he1::tl1,he2::tl2 ->
+ aux f he1 he2 ;
+ dumb_diff (tl1,tl2)
+ | [],tl2 ->
+ List.iter
+ (function n ->
+ let n' = from#importNode n true in
+ ignore (f#appendChild n') ;
+ (* ignore (highlight_node from n') *)
+ ()
+ ) tl2
+ | tl1,[] ->
+ List.iter (function n -> ignore (f#removeChild n)) tl1
+ in
+ let node_list_of_nodeList n =
+ let rec aux =
+ function
+ None -> []
+ | Some n when
+ n#get_nodeType = GdomeNodeTypeT.ELEMENT_NODE
+ or n#get_nodeType = GdomeNodeTypeT.TEXT_NODE ->
+ n::(aux n#get_nextSibling)
+ | Some n ->
+ aux n#get_nextSibling
+ in
+ aux n#get_firstChild
+ in
+ dumb_diff
+ (node_list_of_nodeList f, node_list_of_nodeList t)
+ | _,_,_,_ -> replace t1
+ )
+ | t1,t2 when
+ (t1 = GdomeNodeTypeT.ELEMENT_NODE || t1 = GdomeNodeTypeT.TEXT_NODE) &&
+ (t2 = GdomeNodeTypeT.ELEMENT_NODE || t2 = GdomeNodeTypeT.TEXT_NODE) ->
+ replace t1
+ | _,_ -> assert false
+ in
+ try
+ aux (d :> Gdome.node)
+ (from#get_documentElement :> Gdome.node)
+ (d#get_documentElement :> Gdome.node)
+ with
+ (GdomeInit.DOMException (e,msg) as ex) -> raise ex
+ | e -> raise e
+;;
diff --git a/helm/ocaml/xmldiff/xmlDiff.mli b/helm/ocaml/xmldiff/xmlDiff.mli
new file mode 100644
index 000000000..cf084af94
--- /dev/null
+++ b/helm/ocaml/xmldiff/xmlDiff.mli
@@ -0,0 +1,30 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM 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 HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val update_dom: from: Gdome.document -> Gdome.document -> unit
+
+type highlighted_nodes
+val highlight_nodes: xrefs:(string list) -> Gdome.document -> highlighted_nodes
+val dim_nodes: highlighted_nodes -> unit
--
2.39.2