From 9a0e4f3be9f70662f18d2d3b6dd60ae79fba565b Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Thu, 24 Nov 2005 18:25:43 +0000 Subject: [PATCH] Reshaped structure of ocaml/ libraries. Verbose list of the changes: Modified Files: Makefile.in METAS/meta.helm-cic_disambiguation.src cic_disambiguation/.depend cic_disambiguation/Makefile cic_disambiguation/disambiguate.ml cic_disambiguation/disambiguate.mli cic_disambiguation/disambiguateChoices.ml cic_disambiguation/disambiguateTypes.ml cic_disambiguation/disambiguateTypes.mli extlib/.depend extlib/Makefile xml/xml.ml xml/xml.mli Added Files: METAS/meta.helm-acic_content.src METAS/meta.helm-cic_acic.src METAS/meta.helm-content_pres.src METAS/meta.helm-grafite.src METAS/meta.helm-hgdome.src acic_content/.cvsignore acic_content/.depend acic_content/Makefile acic_content/acic2astMatcher.ml acic_content/acic2astMatcher.mli acic_content/acic2content.ml acic_content/acic2content.mli acic_content/cicNotationEnv.ml acic_content/cicNotationEnv.mli acic_content/cicNotationPp.ml acic_content/cicNotationPp.mli acic_content/cicNotationPt.ml acic_content/cicNotationUtil.ml acic_content/cicNotationUtil.mli acic_content/content.ml acic_content/content.mli acic_content/content2cic.ml acic_content/content2cic.mli acic_content/contentPp.ml acic_content/contentPp.mli acic_content/termAcicContent.ml acic_content/termAcicContent.mli cic_acic/.cvsignore cic_acic/.depend cic_acic/Makefile cic_acic/cic2Xml.ml cic_acic/cic2Xml.mli cic_acic/cic2acic.ml cic_acic/cic2acic.mli cic_acic/doubleTypeInference.ml cic_acic/doubleTypeInference.mli cic_acic/eta_fixing.ml cic_acic/eta_fixing.mli content_pres/.cvsignore content_pres/.depend content_pres/Makefile content_pres/box.ml content_pres/box.mli content_pres/boxPp.ml content_pres/boxPp.mli content_pres/cicNotationLexer.ml content_pres/cicNotationLexer.mli content_pres/cicNotationParser.ml content_pres/cicNotationParser.mli content_pres/cicNotationPres.ml content_pres/cicNotationPres.mli content_pres/content2pres.ml content_pres/content2pres.mli content_pres/content2presMatcher.ml content_pres/content2presMatcher.mli content_pres/mpresentation.ml content_pres/mpresentation.mli content_pres/renderingAttrs.ml content_pres/renderingAttrs.mli content_pres/sequent2pres.ml content_pres/sequent2pres.mli content_pres/termContentPres.ml content_pres/termContentPres.mli content_pres/test_lexer.ml extlib/patternMatcher.ml extlib/patternMatcher.mli grafite/.cvsignore grafite/.depend grafite/Makefile grafite/cicNotation.ml grafite/cicNotation.mli grafite/grafiteAst.ml grafite/grafiteAstPp.ml grafite/grafiteAstPp.mli grafite/grafiteParser.ml grafite/grafiteParser.mli grafite/print_grammar.ml grafite/test_dep.ml grafite/test_parser.ml hgdome/.cvsignore hgdome/.depend hgdome/Makefile hgdome/domMisc.ml hgdome/domMisc.mli hgdome/xml2Gdome.ml hgdome/xml2Gdome.mli Removed Files: METAS/meta.helm-cic_notation.src METAS/meta.helm-cic_omdoc.src METAS/meta.helm-cic_transformations.src cic_disambiguation/disambiguatePp.ml cic_disambiguation/disambiguatePp.mli cic_notation/.cvsignore cic_notation/.depend cic_notation/Makefile cic_notation/TODO cic_notation/box.ml cic_notation/box.mli cic_notation/boxPp.ml cic_notation/boxPp.mli cic_notation/cicNotation.ml cic_notation/cicNotation.mli cic_notation/cicNotationEnv.ml cic_notation/cicNotationEnv.mli cic_notation/cicNotationFwd.ml cic_notation/cicNotationFwd.mli cic_notation/cicNotationLexer.ml cic_notation/cicNotationLexer.mli cic_notation/cicNotationMatcher.ml cic_notation/cicNotationMatcher.mli cic_notation/cicNotationParser.expanded.ml cic_notation/cicNotationParser.ml cic_notation/cicNotationParser.mli cic_notation/cicNotationPp.ml cic_notation/cicNotationPp.mli cic_notation/cicNotationPres.ml cic_notation/cicNotationPres.mli cic_notation/cicNotationPt.ml cic_notation/cicNotationRew.ml cic_notation/cicNotationRew.mli cic_notation/cicNotationTag.ml cic_notation/cicNotationTag.mli cic_notation/cicNotationUtil.ml cic_notation/cicNotationUtil.mli cic_notation/grafiteAst.ml cic_notation/grafiteAstPp.ml cic_notation/grafiteAstPp.mli cic_notation/grafiteParser.ml cic_notation/grafiteParser.mli cic_notation/mpresentation.ml cic_notation/mpresentation.mli cic_notation/print_grammar.ml cic_notation/renderingAttrs.ml cic_notation/renderingAttrs.mli cic_notation/test_dep.ml cic_notation/test_lexer.ml cic_notation/test_parser.conf.xml cic_notation/test_parser.ml cic_notation/doc/.cvsignore cic_notation/doc/Makefile cic_notation/doc/body.tex cic_notation/doc/infernce.sty cic_notation/doc/ligature.sty cic_notation/doc/main.tex cic_notation/doc/manfnt.sty cic_notation/doc/reserved.sty cic_notation/doc/samples.ma cic_notation/doc/semantic.sty cic_notation/doc/shrthand.sty cic_notation/doc/tdiagram.sty cic_omdoc/.cvsignore cic_omdoc/.depend cic_omdoc/Makefile cic_omdoc/cic2acic.ml cic_omdoc/cic2acic.mli cic_omdoc/cic2content.ml cic_omdoc/cic2content.mli cic_omdoc/content.ml cic_omdoc/content.mli cic_omdoc/content2cic.ml cic_omdoc/content2cic.mli cic_omdoc/contentPp.ml cic_omdoc/contentPp.mli cic_omdoc/doubleTypeInference.ml cic_omdoc/doubleTypeInference.mli cic_omdoc/eta_fixing.ml cic_omdoc/eta_fixing.mli cic_transformations/.cvsignore cic_transformations/.depend cic_transformations/Makefile cic_transformations/applyTransformation.ml cic_transformations/applyTransformation.mli cic_transformations/cic2Xml.ml cic_transformations/cic2Xml.mli cic_transformations/content2pres.ml cic_transformations/content2pres.mli cic_transformations/domMisc.ml cic_transformations/domMisc.mli cic_transformations/sequent2pres.ml cic_transformations/sequent2pres.mli cic_transformations/xml2Gdome.ml cic_transformations/xml2Gdome.mli --- helm/ocaml/METAS/meta.helm-acic_content.src | 4 + helm/ocaml/METAS/meta.helm-cic_acic.src | 4 + .../METAS/meta.helm-cic_disambiguation.src | 2 +- helm/ocaml/METAS/meta.helm-cic_notation.src | 4 - helm/ocaml/METAS/meta.helm-cic_omdoc.src | 4 - .../METAS/meta.helm-cic_transformations.src | 5 - helm/ocaml/METAS/meta.helm-content_pres.src | 4 + helm/ocaml/METAS/meta.helm-grafite.src | 4 + helm/ocaml/METAS/meta.helm-hgdome.src | 4 + helm/ocaml/Makefile.in | 8 +- helm/ocaml/acic_content/.cvsignore | 2 + helm/ocaml/acic_content/.depend | 30 + helm/ocaml/acic_content/Makefile | 19 + helm/ocaml/acic_content/acic2astMatcher.ml | 96 ++ .../acic2astMatcher.mli} | 16 +- .../acic2content.ml} | 0 .../acic2content.mli} | 0 .../cicNotationEnv.ml | 0 .../cicNotationEnv.mli | 0 .../cicNotationPp.ml | 62 + .../cicNotationPp.mli | 3 + .../cicNotationPt.ml | 17 + .../cicNotationUtil.ml | 12 +- .../cicNotationUtil.mli | 2 +- .../{cic_omdoc => acic_content}/content.ml | 0 .../{cic_omdoc => acic_content}/content.mli | 0 .../content2cic.ml | 0 .../content2cic.mli | 0 .../{cic_omdoc => acic_content}/contentPp.ml | 0 .../{cic_omdoc => acic_content}/contentPp.mli | 0 helm/ocaml/acic_content/termAcicContent.ml | 369 +++++ .../termAcicContent.mli} | 44 +- helm/ocaml/cic_acic/.cvsignore | 2 + helm/ocaml/cic_acic/.depend | 9 + helm/ocaml/{cic_omdoc => cic_acic}/Makefile | 10 +- .../cic2Xml.ml | 0 .../cic2Xml.mli | 0 .../ocaml/{cic_omdoc => cic_acic}/cic2acic.ml | 0 .../{cic_omdoc => cic_acic}/cic2acic.mli | 0 .../doubleTypeInference.ml | 0 .../doubleTypeInference.mli | 0 .../{cic_omdoc => cic_acic}/eta_fixing.ml | 0 .../{cic_omdoc => cic_acic}/eta_fixing.mli | 0 helm/ocaml/cic_disambiguation/.depend | 5 - helm/ocaml/cic_disambiguation/Makefile | 1 - helm/ocaml/cic_disambiguation/disambiguate.ml | 18 +- .../ocaml/cic_disambiguation/disambiguate.mli | 6 +- .../cic_disambiguation/disambiguateChoices.ml | 6 +- .../cic_disambiguation/disambiguatePp.ml | 83 -- .../cic_disambiguation/disambiguateTypes.ml | 2 + .../cic_disambiguation/disambiguateTypes.mli | 2 + helm/ocaml/cic_notation/.depend | 73 - helm/ocaml/cic_notation/Makefile | 67 - helm/ocaml/cic_notation/TODO | 47 - helm/ocaml/cic_notation/cicNotationFwd.ml | 218 --- helm/ocaml/cic_notation/cicNotationMatcher.ml | 448 ------ .../cicNotationParser.expanded.ml | 1162 ---------------- helm/ocaml/cic_notation/cicNotationTag.ml | 45 - helm/ocaml/cic_notation/doc/.cvsignore | 6 - helm/ocaml/cic_notation/doc/Makefile | 124 -- helm/ocaml/cic_notation/doc/body.tex | 1225 ----------------- helm/ocaml/cic_notation/doc/infernce.sty | 217 --- helm/ocaml/cic_notation/doc/ligature.sty | 169 --- helm/ocaml/cic_notation/doc/main.tex | 43 - helm/ocaml/cic_notation/doc/manfnt.sty | 74 - helm/ocaml/cic_notation/doc/reserved.sty | 80 -- helm/ocaml/cic_notation/doc/samples.ma | 139 -- helm/ocaml/cic_notation/doc/semantic.sty | 137 -- helm/ocaml/cic_notation/doc/shrthand.sty | 96 -- helm/ocaml/cic_notation/doc/tdiagram.sty | 166 --- helm/ocaml/cic_notation/test_parser.conf.xml | 15 - helm/ocaml/cic_omdoc/.cvsignore | 1 - helm/ocaml/cic_omdoc/.depend | 17 - helm/ocaml/cic_transformations/.cvsignore | 1 - helm/ocaml/cic_transformations/.depend | 14 - helm/ocaml/cic_transformations/Makefile | 25 - .../applyTransformation.ml | 70 - .../applyTransformation.mli | 57 - helm/ocaml/content_pres/.cvsignore | 4 + helm/ocaml/content_pres/.depend | 36 + helm/ocaml/content_pres/Makefile | 42 + .../{cic_notation => content_pres}/box.ml | 0 .../{cic_notation => content_pres}/box.mli | 0 .../{cic_notation => content_pres}/boxPp.ml | 0 .../{cic_notation => content_pres}/boxPp.mli | 0 .../cicNotationLexer.ml | 0 .../cicNotationLexer.mli | 0 .../cicNotationParser.ml | 0 .../cicNotationParser.mli | 0 .../cicNotationPres.ml | 0 .../cicNotationPres.mli | 0 .../content2pres.ml | 4 +- .../content2pres.mli | 0 .../ocaml/content_pres/content2presMatcher.ml | 231 ++++ .../content2presMatcher.mli} | 11 +- .../mpresentation.ml | 0 .../mpresentation.mli | 0 .../renderingAttrs.ml | 0 .../renderingAttrs.mli | 0 .../sequent2pres.ml | 4 +- .../sequent2pres.mli | 0 .../termContentPres.ml} | 505 +++---- .../termContentPres.mli} | 28 +- .../test_lexer.ml | 0 helm/ocaml/extlib/.depend | 2 + helm/ocaml/extlib/Makefile | 6 +- helm/ocaml/extlib/patternMatcher.ml | 189 +++ .../patternMatcher.mli} | 21 +- .../{cic_notation => grafite}/.cvsignore | 6 +- helm/ocaml/grafite/.depend | 9 + helm/ocaml/grafite/Makefile | 31 + .../{cic_notation => grafite}/cicNotation.ml | 20 +- .../{cic_notation => grafite}/cicNotation.mli | 0 .../{cic_notation => grafite}/grafiteAst.ml | 21 - .../{cic_notation => grafite}/grafiteAstPp.ml | 66 +- .../grafiteAstPp.mli | 18 +- .../grafiteParser.ml | 16 +- .../grafiteParser.mli | 2 +- .../print_grammar.ml | 0 .../{cic_notation => grafite}/test_dep.ml | 0 .../{cic_notation => grafite}/test_parser.ml | 12 +- helm/ocaml/hgdome/.cvsignore | 2 + helm/ocaml/hgdome/.depend | 4 + helm/ocaml/hgdome/Makefile | 11 + .../domMisc.ml | 8 - .../domMisc.mli | 4 - .../xml2Gdome.ml | 0 .../xml2Gdome.mli | 0 helm/ocaml/xml/xml.ml | 13 + helm/ocaml/xml/xml.mli | 2 + 130 files changed, 1530 insertions(+), 5393 deletions(-) create mode 100644 helm/ocaml/METAS/meta.helm-acic_content.src create mode 100644 helm/ocaml/METAS/meta.helm-cic_acic.src delete mode 100644 helm/ocaml/METAS/meta.helm-cic_notation.src delete mode 100644 helm/ocaml/METAS/meta.helm-cic_omdoc.src delete mode 100644 helm/ocaml/METAS/meta.helm-cic_transformations.src create mode 100644 helm/ocaml/METAS/meta.helm-content_pres.src create mode 100644 helm/ocaml/METAS/meta.helm-grafite.src create mode 100644 helm/ocaml/METAS/meta.helm-hgdome.src create mode 100644 helm/ocaml/acic_content/.cvsignore 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 rename helm/ocaml/{cic_disambiguation/disambiguatePp.mli => acic_content/acic2astMatcher.mli} (75%) rename helm/ocaml/{cic_omdoc/cic2content.ml => acic_content/acic2content.ml} (100%) rename helm/ocaml/{cic_omdoc/cic2content.mli => acic_content/acic2content.mli} (100%) rename helm/ocaml/{cic_notation => acic_content}/cicNotationEnv.ml (100%) rename helm/ocaml/{cic_notation => acic_content}/cicNotationEnv.mli (100%) rename helm/ocaml/{cic_notation => acic_content}/cicNotationPp.ml (82%) rename helm/ocaml/{cic_notation => acic_content}/cicNotationPp.mli (92%) rename helm/ocaml/{cic_notation => acic_content}/cicNotationPt.ml (86%) rename helm/ocaml/{cic_notation => acic_content}/cicNotationUtil.ml (96%) rename helm/ocaml/{cic_notation => acic_content}/cicNotationUtil.mli (98%) rename helm/ocaml/{cic_omdoc => acic_content}/content.ml (100%) rename helm/ocaml/{cic_omdoc => acic_content}/content.mli (100%) rename helm/ocaml/{cic_omdoc => acic_content}/content2cic.ml (100%) rename helm/ocaml/{cic_omdoc => acic_content}/content2cic.mli (100%) rename helm/ocaml/{cic_omdoc => acic_content}/contentPp.ml (100%) rename helm/ocaml/{cic_omdoc => acic_content}/contentPp.mli (100%) create mode 100644 helm/ocaml/acic_content/termAcicContent.ml rename helm/ocaml/{cic_notation/cicNotationRew.mli => acic_content/termAcicContent.mli} (77%) create mode 100644 helm/ocaml/cic_acic/.cvsignore create mode 100644 helm/ocaml/cic_acic/.depend rename helm/ocaml/{cic_omdoc => cic_acic}/Makefile (55%) rename helm/ocaml/{cic_transformations => cic_acic}/cic2Xml.ml (100%) rename helm/ocaml/{cic_transformations => cic_acic}/cic2Xml.mli (100%) rename helm/ocaml/{cic_omdoc => cic_acic}/cic2acic.ml (100%) rename helm/ocaml/{cic_omdoc => cic_acic}/cic2acic.mli (100%) rename helm/ocaml/{cic_omdoc => cic_acic}/doubleTypeInference.ml (100%) rename helm/ocaml/{cic_omdoc => cic_acic}/doubleTypeInference.mli (100%) rename helm/ocaml/{cic_omdoc => cic_acic}/eta_fixing.ml (100%) rename helm/ocaml/{cic_omdoc => cic_acic}/eta_fixing.mli (100%) delete mode 100644 helm/ocaml/cic_disambiguation/disambiguatePp.ml delete mode 100644 helm/ocaml/cic_notation/.depend delete mode 100644 helm/ocaml/cic_notation/Makefile delete mode 100644 helm/ocaml/cic_notation/TODO delete mode 100644 helm/ocaml/cic_notation/cicNotationFwd.ml delete mode 100644 helm/ocaml/cic_notation/cicNotationMatcher.ml delete mode 100644 helm/ocaml/cic_notation/cicNotationParser.expanded.ml delete mode 100644 helm/ocaml/cic_notation/cicNotationTag.ml delete mode 100644 helm/ocaml/cic_notation/doc/.cvsignore delete mode 100644 helm/ocaml/cic_notation/doc/Makefile delete mode 100644 helm/ocaml/cic_notation/doc/body.tex delete mode 100644 helm/ocaml/cic_notation/doc/infernce.sty delete mode 100644 helm/ocaml/cic_notation/doc/ligature.sty delete mode 100644 helm/ocaml/cic_notation/doc/main.tex delete mode 100644 helm/ocaml/cic_notation/doc/manfnt.sty delete mode 100644 helm/ocaml/cic_notation/doc/reserved.sty delete mode 100644 helm/ocaml/cic_notation/doc/samples.ma delete mode 100644 helm/ocaml/cic_notation/doc/semantic.sty delete mode 100644 helm/ocaml/cic_notation/doc/shrthand.sty delete mode 100644 helm/ocaml/cic_notation/doc/tdiagram.sty delete mode 100644 helm/ocaml/cic_notation/test_parser.conf.xml delete mode 100644 helm/ocaml/cic_omdoc/.cvsignore delete mode 100644 helm/ocaml/cic_omdoc/.depend delete mode 100644 helm/ocaml/cic_transformations/.cvsignore delete mode 100644 helm/ocaml/cic_transformations/.depend delete mode 100644 helm/ocaml/cic_transformations/Makefile delete mode 100644 helm/ocaml/cic_transformations/applyTransformation.ml delete mode 100644 helm/ocaml/cic_transformations/applyTransformation.mli create mode 100644 helm/ocaml/content_pres/.cvsignore create mode 100644 helm/ocaml/content_pres/.depend create mode 100644 helm/ocaml/content_pres/Makefile rename helm/ocaml/{cic_notation => content_pres}/box.ml (100%) rename helm/ocaml/{cic_notation => content_pres}/box.mli (100%) rename helm/ocaml/{cic_notation => content_pres}/boxPp.ml (100%) rename helm/ocaml/{cic_notation => content_pres}/boxPp.mli (100%) rename helm/ocaml/{cic_notation => content_pres}/cicNotationLexer.ml (100%) rename helm/ocaml/{cic_notation => content_pres}/cicNotationLexer.mli (100%) rename helm/ocaml/{cic_notation => content_pres}/cicNotationParser.ml (100%) rename helm/ocaml/{cic_notation => content_pres}/cicNotationParser.mli (100%) rename helm/ocaml/{cic_notation => content_pres}/cicNotationPres.ml (100%) rename helm/ocaml/{cic_notation => content_pres}/cicNotationPres.mli (100%) rename helm/ocaml/{cic_transformations => content_pres}/content2pres.ml (99%) rename helm/ocaml/{cic_transformations => content_pres}/content2pres.mli (100%) create mode 100644 helm/ocaml/content_pres/content2presMatcher.ml rename helm/ocaml/{cic_notation/cicNotationTag.mli => content_pres/content2presMatcher.mli} (78%) rename helm/ocaml/{cic_notation => content_pres}/mpresentation.ml (100%) rename helm/ocaml/{cic_notation => content_pres}/mpresentation.mli (100%) rename helm/ocaml/{cic_notation => content_pres}/renderingAttrs.ml (100%) rename helm/ocaml/{cic_notation => content_pres}/renderingAttrs.mli (100%) rename helm/ocaml/{cic_transformations => content_pres}/sequent2pres.ml (97%) rename helm/ocaml/{cic_transformations => content_pres}/sequent2pres.mli (100%) rename helm/ocaml/{cic_notation/cicNotationRew.ml => content_pres/termContentPres.ml} (59%) rename helm/ocaml/{cic_notation/cicNotationFwd.mli => content_pres/termContentPres.mli} (68%) rename helm/ocaml/{cic_notation => content_pres}/test_lexer.ml (100%) create mode 100644 helm/ocaml/extlib/patternMatcher.ml rename helm/ocaml/{cic_notation/cicNotationMatcher.mli => extlib/patternMatcher.mli} (80%) rename helm/ocaml/{cic_notation => grafite}/.cvsignore (59%) create mode 100644 helm/ocaml/grafite/.depend create mode 100644 helm/ocaml/grafite/Makefile rename helm/ocaml/{cic_notation => grafite}/cicNotation.ml (79%) rename helm/ocaml/{cic_notation => grafite}/cicNotation.mli (100%) rename helm/ocaml/{cic_notation => grafite}/grafiteAst.ml (89%) rename helm/ocaml/{cic_notation => grafite}/grafiteAstPp.ml (84%) rename helm/ocaml/{cic_notation => grafite}/grafiteAstPp.mli (88%) rename helm/ocaml/{cic_notation => grafite}/grafiteParser.ml (97%) rename helm/ocaml/{cic_notation => grafite}/grafiteParser.mli (97%) rename helm/ocaml/{cic_notation => grafite}/print_grammar.ml (100%) rename helm/ocaml/{cic_notation => grafite}/test_dep.ml (100%) rename helm/ocaml/{cic_notation => grafite}/test_parser.ml (94%) create mode 100644 helm/ocaml/hgdome/.cvsignore create mode 100644 helm/ocaml/hgdome/.depend create mode 100644 helm/ocaml/hgdome/Makefile rename helm/ocaml/{cic_transformations => hgdome}/domMisc.ml (86%) rename helm/ocaml/{cic_transformations => hgdome}/domMisc.mli (94%) rename helm/ocaml/{cic_transformations => hgdome}/xml2Gdome.ml (100%) rename helm/ocaml/{cic_transformations => hgdome}/xml2Gdome.mli (100%) 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_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_disambiguation.src b/helm/ocaml/METAS/meta.helm-cic_disambiguation.src index 1d084c4e3..d0a61cd51 100644 --- a/helm/ocaml/METAS/meta.helm-cic_disambiguation.src +++ b/helm/ocaml/METAS/meta.helm-cic_disambiguation.src @@ -1,4 +1,4 @@ -requires="helm-whelp helm-cic_notation helm-cic_unification" +requires="helm-whelp helm-content_pres 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_notation.src b/helm/ocaml/METAS/meta.helm-cic_notation.src deleted file mode 100644 index 332714edf..000000000 --- a/helm/ocaml/METAS/meta.helm-cic_notation.src +++ /dev/null @@ -1,4 +0,0 @@ -requires="helm-cic helm-utf8_macros camlp4.gramlib helm-cic_proof_checking ulex" -version="0.0.1" -archive(byte)="cic_notation.cma" -archive(native)="cic_notation.cmxa" diff --git a/helm/ocaml/METAS/meta.helm-cic_omdoc.src b/helm/ocaml/METAS/meta.helm-cic_omdoc.src deleted file mode 100644 index 313d19cd2..000000000 --- a/helm/ocaml/METAS/meta.helm-cic_omdoc.src +++ /dev/null @@ -1,4 +0,0 @@ -requires="helm-cic_proof_checking" -version="0.0.1" -archive(byte)="cic_omdoc.cma" -archive(native)="cic_omdoc.cmxa" diff --git a/helm/ocaml/METAS/meta.helm-cic_transformations.src b/helm/ocaml/METAS/meta.helm-cic_transformations.src deleted file mode 100644 index 0543f4220..000000000 --- a/helm/ocaml/METAS/meta.helm-cic_transformations.src +++ /dev/null @@ -1,5 +0,0 @@ -requires="helm-utf8_macros helm-xml helm-cic_proof_checking helm-cic_omdoc helm-registry helm-cic_notation gdome2" -version="0.0.1" -archive(byte)="cic_transformations.cma" -archive(native)="cic_transformations.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-grafite.src b/helm/ocaml/METAS/meta.helm-grafite.src new file mode 100644 index 000000000..847d6e333 --- /dev/null +++ b/helm/ocaml/METAS/meta.helm-grafite.src @@ -0,0 +1,4 @@ +requires="helm-content_pres" +version="0.0.1" +archive(byte)="grafite.cma" +archive(native)="grafite.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/Makefile.in b/helm/ocaml/Makefile.in index 4147a9226..30c25dc19 100644 --- a/helm/ocaml/Makefile.in +++ b/helm/ocaml/Makefile.in @@ -3,6 +3,7 @@ NULL = MODULES = \ extlib \ xml \ + hgdome \ registry \ hmysql \ utf8_macros \ @@ -14,12 +15,13 @@ MODULES = \ cic \ cic_proof_checking \ cic_unification \ - cic_omdoc \ + cic_acic \ + acic_content \ + content_pres \ + grafite \ metadata \ whelp \ tactics \ - cic_notation \ - cic_transformations \ cic_disambiguation \ paramodulation \ $(NULL) diff --git a/helm/ocaml/acic_content/.cvsignore b/helm/ocaml/acic_content/.cvsignore new file mode 100644 index 000000000..8d64a5378 --- /dev/null +++ b/helm/ocaml/acic_content/.cvsignore @@ -0,0 +1,2 @@ +*.cm[iaox] +*.cmxa 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..7575dc8ba --- /dev/null +++ b/helm/ocaml/acic_content/acic2astMatcher.ml @@ -0,0 +1,96 @@ +(* 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 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/cic_disambiguation/disambiguatePp.mli b/helm/ocaml/acic_content/acic2astMatcher.mli similarity index 75% rename from helm/ocaml/cic_disambiguation/disambiguatePp.mli rename to helm/ocaml/acic_content/acic2astMatcher.mli index 69b6e8451..0a9ec6a6b 100644 --- a/helm/ocaml/cic_disambiguation/disambiguatePp.mli +++ b/helm/ocaml/acic_content/acic2astMatcher.mli @@ -23,12 +23,12 @@ * http://helm.cs.unibo.it/ *) -val parse_environment: - string -> - DisambiguateTypes.environment * DisambiguateTypes.multiple_environment +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 -val aliases_of_domain_and_codomain_items_list: - (DisambiguateTypes.domain_item * DisambiguateTypes.codomain_item) list -> - GrafiteAst.alias_spec list - -val pp_environment: DisambiguateTypes.environment -> string diff --git a/helm/ocaml/cic_omdoc/cic2content.ml b/helm/ocaml/acic_content/acic2content.ml similarity index 100% rename from helm/ocaml/cic_omdoc/cic2content.ml rename to helm/ocaml/acic_content/acic2content.ml diff --git a/helm/ocaml/cic_omdoc/cic2content.mli b/helm/ocaml/acic_content/acic2content.mli similarity index 100% rename from helm/ocaml/cic_omdoc/cic2content.mli rename to helm/ocaml/acic_content/acic2content.mli diff --git a/helm/ocaml/cic_notation/cicNotationEnv.ml b/helm/ocaml/acic_content/cicNotationEnv.ml similarity index 100% rename from helm/ocaml/cic_notation/cicNotationEnv.ml rename to helm/ocaml/acic_content/cicNotationEnv.ml diff --git a/helm/ocaml/cic_notation/cicNotationEnv.mli b/helm/ocaml/acic_content/cicNotationEnv.mli similarity index 100% rename from helm/ocaml/cic_notation/cicNotationEnv.mli rename to helm/ocaml/acic_content/cicNotationEnv.mli diff --git a/helm/ocaml/cic_notation/cicNotationPp.ml b/helm/ocaml/acic_content/cicNotationPp.ml similarity index 82% rename from helm/ocaml/cic_notation/cicNotationPp.ml rename to helm/ocaml/acic_content/cicNotationPp.ml index b5a2e04f2..bf0f9ed4c 100644 --- a/helm/ocaml/cic_notation/cicNotationPp.ml +++ b/helm/ocaml/acic_content/cicNotationPp.ml @@ -234,6 +234,61 @@ and pp_variable = function 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) -> " " ^ name ^ ": " ^ 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 @@ -257,3 +312,10 @@ let pp_env env = 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/cic_notation/cicNotationPp.mli b/helm/ocaml/acic_content/cicNotationPp.mli similarity index 92% rename from helm/ocaml/cic_notation/cicNotationPp.mli rename to helm/ocaml/acic_content/cicNotationPp.mli index 2fb05c51b..57a4d6b82 100644 --- a/helm/ocaml/cic_notation/cicNotationPp.mli +++ b/helm/ocaml/acic_content/cicNotationPp.mli @@ -24,6 +24,7 @@ *) val pp_term: CicNotationPt.term -> string +val pp_obj: CicNotationPt.obj -> string val pp_env: CicNotationEnv.t -> string val pp_value: CicNotationEnv.value -> string @@ -32,3 +33,5 @@ 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/cic_notation/cicNotationPt.ml b/helm/ocaml/acic_content/cicNotationPt.ml similarity index 86% rename from helm/ocaml/cic_notation/cicNotationPt.ml rename to helm/ocaml/acic_content/cicNotationPt.ml index d0310d0e5..e3d5fc544 100644 --- a/helm/ocaml/cic_notation/cicNotationPt.ml +++ b/helm/ocaml/acic_content/cicNotationPt.ml @@ -157,6 +157,23 @@ type cic_appl_pattern = | ImplicitPattern | ApplPattern of cic_appl_pattern 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) list + (** left parameters, name, type, fields *) + (** {2 Standard precedences} *) let let_in_prec = 10 diff --git a/helm/ocaml/cic_notation/cicNotationUtil.ml b/helm/ocaml/acic_content/cicNotationUtil.ml similarity index 96% rename from helm/ocaml/cic_notation/cicNotationUtil.ml rename to helm/ocaml/acic_content/cicNotationUtil.ml index 887f5bf05..0aa6b48b3 100644 --- a/helm/ocaml/cic_notation/cicNotationUtil.ml +++ b/helm/ocaml/acic_content/cicNotationUtil.ml @@ -365,20 +365,20 @@ let freshen_obj obj = let freshen_term = freshen_term ~index in let freshen_name_ty = List.map (fun (n, t) -> (n, freshen_term t)) in match obj with - | GrafiteAst.Inductive (params, indtypes) -> + | CicNotationPt.Inductive (params, indtypes) -> let indtypes = List.map (fun (n, co, ty, ctors) -> (n, co, ty, freshen_name_ty ctors)) indtypes in - GrafiteAst.Inductive (freshen_name_ty params, indtypes) - | GrafiteAst.Theorem (flav, n, t, ty_opt) -> + 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 - GrafiteAst.Theorem (flav, n, freshen_term t, ty_opt) - | GrafiteAst.Record (params, n, ty, fields) -> - GrafiteAst.Record (freshen_name_ty params, n, freshen_term ty, + 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 fields) let freshen_term = freshen_term ?index:None diff --git a/helm/ocaml/cic_notation/cicNotationUtil.mli b/helm/ocaml/acic_content/cicNotationUtil.mli similarity index 98% rename from helm/ocaml/cic_notation/cicNotationUtil.mli rename to helm/ocaml/acic_content/cicNotationUtil.mli index ad16a2eb6..5d309d68f 100644 --- a/helm/ocaml/cic_notation/cicNotationUtil.mli +++ b/helm/ocaml/acic_content/cicNotationUtil.mli @@ -81,7 +81,7 @@ val name_of_cic_name: Cic.name -> CicNotationPt.term (** Symbol/Numbers instances *) val freshen_term: CicNotationPt.term -> CicNotationPt.term -val freshen_obj: GrafiteAst.obj -> GrafiteAst.obj +val freshen_obj: CicNotationPt.obj -> CicNotationPt.obj (** Notation id handling *) diff --git a/helm/ocaml/cic_omdoc/content.ml b/helm/ocaml/acic_content/content.ml similarity index 100% rename from helm/ocaml/cic_omdoc/content.ml rename to helm/ocaml/acic_content/content.ml diff --git a/helm/ocaml/cic_omdoc/content.mli b/helm/ocaml/acic_content/content.mli similarity index 100% rename from helm/ocaml/cic_omdoc/content.mli rename to helm/ocaml/acic_content/content.mli diff --git a/helm/ocaml/cic_omdoc/content2cic.ml b/helm/ocaml/acic_content/content2cic.ml similarity index 100% rename from helm/ocaml/cic_omdoc/content2cic.ml rename to helm/ocaml/acic_content/content2cic.ml diff --git a/helm/ocaml/cic_omdoc/content2cic.mli b/helm/ocaml/acic_content/content2cic.mli similarity index 100% rename from helm/ocaml/cic_omdoc/content2cic.mli rename to helm/ocaml/acic_content/content2cic.mli diff --git a/helm/ocaml/cic_omdoc/contentPp.ml b/helm/ocaml/acic_content/contentPp.ml similarity index 100% rename from helm/ocaml/cic_omdoc/contentPp.ml rename to helm/ocaml/acic_content/contentPp.ml diff --git a/helm/ocaml/cic_omdoc/contentPp.mli b/helm/ocaml/acic_content/contentPp.mli similarity index 100% rename from helm/ocaml/cic_omdoc/contentPp.mli rename to helm/ocaml/acic_content/contentPp.mli diff --git a/helm/ocaml/acic_content/termAcicContent.ml b/helm/ocaml/acic_content/termAcicContent.ml new file mode 100644 index 000000000..a9cf9a4d1 --- /dev/null +++ b/helm/ocaml/acic_content/termAcicContent.ml @@ -0,0 +1,369 @@ +(* 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 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 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) as t -> + 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/cic_notation/cicNotationRew.mli b/helm/ocaml/acic_content/termAcicContent.mli similarity index 77% rename from helm/ocaml/cic_notation/cicNotationRew.mli rename to helm/ocaml/acic_content/termAcicContent.mli index f587291aa..1fd57e0d0 100644 --- a/helm/ocaml/cic_notation/cicNotationRew.mli +++ b/helm/ocaml/acic_content/termAcicContent.mli @@ -1,4 +1,4 @@ -(* Copyright (C) 2004-2005, HELM Team. +(* Copyright (C) 2005, HELM Team. * * This file is part of HELM, an Hypertextual, Electronic * Library of Mathematics, developed at the Computer Science @@ -23,20 +23,9 @@ * http://helm.cs.unibo.it/ *) - (** level 3 -> level 2 *) -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 *) - - (** level 2 -> level 1 *) -val pp_ast: CicNotationPt.term -> CicNotationPt.term - - (** for level 1 -> level 0: see CicNotationPres.render *) + (** {2 Persistant state handling} *) type interpretation_id -type pretty_printer_id val add_interpretation: string -> (* id / description *) @@ -50,25 +39,30 @@ val lookup_interpretations: (string * CicNotationPt.argument_pattern list * CicNotationPt.cic_appl_pattern) list -val add_pretty_printer: - precedence:int -> - associativity:Gramext.g_assoc -> - CicNotationPt.term -> (* level 2 pattern *) - CicNotationPt.term -> (* level 1 pattern *) - pretty_printer_id - exception Interpretation_not_found -exception Pretty_printer_not_found (** @raise Interpretation_not_found *) val remove_interpretation: interpretation_id -> unit - (** @raise Pretty_printer_not_found *) -val remove_pretty_printer: pretty_printer_id -> unit - -(** {2 Interpretations toggling} *) + (** {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_acic/.cvsignore b/helm/ocaml/cic_acic/.cvsignore new file mode 100644 index 000000000..8d64a5378 --- /dev/null +++ b/helm/ocaml/cic_acic/.cvsignore @@ -0,0 +1,2 @@ +*.cm[iaox] +*.cmxa 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_omdoc/Makefile b/helm/ocaml/cic_acic/Makefile similarity index 55% rename from helm/ocaml/cic_omdoc/Makefile rename to helm/ocaml/cic_acic/Makefile index f4c3b5b6f..a7f1e19cf 100644 --- a/helm/ocaml/cic_omdoc/Makefile +++ b/helm/ocaml/cic_acic/Makefile @@ -1,18 +1,12 @@ -PACKAGE = cic_omdoc +PACKAGE = cic_acic PREDICATES = INTERFACE_FILES = \ eta_fixing.mli \ doubleTypeInference.mli \ cic2acic.mli \ - content.mli \ - contentPp.mli \ - cic2content.mli \ - content2cic.mli \ + cic2Xml.mli \ $(NULL) IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml) -EXTRA_OBJECTS_TO_INSTALL = \ -EXTRA_OBJECTS_TO_CLEAN = - include ../Makefile.common diff --git a/helm/ocaml/cic_transformations/cic2Xml.ml b/helm/ocaml/cic_acic/cic2Xml.ml similarity index 100% rename from helm/ocaml/cic_transformations/cic2Xml.ml rename to helm/ocaml/cic_acic/cic2Xml.ml diff --git a/helm/ocaml/cic_transformations/cic2Xml.mli b/helm/ocaml/cic_acic/cic2Xml.mli similarity index 100% rename from helm/ocaml/cic_transformations/cic2Xml.mli rename to helm/ocaml/cic_acic/cic2Xml.mli diff --git a/helm/ocaml/cic_omdoc/cic2acic.ml b/helm/ocaml/cic_acic/cic2acic.ml similarity index 100% rename from helm/ocaml/cic_omdoc/cic2acic.ml rename to helm/ocaml/cic_acic/cic2acic.ml diff --git a/helm/ocaml/cic_omdoc/cic2acic.mli b/helm/ocaml/cic_acic/cic2acic.mli similarity index 100% rename from helm/ocaml/cic_omdoc/cic2acic.mli rename to helm/ocaml/cic_acic/cic2acic.mli diff --git a/helm/ocaml/cic_omdoc/doubleTypeInference.ml b/helm/ocaml/cic_acic/doubleTypeInference.ml similarity index 100% rename from helm/ocaml/cic_omdoc/doubleTypeInference.ml rename to helm/ocaml/cic_acic/doubleTypeInference.ml diff --git a/helm/ocaml/cic_omdoc/doubleTypeInference.mli b/helm/ocaml/cic_acic/doubleTypeInference.mli similarity index 100% rename from helm/ocaml/cic_omdoc/doubleTypeInference.mli rename to helm/ocaml/cic_acic/doubleTypeInference.mli diff --git a/helm/ocaml/cic_omdoc/eta_fixing.ml b/helm/ocaml/cic_acic/eta_fixing.ml similarity index 100% rename from helm/ocaml/cic_omdoc/eta_fixing.ml rename to helm/ocaml/cic_acic/eta_fixing.ml diff --git a/helm/ocaml/cic_omdoc/eta_fixing.mli b/helm/ocaml/cic_acic/eta_fixing.mli similarity index 100% rename from helm/ocaml/cic_omdoc/eta_fixing.mli rename to helm/ocaml/cic_acic/eta_fixing.mli diff --git a/helm/ocaml/cic_disambiguation/.depend b/helm/ocaml/cic_disambiguation/.depend index 555b7438d..ca4124461 100644 --- a/helm/ocaml/cic_disambiguation/.depend +++ b/helm/ocaml/cic_disambiguation/.depend @@ -1,14 +1,9 @@ disambiguateChoices.cmi: disambiguateTypes.cmi -disambiguatePp.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 -disambiguatePp.cmo: disambiguateTypes.cmi disambiguateChoices.cmi \ - disambiguatePp.cmi -disambiguatePp.cmx: disambiguateTypes.cmx disambiguateChoices.cmx \ - disambiguatePp.cmi disambiguate.cmo: disambiguateTypes.cmi disambiguateChoices.cmi \ disambiguate.cmi disambiguate.cmx: disambiguateTypes.cmx disambiguateChoices.cmx \ diff --git a/helm/ocaml/cic_disambiguation/Makefile b/helm/ocaml/cic_disambiguation/Makefile index a94d8cebc..729590da5 100644 --- a/helm/ocaml/cic_disambiguation/Makefile +++ b/helm/ocaml/cic_disambiguation/Makefile @@ -4,7 +4,6 @@ NOTATIONS = number INTERFACE_FILES = \ disambiguateTypes.mli \ disambiguateChoices.mli \ - disambiguatePp.mli \ disambiguate.mli IMPLEMENTATION_FILES = \ $(patsubst %.mli, %.ml, $(INTERFACE_FILES)) \ diff --git a/helm/ocaml/cic_disambiguation/disambiguate.ml b/helm/ocaml/cic_disambiguation/disambiguate.ml index 3acfd3904..e69099cb5 100644 --- a/helm/ocaml/cic_disambiguation/disambiguate.ml +++ b/helm/ocaml/cic_disambiguation/disambiguate.ml @@ -364,7 +364,7 @@ let interpretate_obj ~context ~env ~uri ~is_path obj = assert (context = []); assert (is_path = false); match obj with - | GrafiteAst.Inductive (params,tyl) -> + | CicNotationPt.Inductive (params,tyl) -> let uri = match uri with Some uri -> uri | None -> assert false in let context,params = let context,res = @@ -412,7 +412,7 @@ let interpretate_obj ~context ~env ~uri ~is_path obj = ) tyl in Cic.InductiveDefinition (tyl,[],List.length params,[]) - | GrafiteAst.Record (params,name,ty,fields) -> + | CicNotationPt.Record (params,name,ty,fields) -> let uri = match uri with Some uri -> uri | None -> assert false in let context,params = let context,res = @@ -450,7 +450,7 @@ let interpretate_obj ~context ~env ~uri ~is_path obj = let field_names = List.map fst fields in Cic.InductiveDefinition (tyl,[],List.length params,[`Class (`Record field_names)]) - | GrafiteAst.Theorem (flavour, name, ty, bo) -> + | CicNotationPt.Theorem (flavour, name, ty, bo) -> let attrs = [`Flavour flavour] in let ty' = interpretate_term [] env None false ty in (match bo with @@ -601,12 +601,12 @@ let domain_of_obj ~context ast = assert (context = []); let domain_rev = match ast with - | GrafiteAst.Theorem (_,_,ty,bo) -> + | CicNotationPt.Theorem (_,_,ty,bo) -> (match bo with None -> [] | Some bo -> domain_rev_of_term [] bo) @ domain_of_term [] ty - | GrafiteAst.Inductive (params,tyl) -> + | CicNotationPt.Inductive (params,tyl) -> let dom = List.flatten ( List.rev_map @@ -626,7 +626,7 @@ let domain_of_obj ~context ast = not ( List.exists (fun (name',_) -> name = Id name') params || List.exists (fun (name',_,_,_) -> name = Id name') tyl) ) dom - | GrafiteAst.Record (params,_,ty,fields) -> + | CicNotationPt.Record (params,_,ty,fields) -> let dom = List.flatten (List.rev_map (fun (_,ty) -> domain_rev_of_term [] ty) fields) in @@ -676,7 +676,7 @@ sig aliases:DisambiguateTypes.environment ->(* previous interpretation status *) universe:DisambiguateTypes.multiple_environment option -> uri:UriManager.uri option -> (* required only for inductive types *) - GrafiteAst.obj -> + CicNotationPt.obj -> ((DisambiguateTypes.domain_item * DisambiguateTypes.codomain_item) list * Cic.metasenv * (* new metasenv *) Cic.obj * @@ -752,7 +752,7 @@ let refine_profiler = HExtlib.profile "disambiguate_thing.refine_thing" | Id id -> choices_of_id dbd id | Symbol (symb, _) -> List.map DisambiguateChoices.mk_choice - (CicNotationRew.lookup_interpretations symb) + (TermAcicContent.lookup_interpretations symb) | Num instance -> DisambiguateChoices.lookup_num_choices () in @@ -942,7 +942,7 @@ in refine_profiler.HExtlib.profile foo () if fresh_instances then CicNotationUtil.freshen_obj obj else obj in disambiguate_thing ~dbd ~context:[] ~metasenv:[] ~aliases ~universe ~uri - ~pp_thing:GrafiteAstPp.pp_obj ~domain_of_thing:domain_of_obj + ~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 index e8d21c0cd..bb506e8dc 100644 --- a/helm/ocaml/cic_disambiguation/disambiguate.mli +++ b/helm/ocaml/cic_disambiguation/disambiguate.mli @@ -29,7 +29,7 @@ exception NoWellTypedInterpretation of string Lazy.t list exception PathNotWellFormed val interpretate_path : - context:Cic.name list -> DisambiguateTypes.term -> + context:Cic.name list -> CicNotationPt.term -> Cic.term module type Disambiguator = @@ -45,7 +45,7 @@ sig ?initial_ugraph:CicUniv.universe_graph -> aliases:DisambiguateTypes.environment ->(* previous interpretation status *) universe:DisambiguateTypes.multiple_environment option -> - DisambiguateTypes.term -> + CicNotationPt.term -> ((DisambiguateTypes.domain_item * DisambiguateTypes.codomain_item) list * Cic.metasenv * (* new metasenv *) Cic.term * @@ -59,7 +59,7 @@ sig aliases:DisambiguateTypes.environment ->(* previous interpretation status *) universe:DisambiguateTypes.multiple_environment option -> uri:UriManager.uri option -> (* required only for inductive types *) - GrafiteAst.obj -> + CicNotationPt.obj -> ((DisambiguateTypes.domain_item * DisambiguateTypes.codomain_item) list * Cic.metasenv * (* new metasenv *) Cic.obj * diff --git a/helm/ocaml/cic_disambiguation/disambiguateChoices.ml b/helm/ocaml/cic_disambiguation/disambiguateChoices.ml index b7f241036..71e320428 100644 --- a/helm/ocaml/cic_disambiguation/disambiguateChoices.ml +++ b/helm/ocaml/cic_disambiguation/disambiguateChoices.ml @@ -54,14 +54,14 @@ let mk_choice (dsc, args, appl_pattern) = with Invalid_argument _ -> raise (Invalid_choice (lazy "The notation expects a different number of arguments")) in - CicNotationFwd.instantiate_appl_pattern env' appl_pattern) + TermAcicContent.instantiate_appl_pattern env' appl_pattern) let lookup_symbol_by_dsc symbol dsc = try mk_choice (List.find (fun (dsc', _, _) -> dsc = dsc') - (CicNotationRew.lookup_interpretations symbol)) - with CicNotationRew.Interpretation_not_found | Not_found -> + (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/disambiguatePp.ml b/helm/ocaml/cic_disambiguation/disambiguatePp.ml deleted file mode 100644 index c3a48e409..000000000 --- a/helm/ocaml/cic_disambiguation/disambiguatePp.ml +++ /dev/null @@ -1,83 +0,0 @@ -(* 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 DisambiguateTypes - -let parse_environment str = - let stream = Ulexing.from_utf8_string str in - let environment = ref Environment.empty in - let multiple_environment = ref Environment.empty in - try - while true do - let alias = - match GrafiteParser.parse_statement stream with - GrafiteAst.Executable (_, GrafiteAst.Command (_, GrafiteAst.Alias (_,alias))) - -> alias - | _ -> assert false in - let key,value = - (*CSC: Warning: this code should be factorized with the corresponding - code in MatitaEngine *) - match alias with - GrafiteAst.Ident_alias (id,uri) -> - Id id, - (uri,(fun _ _ _-> CicUtil.term_of_uri (UriManager.uri_of_string uri))) - | GrafiteAst.Symbol_alias (symb,instance,desc) -> - Symbol (symb,instance), - DisambiguateChoices.lookup_symbol_by_dsc symb desc - | GrafiteAst.Number_alias (instance,desc) -> - Num instance, - DisambiguateChoices.lookup_num_by_dsc desc - in - environment := Environment.add key value !environment; - multiple_environment := Environment.cons key value !multiple_environment; - done; - assert false - with End_of_file -> - !environment, !multiple_environment - -let alias_of_domain_and_codomain_items domain_item (dsc,_) = - match domain_item with - Id id -> GrafiteAst.Ident_alias (id, dsc) - | Symbol (symb, i) -> GrafiteAst.Symbol_alias (symb, i, dsc) - | Num i -> GrafiteAst.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 -> GrafiteAstPp.pp_alias alias ^ ".") aliases - in - String.concat "\n" (List.sort compare strings) diff --git a/helm/ocaml/cic_disambiguation/disambiguateTypes.ml b/helm/ocaml/cic_disambiguation/disambiguateTypes.ml index b323f9231..c22f08ed7 100644 --- a/helm/ocaml/cic_disambiguation/disambiguateTypes.ml +++ b/helm/ocaml/cic_disambiguation/disambiguateTypes.ml @@ -23,6 +23,7 @@ * http://helm.cs.unibo.it/ *) +(* type term = CicNotationPt.term type tactic = (term, term, GrafiteAst.reduction, string) GrafiteAst.tactic type tactical = (term, term, GrafiteAst.reduction, string) GrafiteAst.tactical @@ -30,6 +31,7 @@ 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 *) diff --git a/helm/ocaml/cic_disambiguation/disambiguateTypes.mli b/helm/ocaml/cic_disambiguation/disambiguateTypes.mli index 4d077f2f8..48ae7880d 100644 --- a/helm/ocaml/cic_disambiguation/disambiguateTypes.mli +++ b/helm/ocaml/cic_disambiguation/disambiguateTypes.mli @@ -84,6 +84,7 @@ 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 @@ -92,6 +93,7 @@ type script_entry = | Command of tactical | Comment of CicNotationPt.location * string type script = CicNotationPt.location * script_entry list +*) val dummy_floc: Lexing.position * Lexing.position diff --git a/helm/ocaml/cic_notation/.depend b/helm/ocaml/cic_notation/.depend deleted file mode 100644 index c19c9ea3c..000000000 --- a/helm/ocaml/cic_notation/.depend +++ /dev/null @@ -1,73 +0,0 @@ -cicNotationUtil.cmi: grafiteAst.cmo cicNotationPt.cmo -cicNotationTag.cmi: cicNotationPt.cmo -cicNotationEnv.cmi: cicNotationPt.cmo -cicNotationPp.cmi: cicNotationPt.cmo cicNotationEnv.cmi -grafiteAstPp.cmi: grafiteAst.cmo cicNotationPt.cmo -cicNotationMatcher.cmi: cicNotationPt.cmo cicNotationEnv.cmi -cicNotationFwd.cmi: cicNotationPt.cmo cicNotationEnv.cmi -cicNotationRew.cmi: cicNotationPt.cmo -cicNotationParser.cmi: cicNotationPt.cmo cicNotationEnv.cmi -grafiteParser.cmi: grafiteAst.cmo cicNotationPt.cmo -cicNotationPres.cmi: mpresentation.cmi cicNotationPt.cmo box.cmi -boxPp.cmi: cicNotationPres.cmi -cicNotation.cmi: grafiteAst.cmo -grafiteAst.cmo: cicNotationPt.cmo -grafiteAst.cmx: cicNotationPt.cmx -renderingAttrs.cmo: renderingAttrs.cmi -renderingAttrs.cmx: renderingAttrs.cmi -cicNotationUtil.cmo: grafiteAst.cmo cicNotationPt.cmo cicNotationUtil.cmi -cicNotationUtil.cmx: grafiteAst.cmx cicNotationPt.cmx cicNotationUtil.cmi -cicNotationTag.cmo: cicNotationUtil.cmi cicNotationPt.cmo cicNotationTag.cmi -cicNotationTag.cmx: cicNotationUtil.cmx cicNotationPt.cmx cicNotationTag.cmi -cicNotationLexer.cmo: cicNotationLexer.cmi -cicNotationLexer.cmx: cicNotationLexer.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 -grafiteAstPp.cmo: grafiteAst.cmo cicNotationPt.cmo cicNotationPp.cmi \ - grafiteAstPp.cmi -grafiteAstPp.cmx: grafiteAst.cmx cicNotationPt.cmx cicNotationPp.cmx \ - grafiteAstPp.cmi -cicNotationMatcher.cmo: grafiteAstPp.cmi cicNotationUtil.cmi \ - cicNotationTag.cmi cicNotationPt.cmo cicNotationPp.cmi cicNotationEnv.cmi \ - cicNotationMatcher.cmi -cicNotationMatcher.cmx: grafiteAstPp.cmx cicNotationUtil.cmx \ - cicNotationTag.cmx cicNotationPt.cmx cicNotationPp.cmx cicNotationEnv.cmx \ - cicNotationMatcher.cmi -cicNotationFwd.cmo: cicNotationUtil.cmi cicNotationPt.cmo cicNotationPp.cmi \ - cicNotationEnv.cmi cicNotationFwd.cmi -cicNotationFwd.cmx: cicNotationUtil.cmx cicNotationPt.cmx cicNotationPp.cmx \ - cicNotationEnv.cmx cicNotationFwd.cmi -cicNotationRew.cmo: renderingAttrs.cmi cicNotationUtil.cmi cicNotationPt.cmo \ - cicNotationPp.cmi cicNotationMatcher.cmi cicNotationEnv.cmi \ - cicNotationRew.cmi -cicNotationRew.cmx: renderingAttrs.cmx cicNotationUtil.cmx cicNotationPt.cmx \ - cicNotationPp.cmx cicNotationMatcher.cmx cicNotationEnv.cmx \ - cicNotationRew.cmi -cicNotationParser.cmo: cicNotationUtil.cmi cicNotationPt.cmo \ - cicNotationPp.cmi cicNotationLexer.cmi cicNotationEnv.cmi \ - cicNotationParser.cmi -cicNotationParser.cmx: cicNotationUtil.cmx cicNotationPt.cmx \ - cicNotationPp.cmx cicNotationLexer.cmx cicNotationEnv.cmx \ - cicNotationParser.cmi -grafiteParser.cmo: grafiteAst.cmo cicNotationPt.cmo cicNotationParser.cmi \ - cicNotationLexer.cmi grafiteParser.cmi -grafiteParser.cmx: grafiteAst.cmx cicNotationPt.cmx cicNotationParser.cmx \ - cicNotationLexer.cmx grafiteParser.cmi -mpresentation.cmo: mpresentation.cmi -mpresentation.cmx: mpresentation.cmi -box.cmo: renderingAttrs.cmi box.cmi -box.cmx: renderingAttrs.cmx box.cmi -cicNotationPres.cmo: renderingAttrs.cmi mpresentation.cmi cicNotationUtil.cmi \ - cicNotationPt.cmo cicNotationPp.cmi box.cmi cicNotationPres.cmi -cicNotationPres.cmx: renderingAttrs.cmx mpresentation.cmx cicNotationUtil.cmx \ - cicNotationPt.cmx cicNotationPp.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 -cicNotation.cmo: grafiteParser.cmi grafiteAst.cmo cicNotationRew.cmi \ - cicNotationParser.cmi cicNotationFwd.cmi cicNotation.cmi -cicNotation.cmx: grafiteParser.cmx grafiteAst.cmx cicNotationRew.cmx \ - cicNotationParser.cmx cicNotationFwd.cmx cicNotation.cmi diff --git a/helm/ocaml/cic_notation/Makefile b/helm/ocaml/cic_notation/Makefile deleted file mode 100644 index 21c9a4e8c..000000000 --- a/helm/ocaml/cic_notation/Makefile +++ /dev/null @@ -1,67 +0,0 @@ - -PACKAGE = cic_notation -NULL = -INTERFACE_FILES = \ - renderingAttrs.mli \ - cicNotationUtil.mli \ - cicNotationTag.mli \ - cicNotationLexer.mli \ - cicNotationEnv.mli \ - cicNotationPp.mli \ - grafiteAstPp.mli \ - cicNotationMatcher.mli \ - cicNotationFwd.mli \ - cicNotationRew.mli \ - cicNotationParser.mli \ - grafiteParser.mli \ - mpresentation.mli \ - box.mli \ - cicNotationPres.mli \ - boxPp.mli \ - cicNotation.mli \ - $(NULL) -IMPLEMENTATION_FILES = \ - cicNotationPt.ml \ - grafiteAst.ml \ - $(patsubst %.mli, %.ml, $(INTERFACE_FILES)) \ - $(NULL) - -all: test_lexer test_parser test_dep print_grammar - -LOCAL_LINKOPTS = -package helm-cic_notation -linkpkg -test: test_lexer test_parser test_dep -test_lexer: test_lexer.ml $(PACKAGE).cma - $(OCAMLC) $(LOCAL_LINKOPTS) -o $@ $< -test_parser: REQUIRES += helm-cic_omdoc -test_parser: test_parser.ml $(PACKAGE).cma - $(OCAMLC) $(LOCAL_LINKOPTS) -o $@ $< -test_dep: test_dep.ml $(PACKAGE).cma - $(OCAMLC) $(LOCAL_LINKOPTS) -o $@ $< -print_grammar: print_grammar.ml $(PACKAGE).cma - $(OCAMLC) $(LOCAL_LINKOPTS) -o $@ $< - -cicNotationLexer.cmo: OCAMLC = $(OCAMLC_P4) -cicNotationParser.cmo: OCAMLC = $(OCAMLC_P4) -grafiteParser.cmo: OCAMLC = $(OCAMLC_P4) -cicNotationLexer.cmx: OCAMLOPT = $(OCAMLOPT_P4) -cicNotationParser.cmx: OCAMLOPT = $(OCAMLOPT_P4) -grafiteParser.cmx: OCAMLOPT = $(OCAMLOPT_P4) -cicNotationParser.ml.annot: OCAMLC = $(OCAMLC_P4) -grafiteParser.ml.annot: OCAMLC = $(OCAMLC_P4) -cicNotationLexer.ml.annot: OCAMLC = $(OCAMLC_P4) -cicNotationPres.cmi: OCAMLOPTIONS += -rectypes -cicNotationPres.cmo: OCAMLOPTIONS += -rectypes -cicNotationPres.cmx: OCAMLOPTIONS += -rectypes - -clean: extra_clean -distclean: extra_clean - rm -f macro_table.dump -extra_clean: - rm -f test_lexer test_parser - -include ../Makefile.common -OCAMLARCHIVEOPTIONS += -linkall - -cicNotationParser.expanded.ml: cicNotationParser.ml - camlp4 -nolib '-I' '/usr/lib/ocaml/3.08.3/' '-I' '/home/zack/helm/ocaml/urimanager' '-I' '/usr/lib/ocaml/3.08.3/pcre' '-I' '/usr/lib/ocaml/3.08.3/' '-I' '/usr/lib/ocaml/3.08.3/netstring' '-I' '/usr/lib/ocaml/3.08.3/pxp-engine' '-I' '/usr/lib/ocaml/3.08.3/pxp-lex-utf8' '-I' '/usr/lib/ocaml/3.08.3/pxp-lex-iso88591' '-I' '/usr/lib/ocaml/3.08.3/pxp-lex-iso885915' '-I' '/usr/lib/ocaml/3.08.3/http' '-I' '/home/zacchiro/helm/ocaml/pxp' '-I' '/usr/lib/ocaml/3.08.3/zip' '-I' '/usr/lib/ocaml/3.08.3/expat' '-I' '/home/zacchiro/helm/ocaml/xml' '-I' '/home/zack/helm/ocaml/cic' '-I' '/usr/lib/ocaml/3.08.3/camlp4' '-I' '/home/zack/helm/ocaml/utf8_macros' '-I' '/usr/lib/ocaml/3.08.3/camlp4' '-I' '/usr/lib/ocaml/3.08.3/ulex' 'pa_o.cmo' 'pa_op.cmo' 'pr_o.cmo' 'pa_extend.cmo' 'pa_unicode_macro.cma' 'pa_ulex.cma' $< > $@ - diff --git a/helm/ocaml/cic_notation/TODO b/helm/ocaml/cic_notation/TODO deleted file mode 100644 index a98131c07..000000000 --- a/helm/ocaml/cic_notation/TODO +++ /dev/null @@ -1,47 +0,0 @@ - -TODO - -* implementare type-checker per le trasformazioni -* prestazioni trasformazioni 3 => 2 e 2 => 1 -* magic per gestione degli array? -* gestione della notazione per i numeri -* sintassi concreta - - studiare/implementare sintassi con ... per i magic fold -* trasformazioni - - parentesi cagose (tail) - - hyperlink multipli con il magic fold (e.g. notazione per le liste) - - ident0 -> ident_0 ? - -DONE - -* trasformazioni - - spacing delle keyword - - hyperlink su head dei case pattern e sul tipo induttivo su cui si fa match -* bug di rimozione della notazione: pare che camlp4 distrugga un livello - grammaticale quando toglie l'ultima produzione ivi definita -* pretty printing verso testo -* gestione priorita'/associativita' - - triplicare livelli nella grammatica? -* implementare trasformazione 1 => 0 -* implementare istanziazione dei magic a livello 1 (2 => 1) -* implementare compilazione dei default in 2 => 1 -* annotazioni nel livello 1 generato -* problema con pattern overlapping per i magic al livello 2 -* gestione greedyness dei magic in 2 => 1 -* href multipli -* integrazione - - apportare all'ast le modifiche di CicAst (case, cast non come annotazione, - tipi opzionali nel let rec e nelle definizioni) -* integrazione - - porting della disambiguazione al nuovo ast - - refactoring: unico punto di accesso allo stato imperativo della notazione - - gestire cast - - salvare la notazione nei file .moo - - portare le trasformazioni al nuovo ast - - gestire i problemi di ridefinizione della stessa notazione? - - togliere file non piu' utilizzati (caterva di cvs remove) -* gtkmathview - - aggiungere metodo per caricare un file di configurazione dell'utente (idem - nel binding) - - algoritmo di layout delle scatole - diff --git a/helm/ocaml/cic_notation/cicNotationFwd.ml b/helm/ocaml/cic_notation/cicNotationFwd.ml deleted file mode 100644 index bf4b3e38e..000000000 --- a/helm/ocaml/cic_notation/cicNotationFwd.ml +++ /dev/null @@ -1,218 +0,0 @@ -(* 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/ - *) - -open Printf - -module Ast = CicNotationPt -module Env = CicNotationEnv - -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 - -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/cic_notation/cicNotationMatcher.ml b/helm/ocaml/cic_notation/cicNotationMatcher.ml deleted file mode 100644 index 7b85b96b5..000000000 --- a/helm/ocaml/cic_notation/cicNotationMatcher.ml +++ /dev/null @@ -1,448 +0,0 @@ -(* 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/ - *) - -open Printf - -module Ast = CicNotationPt -module Env = CicNotationEnv -module Pp = CicNotationPp -module Util = CicNotationUtil - -type pattern_id = int - -exception No_match - -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 - -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 - 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 - -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 _ -> Variable - | Ast.Magic _ - | Ast.Layout _ - | Ast.Literal _ as t -> assert false - | _ -> Constructor - let tag_of_pattern = CicNotationTag.get_tag - let tag_of_term t = CicNotationTag.get_tag t - let string_of_term = CicNotationPp.pp_term - let string_of_pattern = CicNotationPp.pp_term - end - - module M = 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 - -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 = GrafiteAstPp.pp_cic_appl_pattern - let string_of_term t = CicPp.ppterm (Deannotate.deannotate_term t) - - let classify = function - | Ast.ImplicitPattern - | Ast.VarPattern _ -> Variable - | Ast.UriPattern _ - | Ast.ApplPattern _ -> Constructor - end - - module M = 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/cic_notation/cicNotationParser.expanded.ml b/helm/ocaml/cic_notation/cicNotationParser.expanded.ml deleted file mode 100644 index 9d0b57940..000000000 --- a/helm/ocaml/cic_notation/cicNotationParser.expanded.ml +++ /dev/null @@ -1,1162 +0,0 @@ -(* *)(* 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/ - *) - -oopen Printf -mmodule Ast = CicNotationPtmmodule Env = CicNotationEnv -eexception Parse_error of Token.flocation * stringeexception Level_not_found of int -llet level1_pattern_grammar = - Grammar.gcreate CicNotationLexer.level1_pattern_lexerllet level2_ast_grammar = Grammar.gcreate CicNotationLexer.level2_ast_lexerllet level2_meta_grammar = Grammar.gcreate CicNotationLexer.level2_meta_lexer -llet min_precedence = 0llet max_precedence = 100 -llet level1_pattern = - Grammar.Entry.create level1_pattern_grammar "level1_pattern"llet level2_ast = Grammar.Entry.create level2_ast_grammar "level2_ast"llet term = Grammar.Entry.create level2_ast_grammar "term"llet let_defs = Grammar.Entry.create level2_ast_grammar "let_defs"llet level2_meta = Grammar.Entry.create level2_meta_grammar "level2_meta" -llet return_term loc term = () -llet 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} *) - -llet gram_symbol s = Gramext.Stoken ("SYMBOL", s)llet gram_ident s = Gramext.Stoken ("IDENT", s)llet gram_number s = Gramext.Stoken ("NUMBER", s)llet gram_keyword s = Gramext.Stoken ("", s)llet gram_term = Gramext.Sself -llet gram_of_literal = - function - `Symbol s -> gram_symbol s - | `Keyword s -> gram_keyword s - | `Number s -> gram_number s -ttype binding = - NoBinding - | Binding of string * Env.value_type - | Env of (string * Env.value_type) list -llet 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) - | 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) - in - aux [] (List.rev bindings) -llet 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 *) -llet 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 -> [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 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 - | 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; - rule_id - -let delete rule_id = - let atoms = rule_id in - begin try - let keywords = Hashtbl.find owned_keywords rule_id in - List.iter CicNotationLexer.remove_level2_ast_keyword keywords - with - Not_found -> assert false - end; - 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 - 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 *) -let _ = - Grammar.extend - (let _ = (level1_pattern : 'level1_pattern Grammar.Entry.e) in - let grammar_entry_create s = - Grammar.Entry.create (Grammar.of_entry level1_pattern) s - in - let l1_pattern : 'l1_pattern Grammar.Entry.e = - grammar_entry_create "l1_pattern" - and literal : 'literal Grammar.Entry.e = grammar_entry_create "literal" - and sep : 'sep Grammar.Entry.e = grammar_entry_create "sep" - and l1_magic_pattern : 'l1_magic_pattern Grammar.Entry.e = - grammar_entry_create "l1_magic_pattern" - and l1_pattern_variable : 'l1_pattern_variable Grammar.Entry.e = - grammar_entry_create "l1_pattern_variable" - and l1_simple_pattern : 'l1_simple_pattern Grammar.Entry.e = - grammar_entry_create "l1_simple_pattern" - in - [Grammar.Entry.obj (level1_pattern : 'level1_pattern Grammar.Entry.e), - None, - [None, None, - [[Gramext.Snterm - (Grammar.Entry.obj (l1_pattern : 'l1_pattern Grammar.Entry.e)); - Gramext.Stoken ("EOI", "")], - Gramext.action - (fun _ (p : 'l1_pattern) - (loc : Lexing.position * Lexing.position) -> - (CicNotationUtil.boxify p : 'level1_pattern))]]; - Grammar.Entry.obj (l1_pattern : 'l1_pattern Grammar.Entry.e), None, - [None, None, - [[Gramext.Slist1 - (Gramext.Snterm - (Grammar.Entry.obj - (l1_simple_pattern : 'l1_simple_pattern Grammar.Entry.e)))], - Gramext.action - (fun (p : 'l1_simple_pattern list) - (loc : Lexing.position * Lexing.position) -> - (p : 'l1_pattern))]]; - Grammar.Entry.obj (literal : 'literal Grammar.Entry.e), None, - [None, None, - [[Gramext.Stoken ("NUMBER", "")], - Gramext.action - (fun (n : string) (loc : Lexing.position * Lexing.position) -> - (`Number n : 'literal)); - [Gramext.Stoken ("QKEYWORD", "")], - Gramext.action - (fun (k : string) (loc : Lexing.position * Lexing.position) -> - (`Keyword k : 'literal)); - [Gramext.Stoken ("SYMBOL", "")], - Gramext.action - (fun (s : string) (loc : Lexing.position * Lexing.position) -> - (`Symbol s : 'literal))]]; - Grammar.Entry.obj (sep : 'sep Grammar.Entry.e), None, - [None, None, - [[Gramext.Stoken ("", "sep"); - Gramext.Snterm - (Grammar.Entry.obj (literal : 'literal Grammar.Entry.e))], - Gramext.action - (fun (sep : 'literal) _ (loc : Lexing.position * Lexing.position) -> - (sep : 'sep))]]; - Grammar.Entry.obj - (l1_magic_pattern : 'l1_magic_pattern Grammar.Entry.e), - None, - [None, None, - [[Gramext.Stoken ("", "opt"); - Gramext.Snterm - (Grammar.Entry.obj - (l1_simple_pattern : 'l1_simple_pattern Grammar.Entry.e))], - Gramext.action - (fun (p : 'l1_simple_pattern) _ - (loc : Lexing.position * Lexing.position) -> - (Ast.Opt p : 'l1_magic_pattern)); - [Gramext.Stoken ("", "list1"); - Gramext.Snterm - (Grammar.Entry.obj - (l1_simple_pattern : 'l1_simple_pattern Grammar.Entry.e)); - Gramext.Sopt - (Gramext.Snterm (Grammar.Entry.obj (sep : 'sep Grammar.Entry.e)))], - Gramext.action - (fun (sep : 'sep option) (p : 'l1_simple_pattern) _ - (loc : Lexing.position * Lexing.position) -> - (Ast.List1 (p, sep) : 'l1_magic_pattern)); - [Gramext.Stoken ("", "list0"); - Gramext.Snterm - (Grammar.Entry.obj - (l1_simple_pattern : 'l1_simple_pattern Grammar.Entry.e)); - Gramext.Sopt - (Gramext.Snterm (Grammar.Entry.obj (sep : 'sep Grammar.Entry.e)))], - Gramext.action - (fun (sep : 'sep option) (p : 'l1_simple_pattern) _ - (loc : Lexing.position * Lexing.position) -> - (Ast.List0 (p, sep) : 'l1_magic_pattern))]]; - Grammar.Entry.obj - (l1_pattern_variable : 'l1_pattern_variable Grammar.Entry.e), - None, - [None, None, - [[Gramext.Stoken ("", "ident"); Gramext.Stoken ("IDENT", "")], - Gramext.action - (fun (id : string) _ (loc : Lexing.position * Lexing.position) -> - (Ast.IdentVar id : 'l1_pattern_variable)); - [Gramext.Stoken ("", "number"); Gramext.Stoken ("IDENT", "")], - Gramext.action - (fun (id : string) _ (loc : Lexing.position * Lexing.position) -> - (Ast.NumVar id : 'l1_pattern_variable)); - [Gramext.Stoken ("", "term"); Gramext.Stoken ("IDENT", "")], - Gramext.action - (fun (id : string) _ (loc : Lexing.position * Lexing.position) -> - (Ast.TermVar id : 'l1_pattern_variable))]]; - Grammar.Entry.obj - (l1_simple_pattern : 'l1_simple_pattern Grammar.Entry.e), - None, - [Some "layout", Some Gramext.LeftA, - [[Gramext.Stoken ("LPAREN", ""); - Gramext.Snterm - (Grammar.Entry.obj (l1_pattern : 'l1_pattern Grammar.Entry.e)); - Gramext.Stoken ("RPAREN", "")], - Gramext.action - (fun _ (p : 'l1_pattern) _ - (loc : Lexing.position * Lexing.position) -> - (return_term loc (CicNotationUtil.group p) : - 'l1_simple_pattern)); - [Gramext.Stoken ("", "break")], - Gramext.action - (fun _ (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Layout Ast.Break) : 'l1_simple_pattern)); - [Gramext.Stoken ("", "hovbox"); Gramext.Stoken ("LPAREN", ""); - Gramext.Snterm - (Grammar.Entry.obj (l1_pattern : 'l1_pattern Grammar.Entry.e)); - Gramext.Stoken ("RPAREN", "")], - Gramext.action - (fun _ (p : 'l1_pattern) _ _ - (loc : Lexing.position * Lexing.position) -> - (return_term loc - (Ast.Layout (Ast.Box ((Ast.HOV, false, false), p))) : - 'l1_simple_pattern)); - [Gramext.Stoken ("", "hvbox"); Gramext.Stoken ("LPAREN", ""); - Gramext.Snterm - (Grammar.Entry.obj (l1_pattern : 'l1_pattern Grammar.Entry.e)); - Gramext.Stoken ("RPAREN", "")], - Gramext.action - (fun _ (p : 'l1_pattern) _ _ - (loc : Lexing.position * Lexing.position) -> - (return_term loc - (Ast.Layout (Ast.Box ((Ast.HV, false, false), p))) : - 'l1_simple_pattern)); - [Gramext.Stoken ("", "vbox"); Gramext.Stoken ("LPAREN", ""); - Gramext.Snterm - (Grammar.Entry.obj (l1_pattern : 'l1_pattern Grammar.Entry.e)); - Gramext.Stoken ("RPAREN", "")], - Gramext.action - (fun _ (p : 'l1_pattern) _ _ - (loc : Lexing.position * Lexing.position) -> - (return_term loc - (Ast.Layout (Ast.Box ((Ast.V, false, false), p))) : - 'l1_simple_pattern)); - [Gramext.Stoken ("", "hbox"); Gramext.Stoken ("LPAREN", ""); - Gramext.Snterm - (Grammar.Entry.obj (l1_pattern : 'l1_pattern Grammar.Entry.e)); - Gramext.Stoken ("RPAREN", "")], - Gramext.action - (fun _ (p : 'l1_pattern) _ _ - (loc : Lexing.position * Lexing.position) -> - (return_term loc - (Ast.Layout (Ast.Box ((Ast.H, false, false), p))) : - 'l1_simple_pattern)); - [Gramext.Stoken ("SYMBOL", "\\root"); Gramext.Sself; - Gramext.Stoken ("SYMBOL", "\\of"); Gramext.Sself], - Gramext.action - (fun (arg : 'l1_simple_pattern) _ (index : 'l1_simple_pattern) _ - (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Layout (Ast.Root (arg, index))) : - 'l1_simple_pattern)); - [Gramext.Stoken ("SYMBOL", "\\sqrt"); Gramext.Sself], - Gramext.action - (fun (p : 'l1_simple_pattern) _ - (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Layout (Ast.Sqrt p)) : - 'l1_simple_pattern)); - [Gramext.Stoken ("SYMBOL", "\\frac"); Gramext.Sself; Gramext.Sself], - Gramext.action - (fun (p2 : 'l1_simple_pattern) (p1 : 'l1_simple_pattern) _ - (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Layout (Ast.Frac (p1, p2))) : - 'l1_simple_pattern)); - [Gramext.Sself; Gramext.Stoken ("SYMBOL", "\\atop"); Gramext.Sself], - Gramext.action - (fun (p2 : 'l1_simple_pattern) _ (p1 : 'l1_simple_pattern) - (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Layout (Ast.Atop (p1, p2))) : - 'l1_simple_pattern)); - [Gramext.Sself; Gramext.Stoken ("SYMBOL", "\\over"); Gramext.Sself], - Gramext.action - (fun (p2 : 'l1_simple_pattern) _ (p1 : 'l1_simple_pattern) - (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Layout (Ast.Over (p1, p2))) : - 'l1_simple_pattern)); - [Gramext.Sself; Gramext.Stoken ("SYMBOL", "\\above"); Gramext.Sself], - Gramext.action - (fun (p2 : 'l1_simple_pattern) _ (p1 : 'l1_simple_pattern) - (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Layout (Ast.Above (p1, p2))) : - 'l1_simple_pattern)); - [Gramext.Sself; Gramext.Stoken ("SYMBOL", "\\below"); Gramext.Sself], - Gramext.action - (fun (p2 : 'l1_simple_pattern) _ (p1 : 'l1_simple_pattern) - (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Layout (Ast.Below (p1, p2))) : - 'l1_simple_pattern)); - [Gramext.Sself; Gramext.Stoken ("SYMBOL", "\\sup"); Gramext.Sself], - Gramext.action - (fun (p2 : 'l1_simple_pattern) _ (p1 : 'l1_simple_pattern) - (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Layout (Ast.Sup (p1, p2))) : - 'l1_simple_pattern)); - [Gramext.Sself; Gramext.Stoken ("SYMBOL", "\\sub"); Gramext.Sself], - Gramext.action - (fun (p2 : 'l1_simple_pattern) _ (p1 : 'l1_simple_pattern) - (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Layout (Ast.Sub (p1, p2))) : - 'l1_simple_pattern))]; - Some "simple", Some Gramext.NonA, - [[Gramext.Snterm - (Grammar.Entry.obj (literal : 'literal Grammar.Entry.e))], - Gramext.action - (fun (l : 'literal) (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Literal l) : 'l1_simple_pattern)); - [Gramext.Snterm - (Grammar.Entry.obj - (l1_pattern_variable : 'l1_pattern_variable Grammar.Entry.e))], - Gramext.action - (fun (v : 'l1_pattern_variable) - (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Variable v) : 'l1_simple_pattern)); - [Gramext.Snterm - (Grammar.Entry.obj - (l1_magic_pattern : 'l1_magic_pattern Grammar.Entry.e))], - Gramext.action - (fun (m : 'l1_magic_pattern) - (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Magic m) : 'l1_simple_pattern)); - [Gramext.Stoken ("IDENT", "")], - Gramext.action - (fun (i : string) (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Variable (Ast.TermVar i)) : - 'l1_simple_pattern))]]]) -(* }}} *) - -(* {{{ Grammar for ast magics, notation level 2 *) -let _ = - Grammar.extend - (let _ = (level2_meta : 'level2_meta Grammar.Entry.e) in - let grammar_entry_create s = - Grammar.Entry.create (Grammar.of_entry level2_meta) s - in - let l2_variable : 'l2_variable Grammar.Entry.e = - grammar_entry_create "l2_variable" - and l2_magic : 'l2_magic Grammar.Entry.e = - grammar_entry_create "l2_magic" - in - [Grammar.Entry.obj (l2_variable : 'l2_variable Grammar.Entry.e), None, - [None, None, - [[Gramext.Stoken ("IDENT", "")], - Gramext.action - (fun (id : string) (loc : Lexing.position * Lexing.position) -> - (Ast.TermVar id : 'l2_variable)); - [Gramext.Stoken ("", "anonymous")], - Gramext.action - (fun _ (loc : Lexing.position * Lexing.position) -> - (Ast.TermVar "_" : 'l2_variable)); - [Gramext.Stoken ("", "fresh"); Gramext.Stoken ("IDENT", "")], - Gramext.action - (fun (id : string) _ (loc : Lexing.position * Lexing.position) -> - (Ast.FreshVar id : 'l2_variable)); - [Gramext.Stoken ("", "ident"); Gramext.Stoken ("IDENT", "")], - Gramext.action - (fun (id : string) _ (loc : Lexing.position * Lexing.position) -> - (Ast.IdentVar id : 'l2_variable)); - [Gramext.Stoken ("", "number"); Gramext.Stoken ("IDENT", "")], - Gramext.action - (fun (id : string) _ (loc : Lexing.position * Lexing.position) -> - (Ast.NumVar id : 'l2_variable)); - [Gramext.Stoken ("", "term"); Gramext.Stoken ("IDENT", "")], - Gramext.action - (fun (id : string) _ (loc : Lexing.position * Lexing.position) -> - (Ast.TermVar id : 'l2_variable))]]; - Grammar.Entry.obj (l2_magic : 'l2_magic Grammar.Entry.e), None, - [None, None, - [[Gramext.Stoken ("", "fail")], - Gramext.action - (fun _ (loc : Lexing.position * Lexing.position) -> - (Ast.Fail : 'l2_magic)); - [Gramext.Stoken ("", "if"); - Gramext.Snterm - (Grammar.Entry.obj (level2_meta : 'level2_meta Grammar.Entry.e)); - Gramext.Stoken ("", "then"); - Gramext.Snterm - (Grammar.Entry.obj (level2_meta : 'level2_meta Grammar.Entry.e)); - Gramext.Stoken ("", "else"); - Gramext.Snterm - (Grammar.Entry.obj (level2_meta : 'level2_meta Grammar.Entry.e))], - Gramext.action - (fun (p_false : 'level2_meta) _ (p_true : 'level2_meta) _ - (p_test : 'level2_meta) _ - (loc : Lexing.position * Lexing.position) -> - (Ast.If (p_test, p_true, p_false) : 'l2_magic)); - [Gramext.Stoken ("", "default"); - Gramext.Snterm - (Grammar.Entry.obj (level2_meta : 'level2_meta Grammar.Entry.e)); - Gramext.Snterm - (Grammar.Entry.obj (level2_meta : 'level2_meta Grammar.Entry.e))], - Gramext.action - (fun (none : 'level2_meta) (some : 'level2_meta) _ - (loc : Lexing.position * Lexing.position) -> - (Ast.Default (some, none) : 'l2_magic)); - [Gramext.Stoken ("", "fold"); - Gramext.srules - [[Gramext.Stoken ("", "right")], - Gramext.action - (fun _ (loc : Lexing.position * Lexing.position) -> - (`Right : 'e__1)); - [Gramext.Stoken ("", "left")], - Gramext.action - (fun _ (loc : Lexing.position * Lexing.position) -> - (`Left : 'e__1))]; - Gramext.Snterm - (Grammar.Entry.obj (level2_meta : 'level2_meta Grammar.Entry.e)); - Gramext.Stoken ("", "rec"); Gramext.Stoken ("IDENT", ""); - Gramext.Snterm - (Grammar.Entry.obj (level2_meta : 'level2_meta Grammar.Entry.e))], - Gramext.action - (fun (recursive : 'level2_meta) (id : string) _ - (base : 'level2_meta) (kind : 'e__1) _ - (loc : Lexing.position * Lexing.position) -> - (Ast.Fold (kind, base, [id], recursive) : 'l2_magic))]]; - Grammar.Entry.obj (level2_meta : 'level2_meta Grammar.Entry.e), None, - [None, None, - [[Gramext.Stoken ("UNPARSED_AST", "")], - Gramext.action - (fun (blob : string) (loc : Lexing.position * Lexing.position) -> - (!parse_level2_ast_ref (Ulexing.from_utf8_string blob) : - 'level2_meta)); - [Gramext.Snterm - (Grammar.Entry.obj (l2_variable : 'l2_variable Grammar.Entry.e))], - Gramext.action - (fun (var : 'l2_variable) - (loc : Lexing.position * Lexing.position) -> - (Ast.Variable var : 'level2_meta)); - [Gramext.Snterm - (Grammar.Entry.obj (l2_magic : 'l2_magic Grammar.Entry.e))], - Gramext.action - (fun (magic : 'l2_magic) - (loc : Lexing.position * Lexing.position) -> - (Ast.Magic magic : 'level2_meta))]]]) -(* }}} *) - -(* {{{ Grammar for ast patterns, notation level 2 *) -let _ = - Grammar.extend - (let _ = (level2_ast : 'level2_ast Grammar.Entry.e) - and _ = (term : 'term Grammar.Entry.e) - and _ = (let_defs : 'let_defs Grammar.Entry.e) in - let grammar_entry_create s = - Grammar.Entry.create (Grammar.of_entry level2_ast) s - in - let sort : 'sort Grammar.Entry.e = grammar_entry_create "sort" - and explicit_subst : 'explicit_subst Grammar.Entry.e = - grammar_entry_create "explicit_subst" - and meta_subst : 'meta_subst Grammar.Entry.e = - grammar_entry_create "meta_subst" - and meta_substs : 'meta_substs Grammar.Entry.e = - grammar_entry_create "meta_substs" - and possibly_typed_name : 'possibly_typed_name Grammar.Entry.e = - grammar_entry_create "possibly_typed_name" - and match_pattern : 'match_pattern Grammar.Entry.e = - grammar_entry_create "match_pattern" - and binder : 'binder Grammar.Entry.e = grammar_entry_create "binder" - and arg : 'arg Grammar.Entry.e = grammar_entry_create "arg" - and single_arg : 'single_arg Grammar.Entry.e = - grammar_entry_create "single_arg" - and induction_kind : 'induction_kind Grammar.Entry.e = - grammar_entry_create "induction_kind" - and binder_vars : 'binder_vars Grammar.Entry.e = - grammar_entry_create "binder_vars" - in - [Grammar.Entry.obj (level2_ast : 'level2_ast Grammar.Entry.e), None, - [None, None, - [[Gramext.Snterm (Grammar.Entry.obj (term : 'term Grammar.Entry.e))], - Gramext.action - (fun (p : 'term) (loc : Lexing.position * Lexing.position) -> - (p : 'level2_ast))]]; - Grammar.Entry.obj (sort : 'sort Grammar.Entry.e), None, - [None, None, - [[Gramext.Stoken ("", "CProp")], - Gramext.action - (fun _ (loc : Lexing.position * Lexing.position) -> - (`CProp : 'sort)); - [Gramext.Stoken ("", "Type")], - Gramext.action - (fun _ (loc : Lexing.position * Lexing.position) -> - (`Type : 'sort)); - [Gramext.Stoken ("", "Set")], - Gramext.action - (fun _ (loc : Lexing.position * Lexing.position) -> (`Set : 'sort)); - [Gramext.Stoken ("", "Prop")], - Gramext.action - (fun _ (loc : Lexing.position * Lexing.position) -> - (`Prop : 'sort))]]; - Grammar.Entry.obj (explicit_subst : 'explicit_subst Grammar.Entry.e), - None, - [None, None, - [[Gramext.Stoken ("SYMBOL", "\\subst"); Gramext.Stoken ("SYMBOL", "["); - Gramext.Slist1sep - (Gramext.srules - [[Gramext.Stoken ("IDENT", ""); - Gramext.Stoken ("SYMBOL", "≔"); - Gramext.Snterm - (Grammar.Entry.obj (term : 'term Grammar.Entry.e))], - Gramext.action - (fun (t : 'term) _ (i : string) - (loc : Lexing.position * Lexing.position) -> - (i, t : 'e__2))], - Gramext.Stoken ("SYMBOL", ";")); - Gramext.Stoken ("SYMBOL", "]")], - Gramext.action - (fun _ (substs : 'e__2 list) _ _ - (loc : Lexing.position * Lexing.position) -> - (substs : 'explicit_subst))]]; - Grammar.Entry.obj (meta_subst : 'meta_subst Grammar.Entry.e), None, - [None, None, - [[Gramext.Snterm (Grammar.Entry.obj (term : 'term Grammar.Entry.e))], - Gramext.action - (fun (p : 'term) (loc : Lexing.position * Lexing.position) -> - (Some p : 'meta_subst)); - [Gramext.Stoken ("SYMBOL", "_")], - Gramext.action - (fun (s : string) (loc : Lexing.position * Lexing.position) -> - (None : 'meta_subst))]]; - Grammar.Entry.obj (meta_substs : 'meta_substs Grammar.Entry.e), None, - [None, None, - [[Gramext.Stoken ("SYMBOL", "["); - Gramext.Slist0 - (Gramext.Snterm - (Grammar.Entry.obj (meta_subst : 'meta_subst Grammar.Entry.e))); - Gramext.Stoken ("SYMBOL", "]")], - Gramext.action - (fun _ (substs : 'meta_subst list) _ - (loc : Lexing.position * Lexing.position) -> - (substs : 'meta_substs))]]; - Grammar.Entry.obj - (possibly_typed_name : 'possibly_typed_name Grammar.Entry.e), - None, - [None, None, - [[Gramext.Snterm - (Grammar.Entry.obj (single_arg : 'single_arg Grammar.Entry.e))], - Gramext.action - (fun (arg : 'single_arg) - (loc : Lexing.position * Lexing.position) -> - (arg, None : 'possibly_typed_name)); - [Gramext.Stoken ("LPAREN", ""); - Gramext.Snterm - (Grammar.Entry.obj (single_arg : 'single_arg Grammar.Entry.e)); - Gramext.Stoken ("SYMBOL", ":"); - Gramext.Snterm (Grammar.Entry.obj (term : 'term Grammar.Entry.e)); - Gramext.Stoken ("RPAREN", "")], - Gramext.action - (fun _ (typ : 'term) _ (id : 'single_arg) _ - (loc : Lexing.position * Lexing.position) -> - (id, Some typ : 'possibly_typed_name))]]; - Grammar.Entry.obj (match_pattern : 'match_pattern Grammar.Entry.e), - None, - [None, None, - [[Gramext.Stoken ("LPAREN", ""); Gramext.Stoken ("IDENT", ""); - Gramext.Slist1 - (Gramext.Snterm - (Grammar.Entry.obj - (possibly_typed_name : - 'possibly_typed_name Grammar.Entry.e))); - Gramext.Stoken ("RPAREN", "")], - Gramext.action - (fun _ (vars : 'possibly_typed_name list) (id : string) _ - (loc : Lexing.position * Lexing.position) -> - (id, None, vars : 'match_pattern)); - [Gramext.Stoken ("IDENT", "")], - Gramext.action - (fun (id : string) (loc : Lexing.position * Lexing.position) -> - (id, None, [] : 'match_pattern))]]; - Grammar.Entry.obj (binder : 'binder Grammar.Entry.e), None, - [None, None, - [[Gramext.Stoken ("SYMBOL", "λ")], - Gramext.action - (fun _ (loc : Lexing.position * Lexing.position) -> - (`Lambda : 'binder)); - [Gramext.Stoken ("SYMBOL", "∀")], - Gramext.action - (fun _ (loc : Lexing.position * Lexing.position) -> - (`Forall : 'binder)); - [Gramext.Stoken ("SYMBOL", "Π")], - Gramext.action - (fun _ (loc : Lexing.position * Lexing.position) -> - (`Pi : 'binder))]]; - Grammar.Entry.obj (arg : 'arg Grammar.Entry.e), None, - [None, None, - [[Gramext.Stoken ("UNPARSED_META", "")], - Gramext.action - (fun (blob : string) (loc : Lexing.position * Lexing.position) -> - (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." : - 'arg)); - [Gramext.Stoken ("IDENT", "")], - Gramext.action - (fun (name : string) (loc : Lexing.position * Lexing.position) -> - ([Ast.Ident (name, None)], None : 'arg)); - [Gramext.Stoken ("LPAREN", ""); - Gramext.Slist1sep - (Gramext.Stoken ("IDENT", ""), Gramext.Stoken ("SYMBOL", ",")); - Gramext.Stoken ("SYMBOL", ":"); - Gramext.Snterm (Grammar.Entry.obj (term : 'term Grammar.Entry.e)); - Gramext.Stoken ("RPAREN", "")], - Gramext.action - (fun _ (ty : 'term) _ (names : string list) _ - (loc : Lexing.position * Lexing.position) -> - (List.map (fun n -> Ast.Ident (n, None)) names, Some ty : - 'arg))]]; - Grammar.Entry.obj (single_arg : 'single_arg Grammar.Entry.e), None, - [None, None, - [[Gramext.Stoken ("UNPARSED_META", "")], - Gramext.action - (fun (blob : string) (loc : Lexing.position * Lexing.position) -> - (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." : - 'single_arg)); - [Gramext.Stoken ("IDENT", "")], - Gramext.action - (fun (name : string) (loc : Lexing.position * Lexing.position) -> - (Ast.Ident (name, None) : 'single_arg))]]; - Grammar.Entry.obj (induction_kind : 'induction_kind Grammar.Entry.e), - None, - [None, None, - [[Gramext.Stoken ("", "corec")], - Gramext.action - (fun _ (loc : Lexing.position * Lexing.position) -> - (`CoInductive : 'induction_kind)); - [Gramext.Stoken ("", "rec")], - Gramext.action - (fun _ (loc : Lexing.position * Lexing.position) -> - (`Inductive : 'induction_kind))]]; - Grammar.Entry.obj (let_defs : 'let_defs Grammar.Entry.e), None, - [None, None, - [[Gramext.Slist1sep - (Gramext.srules - [[Gramext.Snterm - (Grammar.Entry.obj - (single_arg : 'single_arg Grammar.Entry.e)); - Gramext.Slist1 - (Gramext.Snterm - (Grammar.Entry.obj (arg : 'arg Grammar.Entry.e))); - Gramext.Sopt - (Gramext.srules - [[Gramext.Stoken ("", "on"); - Gramext.Snterm - (Grammar.Entry.obj - (single_arg : 'single_arg Grammar.Entry.e))], - Gramext.action - (fun (id : 'single_arg) _ - (loc : Lexing.position * Lexing.position) -> - (id : 'e__3))]); - Gramext.Sopt - (Gramext.srules - [[Gramext.Stoken ("SYMBOL", ":"); - Gramext.Snterm - (Grammar.Entry.obj (term : 'term Grammar.Entry.e))], - Gramext.action - (fun (p : 'term) _ - (loc : Lexing.position * Lexing.position) -> - (p : 'e__4))]); - Gramext.Stoken ("SYMBOL", "≝"); - Gramext.Snterm - (Grammar.Entry.obj (term : 'term Grammar.Entry.e))], - Gramext.action - (fun (body : 'term) _ (ty : 'e__4 option) - (index_name : 'e__3 option) (args : 'arg list) - (name : 'single_arg) - (loc : Lexing.position * Lexing.position) -> - (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 : - 'e__5))], - Gramext.Stoken ("", "and"))], - Gramext.action - (fun (defs : 'e__5 list) - (loc : Lexing.position * Lexing.position) -> - (defs : 'let_defs))]]; - Grammar.Entry.obj (binder_vars : 'binder_vars Grammar.Entry.e), None, - [None, None, - [[Gramext.Stoken ("LPAREN", ""); - Gramext.srules - [[Gramext.Stoken ("SYMBOL", "_")], - Gramext.action - (fun _ (loc : Lexing.position * Lexing.position) -> - ([Ast.Ident ("_", None)] : 'e__8)); - [Gramext.Slist1sep - (Gramext.Snterm - (Grammar.Entry.obj - (single_arg : 'single_arg Grammar.Entry.e)), - Gramext.Stoken ("SYMBOL", ","))], - Gramext.action - (fun (l : 'single_arg list) - (loc : Lexing.position * Lexing.position) -> - (l : 'e__8))]; - Gramext.Sopt - (Gramext.srules - [[Gramext.Stoken ("SYMBOL", ":"); - Gramext.Snterm - (Grammar.Entry.obj (term : 'term Grammar.Entry.e))], - Gramext.action - (fun (t : 'term) _ - (loc : Lexing.position * Lexing.position) -> - (t : 'e__9))]); - Gramext.Stoken ("RPAREN", "")], - Gramext.action - (fun _ (typ : 'e__9 option) (vars : 'e__8) _ - (loc : Lexing.position * Lexing.position) -> - (vars, typ : 'binder_vars)); - [Gramext.srules - [[Gramext.Stoken ("SYMBOL", "_")], - Gramext.action - (fun _ (loc : Lexing.position * Lexing.position) -> - ([Ast.Ident ("_", None)] : 'e__6)); - [Gramext.Slist1sep - (Gramext.Snterm - (Grammar.Entry.obj - (single_arg : 'single_arg Grammar.Entry.e)), - Gramext.Stoken ("SYMBOL", ","))], - Gramext.action - (fun (l : 'single_arg list) - (loc : Lexing.position * Lexing.position) -> - (l : 'e__6))]; - Gramext.Sopt - (Gramext.srules - [[Gramext.Stoken ("SYMBOL", ":"); - Gramext.Snterm - (Grammar.Entry.obj (term : 'term Grammar.Entry.e))], - Gramext.action - (fun (t : 'term) _ - (loc : Lexing.position * Lexing.position) -> - (t : 'e__7))])], - Gramext.action - (fun (typ : 'e__7 option) (vars : 'e__6) - (loc : Lexing.position * Lexing.position) -> - (vars, typ : 'binder_vars))]]; - Grammar.Entry.obj (term : 'term Grammar.Entry.e), - Some (Gramext.Level "10N"), - [None, None, - [[Gramext.Stoken ("", "let"); - Gramext.Snterm - (Grammar.Entry.obj - (induction_kind : 'induction_kind Grammar.Entry.e)); - Gramext.Snterm - (Grammar.Entry.obj (let_defs : 'let_defs Grammar.Entry.e)); - Gramext.Stoken ("", "in"); Gramext.Sself], - Gramext.action - (fun (body : 'term) _ (defs : 'let_defs) (k : 'induction_kind) _ - (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.LetRec (k, defs, body)) : 'term)); - [Gramext.Stoken ("", "let"); - Gramext.Snterm - (Grammar.Entry.obj - (possibly_typed_name : 'possibly_typed_name Grammar.Entry.e)); - Gramext.Stoken ("SYMBOL", "≝"); Gramext.Sself; - Gramext.Stoken ("", "in"); Gramext.Sself], - Gramext.action - (fun (p2 : 'term) _ (p1 : 'term) _ (var : 'possibly_typed_name) _ - (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.LetIn (var, p1, p2)) : 'term))]]; - Grammar.Entry.obj (term : 'term Grammar.Entry.e), - Some (Gramext.Level "20R"), - [None, None, - [[Gramext.Stoken ("SYMBOL", "∃"); - Gramext.Snterm - (Grammar.Entry.obj (binder_vars : 'binder_vars Grammar.Entry.e)); - Gramext.Stoken ("SYMBOL", "."); Gramext.Sself], - Gramext.action - (fun (body : 'term) _ (vars, typ : 'binder_vars) _ - (loc : Lexing.position * Lexing.position) -> - (return_term loc (fold_exists vars typ body) : 'term)); - [Gramext.Snterm - (Grammar.Entry.obj (binder : 'binder Grammar.Entry.e)); - Gramext.Snterm - (Grammar.Entry.obj (binder_vars : 'binder_vars Grammar.Entry.e)); - Gramext.Stoken ("SYMBOL", "."); Gramext.Sself], - Gramext.action - (fun (body : 'term) _ (vars, typ : 'binder_vars) (b : 'binder) - (loc : Lexing.position * Lexing.position) -> - (return_term loc (fold_cluster b vars typ body) : 'term))]]; - Grammar.Entry.obj (term : 'term Grammar.Entry.e), - Some (Gramext.Level "70L"), - [None, None, - [[Gramext.Sself; Gramext.Sself], - Gramext.action - (fun (p2 : 'term) (p1 : 'term) - (loc : Lexing.position * Lexing.position) -> - (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))]]; - Grammar.Entry.obj (term : 'term Grammar.Entry.e), - Some (Gramext.Level "90N"), - [None, None, - [[Gramext.Stoken ("UNPARSED_META", "")], - Gramext.action - (fun (blob : string) (loc : Lexing.position * Lexing.position) -> - (!parse_level2_meta_ref (Ulexing.from_utf8_string blob) : - 'term)); - [Gramext.Stoken ("LPAREN", ""); Gramext.Sself; - Gramext.Stoken ("RPAREN", "")], - Gramext.action - (fun _ (p : 'term) _ (loc : Lexing.position * Lexing.position) -> - (p : 'term)); - [Gramext.Stoken ("LPAREN", ""); Gramext.Sself; - Gramext.Stoken ("SYMBOL", ":"); Gramext.Sself; - Gramext.Stoken ("RPAREN", "")], - Gramext.action - (fun _ (p2 : 'term) _ (p1 : 'term) _ - (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Cast (p1, p2)) : 'term)); - [Gramext.Sopt - (Gramext.srules - [[Gramext.Stoken ("SYMBOL", "["); - Gramext.Snterm - (Grammar.Entry.obj (term : 'term Grammar.Entry.e)); - Gramext.Stoken ("SYMBOL", "]")], - Gramext.action - (fun _ (ty : 'term) _ - (loc : Lexing.position * Lexing.position) -> - (ty : 'e__10))]); - Gramext.Stoken ("", "match"); Gramext.Sself; - Gramext.Sopt - (Gramext.srules - [[Gramext.Stoken ("", "in"); Gramext.Stoken ("IDENT", "")], - Gramext.action - (fun (id : string) _ - (loc : Lexing.position * Lexing.position) -> - (id, None : 'e__11))]); - Gramext.Stoken ("", "with"); Gramext.Stoken ("SYMBOL", "["); - Gramext.Slist0sep - (Gramext.srules - [[Gramext.Snterm - (Grammar.Entry.obj - (match_pattern : 'match_pattern Grammar.Entry.e)); - Gramext.Stoken ("SYMBOL", "⇒"); - Gramext.Snterm - (Grammar.Entry.obj (term : 'term Grammar.Entry.e))], - Gramext.action - (fun (rhs : 'term) _ (lhs : 'match_pattern) - (loc : Lexing.position * Lexing.position) -> - (lhs, rhs : 'e__12))], - Gramext.Stoken ("SYMBOL", "|")); - Gramext.Stoken ("SYMBOL", "]")], - Gramext.action - (fun _ (patterns : 'e__12 list) _ _ (indty_ident : 'e__11 option) - (t : 'term) _ (outtyp : 'e__10 option) - (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Case (t, indty_ident, outtyp, patterns)) : - 'term)); - [Gramext.Snterm (Grammar.Entry.obj (sort : 'sort Grammar.Entry.e))], - Gramext.action - (fun (s : 'sort) (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Sort s) : 'term)); - [Gramext.Stoken ("META", ""); - Gramext.Snterm - (Grammar.Entry.obj (meta_substs : 'meta_substs Grammar.Entry.e))], - Gramext.action - (fun (s : 'meta_substs) (m : string) - (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Meta (int_of_string m, s)) : 'term)); - [Gramext.Stoken ("META", "")], - Gramext.action - (fun (m : string) (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Meta (int_of_string m, [])) : 'term)); - [Gramext.Stoken ("PLACEHOLDER", "")], - Gramext.action - (fun _ (loc : Lexing.position * Lexing.position) -> - (return_term loc Ast.UserInput : 'term)); - [Gramext.Stoken ("IMPLICIT", "")], - Gramext.action - (fun _ (loc : Lexing.position * Lexing.position) -> - (return_term loc Ast.Implicit : 'term)); - [Gramext.Stoken ("NUMBER", "")], - Gramext.action - (fun (n : string) (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Num (n, 0)) : 'term)); - [Gramext.Stoken ("URI", "")], - Gramext.action - (fun (u : string) (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Uri (u, None)) : 'term)); - [Gramext.Stoken ("CSYMBOL", "")], - Gramext.action - (fun (s : string) (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Symbol (s, 0)) : 'term)); - [Gramext.Stoken ("IDENT", ""); - Gramext.Snterm - (Grammar.Entry.obj - (explicit_subst : 'explicit_subst Grammar.Entry.e))], - Gramext.action - (fun (s : 'explicit_subst) (id : string) - (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Ident (id, Some s)) : 'term)); - [Gramext.Stoken ("IDENT", "")], - Gramext.action - (fun (id : string) (loc : Lexing.position * Lexing.position) -> - (return_term loc (Ast.Ident (id, None)) : 'term))]]]) -(* }}} *) - -(** {2 API implementation} *) - -let exc_located_wrapper f = - try f () with - Stdpp.Exc_located (floc, Stream.Error msg) -> - raise (Parse_error (floc, msg)) - | Stdpp.Exc_located (floc, exn) -> - raise (Parse_error (floc, Printexc.to_string exn)) - -let parse_level1_pattern lexbuf = - CicNotationLexer.set_lexbuf lexbuf; - exc_located_wrapper - (fun () -> Grammar.Entry.parse level1_pattern Stream.sempty) - -let parse_level2_ast lexbuf = - CicNotationLexer.set_lexbuf lexbuf; - exc_located_wrapper (fun () -> Grammar.Entry.parse level2_ast Stream.sempty) - -let parse_level2_meta lexbuf = - CicNotationLexer.set_lexbuf lexbuf; - exc_located_wrapper - (fun () -> Grammar.Entry.parse level2_meta Stream.sempty) - -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/cic_notation/cicNotationTag.ml b/helm/ocaml/cic_notation/cicNotationTag.ml deleted file mode 100644 index 3cbffa2db..000000000 --- a/helm/ocaml/cic_notation/cicNotationTag.ml +++ /dev/null @@ -1,45 +0,0 @@ -(* 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/ - *) - -module Ast = CicNotationPt - -type tag = int -type pattern_t = Ast.term - -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 - diff --git a/helm/ocaml/cic_notation/doc/.cvsignore b/helm/ocaml/cic_notation/doc/.cvsignore deleted file mode 100644 index 583537c57..000000000 --- a/helm/ocaml/cic_notation/doc/.cvsignore +++ /dev/null @@ -1,6 +0,0 @@ -main.aux -main.dvi -main.log -main.out -main.pdf -main.ps diff --git a/helm/ocaml/cic_notation/doc/Makefile b/helm/ocaml/cic_notation/doc/Makefile deleted file mode 100644 index b7d8fb45c..000000000 --- a/helm/ocaml/cic_notation/doc/Makefile +++ /dev/null @@ -1,124 +0,0 @@ - -# -# Generic makefile for latex -# -# Author: Stefano Zacchiroli -# -# 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/cic_notation/doc/body.tex b/helm/ocaml/cic_notation/doc/body.tex deleted file mode 100644 index fef547e1d..000000000 --- a/helm/ocaml/cic_notation/doc/body.tex +++ /dev/null @@ -1,1225 +0,0 @@ - -\section{Introduction} - -Mathematical notation plays a fundamental role in mathematical practice: it -helps expressing in a concise symbolic fashion concepts of arbitrary complexity. -Its use in proof assistants like \MATITA{} is no exception. Formal mathematics -indeed often impose to encode mathematical concepts at a very high level of -details (e.g. Peano numbers, implicit arguments) having a restricted toolbox of -syntactic constructions in the calculus. - -Consider for example one of the point reached while proving the distributivity -of times over minus on natural numbers included in the \MATITA{} standards -library. (Part of) the reached sequent can be seen in \MATITA{} both using the -notation for various arithmetical and relational operator or without using it. -The sequent rendered without using notation looks as follows: - -\sequent{ -\mathtt{H}: \mathtt{le} z y\\ -\mathtt{Hcut}: \mathtt{eq} \mathtt{nat} (\mathtt{plus} (\mathtt{times} x (\mathtt{minus} -y z)) (\mathtt{times} x z))\\ -(\mathtt{plus} (\mathtt{minus} (\mathtt{times} x y) (\mathtt{times} x z)) -(\mathtt{times} x z))}{ -\mathtt{eq} \mathtt{nat} (\mathtt{times} x (\mathtt{minus} y z)) (\mathtt{minus} -(\mathtt{times} x y) (\mathtt{times} x z))} - -while the corresponding sequent rendered with notation enabled looks: - -\sequent{ -H: z\leq y\\ -Hcut: x*(y-z)+x*z=x*y-x*z+x*z}{ -x*(y-z)=x*y-x*z} - -The latter representation is evidently more readable than the former helping -users both in concentrating on the key aspects of the proof (namely on choosing -the right strategy to proceed in the proof) and in reducing the amount of input -that need to be provided to the system when term input is required (assuming the -exists a correspondence among the rendered output and the textual input syntax -used by the user, as it happens in \MATITA). - -In this section we present the \emph{extensible notation} mechanism implemented -in \MATITA. Its role may be looked at from two different point of view: the term -input phase and the term output --- or rendering --- phase. We arbitrarly -decided to call the former view ``from the left'' and the latter ``from the -right''. Looking from the point of view of the input phase it offers a mechanism -of dynamic extension of the term grammar enabling the user to define fancy -mathematical notations. Looking from the point of view of rendering it enable -the reconstruction of such notations from CIC term and its rendering to various -presentation languages (at the time of writing supported languages are MathML -Presentation and the \MATITA{} concrete syntax for terms). - -If you're wondering why the notation mechanisms need to be ``extensible'', the -answer lays in how notation is used in the development of formal mathematics -with proof assistants. When doing ordinary (i.e. non automatically checkable by -the mean of a proof checker) mathematics, notation is often confused with the -mathematical objects being defined. ``+'' may be thought as \emph{the} addition -(and is often termed as such in mathematical textbooks!), but is rather the -notation for one particolar kind of addition which may possibly be used in an -overloaded fashion elsewhere. When doing formal mathematics the difference is -tangible and users has to deal separately with all the actions we skimmed -through: - -\begin{enumerate} - - \item definition of mathematical objects (e.g. addition over Peano numbers - using the primitive recursion scheme); - - \item definition of new mathematical notation (e.g. infix use of the $+$ symbol - as in $x + 3$); - - \item (incremental) definition of the meanings of a given notation (e.g. the - use of the notation of (2) above for denoting the addition of (1)). - -\end{enumerate} - -Since all the points above are part of everyday life of proof assistants users -we know that mathematical notation in the system will change and we can't -provide a ``one-size fits all'' solution as is done for instance in mainstream -programming languages mathematical notation. For this reason \MATITA{} supports -all the above actions in a coherent manner in both term input and output. - -\section{Looking from the left: term input} - -\subsubsection{\MATITA{} input phase} - - \begin{table} - \caption{\label{tab:termsyn} Concrete syntax of CIC terms: built-in - notation\strut} - \hrule - \[ - \begin{array}{@{}rcll@{}} - \NT{term} & ::= & & \mbox{\bf terms} \\ - & & x & \mbox{(identifier)} \\ - & | & n & \mbox{(number)} \\ - & | & s & \mbox{(symbol)} \\ - & | & \mathrm{URI} & \mbox{(URI)} \\ - & | & \verb+_+ & \mbox{(implicit)} \\ - & | & \verb+?+n~[\verb+[+~\{\NT{subst}\}~\verb+]+] & \mbox{(meta)} \\ - & | & \verb+let+~\NT{ptname}~\verb+\def+~\NT{term}~\verb+in+~\NT{term} \\ - & | & \verb+let+~\NT{kind}~\NT{defs}~\verb+in+~\NT{term} \\ - & | & \NT{binder}~\{\NT{ptnames}\}^{+}~\verb+.+~\NT{term} \\ - & | & \NT{term}~\NT{term} & \mbox{(application)} \\ - & | & \verb+Prop+ \mid \verb+Set+ \mid \verb+Type+ \mid \verb+CProp+ & \mbox{(sort)} \\ - & | & \verb+match+~\NT{term}~ & \mbox{(pattern matching)} \\ - & & ~ ~ [\verb+[+~\verb+in+~x~\verb+]+] - ~ [\verb+[+~\verb+return+~\NT{term}~\verb+]+] \\ - & & ~ ~ \verb+with [+~[\NT{rule}~\{\verb+|+~\NT{rule}\}]~\verb+]+ & \\ - & | & \verb+(+~\NT{term}~\verb+:+~\NT{term}~\verb+)+ & \mbox{(cast)} \\ - & | & \verb+(+~\NT{term}~\verb+)+ \\ - \NT{defs} & ::= & & \mbox{\bf mutual definitions} \\ - & & \NT{fun}~\{\verb+and+~\NT{fun}\} \\ - \NT{fun} & ::= & & \mbox{\bf functions} \\ - & & \NT{arg}~\{\NT{ptnames}\}^{+}~[\verb+on+~x]~\verb+\def+~\NT{term} \\ - \NT{binder} & ::= & & \mbox{\bf binders} \\ - & & \verb+\forall+ \mid \verb+\lambda+ \\ - \NT{arg} & ::= & & \mbox{\bf single argument} \\ - & & \verb+_+ \mid x \\ - \NT{ptname} & ::= & & \mbox{\bf possibly typed name} \\ - & & \NT{arg} \\ - & | & \verb+(+~\NT{arg}~\verb+:+~\NT{term}~\verb+)+ \\ - \NT{ptnames} & ::= & & \mbox{\bf bound variables} \\ - & & \NT{arg} \\ - & | & \verb+(+~\NT{arg}~\{\verb+,+~\NT{arg}\}~[\verb+:+~\NT{term}]~\verb+)+ \\ - \NT{kind} & ::= & & \mbox{\bf induction kind} \\ - & & \verb+rec+ \mid \verb+corec+ \\ - \NT{rule} & ::= & & \mbox{\bf rules} \\ - & & x~\{\NT{ptname}\}~\verb+\Rightarrow+~\NT{term} - \end{array} - \] - \hrule - \end{table} - -The primary form of user interaction employed by \MATITA{} is textual script -editing: the user modifies it and evaluate step by step its composing -\emph{statements}. Examples of statements are inductive type definitions, -theorem declarations, LCF-style tacticals, and macros (e.g. \texttt{Check} can -be used to ask the system to refine a given term and pretty print the result). -Since many statements refer to terms of the underlying calculus, \MATITA{} needs -a concrete syntax able to encode terms of the Calculus of Inductive -Constructions. - -Two of the requirements in the design of such a syntax are apparently in -contrast: - -\begin{enumerate} - - \item the syntax should be as close as possible to common mathematical practice - and implement widespread mathematical notations; - - \item each term described by the syntax should be non-ambiguous meaning that it - should exists a function which associates to it a CIC term. - -\end{enumerate} - -These two requirements are addressed in \MATITA{} by the mean of two mechanisms -which work together: \emph{term disambiguation} and \emph{extensible notation}. -Their interaction is visible in the architecture of the \MATITA{} input phase, -depicted in Fig.~\ref{fig:inputphase}. The architecture is articulated as a -pipeline of three levels: the concrete syntax level (level 0) is the one the -user has to deal with when inserting CIC terms; the abstract syntax level (level -2) is an internal representation which intuitively encodes mathematical formulae -at the content level~\cite{adams}\cite{mkm-structure}; the last level is that of -CIC terms. - -\begin{figure}[ht] - \begin{center} - \includegraphics[width=0.9\textwidth]{input_phase} - \caption{\MATITA{} input phase} - \end{center} - \label{fig:inputphase} -\end{figure} - -Requirement (1) is addressed by a built-in concrete syntax for terms, described -in Tab.~\ref{tab:termsyn}, and the extensible notation mechanisms which offers a -way for extending available mathematical notations and providing a parser for -the extended notation. Requirement (2) is addressed by the conjunct action of -that parsing function and disambiguation which provides a function from content -level terms to CIC terms. - -\subsubsection{From concrete syntax to content level} - -Content level terms are instances of what are commonly referred as Abstract -Syntax Trees (ASTs) in compilers literature. In this respect the mapping from -concrete syntax fo content level is nothing more than the pipelined application -of a lexer and a parser to the characters that form terms at the concrete syntax -level. - -The plus offered by the notation mechanisms is the ability to dinamically extend -the parsing rules which build abstract syntax tree from stream of lexer tokens. -For example, in the standard library of \MATITA{} we found the following -statements which define the notation used for the ``+'' infix operator. - -\begin{example} -\begin{Verbatim} - notation "a + b" - left associative with precedence 50 - for @{ 'plus $a $b }. -\end{Verbatim} -\end{example} - -The meaning of such a statement is to declare a bidirectional -mapping\footnote{in this section we only deal with the left to right part of the -mapping, but it is actually bidirectional} between a concrete syntax pattern -(the part of the statement inside double quotes) and a content level pattern -(the part of the statement which follows \texttt{for}). The syntax of concrete -syntax patterns and content level patterns can be found in Tab.~\ref{tab:l1c} -and Tab.~\ref{tab:l2c} respectively. - -\begin{table} -\caption{\label{tab:l1c} Concrete syntax of level 1 patterns.\strut} -\hrule -\[ -\begin{array}{rcll} - P & ::= & & \mbox{(\bf patterns)} \\ - & & S^{+} \\[2ex] - S & ::= & & \mbox{(\bf simple patterns)} \\ - & & l \\ - & | & S~\verb+\sub+~S\\ - & | & S~\verb+\sup+~S\\ - & | & S~\verb+\below+~S\\ - & | & S~\verb+\atop+~S\\ - & | & S~\verb+\over+~S\\ - & | & S~\verb+\atop+~S\\ - & | & \verb+\frac+~S~S \\ - & | & \verb+\sqrt+~S \\ - & | & \verb+\root+~S~\verb+\of+~S \\ - & | & \verb+(+~P~\verb+)+ \\ - & | & \verb+hbox (+~P~\verb+)+ \\ - & | & \verb+vbox (+~P~\verb+)+ \\ - & | & \verb+hvbox (+~P~\verb+)+ \\ - & | & \verb+hovbox (+~P~\verb+)+ \\ - & | & \verb+break+ \\ - & | & \verb+list0+~S~[\verb+sep+~l] \\ - & | & \verb+list1+~S~[\verb+sep+~l] \\ - & | & \verb+opt+~S \\ - & | & [\verb+term+]~x \\ - & | & \verb+number+~x \\ - & | & \verb+ident+~x \\ -\end{array} -\] -\hrule -\end{table} - -\begin{table} -\caption{\label{tab:l1a} Abstract syntax of level 1 terms and patterns.\strut} -\hrule -\[ -\begin{array}{@{}ll@{}} -\begin{array}[t]{rcll} - T & ::= & & \mbox{(\bf terms)} \\ - & & L_\kappa[T_1,\dots,T_n] & \mbox{(layout)} \\ - & | & B_\kappa^{ab}[T_1\cdots T_n] & \mbox{(box)} \\ - & | & \BREAK & \mbox{(breakpoint)} \\ - & | & \FENCED{T_1\cdots T_n} & \mbox{(fenced)} \\ - & | & l & \mbox{(literal)} \\[2ex] - P & ::= & & \mbox{(\bf patterns)} \\ - & & L_\kappa[P_1,\dots,P_n] & \mbox{(layout)} \\ - & | & B_\kappa^{ab}[P_1\cdots P_n] & \mbox{(box)} \\ - & | & \BREAK & \mbox{(breakpoint)} \\ - & | & \FENCED{P_1\cdots P_n} & \mbox{(fenced)} \\ - & | & M & \mbox{(magic)} \\ - & | & V & \mbox{(variable)} \\ - & | & l & \mbox{(literal)} \\ -\end{array} & -\begin{array}[t]{rcll} - V & ::= & & \mbox{(\bf variables)} \\ - & & \TVAR{x} & \mbox{(term variable)} \\ - & | & \NVAR{x} & \mbox{(number variable)} \\ - & | & \IVAR{x} & \mbox{(name variable)} \\[2ex] - M & ::= & & \mbox{(\bf magic patterns)} \\ - & & \verb+list0+~P~l? & \mbox{(possibly empty list)} \\ - & | & \verb+list1+~P~l? & \mbox{(non-empty list)} \\ - & | & \verb+opt+~P & \mbox{(option)} \\[2ex] -\end{array} -\end{array} -\] -\hrule -\end{table} - -\begin{table} -\caption{\label{tab:synl2} Concrete syntax of level 2 patterns.\strut} -\hrule -\[ -\begin{array}{@{}rcll@{}} - \NT{term} & ::= & & \mbox{\bf terms} \\ - & & x & \mbox{(identifier)} \\ - & | & n & \mbox{(number)} \\ - & | & s & \mbox{(symbol)} \\ - & | & \mathrm{URI} & \mbox{(URI)} \\ - & | & \verb+?+ & \mbox{(implicit)} \\ - & | & \verb+%+ & \mbox{(placeholder)} \\ - & | & \verb+?+n~[\verb+[+~\{\NT{subst}\}~\verb+]+] & \mbox{(meta)} \\ - & | & \verb+let+~\NT{ptname}~\verb+\def+~\NT{term}~\verb+in+~\NT{term} \\ - & | & \verb+let+~\NT{kind}~\NT{defs}~\verb+in+~\NT{term} \\ - & | & \NT{binder}~\{\NT{ptnames}\}^{+}~\verb+.+~\NT{term} \\ - & | & \NT{term}~\NT{term} & \mbox{(application)} \\ - & | & \verb+Prop+ \mid \verb+Set+ \mid \verb+Type+ \mid \verb+CProp+ & \mbox{(sort)} \\ - & | & [\verb+[+~\NT{term}~\verb+]+]~\verb+match+~\NT{term}~\verb+with [+~[\NT{rule}~\{\verb+|+~\NT{rule}\}]~\verb+]+ & \mbox{(pattern match)} \\ - & | & \verb+(+~\NT{term}~\verb+:+~\NT{term}~\verb+)+ & \mbox{(cast)} \\ - & | & \verb+(+~\NT{term}~\verb+)+ \\ - & | & \BLOB(\NT{meta},\dots,\NT{meta}) & \mbox{(meta blob)} \\ - \NT{defs} & ::= & & \mbox{\bf mutual definitions} \\ - & & \NT{fun}~\{\verb+and+~\NT{fun}\} \\ - \NT{fun} & ::= & & \mbox{\bf functions} \\ - & & \NT{arg}~\{\NT{ptnames}\}^{+}~[\verb+on+~x]~\verb+\def+~\NT{term} \\ - \NT{binder} & ::= & & \mbox{\bf binders} \\ - & & \verb+\Pi+ \mid \verb+\exists+ \mid \verb+\forall+ \mid \verb+\lambda+ \\ - \NT{arg} & ::= & & \mbox{\bf single argument} \\ - & & \verb+_+ \mid x \mid \BLOB(\NT{meta},\dots,\NT{meta}) \\ - \NT{ptname} & ::= & & \mbox{\bf possibly typed name} \\ - & & \NT{arg} \\ - & | & \verb+(+~\NT{arg}~\verb+:+~\NT{term}~\verb+)+ \\ - \NT{ptnames} & ::= & & \mbox{\bf bound variables} \\ - & & \NT{arg} \\ - & | & \verb+(+~\NT{arg}~\{\verb+,+~\NT{arg}\}~[\verb+:+~\NT{term}]~\verb+)+ \\ - \NT{kind} & ::= & & \mbox{\bf induction kind} \\ - & & \verb+rec+ \mid \verb+corec+ \\ - \NT{rule} & ::= & & \mbox{\bf rules} \\ - & & x~\{\NT{ptname}\}~\verb+\Rightarrow+~\NT{term} \\[10ex] - - \NT{meta} & ::= & & \mbox{\bf meta} \\ - & & \BLOB(\NT{term},\dots,\NT{term}) & \mbox{(term blob)} \\ - & | & [\verb+term+]~x \\ - & | & \verb+number+~x \\ - & | & \verb+ident+~x \\ - & | & \verb+fresh+~x \\ - & | & \verb+anonymous+ \\ - & | & \verb+fold+~[\verb+left+\mid\verb+right+]~\NT{meta}~\verb+rec+~x~\NT{meta} \\ - & | & \verb+default+~\NT{meta}~\NT{meta} \\ - & | & \verb+if+~\NT{meta}~\verb+then+~\NT{meta}~\verb+else+~\NT{meta} \\ - & | & \verb+fail+ -\end{array} -\] -\hrule -\end{table} - -Each time a \texttt{notation} statement is evaluated by \MATITA{} a new parsing -rule, extracted from the concrete syntax pattern, is added to the term parser -and a semantic action which build a content level term, extracted from the -content level pattern, is associated to it. We will now describe in turn what -can be part of a concrete syntax pattern and what can be part of a content level -pattern. - -Concrete syntax patterns, whose abstract syntax can additionally be found in -Tab.~\ref{tab:l1a} can be made of several components. The most basic of which -are \emph{literal symbols} (like the ``+'' in the example above) and \emph{term -variables} (like ``a'' and ``b''). During the extraction of parsing rules -literal symbols are mapped to productions expecting those symbols verbatim as -input and term variables as production expecting other terms (instances of the -same parsing rule we are extending, possibly with different precedence and/or -associativity). - -\ldots - -\subsubsection{From content level to CIC} - -Responsible of mapping content level terms to CIC terms is the disambiguation -algorithm implemented in \MATITA. Since it has already been described -elsewhere~\cite{disambiguation} we wont enter in too much details here. We only -give some highlights of its fundamental concepts. - -\subsubsection{Sources of ambiguity} - -The translation from content level terms to CIC terms is not straightforward -because some nodes of the content encoding admit more that one CIC encoding, -invalidating requirement (2). - -\begin{example} - \label{ex:disambiguation} - - Consider the term at the concrete syntax level \texttt{\TEXMACRO{forall} x. x + - ln 1 = x} of Fig.~\ref{fig:inputphase}(a), it can be the type of a lemma the - user may want to prove. Assuming that both \texttt{+} and \texttt{=} are parsed - as infix operators, all the following questions are legitimate and must be - answered before obtaining a CIC term from its content level encoding - (Fig.~\ref{fig:inputphase}(b)): - - \begin{enumerate} - - \item Since \texttt{ln} is an unbound identifier, which CIC constants does it - represent? Many different theorems in the library may share its (rather - short) name \dots - - \item Which kind of number (\IN, \IR, \dots) the \texttt{1} literal stand for? - Which encoding is used in CIC to represent it? E.g., assuming $1\in\IN$, is - it an unary or a binary encoding? - - \item Which kind of equality the ``='' node represents? Is it Leibniz's - polymorhpic equality? Is it a decidable equality over \IN, \IR, \dots? - - \end{enumerate} - -\end{example} - -In \MATITA, three \emph{sources of ambiguity} are admitted for content level -terms: unbound identifiers, literal numbers, and operators. Each instance of -ambiguity sources (ambiguous entity) occuring in a content level term is -associated to a \emph{disambiguation domain}. Intuitively a disambiguation -domain is a set of CIC terms which may be replaced for an ambiguous entity -during disambiguation. Each item of the domain is said to be an -\emph{interpretation} for the ambiguous entity. - -\emph{Unbound identifiers} (question 1) are ambiguous entities since the -namespace of CIC objects is not flat and the same identifier may denote many -ofthem. For example the short name \texttt{plus\_assoc} in the \HELM{} library -is shared by three different theorems stating the associative property of -different additions. This kind of ambiguity is avoidable if the user is willing -to use long names (in form of URIs in the \texttt{cic://} scheme) in the -concrete syntax, with the obvious drawbacks of obtaining long and unreadable -terms. - -Given an unbound identifier, the corresponding disambiguation domain is computed -querying the library for all constants, inductive types, and inductive type -constructors having it as their short name (see the \LOCATE{} query in -Sect.~\ref{sec:metadata}). - -\emph{Literal numbers} (question 2) are ambiguous entities as well since -different kinds of numbers can be encoded in CIC (\IN, \IR, \IZ, \dots) using -different encodings. Considering the restricted example of natural numbers we -can for instance encode them in CIC using inductive datatypes with a number of -constructor equal to the encoding base plus 1, obtaining one encoding for each -base. - -For each possible way of mapping a literal number to a CIC term, \MATITA{} is -aware of a \emph{number intepretation function} which, when applied to the -natural number denoted by the literal\footnote{at the moment only literal -natural number are supported in the concrete syntax} returns a corresponding CIC -term. The disambiguation domain for a given literal number is built applying to -the literal all available number interpretation functions in turn. - -Number interpretation functions can at the moment only be defined in OCaml, but -a mechanism to enable their definition directly in \MATITA{} is under -developement. - -\emph{Operators} (question 3) are intuitively head of applications, as such they -are always applied to a (possiblt empty) sequence of arguments. Their ambiguity -is a need since it is often the case that some notation is used in an overloaded -fashion to hide the use of different CIC constants which encodes similar -concepts. For example, in the standard library of \MATITA{} the infix \texttt{+} -notation is available building a binary \texttt{Op(+)} node, whose -disambiguation domain may refer to different constants like the addition over -natural numbers \URI{cic:/matita/nat/plus/plus.con} or that over real numbers of -the \COQ{} standard library \URI{cic:/Coq/Reals/Rdefinitions/Rplus.con}. - -For each possible way of mapping an operator application to a CIC term, -\MATITA{} knows an \emph{operator interpretation function} which, when applied -to an operator and its arguments, returns a CIC term. The disambiguation domain -for a given operator is built applying to the operator and its arguments all -available operator interpretation functions in turn. - -Operator interpretation functions could be added using the -\texttt{interpretation} statement. For example, among the first line of the -script \texttt{matita/library/logic/equality.ma} from the \MATITA{} standard -library we read: - -\begin{Verbatim} -interpretation "leibnitz's equality" - 'eq x y = - (cic:/matita/logic/equality/eq.ind#xpointer(1/1) _ x y). -\end{Verbatim} - -Evaluating it in \MATITA{} will add an operator interpretation function for the -binary operator \texttt{eq} which expands to the CIC term on the right hand side -of the statement. That CIC term can be written using only built-in concrete -syntax, can contain no ambiguity source; still, it can refer to operator -arguments bound on the left hand side and can contain implicit terms (denoted -with \texttt{\_}) which will be expanded to fresh metavariables. The latter -feature is used in the example above for the first argument of Leibniz's -polymorhpic equality. - -\subsubsection{Disambiguation algorithm} - -A \emph{disambiguation algorithm} takes as input a content level term and return -a fully determined CIC term. The key observation on which a disambiguation -algorithm is based is that given a content level term with more than one sources -of ambiguity, not all possible combination of interpretation lead to a typable -CIC term. In the term of Ex.~\ref{ex:disambiguation} for instance the -interpretation of \texttt{ln} as a function from \IR to \IR and the -interpretation of \texttt{1} as the Peano number $1$ can't coexists. The notion -of ``can't coexists'' in the disambiguation of \MATITA{} is defined on top of -the \emph{refiner} for CIC terms described in~\cite{csc-phd}. - -Briefly, a refiner is a function whose input is an \emph{incomplete CIC term} -$t_1$ --- i.e. a term where metavariables occur (Sect.~\ref{sec:metavariables} ---- and whose output is either - -\begin{enumerate} - - \item an incomplete CIC term $t_2$ where $t_2$ is a well-typed term obtained - assigning a type to each metavariable in $t_1$ (in case of dependent types, - instantiation of some of the metavariable occurring in $t_1$ may occur as - well); - - \item $\epsilon$, meaning that no well-typed term could be obtained via - assignment of type to metavariable in $t_1$ and their instantiation; - - \item $\bot$, meaning that the refiner is unable to decide whether of the two - cases above apply (refinement is semi-decidable). - -\end{enumerate} - -On top of a CIC refiner \MATITA{} implement an efficient disambiguation -algorithm, which is outlined below. It takes as input a content level term $c$ -and proceeds as follows: - -\begin{enumerate} - - \item Create disambiguation domains $\{D_i | i\in\mathit{Dom}(c)\}$, where - $\mathit{Dom}(c)$ is the set of ambiguity sources of $c$. Each $D_i$ is a set - of CIC terms and can be built as described above. - - \item An \emph{interpretation} $\Phi$ for $c$ is a map associating an - incomplete CIC term to each ambiguity source of $c$. Given $c$ and one of its - interpretations an incomplete CIC term is fully determined replacing each - ambiguity source of $c$ with its mapping in the interpretation and injecting - the remaining structure of the content level in the CIC level (e.g. replacing - the application of the content level with the application of the CIC level). - This operation is informally called ``interpreting $c$ with $\Phi$''. - - Create an initial interpretation $\Phi_0 = \{\phi_i | \phi_i = \_, - i\in\mathit{Dom}(c)\}$, which associates a fresh metavariable to each source - of ambiguity of $c$. During this step, implicit terms are expanded to fresh - metavariables as well. - - \item Refine the current incomplete CIC term (i.e. the term obtained - interpreting $t$ with $\Phi_i$). - - If the refinement succeeds or is undetermined the next interpretation - $\Phi_{i+1}$ will be created \emph{making a choice}, that is replacing in the - current interpretation one of the metavariable appearing in $\Phi_i$ with one - of the possible choice from the corresponding disambiguation domain. The - metavariable to be replaced is chosen following a preorder visit of the - ambiguous term. Then, step 3 is attempted again with the new interpretation. - - If the refinement fails the current set of choices cannot lead to a well-typed - term and backtracking of the current interpretation is attempted. - - \item Once an unambiguous correct interpretation is found (i.e. $\Phi_i$ does - no longer contain any placeholder), backtracking is attempted anyway to find - the other correct interpretations. - - \item Let $n$ be the number of interpretations who survived step 4. If $n=0$ - signal a type error. If $n=1$ we have found exactly one (incomplete) CIC term - corresponding to the content level term $c$, returns it as output of the - disambiguation phase. If $n>1$ we have found many different (incomplete) CIC - terms which can correspond to the content level term, let the user choose one - of the $n$ interpretations and returns the corresponding term. - -\end{enumerate} - -The efficiency of this algorithm resides in the fact that as soon as an -incomplete CIC term is not typable, no further instantiation of the -metavariables of the corresponding interpretation is attemped. -% For example, during the disambiguation of the user input -% \texttt{\TEXMACRO{forall} x. x*0 = 0}, an interpretation $\Phi_i$ is -% encountered which associates $?$ to the instance of \texttt{0} on the right, -% the real number $0$ to the instance of \texttt{0} on the left, and the -% multiplication over natural numbers (\texttt{mult} for short) to \texttt{*}. -% The refiner will fail, since \texttt{mult} require a natural argument, and no -% further instantiation of the placeholder will be tried. - -Details of the disambiguation algorithm along with an analysis of its complexity -can be found in~\cite{disambiguation}, where a formulation without backtracking -(corresponding to the actual \MATITA{} implementation) is also presented. - -\subsubsection{Disambiguation stages} - -\section{Environment} - -\[ -\begin{array}{rcll} - V & ::= & & \mbox{(\bf values)} \\ - & & \verb+Term+~T & \mbox{(term)} \\ - & | & \verb+String+~s & \mbox{(string)} \\ - & | & \verb+Number+~n & \mbox{(number)} \\ - & | & \verb+None+ & \mbox{(optional value)} \\ - & | & \verb+Some+~V & \mbox{(optional value)} \\ - & | & [V_1,\dots,V_n] & \mbox{(list value)} \\[2ex] -\end{array} -\] - -An environment is a map $\mathcal E : \mathit{Name} -> V$. - -\section{Level 1: concrete syntax} - -Rationale: while the layout schemata can occur in the concrete syntax -used by user, the box schemata and the magic patterns can only occur -when defining the notation. This is why the layout schemata are -``escaped'' with a backslash, so that they cannot be confused with -plain identifiers, wherease the others are not. Alternatively, they -could be defined as keywords, but this would prevent their names to be -used in different contexts. - -\[ -\ITO{\cdot}{{}} : P -> \mathit{Env} -> T -\] - -\begin{table} -\caption{\label{tab:il1f2} Instantiation of level 1 patterns from level 2.\strut} -\hrule -\[ -\begin{array}{rcll} - \ITO{L_\kappa[P_1,\dots,P_n]}{E} & = & L_\kappa[\ITO{(P_1)}{E},\dots,\ITO{(P_n)}{E} ] \\ - \ITO{B_\kappa^{ab}[P_1\cdots P_n]}{E} & = & B_\kappa^{ab}[\ITO{P_1}{E}\cdots\ITO{P_n}{E}] \\ - \ITO{\BREAK}{E} & = & \BREAK \\ - \ITO{(P)}{E} & = & \ITO{P}{E} \\ - \ITO{(P_1\cdots P_n)}{E} & = & B_H^{00}[\ITO{P_1}{E}\cdots\ITO{P_n}{E}] \\ - \ITO{\TVAR{x}}{E} & = & t & \mathcal{E}(x) = \verb+Term+~t \\ - \ITO{\NVAR{x}}{E} & = & l & \mathcal{E}(x) = \verb+Number+~l \\ - \ITO{\IVAR{x}}{E} & = & l & \mathcal{E}(x) = \verb+String+~l \\ - \ITO{\mathtt{opt}~P}{E} & = & \varepsilon & \mathcal{E}(\NAMES(P)) = \{\mathtt{None}\} \\ - \ITO{\mathtt{opt}~P}{E} & = & \ITO{P}{E'} & \mathcal{E}(\NAMES(P)) = \{\mathtt{Some}~v_1,\dots,\mathtt{Some}~v_n\} \\ - & & & \mathcal{E}'(x)=\left\{ - \begin{array}{@{}ll} - v, & \mathcal{E}(x) = \mathtt{Some}~v \\ - \mathcal{E}(x), & \mbox{otherwise} - \end{array} - \right. \\ - \ITO{\mathtt{list}k~P~l?}{E} & = & \ITO{P}{{E}_1}~{l?}\cdots {l?}~\ITO{P}{{E}_n} & - \mathcal{E}(\NAMES(P)) = \{[v_{11},\dots,v_{1n}],\dots,[v_{m1},\dots,v_{mn}]\} \\ - & & & n\ge k \\ - & & & \mathcal{E}_i(x) = \left\{ - \begin{array}{@{}ll} - v_i, & \mathcal{E}(x) = [v_1,\dots,v_n] \\ - \mathcal{E}(x), & \mbox{otherwise} - \end{array} - \right. \\ - \ITO{l}{E} & = & l \\ - -%% & | & (P) & \mbox{(fenced)} \\ -%% & | & M & \mbox{(magic)} \\ -%% & | & V & \mbox{(variable)} \\ -%% & | & l & \mbox{(literal)} \\[2ex] -%% V & ::= & & \mbox{(\bf variables)} \\ -%% & & \TVAR{x} & \mbox{(term variable)} \\ -%% & | & \NVAR{x} & \mbox{(number variable)} \\ -%% & | & \IVAR{x} & \mbox{(name variable)} \\[2ex] -%% M & ::= & & \mbox{(\bf magic patterns)} \\ -%% & & \verb+list0+~S~l? & \mbox{(possibly empty list)} \\ -%% & | & \verb+list1+~S~l? & \mbox{(non-empty list)} \\ -%% & | & \verb+opt+~S & \mbox{(option)} \\[2ex] -\end{array} -\] -\hrule -\end{table} - -\begin{table} -\caption{\label{tab:wfl0} Well-formedness rules for level 1 patterns.\strut} -\hrule -\[ -\renewcommand{\arraystretch}{3.5} -\begin{array}[t]{@{}c@{}} - \inference[\sc layout] - {P_i :: D_i & \forall i,j, i\ne j => \DOMAIN(D_i) \cap \DOMAIN(D_j) = \emptyset} - {L_\kappa[P_1,\dots,P_n] :: D_1\oplus\cdots\oplus D_n} - \\ - \inference[\sc box] - {P_i :: D_i & \forall i,j, i\ne j => \DOMAIN(D_i) \cap \DOMAIN(D_j) = \emptyset} - {B_\kappa^{ab}[P_1\cdots P_n] :: D_1\oplus\cdots\oplus D_n} - \\ - \inference[\sc fenced] - {P_i :: D_i & \forall i,j, i\ne j => \DOMAIN(D_i) \cap \DOMAIN(D_j) = \emptyset} - {\FENCED{P_1\cdots P_n} :: D_1\oplus\cdots\oplus D_n} - \\ - \inference[\sc breakpoint] - {} - {\BREAK :: \emptyset} - \qquad - \inference[\sc literal] - {} - {l :: \emptyset} - \qquad - \inference[\sc tvar] - {} - {\TVAR{x} :: \TVAR{x}} - \\ - \inference[\sc nvar] - {} - {\NVAR{x} :: \NVAR{x}} - \qquad - \inference[\sc ivar] - {} - {\IVAR{x} :: \IVAR{x}} - \\ - \inference[\sc list0] - {P :: D & \forall x\in\DOMAIN(D), D'(x) = D(x)~\mathtt{List}} - {\mathtt{list0}~P~l? :: D'} - \\ - \inference[\sc list1] - {P :: D & \forall x\in\DOMAIN(D), D'(x) = D(x)~\mathtt{List}} - {\mathtt{list1}~P~l? :: D'} - \\ - \inference[\sc opt] - {P :: D & \forall x\in\DOMAIN(D), D'(x) = D(x)~\mathtt{Option}} - {\mathtt{opt}~P :: D'} -\end{array} -\] -\hrule -\end{table} - -\newcommand{\ATTRS}[1]{\langle#1\rangle} -\newcommand{\ANNPOS}[2]{\mathit{pos}(#1)_{#2}} - -\begin{table} -\caption{\label{tab:addparens} Can't read the AST and need parentheses? Here you go!.\strut} -\hrule -\[ -\begin{array}{rcll} - \ADDPARENS{l}{n} & = & l \\ - \ADDPARENS{\BREAK}{n} & = & \BREAK \\ - \ADDPARENS{\ATTRS{\mathit{prec}=m}T}{n} & = & \ADDPARENS{T}{m} & n < m \\ - \ADDPARENS{\ATTRS{\mathit{prec}=m}T}{n} & = & \FENCED{\ADDPARENS{T}{\bot}} & n > m \\ - \ADDPARENS{\ATTRS{\mathit{prec}=n,\mathit{assoc}=L,\mathit{pos}=R}T}{n} & = & \FENCED{\ADDPARENS{T}{\bot}} \\ - \ADDPARENS{\ATTRS{\mathit{prec}=n,\mathit{assoc}=R,\mathit{pos}=L}T}{n} & = & \FENCED{\ADDPARENS{T}{\bot}} \\ - \ADDPARENS{\ATTRS{\cdots}T}{n} & = & \ADDPARENS{T}{n} \\ - \ADDPARENS{L_\kappa[T_1,\dots,\underline{T_k},\dots,T_m]}{n} & = & L_\kappa[\ADDPARENS{T_1}{n},\dots,\ADDPARENS{T_k}{\bot},\dots,\ADDPARENS{T_m}{n}] \\ - \ADDPARENS{B_\kappa^{ab}[T_1,\dots,T_m]}{n} & = & B_\kappa^{ab}[\ADDPARENS{T_1}{n},\dots,\ADDPARENS{T_m}{n}] -\end{array} -\] -\hrule -\end{table} - -\begin{table} -\caption{\label{tab:annpos} Annotation of level 1 meta variable with position information.\strut} -\hrule -\[ -\begin{array}{rcll} - \ANNPOS{l}{p,q} & = & l \\ - \ANNPOS{\BREAK}{p,q} & = & \BREAK \\ - \ANNPOS{x}{1,0} & = & \ATTRS{\mathit{pos}=L}{x} \\ - \ANNPOS{x}{0,1} & = & \ATTRS{\mathit{pos}=R}{x} \\ - \ANNPOS{x}{p,q} & = & \ATTRS{\mathit{pos}=I}{x} \\ - \ANNPOS{B_\kappa^{ab}[P]}{p,q} & = & B_\kappa^{ab}[\ANNPOS{P}{p,q}] \\ - \ANNPOS{B_\kappa^{ab}[\{\BREAK\} P_1\cdots P_n\{\BREAK\}]}{p,q} & = & B_\kappa^{ab}[\begin{array}[t]{@{}l} - \{\BREAK\} \ANNPOS{P_1}{p,0} \\ - \ANNPOS{P_2}{0,0}\cdots\ANNPOS{P_{n-1}}{0,0} \\ - \ANNPOS{P_n}{0,q}\{\BREAK\}] - \end{array} - -%% & & L_\kappa[P_1,\dots,P_n] & \mbox{(layout)} \\ -%% & | & \BREAK & \mbox{(breakpoint)} \\ -%% & | & \FENCED{P_1\cdots P_n} & \mbox{(fenced)} \\ -%% V & ::= & & \mbox{(\bf variables)} \\ -%% & & \TVAR{x} & \mbox{(term variable)} \\ -%% & | & \NVAR{x} & \mbox{(number variable)} \\ -%% & | & \IVAR{x} & \mbox{(name variable)} \\[2ex] -%% M & ::= & & \mbox{(\bf magic patterns)} \\ -%% & & \verb+list0+~P~l? & \mbox{(possibly empty list)} \\ -%% & | & \verb+list1+~P~l? & \mbox{(non-empty list)} \\ -%% & | & \verb+opt+~P & \mbox{(option)} \\[2ex] -\end{array} -\] -\hrule -\end{table} - -\section{Level 2: abstract syntax} - -\begin{table} -\caption{\label{tab:wfl2} Well-formedness rules for level 2 patterns.\strut} -\hrule -\[ -\renewcommand{\arraystretch}{3.5} -\begin{array}{@{}c@{}} - \inference[\sc Constr] - {P_i :: D_i} - {\BLOB[P_1,\dots,P_n] :: D_i \oplus \cdots \oplus D_j} \\ - \inference[\sc TermVar] - {} - {\mathtt{term}~x :: x : \mathtt{Term}} - \quad - \inference[\sc NumVar] - {} - {\mathtt{number}~x :: x : \mathtt{Number}} - \\ - \inference[\sc IdentVar] - {} - {\mathtt{ident}~x :: x : \mathtt{String}} - \quad - \inference[\sc FreshVar] - {} - {\mathtt{fresh}~x :: x : \mathtt{String}} - \\ - \inference[\sc Success] - {} - {\mathtt{anonymous} :: \emptyset} - \\ - \inference[\sc Fold] - {P_1 :: D_1 & P_2 :: D_2 \oplus (x : \mathtt{Term}) & \DOMAIN(D_2)\ne\emptyset & \DOMAIN(D_1)\cap\DOMAIN(D_2)=\emptyset} - {\mathtt{fold}~P_1~\mathtt{rec}~x~P_2 :: D_1 \oplus D_2~\mathtt{List}} - \\ - \inference[\sc Default] - {P_1 :: D \oplus D_1 & P_2 :: D & \DOMAIN(D_1) \ne \emptyset & \DOMAIN(D) \cap \DOMAIN(D_1) = \emptyset} - {\mathtt{default}~P_1~P_2 :: D \oplus D_1~\mathtt{Option}} - \\ - \inference[\sc If] - {P_1 :: \emptyset & P_2 :: D & P_3 :: D } - {\mathtt{if}~P_1~\mathtt{then}~P_2~\mathtt{else}~P_3 :: D} - \qquad - \inference[\sc Fail] - {} - {\mathtt{fail} :: \emptyset} -%% & | & \verb+if+~\NT{meta}~\verb+then+~\NT{meta}~\verb+else+~\NT{meta} \\ -%% & | & \verb+fail+ -\end{array} -\] -\hrule -\end{table} - -\begin{table} - \caption{\label{tab:il2f1} Instantiation of level 2 patterns from level 1. - \strut} -\hrule -\[ -\begin{array}{rcll} - -\IOT{C[t_1,\dots,t_n]}{\mathcal{E}} & = -& C[\IOT{t_1}{\mathcal{E}},\dots,\IOT{t_n}{\mathcal{E}}] \\ - -\IOT{\mathtt{term}~x}{\mathcal{E}} & = & t & \mathcal{E}(x) = \mathtt{Term}~t \\ - -\IOT{\mathtt{number}~x}{\mathcal{E}} & = -& n & \mathcal{E}(x) = \mathtt{Number}~n \\ - -\IOT{\mathtt{ident}~x}{\mathcal{E}} & = -& y & \mathcal{E}(x) = \mathtt{String}~y \\ - -\IOT{\mathtt{fresh}~x}{\mathcal{E}} & = & y & \mathcal{E}(x) = \mathtt{String}~y \\ - -\IOT{\mathtt{default}~P_1~P_2}{\mathcal{E}} & = -& \IOT{P_1}{\UPDATE{\mathcal{E}}{x_i|->v_i}} -& \mathcal{E}(x_i)=\mathtt{Some}~v_i \\ -& & & \NAMES(P_1)\setminus\NAMES(P_2)=\{x_1,\dots,x_n\} \\ - -\IOT{\mathtt{default}~P_1~P_2}{\mathcal{E}} & = -& \IOT{P_2}{\UPDATE{\mathcal{E}}{x_i|->\bot}} -& \mathcal{E}(x_i)=\mathtt{None} \\ -& & & \NAMES(P_1)\setminus\NAMES(P_2)=\{x_1,\dots,x_n\} \\ - -\IOT{\mathtt{fold}~\mathtt{right}~P_1~\mathtt{rec}~x~P_2}{\mathcal{E}} -& = -& \IOT{P_1}{\mathcal{E}'} -& \mathcal{E}(\NAMES(P_2)\setminus\{x\}) = \{[],\dots,[]\} \\ -& & \multicolumn{2}{l}{\mathcal{E}'=\UPDATE{\mathcal{E}}{\NAMES(P_2)\setminus\{x\}|->\bot}} -\\ - -\IOT{\mathtt{fold}~\mathtt{right}~P_1~\mathtt{rec}~x~P_2}{\mathcal{E}} -& = -& \IOT{P_2}{\mathcal{E}'} -& \mathcal{E}(y_i) = [v_{i1},\dots,v_{in}] \\ -& & & \NAMES(P_2)\setminus\{x\}=\{y_1,\dots,y_m\} \\ -& & \multicolumn{2}{l}{\mathcal{E}'(y) = - \left\{ - \begin{array}{@{}ll} - \IOT{\mathtt{fold}~\mathtt{right}~P_1~\mathtt{rec}~x~P_e}{\mathcal{E}''} - & y=x \\ - v_{i1} & y=y_i \\ - \mathcal{E}(y) & \mbox{otherwise} \\ - \end{array} - \right.} \\ -& & \multicolumn{2}{l}{\mathcal{E}''(y) = - \left\{ - \begin{array}{@{}ll} - [v_{i2};\dots;v_{in}] & y=y_i \\ - \mathcal{E}(y) & \mbox{otherwise} \\ - \end{array} - \right.} \\ - -\IOT{\mathtt{fold}~\mathtt{left}~P_1~\mathtt{rec}~x~P_2}{\mathcal{E}} -& = -& \mathit{eval\_fold}(x,P_2,\mathcal{E}') -& \\ -& & \multicolumn{2}{l}{\mathcal{E}' = \UPDATE{\mathcal{E}}{x|-> -\IOT{P_1}{\UPDATE{\mathcal{E}}{\NAMES(P_2)|->\bot}}}} \\ - -\mathit{eval\_fold}(x,P,\mathcal{E}) -& = -& \mathcal{E}(x) -& \mathcal{E}(\NAMES(P)\setminus\{x\})=\{[],\dots,[]\} \\ - -\mathit{eval\_fold}(x,P,\mathcal{E}) -& = -& \mathit{eval\_fold}(x,P,\mathcal{E}') -& \mathcal{E}(y_i) = [v_{i1},\dots,v_{in}] \\ -& & & \NAMES(P)\setminus{x}=\{y_1,\dots,y_m\} \\ -& -& \multicolumn{2}{l}{\mathcal{E}' = \UPDATE{\mathcal{E}}{x|->\IOT{P}{\mathcal{E}''}; ~ y_i |-> [v_{i2};\dots;v_{in_i}]}} -\\ -& -& \multicolumn{2}{l}{\mathcal{E}''(y) = -\left\{ -\begin{array}{ll} - v_1 & y\in \NAMES(P)\setminus\{x\} \\ - \mathcal{E}(x) & y=x \\ - \bot & \mathit{otherwise} \\ -\end{array} -\right. -} -\\ - -\end{array} \\ -\] -\end{table} - -\begin{table} -\caption{\label{tab:l2match} Pattern matching of level 2 terms.\strut} -\hrule -\[ -\renewcommand{\arraystretch}{3.5} -\begin{array}{@{}c@{}} - \inference[\sc Constr] - {t_i \in P_i ~> \mathcal E_i & i\ne j => \DOMAIN(\mathcal E_i)\cap\DOMAIN(\mathcal E_j)=\emptyset} - {C[t_1,\dots,t_n] \in C[P_1,\dots,P_n] ~> \mathcal E_1 \oplus \cdots \oplus \mathcal E_n} - \\ - \inference[\sc TermVar] - {} - {t \in [\mathtt{term}]~x ~> [x |-> \mathtt{Term}~t]} - \quad - \inference[\sc NumVar] - {} - {n \in \mathtt{number}~x ~> [x |-> \mathtt{Number}~n]} - \\ - \inference[\sc IdentVar] - {} - {x \in \mathtt{ident}~x ~> [x |-> \mathtt{String}~x]} - \quad - \inference[\sc FreshVar] - {} - {x \in \mathtt{fresh}~x ~> [x |-> \mathtt{String}~x]} - \\ - \inference[\sc Success] - {} - {t \in \mathtt{anonymous} ~> \emptyset} - \\ - \inference[\sc DefaultT] - {t \in P_1 ~> \mathcal E} - {t \in \mathtt{default}~P_1~P_2 ~> \mathcal E'} - \quad - \mathcal E'(x) = \left\{ - \renewcommand{\arraystretch}{1} - \begin{array}{ll} - \mathtt{Some}~\mathcal{E}(x) & x \in \NAMES(P_1) \setminus \NAMES(P_2) \\ - \mathcal{E}(x) & \mbox{otherwise} - \end{array} - \right. - \\ - \inference[\sc DefaultF] - {t \not\in P_1 & t \in P_2 ~> \mathcal E} - {t \in \mathtt{default}~P_1~P_2 ~> \mathcal E'} - \quad - \mathcal E'(x) = \left\{ - \renewcommand{\arraystretch}{1} - \begin{array}{ll} - \mathtt{None} & x \in \NAMES(P_1) \setminus \NAMES(P_2) \\ - \mathcal{E}(x) & \mbox{otherwise} - \end{array} - \right. - \\ - \inference[\sc IfT] - {t \in P_1 ~> \mathcal E' & t \in P_2 ~> \mathcal E} - {t \in \mathtt{if}~P_1~\mathtt{then}~P_2~\mathtt{else}~P_3 ~> \mathcal E} - \quad - \inference[\sc IfF] - {t \not\in P_1 & t \in P_3 ~> \mathcal E} - {t \in \mathtt{if}~P_1~\mathtt{then}~P_2~\mathtt{else}~P_3 ~> \mathcal E} - \\ - \inference[\sc FoldRec] - {t \in P_2 ~> \mathcal E & \mathcal{E}(x) \in \mathtt{fold}~d~P_1~\mathtt{rec}~x~P_2 ~> \mathcal E'} - {t \in \mathtt{fold}~d~P_1~\mathtt{rec}~x~P_2 ~> \mathcal E''} - \\ - \mbox{where}~\mathcal{E}''(y) = \left\{ - \renewcommand{\arraystretch}{1} - \begin{array}{ll} - \mathcal{E}(y)::\mathcal{E}'(y) & y \in \NAMES(P_2) \setminus \{x\} \wedge d = \mathtt{right} \\ - \mathcal{E}'(y)@[\mathcal{E}(y)] & y \in \NAMES(P_2) \setminus \{x\} \wedge d = \mathtt{left} \\ - \mathcal{E}'(y) & \mbox{otherwise} - \end{array} - \right. - \\ - \inference[\sc FoldBase] - {t \not\in P_2 & t \in P_1 ~> \mathcal E} - {t \in \mathtt{fold}~P_1~\mathtt{rec}~x~P_2 ~> \mathcal E'} - \quad - \mathcal E'(y) = \left\{ - \renewcommand{\arraystretch}{1} - \begin{array}{ll} - [] & y \in \NAMES(P_2) \setminus \{x\} \\ - \mathcal{E}(y) & \mbox{otherwise} - \end{array} - \right. -\end{array} -\] -\hrule -\end{table} - -\begin{table} - \caption{\label{tab:synl3} Abstract syntax of level 3 terms and patterns.} - \hrule - \[ - \begin{array}{@{}ll@{}} - \begin{array}[t]{rcll} - T & : := & & \mbox{(\bf terms)} \\ - & & u & \mbox{(uri)} \\ - & | & \lambda x.T & \mbox{($\lambda$-abstraction)} \\ - & | & (T_1 \dots T_n) & \mbox{(application)} \\ - & | & \dots \\[2ex] - \end{array} & - \begin{array}[t]{rcll} - P & : := & & \mbox{(\bf patterns)} \\ - & & u & \mbox{(uri)} \\ - & | & V & \mbox{(variable)} \\ - & | & (P_1 \dots P_n) & \mbox{(application)} \\[2ex] - V & : := & & \mbox{(\bf variables)} \\ - & & \TVAR{x} & \mbox{(term variable)} \\ - & | & \IMPVAR & \mbox{(implicit variable)} \\ - \end{array} \\ - \end{array} - \] - \hrule -\end{table} - -\begin{table} -\caption{\label{tab:wfl3} Well-formedness rules for level 3 patterns.\strut} -\hrule -\[ -\renewcommand{\arraystretch}{3.5} -\begin{array}{@{}c@{}} - \inference[\sc Uri] {} {u :: \emptyset} \quad - \inference[\sc ImpVar] {} {\TVAR{x} :: \emptyset} \quad - \inference[\sc TermVar] {} {\TVAR{x} :: x:\mathtt{Term}} \\ - \inference[\sc Appl] - {P_i :: D_i - \quad \forall i,j,i\neq j=>\DOMAIN(D_i)\cap\DOMAIN(D_j)=\emptyset} - {P_1\cdots P_n :: D_1\oplus\cdots\oplus D_n} \\ -\end{array} -\] -\hrule -\end{table} - -\begin{table} - \caption{\label{tab:synargp} Abstract syntax of applicative symbol patterns.} - \hrule - \[ - \begin{array}{rcll} - P & : := & & \mbox{(\bf patterns)} \\ - & & s ~ \{ \mathit{arg} \} & \mbox{(symbol pattern)} \\[2ex] - \mathit{arg} & : := & & \mbox{(\bf argument)} \\ - & & \TVAR{x} & \mbox{(term variable)} \\ - & | & \eta.\mathit{arg} & \mbox{($\eta$-abstraction)} \\ - \end{array} - \] - \hrule -\end{table} - -\begin{table} -\caption{\label{tab:wfargp} Well-formedness rules for applicative symbol -patterns.\strut} -\hrule -\[ -\renewcommand{\arraystretch}{3.5} -\begin{array}{@{}c@{}} - \inference[\sc Pattern] - {\mathit{arg}_i :: D_i - \quad \forall i,j,i\neq j=>\DOMAIN(D_i)\cap\DOMAIN(D_j)=\emptyset} - {s~\mathit{arg}_1\cdots\mathit{arg}_n :: D_1\oplus\cdots\oplus D_n} \\ - \inference[\sc TermVar] - {} - {\TVAR{x} :: x : \mathtt{Term}} - \quad - \inference[\sc EtaAbs] - {\mathit{arg} :: D} - {\eta.\mathit{arg} :: D} - \\ -\end{array} -\] -\hrule -\end{table} - -\begin{table} -\caption{\label{tab:l3match} Pattern matching of level 3 terms.\strut} -\hrule -\[ -\renewcommand{\arraystretch}{3.5} -\begin{array}{@{}c@{}} - \inference[\sc Uri] {} {u\in u ~> []} \quad - \inference[\sc Appl] {t_i\in P_i ~> \mathcal{E}_i} - {(t_1\dots t_n)\in(P_1\dots P_n) ~> - \mathcal{E}_1\oplus\cdots\oplus\mathcal{E}_n} \\ - \inference[\sc TermVar] {} {t\in \TVAR{x} ~> [x |-> \mathtt{Term}~t]} \quad - \inference[\sc ImpVar] {} {t\in \IMPVAR ~> []} \\ -\end{array} -\] -\hrule -\end{table} - -\begin{table} -\caption{\label{tab:iapf3} Instantiation of applicative symbol patterns (from -level 3).\strut} -\hrule -\[ -\begin{array}{rcll} - \IAP{s~a_1\cdots a_n}{\mathcal{E}} & = & - (s~\IAPP{a_1}{\mathcal{E}}{0}\cdots\IAPP{a_n}{\mathcal{E}}{0}) & \\ - \IAPP{\TVAR{x}}{\mathcal{E}}{0} & = & t & \mathcal{E}(x)=\mathtt{Term}~t \\ - \IAPP{\TVAR{x}}{\mathcal{E}}{i+1} & = & \lambda y.\IAPP{t}{\mathcal{E}}{i} - & \mathcal{E}(x)=\mathtt{Term}~\lambda y.t \\ - \IAPP{\TVAR{x}}{\mathcal{E}}{i+1} & = - & \lambda y_1.\cdots.\lambda y_{i+1}.t~y_1\cdots y_{i+1} - & \mathcal{E}(x)=\mathtt{Term}~t\wedge\forall y,t\neq\lambda y.t \\ - \IAPP{\eta.a}{\mathcal{E}}{i} & = & \IAPP{a}{\mathcal{E}}{i+1} \\ -\end{array} -\] -\hrule -\end{table} - -\section{Type checking} - -\subsection{Level 1 $<->$ Level 2} - -\newcommand{\GUARDED}{\mathit{guarded}} -\newcommand{\TRUE}{\mathit{true}} -\newcommand{\FALSE}{\mathit{false}} - -\newcommand{\TN}{\mathit{tn}} - -\begin{table} -\caption{\label{tab:guarded} Guarded condition of level 2 -pattern. Note that the recursive case of the \texttt{fold} magic is -not explicitly required to be guarded. The point is that it must -contain at least two distinct names, and this guarantees that whatever -is matched by the recursive pattern, the terms matched by those two -names will be smaller than the whole matched term.\strut} \hrule -\[ -\begin{array}{rcll} - \GUARDED(C(M(P))) & = & \GUARDED(P) \\ - \GUARDED(C(t_1,\dots,t_n)) & = & \TRUE \\ - \GUARDED(\mathtt{term}~x) & = & \FALSE \\ - \GUARDED(\mathtt{number}~x) & = & \FALSE \\ - \GUARDED(\mathtt{ident}~x) & = & \FALSE \\ - \GUARDED(\mathtt{fresh}~x) & = & \FALSE \\ - \GUARDED(\mathtt{anonymous}) & = & \TRUE \\ - \GUARDED(\mathtt{default}~P_1~P_2) & = & \GUARDED(P_1) \wedge \GUARDED(P_2) \\ - \GUARDED(\mathtt{if}~P_1~\mathtt{then}~P_2~\mathtt{else}~P_3) & = & \GUARDED(P_2) \wedge \GUARDED(P_3) \\ - \GUARDED(\mathtt{fail}) & = & \TRUE \\ - \GUARDED(\mathtt{fold}~d~P_1~\mathtt{rec}~x~P_2) & = & \GUARDED(P_1) -\end{array} -\] -\hrule -\end{table} - -%% Assume that we have two corresponding patterns $P_1$ (level 1) and -%% $P_2$ (level 2) and that we have to check whether they are -%% ``correct''. First we define the notion of \emph{top-level names} of -%% $P_1$ and $P_2$, as follows: -%% \[ -%% \begin{array}{rcl} -%% \TN(C_1[P'_1,\dots,P'_2]) & = & \TN(P'_1) \cup \cdots \cup \TN(P'_2) \\ -%% \TN(\TVAR{x}) & = & \{x\} \\ -%% \TN(\NVAR{x}) & = & \{x\} \\ -%% \TN(\IVAR{x}) & = & \{x\} \\ -%% \TN(\mathtt{list0}~P'~l?) & = & \emptyset \\ -%% \TN(\mathtt{list1}~P'~l?) & = & \emptyset \\ -%% \TN(\mathtt{opt}~P') & = & \emptyset \\[3ex] -%% \TN(\BLOB(P''_1,\dots,P''_2)) & = & \TN(P''_1) \cup \cdots \cup \TN(P''_2) \\ -%% \TN(\mathtt{term}~x) & = & \{x\} \\ -%% \TN(\mathtt{number}~x) & = & \{x\} \\ -%% \TN(\mathtt{ident}~x) & = & \{x\} \\ -%% \TN(\mathtt{fresh}~x) & = & \{x\} \\ -%% \TN(\mathtt{anonymous}) & = & \emptyset \\ -%% \TN(\mathtt{fold}~P''_1~\mathtt{rec}~x~P''_2) & = & \TN(P''_1) \\ -%% \TN(\mathtt{default}~P''_1~P''_2) & = & \TN(P''_1) \cap \TN(P''_2) \\ -%% \TN(\mathtt{if}~P''_1~\mathtt{then}~P''_2~\mathtt{else}~P''_3) & = & \TN(P''_2) \\ -%% \TN(\mathtt{fail}) & = & \emptyset -%% \end{array} -%% \] - -We say that a \emph{bidirectional transformation} -\[ - P_1 <=> P_2 -\] -is well-formed if: -\begin{itemize} - \item $P_1$ is a well-formed \emph{level 1 pattern} in some context $D$ and - $P_2$ is a well-formed \emph{level 2 pattern} in the very same context $D$, - that is $P_1 :: D$ and $P_2 :: D$; - \item the pattern $P_2$ is guarded, that is $\GUARDED(P_2)=\TRUE$; - \item for any direct sub-pattern $\mathtt{opt}~P'_1$ of $P_1$ such - that $\mathtt{opt}~P'_1 :: X$ there is a sub-pattern - $\mathtt{default}~P'_2~P''_2$ of $P_2$ such that - $\mathtt{default}~P'_2~P''_2 :: X \oplus Y$ for some context $Y$; - \item for any direct sub-pattern $\mathtt{list}~P'_1~l?$ of $P_1$ - such that $\mathtt{list}~P'_1~l? :: X$ there is a sub-pattern - $\mathtt{fold}~P'_2~\mathtt{rec}~x~P''_2$ of $P_2$ such that - $\mathtt{fold}~P'_2~\mathtt{rec}~x~P''_2 :: X \oplus Y$ for some - context $Y$. -\end{itemize} - -A \emph{left-to-right transformation} -\[ - P_1 => P_2 -\] -is well-formed if $P_2$ does not contain \texttt{if}, \texttt{fail}, -or \texttt{anonymous} meta patterns. - -Note that the transformations are in a sense asymmetric. Moving from -the concrete syntax (level 1) to the abstract syntax (level 2) we -forget about syntactic details. Moving from the abstract syntax to the -concrete syntax we may want to forget about redundant structure -(types). - -Relationship with grammatical frameworks? - -\subsection{Level 2 $<->$ Level 3} - -We say that an \emph{interpretation} -\[ - P_2 <=> P_3 -\] -is well-formed if: -\begin{itemize} - \item $P_2$ is a well-formed \emph{applicative symbol pattern} in some context - $D$ and $P_3$ is a well-formed \emph{level 3 pattern} in the very same - context $D$, that is $P_2 :: D$ and $P_3 :: D$. -\end{itemize} - -\section{Semantic selection} - diff --git a/helm/ocaml/cic_notation/doc/infernce.sty b/helm/ocaml/cic_notation/doc/infernce.sty deleted file mode 100644 index fc4afeaaf..000000000 --- a/helm/ocaml/cic_notation/doc/infernce.sty +++ /dev/null @@ -1,217 +0,0 @@ -%% -%% 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 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/cic_notation/doc/ligature.sty b/helm/ocaml/cic_notation/doc/ligature.sty deleted file mode 100644 index a914d91d1..000000000 --- a/helm/ocaml/cic_notation/doc/ligature.sty +++ /dev/null @@ -1,169 +0,0 @@ -%% -%% 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 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/cic_notation/doc/main.tex b/helm/ocaml/cic_notation/doc/main.tex deleted file mode 100644 index 36d35026c..000000000 --- a/helm/ocaml/cic_notation/doc/main.tex +++ /dev/null @@ -1,43 +0,0 @@ -\documentclass[a4paper,draft]{article} - -\usepackage{manfnt} -\usepackage{a4wide} -\usepackage{pifont} -\usepackage{semantic} -\usepackage{stmaryrd,latexsym} - -\newcommand{\BLOB}{\raisebox{0ex}{\small\manstar}} - -\newcommand{\MATITA}{\ding{46}\textsf{\textbf{Matita}}} - -\title{Extensible notation for \MATITA} -\author{Luca Padovani \qquad Stefano Zacchiroli \\ -\small Department of Computer Science, University of Bologna \\ -\small Mura Anteo Zamboni, 7 -- 40127 Bologna, ITALY \\ -\small \{\texttt{lpadovan}, \texttt{zacchiro}\}\texttt{@cs.unibo.it}} - -\newcommand{\BREAK}{\mathtt{break}} -\newcommand{\TVAR}[1]{#1:\mathtt{term}} -\newcommand{\IMPVAR}{\TVAR{\_}} -\newcommand{\NVAR}[1]{#1:\mathtt{number}} -\newcommand{\IVAR}[1]{#1:\mathtt{name}} -\newcommand{\FENCED}[1]{\texttt{\char'050}#1\texttt{\char'051}} -\newcommand{\ITO}[2]{|[#1|]_{\mathcal#2}^1} -\newcommand{\IOT}[2]{|[#1|]_{#2}^2} -\newcommand{\IAP}[2]{|[#1|]_{#2}^a} -\newcommand{\IAPP}[3]{|[#1|]_{#2,#3}^a} -\newcommand{\ADDPARENS}[2]{\llparenthesis#1\rrparenthesis^{#2}} -\newcommand{\NAMES}{\mathit{names}} -\newcommand{\DOMAIN}{\mathit{domain}} -\newcommand{\UPDATE}[2]{#1[#2]} - -\mathlig{~>}{\leadsto} -\mathlig{|->}{\mapsto} - -\begin{document} - \maketitle - - \input{body} - -\end{document} - diff --git a/helm/ocaml/cic_notation/doc/manfnt.sty b/helm/ocaml/cic_notation/doc/manfnt.sty deleted file mode 100644 index c332cc6fc..000000000 --- a/helm/ocaml/cic_notation/doc/manfnt.sty +++ /dev/null @@ -1,74 +0,0 @@ -%% -%% This is file `manfnt.sty', -%% generated with the docstrip utility. -%% -%% The original source files were: -%% -%% manfnt.dtx -%% -%% Copyright (C) 1998 - 99 by Axel Kielhorn, all rights reserved -%% Copyright (C) 1999 by Denis Kosygin, all rights reserved. -%% For additional copyright information see further down in this file. -%% -%% This file is to be used with the LaTeX2e system. -%% ------------------------------------------------ -%% -%% This program can be redistributed and/or modified under the terms -%% of the LaTeX Project Public License Distributed from CTAN -%% archives in directory macros/latex/base/lppl.txt; either -%% version 1 of the License, or any later version. -%% -%% Copyright (C) 1998 - 99 by Axel Kielhorn, all rights reserved -%% Copyright (C) 1999 by Denis Kosygin, all rights reserved. -%% -%% This program can be redistributed and/or modified under the terms -%% of the LaTeX Project Public License Distributed from CTAN -%% archives in directory macros/latex/base/lppl.txt; either -%% version 1 of the License, or any later version. -\def\fileversion{0.2} -\def\filedate{1999/07/01} -\NeedsTeXFormat{LaTeX2e} -\ProvidesPackage{manfnt}[\filedate \fileversion LaTeX2e manfnt package] -\DeclareFontFamily{U}{manual}{} -\DeclareFontShape{U}{manual}{m}{n}{ <-> manfnt }{} -\newcommand{\manfntsymbol}[1]{% - {\fontencoding{U}\fontfamily{manual}\selectfont\symbol{#1}}} -\newcommand{\manhpennib}{\manfntsymbol{21}} -\newcommand{\mantiltpennib}{\manfntsymbol{22}} -\newcommand{\manvpennib}{\manfntsymbol{23}} -\newcommand{\mankidney}{\manfntsymbol{17}} -\newcommand{\manboldkidney}{\manfntsymbol{18}} -\newcommand{\manpenkidney}{\manfntsymbol{19}} -\newcommand{\manlhpenkidney}{\manfntsymbol{20}} -\newcommand{\manquartercircle}{\manfntsymbol{32}} -\newcommand{\manfilledquartercircle}{\manfntsymbol{33}} -\newcommand{\manrotatedquartercircle}{\manfntsymbol{34}} -\newcommand{\mancone}{\manfntsymbol{35}} -\newcommand{\manconcentriccircles}{\manfntsymbol{36}} -\newcommand{\manconcentricdiamond}{\manfntsymbol{37}} -\newcommand{\mantriangleright}{\manfntsymbol{120}}% Triangle for exercises -\newcommand{\mantriangleup}{% Upper triangle for Addison-Wesley logo - \manfntsymbol{54}} -\newcommand{\mantriangledown}{% Lower triangle for Addison-Wesley logo - \manfntsymbol{55}} -\newcommand{\mancube}{\manfntsymbol{28}} -\newcommand{\manimpossiblecube}{\manfntsymbol{29}} -\newcommand{\manquadrifolium}{\manfntsymbol{38}}% \fouru -\newcommand{\manrotatedquadrifolium}{\manfntsymbol{39}}% \fourc -\newcommand{\manstar}{\manfntsymbol{30}}% Bicentennial star -\newcommand{\manerrarrow}{\manfntsymbol{121}}% Arrow for errata lists -\newcommand{\dbend}{\manfntsymbol{127}}% Z-shaped -\newcommand{\lhdbend}{\manfntsymbol{126}}% Lefthanded (S-shaped) -\newcommand{\reversedvideodbend}{\manfntsymbol{0}}% Reversed video -\newcommand{\textdbend}{\text@dbend{\dbend}} -\newcommand{\textlhdbend}{\text@dbend{\lhdbend}} -\newcommand{\textreversedvideodbend}{\text@dbend{\reversedvideodbend}} -\newlength{\dbend@height} -\newcommand{\text@dbend}[1]{% - \settoheight{\dbend@height}{#1}% - \divide\dbend@height by 15% - \multiply\dbend@height by 22% - \raisebox{\dbend@height}{#1}} -\endinput -%% -%% End of file `manfnt.sty'. diff --git a/helm/ocaml/cic_notation/doc/reserved.sty b/helm/ocaml/cic_notation/doc/reserved.sty deleted file mode 100644 index c0d56b8aa..000000000 --- a/helm/ocaml/cic_notation/doc/reserved.sty +++ /dev/null @@ -1,80 +0,0 @@ -%% -%% 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 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 to proceed --- nothing will be set.}}% - {\reserved@a}} -\let\<=\setreserved -\fi -\endinput -%% -%% End of file `reserved.sty'. diff --git a/helm/ocaml/cic_notation/doc/samples.ma b/helm/ocaml/cic_notation/doc/samples.ma deleted file mode 100644 index ff6380151..000000000 --- a/helm/ocaml/cic_notation/doc/samples.ma +++ /dev/null @@ -1,139 +0,0 @@ - -notation - "\langle a , b \rangle" -for - @{ 'pair $a $b }. -check \langle 1, \langle 2, 3 \rangle \rangle. -check 'pair 1 ('pair 2 ('pair 3 4)). - -notation "a :: b" for @{ 'cons $a $b }. -check 1 :: 2 :: 'ugo. - -notation - "[ hovbox (list0 a sep ; ) ]" -for ${ - fold right - @'nil - rec acc - @{ 'cons $a $acc } -}. -check [1;2;3;4]. - -notation - "[ list1 a sep ; | b ]" -for ${ - if @{ 'cons $_ $_ } then - fold right - if @'nil then - fail - else if @{ 'cons $_ $_ } then - fail - else - b - rec acc - @{ 'cons $a $acc } - else - fail -}. -check 'cons 1 ('cons 2 ('cons 3 'ugo)). -check 'cons 1 ('cons 2 ('cons 3 'nil)). -check [1;2;3;4]. -check [1;2;3;4|5]. - -notation "a + b" left associative for @{ 'plus $a $b }. -check 1 + 2 + 3. -check 1 + (2 + 3). - -notation "a + b" left associative for @{ 'plus $a $b }. -notation "a * b" left associative for @{ 'mult $a $b }. -interpretation 'plus x y = (cic:/Coq/Init/Peano/plus.con x y). -interpretation 'mult x y = (cic:/Coq/Init/Peano/mult.con x y). -render cic:/Coq/Arith/Mult/mult_plus_distr_r.con. - -notation - "hvbox ('if' a 'then' break b break 'else' break c)" -for - @{ 'ifthenelse $a $b $c }. -check if even then \forall x:nat.x else bump x. - -notation - "a \vee b" -for - @{ if $a > $b then $a else $b } - -notation - "'fun' ident x \to a" - right associative with precedence 20 -for - @{ 'lambda ${ident x} $a }. - -notation - "hvbox(a break \to b)" -for - @{ \forall $_:$a.$b }. -check nat \to nat. - -NOTES - -@a e' un'abbreviazione per @{term a} -"x" e' un'abbreviazione per @{keyword x} -@_ e' un'abbreviazione per @{anonymous} - -\x simbolo della sintassi concreta -'x simbolo della sintassi astratta - -\lbrace \rbrace per le parentesi graffe al livello 1 - -OLD SAMPLES - -# sample mappings level 1 <--> level 2 - -notation \[ \TERM a ++ \OPT \NUM i \] for 'assign \TERM a ('plus \TERM a \DEFAULT \[\NUM i\] \[1\]). -check 1 ++ 2. - -notation \[ + \LIST0 \NUM a \] for \FOLD right \[ 'zero \] \LAMBDA acc \[ 'plus \NUM a \TERM acc \]. -check + 1 2 3 4. - -notation \[ [ \HOVBOX\[ \LIST0 \TERM a \SEP ; \] ] \] for \FOLD right \[ 'nil \] \LAMBDA acc \[ 'cons \TERM a \TERM acc \]. -check []. -check [1;2;3;4]. - -notation \[ [ \LIST0 \[ \TERM a ; \TERM b \] \SEP ; ] \] for \FOLD right \[ 'nil \] \LAMBDA acc \[ 'cons \TERM a ( 'cons \TERM b \TERM acc) \] . -check []. -check [1;2]. -check [1;2;3;4]. - -notation \[ | \LIST0 \[ \TERM a \OPT \[ , \TERM b \] \] \SEP ; | \] for \FOLD right \[ 'nil \] \LAMBDA acc \[ 'cons \DEFAULT \[ \TERM a \] \[ ('pair \TERM a \TERM b) \] \TERM acc \] . - -notation \[ | \LIST0 \[ \OPT \[ \NUM i \] \] \SEP ; | \] for \FOLD right \[ 'nil \] \LAMBDA acc \[ 'cons \DEFAULT \[ 'Some \NUM i \] \[ 'None \] \TERM acc \] . - -# sample mappings level 2 <--> level 3 - -interpretation 'plus x y = (cic:/Coq/Init/Peano/plus.con x y). -interpretation 'mult x y = (cic:/Coq/Init/Peano/mult.con x y). -render cic:/Coq/Arith/Mult/mult_plus_distr_r.con. - -notation \[ \TERM a \OVER \TERM b : \TERM c \SQRT \TERM d \] for 'megacoso \TERM a \TERM b \TERM c \TERM d. -interpretation "megacoso" 'megacoso x y z w = - (cic:/Coq/Init/Logic/eq.ind#xpointer(1/1) - cic:/Coq/Init/Datatypes/nat.ind#xpointer(1/1) - (cic:/Coq/Init/Peano/plus.con x y) - (cic:/Coq/Init/Peano/plus.con z w)). -render cic:/Coq/Arith/Plus/plus_comm.con. - -# full samples - -notation \[ \TERM a + \TERM b \] for 'plus \TERM a \TERM b. -check 1 + 2. -interpretation 'plus x y = (cic:/Coq/Init/Peano/plus.con x y). -render cic:/Coq/Arith/Plus/plus_comm.con. - -notation \[ \TERM a + \TERM b \] left associative with precedence 50 for 'plus \TERM a \TERM b. -notation \[ \TERM a * \TERM b \] left associative with precedence 60 for 'mult \TERM a \TERM b. -interpretation 'plus x y = (cic:/Coq/Init/Peano/plus.con x y). -interpretation 'mult x y = (cic:/Coq/Init/Peano/mult.con x y). -render cic:/Coq/Arith/Mult/mult_plus_distr_r.con. - -notation \[ \LIST \NUM a \] for \FOLD left \[ 'a \] \LAMBDA acc \[ 'b \NUM a \]. - - diff --git a/helm/ocaml/cic_notation/doc/semantic.sty b/helm/ocaml/cic_notation/doc/semantic.sty deleted file mode 100644 index 98257cab8..000000000 --- a/helm/ocaml/cic_notation/doc/semantic.sty +++ /dev/null @@ -1,137 +0,0 @@ -%% -%% 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 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/cic_notation/doc/shrthand.sty b/helm/ocaml/cic_notation/doc/shrthand.sty deleted file mode 100644 index b73af4470..000000000 --- a/helm/ocaml/cic_notation/doc/shrthand.sty +++ /dev/null @@ -1,96 +0,0 @@ -%% -%% 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 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/cic_notation/doc/tdiagram.sty b/helm/ocaml/cic_notation/doc/tdiagram.sty deleted file mode 100644 index 02202b34a..000000000 --- a/helm/ocaml/cic_notation/doc/tdiagram.sty +++ /dev/null @@ -1,166 +0,0 @@ -%% -%% 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 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 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 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/cic_notation/test_parser.conf.xml b/helm/ocaml/cic_notation/test_parser.conf.xml deleted file mode 100644 index 67b5dbefd..000000000 --- a/helm/ocaml/cic_notation/test_parser.conf.xml +++ /dev/null @@ -1,15 +0,0 @@ - -
- - cic:/ - file:///projects/helm/library/coq_contribs/ - - - cic:/matita/ - file:///home/zacchiro/helm/matita/.matita/xml/matita/ - -
-
- ../../matita/core_notation.moo -
- diff --git a/helm/ocaml/cic_omdoc/.cvsignore b/helm/ocaml/cic_omdoc/.cvsignore deleted file mode 100644 index 6b3eba302..000000000 --- a/helm/ocaml/cic_omdoc/.cvsignore +++ /dev/null @@ -1 +0,0 @@ -*.cm[iaox] *.cmxa diff --git a/helm/ocaml/cic_omdoc/.depend b/helm/ocaml/cic_omdoc/.depend deleted file mode 100644 index 2074968ba..000000000 --- a/helm/ocaml/cic_omdoc/.depend +++ /dev/null @@ -1,17 +0,0 @@ -contentPp.cmi: content.cmi -cic2content.cmi: content.cmi cic2acic.cmi -content2cic.cmi: content.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 -content.cmo: content.cmi -content.cmx: content.cmi -contentPp.cmo: content.cmi contentPp.cmi -contentPp.cmx: content.cmx contentPp.cmi -cic2content.cmo: content.cmi cic2acic.cmi cic2content.cmi -cic2content.cmx: content.cmx cic2acic.cmx cic2content.cmi -content2cic.cmo: content.cmi content2cic.cmi -content2cic.cmx: content.cmx content2cic.cmi diff --git a/helm/ocaml/cic_transformations/.cvsignore b/helm/ocaml/cic_transformations/.cvsignore deleted file mode 100644 index 6b3eba302..000000000 --- a/helm/ocaml/cic_transformations/.cvsignore +++ /dev/null @@ -1 +0,0 @@ -*.cm[iaox] *.cmxa diff --git a/helm/ocaml/cic_transformations/.depend b/helm/ocaml/cic_transformations/.depend deleted file mode 100644 index 3510045e9..000000000 --- a/helm/ocaml/cic_transformations/.depend +++ /dev/null @@ -1,14 +0,0 @@ -cic2Xml.cmo: cic2Xml.cmi -cic2Xml.cmx: cic2Xml.cmi -content2pres.cmo: content2pres.cmi -content2pres.cmx: content2pres.cmi -sequent2pres.cmo: sequent2pres.cmi -sequent2pres.cmx: sequent2pres.cmi -domMisc.cmo: domMisc.cmi -domMisc.cmx: domMisc.cmi -xml2Gdome.cmo: xml2Gdome.cmi -xml2Gdome.cmx: xml2Gdome.cmi -applyTransformation.cmo: xml2Gdome.cmi sequent2pres.cmi domMisc.cmi \ - content2pres.cmi applyTransformation.cmi -applyTransformation.cmx: xml2Gdome.cmx sequent2pres.cmx domMisc.cmx \ - content2pres.cmx applyTransformation.cmi diff --git a/helm/ocaml/cic_transformations/Makefile b/helm/ocaml/cic_transformations/Makefile deleted file mode 100644 index c5b5eaf09..000000000 --- a/helm/ocaml/cic_transformations/Makefile +++ /dev/null @@ -1,25 +0,0 @@ -PACKAGE = cic_transformations -PREDICATES = - -# modules which have both a .ml and a .mli -INTERFACE_FILES = \ - cic2Xml.mli \ - content2pres.mli \ - sequent2pres.mli \ - domMisc.mli \ - xml2Gdome.mli \ - applyTransformation.mli \ - $(NULL) -IMPLEMENTATION_FILES = \ - $(INTERFACE_FILES:%.mli=%.ml) -EXTRA_OBJECTS_TO_INSTALL = -EXTRA_OBJECTS_TO_CLEAN = - -all: - -clean: extra_clean -distclean: extra_clean -extra_clean: - rm -f make_table - -include ../Makefile.common diff --git a/helm/ocaml/cic_transformations/applyTransformation.ml b/helm/ocaml/cic_transformations/applyTransformation.ml deleted file mode 100644 index 54402e0bc..000000000 --- a/helm/ocaml/cic_transformations/applyTransformation.ml +++ /dev/null @@ -1,70 +0,0 @@ -(* 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 *) -(* 21/11/2003 *) -(* *) -(* *) -(***************************************************************************) - -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 = Cic2content.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 = - Cic2content.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/ocaml/cic_transformations/applyTransformation.mli b/helm/ocaml/cic_transformations/applyTransformation.mli deleted file mode 100644 index 8e023aea6..000000000 --- a/helm/ocaml/cic_transformations/applyTransformation.mli +++ /dev/null @@ -1,57 +0,0 @@ -(* 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 *) -(* 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/ocaml/content_pres/.cvsignore b/helm/ocaml/content_pres/.cvsignore new file mode 100644 index 000000000..ce13c765e --- /dev/null +++ b/helm/ocaml/content_pres/.cvsignore @@ -0,0 +1,4 @@ +*.cm[iaox] +*.cmxa +test_lexer +test_lexer.opt diff --git a/helm/ocaml/content_pres/.depend b/helm/ocaml/content_pres/.depend new file mode 100644 index 000000000..781c9e45b --- /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: renderingAttrs.cmi mpresentation.cmi cicNotationPres.cmi \ + box.cmi content2pres.cmi +content2pres.cmx: renderingAttrs.cmx mpresentation.cmx cicNotationPres.cmx \ + box.cmx content2pres.cmi +sequent2pres.cmo: mpresentation.cmi cicNotationPres.cmi box.cmi \ + sequent2pres.cmi +sequent2pres.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..6816a9c24 --- /dev/null +++ b/helm/ocaml/content_pres/Makefile @@ -0,0 +1,42 @@ +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 diff --git a/helm/ocaml/cic_notation/box.ml b/helm/ocaml/content_pres/box.ml similarity index 100% rename from helm/ocaml/cic_notation/box.ml rename to helm/ocaml/content_pres/box.ml diff --git a/helm/ocaml/cic_notation/box.mli b/helm/ocaml/content_pres/box.mli similarity index 100% rename from helm/ocaml/cic_notation/box.mli rename to helm/ocaml/content_pres/box.mli diff --git a/helm/ocaml/cic_notation/boxPp.ml b/helm/ocaml/content_pres/boxPp.ml similarity index 100% rename from helm/ocaml/cic_notation/boxPp.ml rename to helm/ocaml/content_pres/boxPp.ml diff --git a/helm/ocaml/cic_notation/boxPp.mli b/helm/ocaml/content_pres/boxPp.mli similarity index 100% rename from helm/ocaml/cic_notation/boxPp.mli rename to helm/ocaml/content_pres/boxPp.mli diff --git a/helm/ocaml/cic_notation/cicNotationLexer.ml b/helm/ocaml/content_pres/cicNotationLexer.ml similarity index 100% rename from helm/ocaml/cic_notation/cicNotationLexer.ml rename to helm/ocaml/content_pres/cicNotationLexer.ml diff --git a/helm/ocaml/cic_notation/cicNotationLexer.mli b/helm/ocaml/content_pres/cicNotationLexer.mli similarity index 100% rename from helm/ocaml/cic_notation/cicNotationLexer.mli rename to helm/ocaml/content_pres/cicNotationLexer.mli diff --git a/helm/ocaml/cic_notation/cicNotationParser.ml b/helm/ocaml/content_pres/cicNotationParser.ml similarity index 100% rename from helm/ocaml/cic_notation/cicNotationParser.ml rename to helm/ocaml/content_pres/cicNotationParser.ml diff --git a/helm/ocaml/cic_notation/cicNotationParser.mli b/helm/ocaml/content_pres/cicNotationParser.mli similarity index 100% rename from helm/ocaml/cic_notation/cicNotationParser.mli rename to helm/ocaml/content_pres/cicNotationParser.mli diff --git a/helm/ocaml/cic_notation/cicNotationPres.ml b/helm/ocaml/content_pres/cicNotationPres.ml similarity index 100% rename from helm/ocaml/cic_notation/cicNotationPres.ml rename to helm/ocaml/content_pres/cicNotationPres.ml diff --git a/helm/ocaml/cic_notation/cicNotationPres.mli b/helm/ocaml/content_pres/cicNotationPres.mli similarity index 100% rename from helm/ocaml/cic_notation/cicNotationPres.mli rename to helm/ocaml/content_pres/cicNotationPres.mli diff --git a/helm/ocaml/cic_transformations/content2pres.ml b/helm/ocaml/content_pres/content2pres.ml similarity index 99% rename from helm/ocaml/cic_transformations/content2pres.ml rename to helm/ocaml/content_pres/content2pres.ml index ee3e64bd5..4114d2b51 100644 --- a/helm/ocaml/cic_transformations/content2pres.ml +++ b/helm/ocaml/content_pres/content2pres.ml @@ -815,9 +815,9 @@ let content2pres ~ids_to_inner_sorts = content2pres (fun annterm -> let ast, ids_to_uris = - CicNotationRew.ast_of_acic ids_to_inner_sorts annterm + TermAcicContent.ast_of_acic ids_to_inner_sorts annterm in CicNotationPres.box_of_mpres (CicNotationPres.render ids_to_uris - (CicNotationRew.pp_ast ast))) + (TermContentPres.pp_ast ast))) diff --git a/helm/ocaml/cic_transformations/content2pres.mli b/helm/ocaml/content_pres/content2pres.mli similarity index 100% rename from helm/ocaml/cic_transformations/content2pres.mli rename to helm/ocaml/content_pres/content2pres.mli diff --git a/helm/ocaml/content_pres/content2presMatcher.ml b/helm/ocaml/content_pres/content2presMatcher.ml new file mode 100644 index 000000000..9a2f0d20b --- /dev/null +++ b/helm/ocaml/content_pres/content2presMatcher.ml @@ -0,0 +1,231 @@ +(* 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 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 _ as t -> 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/cic_notation/cicNotationTag.mli b/helm/ocaml/content_pres/content2presMatcher.mli similarity index 78% rename from helm/ocaml/cic_notation/cicNotationTag.mli rename to helm/ocaml/content_pres/content2presMatcher.mli index bf04e0a9f..86b97b6d8 100644 --- a/helm/ocaml/cic_notation/cicNotationTag.mli +++ b/helm/ocaml/content_pres/content2presMatcher.mli @@ -1,4 +1,4 @@ -(* Copyright (C) 2004-2005, HELM Team. +(* Copyright (C) 2005, HELM Team. * * This file is part of HELM, an Hypertextual, Electronic * Library of Mathematics, developed at the Computer Science @@ -23,5 +23,12 @@ * http://helm.cs.unibo.it/ *) -val get_tag: CicNotationPt.term -> int * CicNotationPt.term list +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/cic_notation/mpresentation.ml b/helm/ocaml/content_pres/mpresentation.ml similarity index 100% rename from helm/ocaml/cic_notation/mpresentation.ml rename to helm/ocaml/content_pres/mpresentation.ml diff --git a/helm/ocaml/cic_notation/mpresentation.mli b/helm/ocaml/content_pres/mpresentation.mli similarity index 100% rename from helm/ocaml/cic_notation/mpresentation.mli rename to helm/ocaml/content_pres/mpresentation.mli diff --git a/helm/ocaml/cic_notation/renderingAttrs.ml b/helm/ocaml/content_pres/renderingAttrs.ml similarity index 100% rename from helm/ocaml/cic_notation/renderingAttrs.ml rename to helm/ocaml/content_pres/renderingAttrs.ml diff --git a/helm/ocaml/cic_notation/renderingAttrs.mli b/helm/ocaml/content_pres/renderingAttrs.mli similarity index 100% rename from helm/ocaml/cic_notation/renderingAttrs.mli rename to helm/ocaml/content_pres/renderingAttrs.mli diff --git a/helm/ocaml/cic_transformations/sequent2pres.ml b/helm/ocaml/content_pres/sequent2pres.ml similarity index 97% rename from helm/ocaml/cic_transformations/sequent2pres.ml rename to helm/ocaml/content_pres/sequent2pres.ml index b7de8499a..bc0dfd055 100644 --- a/helm/ocaml/cic_transformations/sequent2pres.ml +++ b/helm/ocaml/content_pres/sequent2pres.ml @@ -96,9 +96,9 @@ let sequent2pres ~ids_to_inner_sorts = sequent2pres (fun annterm -> let ast, ids_to_uris = - CicNotationRew.ast_of_acic ids_to_inner_sorts annterm + TermAcicContent.ast_of_acic ids_to_inner_sorts annterm in CicNotationPres.box_of_mpres (CicNotationPres.render ids_to_uris - (CicNotationRew.pp_ast ast))) + (TermContentPres.pp_ast ast))) diff --git a/helm/ocaml/cic_transformations/sequent2pres.mli b/helm/ocaml/content_pres/sequent2pres.mli similarity index 100% rename from helm/ocaml/cic_transformations/sequent2pres.mli rename to helm/ocaml/content_pres/sequent2pres.mli diff --git a/helm/ocaml/cic_notation/cicNotationRew.ml b/helm/ocaml/content_pres/termContentPres.ml similarity index 59% rename from helm/ocaml/cic_notation/cicNotationRew.ml rename to helm/ocaml/content_pres/termContentPres.ml index 8bbc22e24..3236fb433 100644 --- a/helm/ocaml/cic_notation/cicNotationRew.ml +++ b/helm/ocaml/content_pres/termContentPres.ml @@ -26,46 +26,14 @@ 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 interpretation_id = pattern_id type pretty_printer_id = pattern_id -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 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 idref id t = Ast.AttributedTerm (`IdRef id, t) - let resolve_binder = function | `Lambda -> "\\lambda" | `Pi -> "\\Pi" @@ -296,158 +264,20 @@ let pp_ast0 t k = in aux t -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) as t -> - 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 level1_patterns21 = Hashtbl.create 211 -let level2_patterns32 = Hashtbl.create 211 -let interpretations = Hashtbl.create 211 (* symb -> id list ref *) let compiled21 = ref None -let compiled32 = ref None let pattern21_matrix = ref [] -let pattern32_matrix = ref [] let get_compiled21 () = match !compiled21 with | None -> assert false | Some f -> Lazy.force f -let get_compiled32 () = - match !compiled32 with - | None -> assert false - | Some f -> Lazy.force f let set_compiled21 f = compiled21 := Some f -let set_compiled32 f = compiled32 := Some f let add_idrefs = List.fold_right (fun idref t -> Ast.AttributedTerm (`IdRef idref, t)) @@ -590,76 +420,8 @@ let rec pp_ast1 term = in instantiate21 idrefs (ast_env_of_env env) l1) -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 (CicNotationMatcher.Matcher32.compiler t)) - let load_patterns21 t = - set_compiled21 (lazy (CicNotationMatcher.Matcher21.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 + set_compiled21 (lazy (Content2presMatcher.Matcher21.compiler t)) let pp_ast ast = debug_print (lazy "pp_ast <-"); @@ -667,73 +429,8 @@ let pp_ast ast = debug_print (lazy ("pp_ast -> " ^ CicNotationPp.pp_term ast')); ast' -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 exception Pretty_printer_not_found -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 lookup_interpretations symbol = - try - 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 fill_pos_info l1_pattern = l1_pattern (* let rec aux toplevel pos = function @@ -747,6 +444,12 @@ let fill_pos_info l1_pattern = l1_pattern 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 @@ -756,17 +459,6 @@ let add_pretty_printer ~precedence ~associativity l2 l1 = load_patterns21 !pattern21_matrix; id -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 remove_pretty_printer id = (try Hashtbl.remove level1_patterns21 id; @@ -774,7 +466,182 @@ let remove_pretty_printer id = pattern21_matrix := List.filter (fun (_, id') -> id <> id') !pattern21_matrix; load_patterns21 !pattern21_matrix -let _ = - load_patterns21 []; - load_patterns32 [] + (* 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/cic_notation/cicNotationFwd.mli b/helm/ocaml/content_pres/termContentPres.mli similarity index 68% rename from helm/ocaml/cic_notation/cicNotationFwd.mli rename to helm/ocaml/content_pres/termContentPres.mli index 4a5d89f98..5ff710036 100644 --- a/helm/ocaml/cic_notation/cicNotationFwd.mli +++ b/helm/ocaml/content_pres/termContentPres.mli @@ -23,14 +23,30 @@ * 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 - (** @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_notation/test_lexer.ml b/helm/ocaml/content_pres/test_lexer.ml similarity index 100% rename from helm/ocaml/cic_notation/test_lexer.ml rename to helm/ocaml/content_pres/test_lexer.ml diff --git a/helm/ocaml/extlib/.depend b/helm/ocaml/extlib/.depend index cbb3fcdfe..249ee3196 100644 --- a/helm/ocaml/extlib/.depend +++ b/helm/ocaml/extlib/.depend @@ -1,2 +1,4 @@ hExtlib.cmo: hExtlib.cmi hExtlib.cmx: hExtlib.cmi +patternMatcher.cmo: patternMatcher.cmi +patternMatcher.cmx: patternMatcher.cmi diff --git a/helm/ocaml/extlib/Makefile b/helm/ocaml/extlib/Makefile index 76370ee73..9f6267a06 100644 --- a/helm/ocaml/extlib/Makefile +++ b/helm/ocaml/extlib/Makefile @@ -1,8 +1,10 @@ PACKAGE = extlib PREDICATES = -INTERFACE_FILES = \ - hExtlib.mli +INTERFACE_FILES = \ + hExtlib.mli \ + patternMatcher.mli \ + $(NULL) IMPLEMENTATION_FILES = \ $(INTERFACE_FILES:%.mli=%.ml) EXTRA_OBJECTS_TO_INSTALL = diff --git a/helm/ocaml/extlib/patternMatcher.ml b/helm/ocaml/extlib/patternMatcher.ml new file mode 100644 index 000000000..27b916bfe --- /dev/null +++ b/helm/ocaml/extlib/patternMatcher.ml @@ -0,0 +1,189 @@ +(* 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 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/cic_notation/cicNotationMatcher.mli b/helm/ocaml/extlib/patternMatcher.mli similarity index 80% rename from helm/ocaml/cic_notation/cicNotationMatcher.mli rename to helm/ocaml/extlib/patternMatcher.mli index f8daca798..2201ddf7f 100644 --- a/helm/ocaml/cic_notation/cicNotationMatcher.mli +++ b/helm/ocaml/extlib/patternMatcher.mli @@ -1,4 +1,5 @@ -(* Copyright (C) 2004-2005, HELM Team. + +(* Copyright (C) 2005, HELM Team. * * This file is part of HELM, an Hypertextual, Electronic * Library of Mathematics, developed at the Computer Science @@ -59,21 +60,3 @@ sig (P.term_t -> 'a option) end -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 - -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/cic_notation/.cvsignore b/helm/ocaml/grafite/.cvsignore similarity index 59% rename from helm/ocaml/cic_notation/.cvsignore rename to helm/ocaml/grafite/.cvsignore index 45ec2c22f..8697eb7ee 100644 --- a/helm/ocaml/cic_notation/.cvsignore +++ b/helm/ocaml/grafite/.cvsignore @@ -1,7 +1,5 @@ -*.cm[aiox] +*.cm[iaox] *.cmxa -*.[ao] -test_lexer -test_parser test_dep +test_parser print_grammar diff --git a/helm/ocaml/grafite/.depend b/helm/ocaml/grafite/.depend new file mode 100644 index 000000000..c0590d25a --- /dev/null +++ b/helm/ocaml/grafite/.depend @@ -0,0 +1,9 @@ +grafiteAstPp.cmi: grafiteAst.cmo +grafiteParser.cmi: grafiteAst.cmo +cicNotation.cmi: grafiteAst.cmo +grafiteAstPp.cmo: grafiteAst.cmo grafiteAstPp.cmi +grafiteAstPp.cmx: grafiteAst.cmx grafiteAstPp.cmi +grafiteParser.cmo: grafiteAst.cmo grafiteParser.cmi +grafiteParser.cmx: grafiteAst.cmx grafiteParser.cmi +cicNotation.cmo: grafiteParser.cmi grafiteAst.cmo cicNotation.cmi +cicNotation.cmx: grafiteParser.cmx grafiteAst.cmx cicNotation.cmi diff --git a/helm/ocaml/grafite/Makefile b/helm/ocaml/grafite/Makefile new file mode 100644 index 000000000..f7cbc9d82 --- /dev/null +++ b/helm/ocaml/grafite/Makefile @@ -0,0 +1,31 @@ +PACKAGE = grafite +PREDICATES = + +INTERFACE_FILES = \ + grafiteAstPp.mli \ + grafiteParser.mli \ + cicNotation.mli \ + $(NULL) +IMPLEMENTATION_FILES = \ + grafiteAst.ml \ + $(INTERFACE_FILES:%.mli=%.ml) + +all: test_parser print_grammar test_dep +clean: clean_tests + +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-grafite -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/cic_notation/cicNotation.ml b/helm/ocaml/grafite/cicNotation.ml similarity index 79% rename from helm/ocaml/cic_notation/cicNotation.ml rename to helm/ocaml/grafite/cicNotation.ml index cbad3391f..bab8cb97b 100644 --- a/helm/ocaml/cic_notation/cicNotation.ml +++ b/helm/ocaml/grafite/cicNotation.ml @@ -27,8 +27,8 @@ open GrafiteAst type notation_id = | RuleId of CicNotationParser.rule_id - | InterpretationId of CicNotationRew.interpretation_id - | PrettyPrinterId of CicNotationRew.pretty_printer_id + | InterpretationId of TermAcicContent.interpretation_id + | PrettyPrinterId of TermContentPres.pretty_printer_id let process_notation st = match st with @@ -36,28 +36,28 @@ let process_notation st = let rule_id = if dir <> Some `RightToLeft then [ RuleId (CicNotationParser.extend l1 ?precedence ?associativity - (fun env loc -> CicNotationFwd.instantiate_level2 env l2)) ] + (fun env loc -> TermContentPres.instantiate_level2 env l2)) ] else [] in let pp_id = if dir <> Some `LeftToRight then [ PrettyPrinterId - (CicNotationRew.add_pretty_printer ?precedence ?associativity + (TermContentPres.add_pretty_printer ?precedence ?associativity l2 l1) ] else [] in st, rule_id @ pp_id | Interpretation (loc, dsc, l2, l3) -> - let interp_id = CicNotationRew.add_interpretation dsc l2 l3 in + let interp_id = TermAcicContent.add_interpretation dsc l2 l3 in st, [ InterpretationId interp_id ] | st -> st, [] let remove_notation = function | RuleId id -> CicNotationParser.delete id - | PrettyPrinterId id -> CicNotationRew.remove_pretty_printer id - | InterpretationId id -> CicNotationRew.remove_interpretation id + | PrettyPrinterId id -> TermContentPres.remove_pretty_printer id + | InterpretationId id -> TermAcicContent.remove_interpretation id let load_notation fname = let ic = open_in fname in @@ -74,11 +74,11 @@ let get_all_notations () = List.map (fun (interp_id, dsc) -> InterpretationId interp_id, "interpretation: " ^ dsc) - (CicNotationRew.get_all_interpretations ()) + (TermAcicContent.get_all_interpretations ()) let get_active_notations () = List.map (fun id -> InterpretationId id) - (CicNotationRew.get_active_interpretations ()) + (TermAcicContent.get_active_interpretations ()) let set_active_notations ids = let interp_ids = @@ -86,5 +86,5 @@ let set_active_notations ids = (function InterpretationId interp_id -> Some interp_id | _ -> None) ids in - CicNotationRew.set_active_interpretations interp_ids + TermAcicContent.set_active_interpretations interp_ids diff --git a/helm/ocaml/cic_notation/cicNotation.mli b/helm/ocaml/grafite/cicNotation.mli similarity index 100% rename from helm/ocaml/cic_notation/cicNotation.mli rename to helm/ocaml/grafite/cicNotation.mli diff --git a/helm/ocaml/cic_notation/grafiteAst.ml b/helm/ocaml/grafite/grafiteAst.ml similarity index 89% rename from helm/ocaml/cic_notation/grafiteAst.ml rename to helm/ocaml/grafite/grafiteAst.ml index cba5acd1f..2058ba37a 100644 --- a/helm/ocaml/cic_notation/grafiteAst.ml +++ b/helm/ocaml/grafite/grafiteAst.ml @@ -86,12 +86,6 @@ type ('term, 'lazy_term, 'reduction, 'ident) tactic = | Symmetry of loc | Transitivity of loc * 'term -type thm_flavour = Cic.object_flavour - - (** - * true means inductive, false coinductive *) -type 'term inductive_type = string * bool * 'term * (string * 'term) list - type search_kind = [ `Locate | `Hint | `Match | `Elim ] type print_kind = [ `Env | `Coer ] @@ -120,21 +114,6 @@ type alias_spec = | Symbol_alias of string * int * string (* name, instance no, description *) | Number_alias of int * string (* instance no, description *) -type obj = - | Inductive of (string * Ast.term) list * - Ast.term inductive_type list - (** parameters, list of loc * mutual inductive types *) - | Theorem of thm_flavour * string * Ast.term * Ast.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 * Ast.term) list * string * Ast.term * - (string * Ast.term) list - (** left parameters, name, type, fields *) - type metadata = | Dependency of string (* baseuri without trailing slash *) | Baseuri of string diff --git a/helm/ocaml/cic_notation/grafiteAstPp.ml b/helm/ocaml/grafite/grafiteAstPp.ml similarity index 84% rename from helm/ocaml/cic_notation/grafiteAstPp.ml rename to helm/ocaml/grafite/grafiteAstPp.ml index 3e19ed281..36b54694d 100644 --- a/helm/ocaml/cic_notation/grafiteAstPp.ml +++ b/helm/ocaml/grafite/grafiteAstPp.ml @@ -145,15 +145,6 @@ let rec pp_tactic = function | Symmetry _ -> "symmetry" | Transitivity (_, term) -> "transitivity " ^ pp_term_ast term -let pp_flavour = function - | `Definition -> "Definition" - | `Fact -> "Fact" - | `Goal -> "Goal" - | `Lemma -> "Lemma" - | `Remark -> "Remark" - | `Theorem -> "Theorem" - | `Variant -> "Variant" - let pp_search_kind = function | `Locate -> "locate" | `Hint -> "hint" @@ -194,52 +185,6 @@ let pp_alias = function | Number_alias (instance,desc) -> sprintf "alias num (instance %d) = \"%s\"" instance desc -let pp_params = function - | [] -> "" - | params -> - " " ^ - String.concat " " - (List.map - (fun (name, typ) -> sprintf "(%s:%s)" name (pp_term_ast typ)) - params) - -let pp_fields fields = - (if fields <> [] then "\n" else "") ^ - String.concat ";\n" - (List.map (fun (name,ty) -> " " ^ name ^ ": " ^ pp_term_ast ty) fields) - -let pp_obj = function - | Inductive (params, types) -> - let pp_constructors constructors = - String.concat "\n" - (List.map (fun (name, typ) -> sprintf "| %s: %s" name (pp_term_ast typ)) - constructors) - in - let pp_type (name, _, typ, constructors) = - sprintf "\nwith %s: %s \\def\n%s" name (pp_term_ast 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_ast typ) (pp_constructors constructors) - in - fst_typ_pp ^ String.concat "" (List.map pp_type tl)) - | Theorem (flavour, name, typ, body) -> - sprintf "%s %s: %s %s" - (pp_flavour flavour) - name - (pp_term_ast typ) - (match body with - | None -> "" - | Some body -> "\\def " ^ pp_term_ast body) - | Record (params,name,ty,fields) -> - "record " ^ name ^ " " ^ pp_params params ^ " \\def {" ^ - pp_fields fields ^ "}" - let pp_argument_pattern = function | Ast.IdentArg (eta_depth, name) -> let eta_buf = Buffer.create 5 in @@ -248,13 +193,6 @@ let pp_argument_pattern = function done; sprintf "%s%s" (Buffer.contents eta_buf) name -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)) - let pp_l1_pattern = CicNotationPp.pp_term let pp_l2_pattern = CicNotationPp.pp_term @@ -282,7 +220,7 @@ let pp_command = function | Set (_, name, value) -> sprintf "set \"%s\" \"%s\"" name value | Coercion (_,term) -> sprintf "coercion %s" (pp_term_ast term) | Alias (_,s) -> pp_alias s - | Obj (_,obj) -> pp_obj obj + | Obj (_,obj) -> CicNotationPp.pp_obj obj | Default (_,what,uris) -> sprintf "default \"%s\" %s" what (String.concat " " (List.map UriManager.string_of_uri uris)) @@ -290,7 +228,7 @@ let pp_command = function sprintf "interpretation \"%s\" '%s %s = %s" dsc symbol (String.concat " " (List.map pp_argument_pattern arg_patterns)) - (pp_cic_appl_pattern cic_appl_pattern) + (CicNotationPp.pp_cic_appl_pattern cic_appl_pattern) | Notation (_, dir_opt, l1_pattern, assoc, prec, l2_pattern) -> sprintf "notation %s\"%s\" %s %s for %s" (pp_dir_opt dir_opt) diff --git a/helm/ocaml/cic_notation/grafiteAstPp.mli b/helm/ocaml/grafite/grafiteAstPp.mli similarity index 88% rename from helm/ocaml/cic_notation/grafiteAstPp.mli rename to helm/ocaml/grafite/grafiteAstPp.mli index b8445095f..79900a342 100644 --- a/helm/ocaml/cic_notation/grafiteAstPp.mli +++ b/helm/ocaml/grafite/grafiteAstPp.mli @@ -28,26 +28,26 @@ val pp_tactic: GrafiteAst.tactic -> string -val pp_obj: GrafiteAst.obj -> string -val pp_command: (CicNotationPt.term,GrafiteAst.obj) GrafiteAst.command -> string +val pp_command: + (CicNotationPt.term,CicNotationPt.obj) GrafiteAst.command -> string val pp_metadata: GrafiteAst.metadata -> string val pp_macro: ('a -> string) -> 'a GrafiteAst.macro -> string val pp_comment: - (CicNotationPt.term, CicNotationPt.term, GrafiteAst.reduction, GrafiteAst.obj, - string) + (CicNotationPt.term, CicNotationPt.term, GrafiteAst.reduction, + CicNotationPt.obj, string) GrafiteAst.comment -> string val pp_executable: - (CicNotationPt.term, CicNotationPt.term, GrafiteAst.reduction, GrafiteAst.obj, - string) + (CicNotationPt.term, CicNotationPt.term, GrafiteAst.reduction, + CicNotationPt.obj, string) GrafiteAst.code -> string val pp_statement: - (CicNotationPt.term, CicNotationPt.term, GrafiteAst.reduction, GrafiteAst.obj, - string) + (CicNotationPt.term, CicNotationPt.term, GrafiteAst.reduction, + CicNotationPt.obj, string) GrafiteAst.statement -> string @@ -65,5 +65,3 @@ val pp_cic_command: (Cic.term,Cic.obj) GrafiteAst.command -> string val pp_dependency: GrafiteAst.dependency -> string -val pp_cic_appl_pattern: CicNotationPt.cic_appl_pattern -> string - diff --git a/helm/ocaml/cic_notation/grafiteParser.ml b/helm/ocaml/grafite/grafiteParser.ml similarity index 97% rename from helm/ocaml/cic_notation/grafiteParser.ml rename to helm/ocaml/grafite/grafiteParser.ml index e7c54213d..ea83367a8 100644 --- a/helm/ocaml/cic_notation/grafiteParser.ml +++ b/helm/ocaml/grafite/grafiteParser.ml @@ -29,7 +29,7 @@ module Ast = CicNotationPt type statement = (CicNotationPt.term, CicNotationPt.term, GrafiteAst.reduction, - GrafiteAst.obj, string) + CicNotationPt.obj, string) GrafiteAst.statement let grammar = CicNotationParser.level2_ast_grammar @@ -443,15 +443,15 @@ EXTEND | IDENT "variant" ; name = IDENT; SYMBOL ":"; typ = term; SYMBOL <:unicode> ; newname = IDENT -> GrafiteAst.Obj (loc, - GrafiteAst.Theorem + Ast.Theorem (`Variant,name,typ,Some (Ast.Ident (newname, None)))) | flavour = theorem_flavour; name = IDENT; SYMBOL ":"; typ = term; body = OPT [ SYMBOL <:unicode> (* ≝ *); body = term -> body ] -> - GrafiteAst.Obj (loc,GrafiteAst.Theorem (flavour, name, typ, body)) + GrafiteAst.Obj (loc, Ast.Theorem (flavour, name, typ, body)) | flavour = theorem_flavour; name = IDENT; SYMBOL <:unicode> (* ≝ *); body = term -> GrafiteAst.Obj (loc, - GrafiteAst.Theorem (flavour, name, Ast.Implicit, Some body)) + Ast.Theorem (flavour, name, Ast.Implicit, Some body)) | "let"; ind_kind = [ "corec" -> `CoInductive | "rec"-> `Inductive ]; defs = CicNotationParser.let_defs -> let name,ty = @@ -462,18 +462,18 @@ EXTEND | _ -> assert false in let body = Ast.Ident (name,None) in - GrafiteAst.Obj (loc,GrafiteAst.Theorem(`Definition, name, ty, + 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,GrafiteAst.Inductive (params, ind_types)) + 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,GrafiteAst.Inductive (params, ind_types)) + GrafiteAst.Obj (loc, Ast.Inductive (params, ind_types)) | IDENT "coercion" ; name = IDENT -> GrafiteAst.Coercion (loc, Ast.Ident (name,Some [])) | IDENT "coercion" ; name = URI -> @@ -481,7 +481,7 @@ EXTEND | IDENT "alias" ; spec = alias_spec -> GrafiteAst.Alias (loc, spec) | IDENT "record" ; (params,name,ty,fields) = record_spec -> - GrafiteAst.Obj (loc,GrafiteAst.Record (params,name,ty,fields)) + GrafiteAst.Obj (loc, Ast.Record (params,name,ty,fields)) | IDENT "include" ; path = QSTRING -> GrafiteAst.Include (loc,path) | IDENT "default" ; what = QSTRING ; uris = LIST1 URI -> diff --git a/helm/ocaml/cic_notation/grafiteParser.mli b/helm/ocaml/grafite/grafiteParser.mli similarity index 97% rename from helm/ocaml/cic_notation/grafiteParser.mli rename to helm/ocaml/grafite/grafiteParser.mli index fa732218f..256e2ef27 100644 --- a/helm/ocaml/cic_notation/grafiteParser.mli +++ b/helm/ocaml/grafite/grafiteParser.mli @@ -25,7 +25,7 @@ type statement = (CicNotationPt.term, CicNotationPt.term, GrafiteAst.reduction, - GrafiteAst.obj, string) + CicNotationPt.obj, string) GrafiteAst.statement val parse_statement: Ulexing.lexbuf -> statement (** @raise End_of_file *) diff --git a/helm/ocaml/cic_notation/print_grammar.ml b/helm/ocaml/grafite/print_grammar.ml similarity index 100% rename from helm/ocaml/cic_notation/print_grammar.ml rename to helm/ocaml/grafite/print_grammar.ml diff --git a/helm/ocaml/cic_notation/test_dep.ml b/helm/ocaml/grafite/test_dep.ml similarity index 100% rename from helm/ocaml/cic_notation/test_dep.ml rename to helm/ocaml/grafite/test_dep.ml diff --git a/helm/ocaml/cic_notation/test_parser.ml b/helm/ocaml/grafite/test_parser.ml similarity index 94% rename from helm/ocaml/cic_notation/test_parser.ml rename to helm/ocaml/grafite/test_parser.ml index 0dc914156..d5edf50c9 100644 --- a/helm/ocaml/cic_notation/test_parser.ml +++ b/helm/ocaml/grafite/test_parser.ml @@ -80,7 +80,7 @@ let process_stream istream = CicNotationParser.delete id) *) | G.Executable (_, G.Macro (_, G.Check (_, t))) -> prerr_endline (sprintf "ast: %s" (CicNotationPp.pp_term t)); - let t' = CicNotationRew.pp_ast t in + let t' = TermContentPres.pp_ast t in prerr_endline (sprintf "rendered ast: %s" (CicNotationPp.pp_term t')); let tbl = Hashtbl.create 0 in @@ -99,15 +99,15 @@ let process_stream istream = if dir <> Some `RightToLeft then ignore (CicNotationParser.extend l1 ?precedence ?associativity - (fun env loc -> CicNotationFwd.instantiate_level2 env l2)); + (fun env loc -> TermContentPres.instantiate_level2 env l2)); (* last_rule_id := Some rule_id; *) if dir <> Some `LeftToRight then - ignore (CicNotationRew.add_pretty_printer + ignore (TermContentPres.add_pretty_printer ?precedence ?associativity l2 l1) | G.Executable (_, G.Command (_, G.Interpretation (_, id, l2, l3))) -> prerr_endline "interpretation"; prerr_endline (sprintf "dsc: %s" id); - ignore (CicNotationRew.add_interpretation id l2 l3); + ignore (TermAcicContent.add_interpretation id l2 l3); flush stdout | G.Executable (_, G.Command (_, G.Dump _)) -> CicNotationParser.print_l2_pattern (); print_newline () @@ -123,11 +123,11 @@ let process_stream istream = | _ -> assert false in let t, id_to_uri = - CicNotationRew.ast_of_acic id_to_sort annterm + TermAcicContent.ast_of_acic id_to_sort annterm in prerr_endline "Raw AST"; prerr_endline (CicNotationPp.pp_term t); - let t' = CicNotationRew.pp_ast t in + let t' = TermContentPres.pp_ast t in prerr_endline "Rendered AST"; prerr_endline (CicNotationPp.pp_term t'); dump_xml t' id_to_uri "out.xml" diff --git a/helm/ocaml/hgdome/.cvsignore b/helm/ocaml/hgdome/.cvsignore new file mode 100644 index 000000000..8d64a5378 --- /dev/null +++ b/helm/ocaml/hgdome/.cvsignore @@ -0,0 +1,2 @@ +*.cm[iaox] +*.cmxa 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/cic_transformations/domMisc.ml b/helm/ocaml/hgdome/domMisc.ml similarity index 86% rename from helm/ocaml/cic_transformations/domMisc.ml rename to helm/ocaml/hgdome/domMisc.ml index 56d542556..84445e19c 100644 --- a/helm/ocaml/cic_transformations/domMisc.ml +++ b/helm/ocaml/hgdome/domMisc.ml @@ -39,11 +39,3 @@ 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" - (* 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 = - let xml_headings_RE = Pcre.regexp "^.*\n.*\n.*\n.*\n" in - fun s -> - Pcre.replace ~rex:xml_headings_RE s - diff --git a/helm/ocaml/cic_transformations/domMisc.mli b/helm/ocaml/hgdome/domMisc.mli similarity index 94% rename from helm/ocaml/cic_transformations/domMisc.mli rename to helm/ocaml/hgdome/domMisc.mli index d0779d1e7..25d642bc5 100644 --- a/helm/ocaml/cic_transformations/domMisc.mli +++ b/helm/ocaml/hgdome/domMisc.mli @@ -33,8 +33,6 @@ (* *) (******************************************************************************) -(* TODO rename this module into at least something like CicMisc *) - val domImpl : Gdome.domImplementation val helm_ns : Gdome.domString (** HELM namespace *) @@ -42,5 +40,3 @@ val xlink_ns : Gdome.domString (** XLink namespace *) val mathml_ns : Gdome.domString (** MathML namespace *) val boxml_ns : Gdome.domString (** BoxML namespace *) -val strip_xml_headings: string -> string - diff --git a/helm/ocaml/cic_transformations/xml2Gdome.ml b/helm/ocaml/hgdome/xml2Gdome.ml similarity index 100% rename from helm/ocaml/cic_transformations/xml2Gdome.ml rename to helm/ocaml/hgdome/xml2Gdome.ml diff --git a/helm/ocaml/cic_transformations/xml2Gdome.mli b/helm/ocaml/hgdome/xml2Gdome.mli similarity index 100% rename from helm/ocaml/cic_transformations/xml2Gdome.mli rename to helm/ocaml/hgdome/xml2Gdome.mli diff --git a/helm/ocaml/xml/xml.ml b/helm/ocaml/xml/xml.ml index 42ce7ba57..809e11d3f 100644 --- a/helm/ocaml/xml/xml.ml +++ b/helm/ocaml/xml/xml.ml @@ -160,3 +160,16 @@ let add_xml_declaration stream = ] 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 index 43547eaa0..4feca7503 100644 --- a/helm/ocaml/xml/xml.mli +++ b/helm/ocaml/xml/xml.mli @@ -71,3 +71,5 @@ val pp_to_string : token Stream.t -> string val add_xml_declaration: token Stream.t -> token Stream.t +val strip_xml_headings: string -> string + -- 2.39.2