From bac72fcaa876137ab7a5630e0c1badc2a627dce8 Mon Sep 17 00:00:00 2001 From: Claudio Sacerdoti Coen Date: Thu, 19 Jun 2003 15:31:51 +0000 Subject: [PATCH] Merge of the V7_3_new_exportation branch. --- helm/gTopLevel/.depend | 82 +- helm/gTopLevel/Makefile | 60 +- helm/gTopLevel/applyStylesheets.ml | 167 + helm/gTopLevel/applyStylesheets.mli | 49 + helm/gTopLevel/cic2Xml.ml | 446 +- helm/gTopLevel/cic2Xml.mli | 5 +- helm/gTopLevel/cic2acic.ml | 233 +- helm/gTopLevel/cic2acic.mli | 4 +- helm/gTopLevel/dictionary-cic.xml | 37 + helm/gTopLevel/disambiguate.ml | 284 ++ helm/gTopLevel/disambiguate.mli | 73 + helm/gTopLevel/doubleTypeInference.ml | 162 +- helm/gTopLevel/esempi/and_implies_or2.cic | 10 +- helm/gTopLevel/esempi/apply.cic | 6 +- helm/gTopLevel/esempi/bug.cic | 14 +- .../gTopLevel/esempi/calcolo_proposizioni.cic | 14 +- helm/gTopLevel/esempi/conversion.cic | 10 +- helm/gTopLevel/esempi/decompose.cic | 8 + helm/gTopLevel/esempi/elim.cic | 6 +- helm/gTopLevel/esempi/elim2.cic | 19 +- helm/gTopLevel/esempi/evars.cic | 10 +- helm/gTopLevel/esempi/fourier/fourier.cic | 137 + .../esempi/fourier/fourier_benchmarks.cic | 170 + .../esempi/fourier/fourier_make_benchmarks.ml | 61 + helm/gTopLevel/esempi/prova.cic | 2 +- helm/gTopLevel/esempi/sets.cic | 16 +- helm/gTopLevel/esempi/various.cic | 7 + helm/gTopLevel/gTopLevel.ml | 3681 +++++++++++------ helm/gTopLevel/hbugs.ml | 133 + helm/gTopLevel/hbugs.mli | 40 + helm/gTopLevel/invokeTactics.ml | 472 +++ helm/gTopLevel/invokeTactics.mli | 110 + .../{mQueryGenerator.mli => misc.ml} | 34 +- helm/gTopLevel/misc.mli | 40 + helm/gTopLevel/proofEngine.ml | 254 +- helm/gTopLevel/proofEngine.mli | 65 +- helm/gTopLevel/proofEngineReduction.ml | 678 --- helm/gTopLevel/proofEngineStructuralRules.mli | 2 - helm/gTopLevel/sequentPp.ml | 49 +- helm/gTopLevel/tacticals.ml | 89 - helm/gTopLevel/termEditor.ml | 113 + helm/gTopLevel/termEditor.mli | 51 + helm/gTopLevel/termViewer.ml | 228 + helm/gTopLevel/termViewer.mli | 100 + helm/gTopLevel/texTermEditor.ml | 208 + helm/gTopLevel/texTermEditor.mli | 52 + helm/gTopLevel/topLevel/.depend | 0 helm/gTopLevel/topLevel/Makefile | 47 - helm/gTopLevel/topLevel/esempi.cic | 125 - helm/gTopLevel/xml2Gdome.ml | 2 + helm/ocaml/.cvsignore | 21 +- helm/ocaml/META.helm-tactics.src | 4 + .../META.helm-tex_cic_textual_parser.src | 5 + helm/ocaml/Makefile.common.in | 19 +- helm/ocaml/Makefile.in | 16 +- helm/ocaml/cic/cic.ml | 103 +- helm/ocaml/cic/cicParser.ml | 63 +- helm/ocaml/cic/cicParser.mli | 16 +- helm/ocaml/cic/cicParser2.ml | 201 +- helm/ocaml/cic/cicParser2.mli | 17 +- helm/ocaml/cic/cicParser3.ml | 248 +- helm/ocaml/cic/cicParser3.mli | 6 +- helm/ocaml/cic/deannotate.ml | 69 +- helm/ocaml/cic/deannotate.mli | 3 - .../cic_annotations/cicAnnotation2Xml.ml | 45 +- .../cic_annotations/cicAnnotationParser.ml | 4 - helm/ocaml/cic_annotations/cicXPath.ml | 43 +- helm/ocaml/cic_annotations_cache/cicCache.ml | 8 +- helm/ocaml/cic_cache/cicCache.ml | 14 +- helm/ocaml/cic_proof_checking/.cvsignore | 2 + helm/ocaml/cic_proof_checking/.depend | 14 +- helm/ocaml/cic_proof_checking/Makefile | 18 +- helm/ocaml/cic_proof_checking/cicCooking.ml | 235 -- .../cic_proof_checking/cicEnvironment.ml | 185 +- .../cic_proof_checking/cicEnvironment.mli | 22 +- .../cic_proof_checking/cicMiniReduction.ml | 29 +- helm/ocaml/cic_proof_checking/cicPp.ml | 139 +- .../ocaml/cic_proof_checking/cicReduction.mli | 3 +- .../cic_proof_checking/cicReductionMachine.ml | 1139 +++-- .../cicReductionMachine.mli | 7 +- .../cic_proof_checking/cicReductionNaif.ml | 149 +- .../cic_proof_checking/cicReductionNaif.mli | 7 +- .../cic_proof_checking/cicSubstitution.ml | 268 +- .../cic_proof_checking/cicSubstitution.mli | 19 +- .../cic_proof_checking/cicTypeChecker.ml | 867 ++-- .../cic_proof_checking/cicTypeChecker.mli | 31 +- helm/ocaml/cic_proof_checking/logger.ml | 8 + helm/ocaml/cic_proof_checking/logger.mli | 1 + helm/ocaml/cic_textual_parser/.depend | 7 +- .../cic_textual_parser/cicTextualLexer.mll | 31 +- .../cic_textual_parser/cicTextualParser.mly | 511 ++- .../cic_textual_parser/cicTextualParser0.ml | 24 +- .../cicTextualParserContext.ml | 14 +- .../cicTextualParserContext.mli | 8 +- helm/ocaml/cic_unification/.depend | 3 + helm/ocaml/cic_unification/Makefile | 2 +- helm/ocaml/cic_unification/cicRefine.ml | 365 ++ helm/ocaml/cic_unification/cicRefine.mli | 40 + helm/ocaml/cic_unification/cicUnification.ml | 344 +- helm/ocaml/cic_unification/cicUnification.mli | 30 +- helm/ocaml/getter/.depend | 4 +- helm/ocaml/getter/clientHTTP.ml | 8 +- helm/ocaml/getter/configuration.ml | 48 +- helm/ocaml/getter/configuration.mli | 11 +- helm/ocaml/getter/getter.ml | 32 + helm/ocaml/getter/getter.mli | 9 + helm/ocaml/tactics/.cvsignore | 9 + helm/ocaml/tactics/.depend | 80 + helm/ocaml/tactics/Makefile | 21 + helm/ocaml/tactics/discriminationTactics.ml | 583 +++ helm/ocaml/tactics/discriminationTactics.mli | 30 + helm/ocaml/tactics/eliminationTactics.ml | 220 + helm/ocaml/tactics/eliminationTactics.mli | 34 + helm/ocaml/tactics/equalityTactics.ml | 236 ++ helm/ocaml/tactics/equalityTactics.mli | 35 + helm/{gTopLevel => ocaml/tactics}/fourier.ml | 65 +- helm/ocaml/tactics/fourier.mli | 27 + helm/ocaml/tactics/fourierR.ml | 1233 ++++++ .../{gTopLevel => ocaml/tactics}/fourierR.mli | 3 + helm/ocaml/tactics/introductionTactics.ml | 60 + helm/ocaml/tactics/introductionTactics.mli | 31 + helm/ocaml/tactics/negationTactics.ml | 73 + helm/ocaml/tactics/negationTactics.mli | 28 + .../tactics}/primitiveTactics.ml | 296 +- .../tactics}/primitiveTactics.mli | 9 +- .../tactics}/proofEngineHelpers.ml | 37 + .../tactics}/proofEngineHelpers.mli | 10 +- helm/ocaml/tactics/proofEngineReduction.ml | 867 ++++ .../tactics}/proofEngineReduction.mli | 13 +- .../tactics}/proofEngineStructuralRules.ml | 4 +- .../tactics/proofEngineStructuralRules.mli | 27 + .../tactics}/proofEngineTypes.ml | 6 +- helm/ocaml/tactics/reductionTactics.ml | 127 + helm/ocaml/tactics/reductionTactics.mli | 39 + helm/{gTopLevel => ocaml/tactics}/ring.ml | 245 +- helm/{gTopLevel => ocaml/tactics}/ring.mli | 6 +- helm/ocaml/tactics/tacticChaser.ml | 103 + helm/ocaml/tactics/tacticChaser.mli | 33 + helm/ocaml/tactics/tacticals.ml | 249 ++ .../tactics}/tacticals.mli | 27 + helm/ocaml/tactics/variousTactics.ml | 96 + helm/ocaml/tactics/variousTactics.mli | 31 + helm/ocaml/tex_cic_textual_parser/.cvsignore | 1 + helm/ocaml/tex_cic_textual_parser/.depend | 9 + helm/ocaml/tex_cic_textual_parser/Makefile | 14 + .../texCicTextualLexer.mll | 122 + .../texCicTextualParser.mly | 598 +++ .../texCicTextualParser0.ml} | 11 +- .../texCicTextualParserContext.ml | 36 + .../texCicTextualParserContext.mli | 31 + helm/ocaml/urimanager/uriManager.ml | 17 + helm/ocaml/urimanager/uriManager.mli | 9 + helm/ocaml/xml/xml.ml | 74 +- helm/ocaml/xml/xml.mli | 3 + 154 files changed, 15142 insertions(+), 4980 deletions(-) create mode 100644 helm/gTopLevel/applyStylesheets.ml create mode 100644 helm/gTopLevel/applyStylesheets.mli create mode 100644 helm/gTopLevel/dictionary-cic.xml create mode 100644 helm/gTopLevel/disambiguate.ml create mode 100644 helm/gTopLevel/disambiguate.mli create mode 100644 helm/gTopLevel/esempi/decompose.cic create mode 100644 helm/gTopLevel/esempi/fourier/fourier.cic create mode 100644 helm/gTopLevel/esempi/fourier/fourier_benchmarks.cic create mode 100644 helm/gTopLevel/esempi/fourier/fourier_make_benchmarks.ml create mode 100644 helm/gTopLevel/esempi/various.cic create mode 100644 helm/gTopLevel/hbugs.ml create mode 100644 helm/gTopLevel/hbugs.mli create mode 100644 helm/gTopLevel/invokeTactics.ml create mode 100644 helm/gTopLevel/invokeTactics.mli rename helm/gTopLevel/{mQueryGenerator.mli => misc.ml} (66%) create mode 100644 helm/gTopLevel/misc.mli delete mode 100644 helm/gTopLevel/proofEngineReduction.ml delete mode 100644 helm/gTopLevel/proofEngineStructuralRules.mli delete mode 100644 helm/gTopLevel/tacticals.ml create mode 100644 helm/gTopLevel/termEditor.ml create mode 100644 helm/gTopLevel/termEditor.mli create mode 100644 helm/gTopLevel/termViewer.ml create mode 100644 helm/gTopLevel/termViewer.mli create mode 100644 helm/gTopLevel/texTermEditor.ml create mode 100644 helm/gTopLevel/texTermEditor.mli delete mode 100644 helm/gTopLevel/topLevel/.depend delete mode 100644 helm/gTopLevel/topLevel/Makefile delete mode 100644 helm/gTopLevel/topLevel/esempi.cic create mode 100644 helm/ocaml/META.helm-tactics.src create mode 100644 helm/ocaml/META.helm-tex_cic_textual_parser.src delete mode 100644 helm/ocaml/cic_proof_checking/cicCooking.ml create mode 100644 helm/ocaml/cic_unification/cicRefine.ml create mode 100644 helm/ocaml/cic_unification/cicRefine.mli create mode 100644 helm/ocaml/tactics/.cvsignore create mode 100644 helm/ocaml/tactics/.depend create mode 100644 helm/ocaml/tactics/Makefile create mode 100644 helm/ocaml/tactics/discriminationTactics.ml create mode 100644 helm/ocaml/tactics/discriminationTactics.mli create mode 100644 helm/ocaml/tactics/eliminationTactics.ml create mode 100644 helm/ocaml/tactics/eliminationTactics.mli create mode 100644 helm/ocaml/tactics/equalityTactics.ml create mode 100644 helm/ocaml/tactics/equalityTactics.mli rename helm/{gTopLevel => ocaml/tactics}/fourier.ml (77%) create mode 100644 helm/ocaml/tactics/fourier.mli create mode 100644 helm/ocaml/tactics/fourierR.ml rename helm/{gTopLevel => ocaml/tactics}/fourierR.mli (61%) create mode 100644 helm/ocaml/tactics/introductionTactics.ml create mode 100644 helm/ocaml/tactics/introductionTactics.mli create mode 100644 helm/ocaml/tactics/negationTactics.ml create mode 100644 helm/ocaml/tactics/negationTactics.mli rename helm/{gTopLevel => ocaml/tactics}/primitiveTactics.ml (67%) rename helm/{gTopLevel => ocaml/tactics}/primitiveTactics.mli (80%) rename helm/{gTopLevel => ocaml/tactics}/proofEngineHelpers.ml (79%) rename helm/{gTopLevel => ocaml/tactics}/proofEngineHelpers.mli (79%) create mode 100644 helm/ocaml/tactics/proofEngineReduction.ml rename helm/{gTopLevel => ocaml/tactics}/proofEngineReduction.mli (76%) rename helm/{gTopLevel => ocaml/tactics}/proofEngineStructuralRules.ml (98%) create mode 100644 helm/ocaml/tactics/proofEngineStructuralRules.mli rename helm/{gTopLevel => ocaml/tactics}/proofEngineTypes.ml (86%) create mode 100644 helm/ocaml/tactics/reductionTactics.ml create mode 100644 helm/ocaml/tactics/reductionTactics.mli rename helm/{gTopLevel => ocaml/tactics}/ring.ml (71%) rename helm/{gTopLevel => ocaml/tactics}/ring.mli (70%) create mode 100644 helm/ocaml/tactics/tacticChaser.ml create mode 100644 helm/ocaml/tactics/tacticChaser.mli create mode 100644 helm/ocaml/tactics/tacticals.ml rename helm/{gTopLevel => ocaml/tactics}/tacticals.mli (75%) create mode 100644 helm/ocaml/tactics/variousTactics.ml create mode 100644 helm/ocaml/tactics/variousTactics.mli create mode 100644 helm/ocaml/tex_cic_textual_parser/.cvsignore create mode 100644 helm/ocaml/tex_cic_textual_parser/.depend create mode 100644 helm/ocaml/tex_cic_textual_parser/Makefile create mode 100644 helm/ocaml/tex_cic_textual_parser/texCicTextualLexer.mll create mode 100644 helm/ocaml/tex_cic_textual_parser/texCicTextualParser.mly rename helm/ocaml/{cic_proof_checking/cicCooking.mli => tex_cic_textual_parser/texCicTextualParser0.ml} (74%) create mode 100644 helm/ocaml/tex_cic_textual_parser/texCicTextualParserContext.ml create mode 100644 helm/ocaml/tex_cic_textual_parser/texCicTextualParserContext.mli diff --git a/helm/gTopLevel/.depend b/helm/gTopLevel/.depend index 2b88f0c85..de8a83a5c 100644 --- a/helm/gTopLevel/.depend +++ b/helm/gTopLevel/.depend @@ -1,41 +1,7 @@ xml2Gdome.cmo: xml2Gdome.cmi xml2Gdome.cmx: xml2Gdome.cmi -proofEngineHelpers.cmo: proofEngineHelpers.cmi -proofEngineHelpers.cmx: proofEngineHelpers.cmi -proofEngineReduction.cmo: proofEngineReduction.cmi -proofEngineReduction.cmx: proofEngineReduction.cmi -proofEngineStructuralRules.cmo: proofEngineTypes.cmo \ - proofEngineStructuralRules.cmi -proofEngineStructuralRules.cmx: proofEngineTypes.cmx \ - proofEngineStructuralRules.cmi -proofEngineStructuralRules.cmi: proofEngineTypes.cmo -primitiveTactics.cmo: proofEngineHelpers.cmi proofEngineReduction.cmi \ - proofEngineTypes.cmo primitiveTactics.cmi -primitiveTactics.cmx: proofEngineHelpers.cmx proofEngineReduction.cmx \ - proofEngineTypes.cmx primitiveTactics.cmi -primitiveTactics.cmi: proofEngineTypes.cmo -tacticals.cmo: primitiveTactics.cmi proofEngineTypes.cmo tacticals.cmi -tacticals.cmx: primitiveTactics.cmx proofEngineTypes.cmx tacticals.cmi -tacticals.cmi: proofEngineTypes.cmo -ring.cmo: primitiveTactics.cmi proofEngineStructuralRules.cmi \ - proofEngineTypes.cmo tacticals.cmi ring.cmi -ring.cmx: primitiveTactics.cmx proofEngineStructuralRules.cmx \ - proofEngineTypes.cmx tacticals.cmx ring.cmi -ring.cmi: proofEngineTypes.cmo -fourierR.cmo: fourier.cmo primitiveTactics.cmi proofEngineHelpers.cmi \ - proofEngineReduction.cmi proofEngineTypes.cmo ring.cmi tacticals.cmi \ - fourierR.cmi -fourierR.cmx: fourier.cmx primitiveTactics.cmx proofEngineHelpers.cmx \ - proofEngineReduction.cmx proofEngineTypes.cmx ring.cmx tacticals.cmx \ - fourierR.cmi -fourierR.cmi: proofEngineTypes.cmo -proofEngine.cmo: fourierR.cmi primitiveTactics.cmi proofEngineHelpers.cmi \ - proofEngineReduction.cmi proofEngineStructuralRules.cmi \ - proofEngineTypes.cmo ring.cmi proofEngine.cmi -proofEngine.cmx: fourierR.cmx primitiveTactics.cmx proofEngineHelpers.cmx \ - proofEngineReduction.cmx proofEngineStructuralRules.cmx \ - proofEngineTypes.cmx ring.cmx proofEngine.cmi -proofEngine.cmi: proofEngineTypes.cmo +proofEngine.cmo: cic2Xml.cmi cic2acic.cmi proofEngine.cmi +proofEngine.cmx: cic2Xml.cmx cic2acic.cmx proofEngine.cmi doubleTypeInference.cmo: doubleTypeInference.cmi doubleTypeInference.cmx: doubleTypeInference.cmi cic2acic.cmo: doubleTypeInference.cmi cic2acic.cmi @@ -45,11 +11,39 @@ cic2Xml.cmx: cic2acic.cmx cic2Xml.cmi cic2Xml.cmi: cic2acic.cmi logicalOperations.cmo: proofEngine.cmi logicalOperations.cmi logicalOperations.cmx: proofEngine.cmx logicalOperations.cmi -sequentPp.cmo: cic2Xml.cmi cic2acic.cmi proofEngine.cmi sequentPp.cmi -sequentPp.cmx: cic2Xml.cmx cic2acic.cmx proofEngine.cmx sequentPp.cmi -mQueryGenerator.cmo: mQueryGenerator.cmi -mQueryGenerator.cmx: mQueryGenerator.cmi -gTopLevel.cmo: cic2Xml.cmi cic2acic.cmi logicalOperations.cmi \ - mQueryGenerator.cmi proofEngine.cmi sequentPp.cmi xml2Gdome.cmi -gTopLevel.cmx: cic2Xml.cmx cic2acic.cmx logicalOperations.cmx \ - mQueryGenerator.cmx proofEngine.cmx sequentPp.cmx xml2Gdome.cmx +sequentPp.cmo: cic2Xml.cmi cic2acic.cmi sequentPp.cmi +sequentPp.cmx: cic2Xml.cmx cic2acic.cmx sequentPp.cmi +misc.cmo: misc.cmi +misc.cmx: misc.cmi +disambiguate.cmo: disambiguate.cmi +disambiguate.cmx: disambiguate.cmi +termEditor.cmo: disambiguate.cmi termEditor.cmi +termEditor.cmx: disambiguate.cmx termEditor.cmi +termEditor.cmi: disambiguate.cmi +texTermEditor.cmo: disambiguate.cmi misc.cmi texTermEditor.cmi +texTermEditor.cmx: disambiguate.cmx misc.cmx texTermEditor.cmi +texTermEditor.cmi: disambiguate.cmi +applyStylesheets.cmo: cic2Xml.cmi misc.cmi sequentPp.cmi xml2Gdome.cmi \ + applyStylesheets.cmi +applyStylesheets.cmx: cic2Xml.cmx misc.cmx sequentPp.cmx xml2Gdome.cmx \ + applyStylesheets.cmi +applyStylesheets.cmi: cic2acic.cmi +termViewer.cmo: applyStylesheets.cmi cic2acic.cmi logicalOperations.cmi \ + misc.cmi termViewer.cmi +termViewer.cmx: applyStylesheets.cmx cic2acic.cmx logicalOperations.cmx \ + misc.cmx termViewer.cmi +termViewer.cmi: cic2acic.cmi +invokeTactics.cmo: logicalOperations.cmi proofEngine.cmi termEditor.cmi \ + termViewer.cmi invokeTactics.cmi +invokeTactics.cmx: logicalOperations.cmx proofEngine.cmx termEditor.cmx \ + termViewer.cmx invokeTactics.cmi +invokeTactics.cmi: termEditor.cmi termViewer.cmi +hbugs.cmo: invokeTactics.cmi misc.cmi proofEngine.cmi hbugs.cmi +hbugs.cmx: invokeTactics.cmx misc.cmx proofEngine.cmx hbugs.cmi +hbugs.cmi: invokeTactics.cmi +gTopLevel.cmo: applyStylesheets.cmi cic2Xml.cmi cic2acic.cmi hbugs.cmi \ + invokeTactics.cmi logicalOperations.cmi misc.cmi proofEngine.cmi \ + sequentPp.cmi termEditor.cmi termViewer.cmi texTermEditor.cmi +gTopLevel.cmx: applyStylesheets.cmx cic2Xml.cmx cic2acic.cmx hbugs.cmx \ + invokeTactics.cmx logicalOperations.cmx misc.cmx proofEngine.cmx \ + sequentPp.cmx termEditor.cmx termViewer.cmx texTermEditor.cmx diff --git a/helm/gTopLevel/Makefile b/helm/gTopLevel/Makefile index 403b8b180..fb62256ef 100644 --- a/helm/gTopLevel/Makefile +++ b/helm/gTopLevel/Makefile @@ -1,11 +1,13 @@ BIN_DIR = /usr/local/bin -REQUIRES = lablgtkmathview helm-cic_textual_parser helm-cic_proof_checking \ - helm-xml gdome2-xslt helm-cic_unification helm-mathql \ - helm-mathql_interpreter -PREDICATES = "gnome,init" +REQUIRES = lablgtkmathview helm-cic_textual_parser helm-tex_cic_textual_parser \ + helm-cic_proof_checking helm-xml gdome2-xslt helm-cic_unification \ + helm-mathql helm-mathql_interpreter helm-mathql_generator \ + helm-tactics threads hbugs-client mathml-editor +PREDICATES = "gnome,init,glade" OCAMLOPTIONS = -package "$(REQUIRES)" -predicates "$(PREDICATES)" -pp camlp4o -OCAMLC = ocamlfind ocamlc $(OCAMLOPTIONS) -OCAMLOPT = ocamlfind ocamlopt $(OCAMLOPTIONS) +OCAMLFIND = ocamlfind +OCAMLC = $(OCAMLFIND) ocamlc -thread $(OCAMLOPTIONS) +OCAMLOPT = $(OCAMLFIND) ocamlopt -thread $(OCAMLOPTIONS) OCAMLDEP = ocamldep -pp camlp4o LIBRARIES = $(shell ocamlfind query -recursive -predicates "byte $(PREDICATES)" -format "%d/%a" $(REQUIRES)) @@ -14,24 +16,23 @@ LIBRARIES_OPT = $(shell ocamlfind query -recursive -predicates "native $(PREDICA all: gTopLevel opt: gTopLevel.opt -DEPOBJS = xml2Gdome.ml xml2Gdome.mli proofEngineTypes.ml proofEngineHelpers.ml \ - proofEngineReduction.ml proofEngineReduction.mli \ - proofEngineStructuralRules.ml proofEngineStructuralRules.mli \ - primitiveTactics.ml primitiveTactics.mli tacticals.ml tacticals.mli \ - ring.ml ring.mli fourier.ml fourierR.ml fourierR.mli\ - proofEngine.ml proofEngine.mli \ - doubleTypeInference.ml doubleTypeInference.mli cic2acic.ml \ - cic2acic.mli cic2Xml.ml cic2Xml.mli logicalOperations.ml \ - logicalOperations.mli sequentPp.ml sequentPp.mli mQueryGenerator.mli \ - mQueryGenerator.ml gTopLevel.ml +DEPOBJS = \ + xml2Gdome.ml xml2Gdome.mli proofEngine.ml proofEngine.mli \ + doubleTypeInference.ml doubleTypeInference.mli cic2acic.ml cic2acic.mli\ + cic2Xml.ml cic2Xml.mli logicalOperations.ml logicalOperations.mli \ + sequentPp.ml sequentPp.mli mQueryGenerator.mli mQueryLevels.ml \ + mQueryLevels2.mli mQueryLevels2.ml mQueryGenerator.ml misc.ml misc.mli \ + disambiguate.ml disambiguate.mli termEditor.ml termEditor.mli \ + texTermEditor.ml texTermEditor.mli applyStylesheets.ml \ + applyStylesheets.mli termViewer.ml termViewer.mli invokeTactics.ml \ + invokeTactics.mli hbugs.ml hbugs.mli gTopLevel.ml -TOPLEVELOBJS = xml2Gdome.cmo proofEngineTypes.cmo proofEngineHelpers.cmo \ - proofEngineReduction.cmo proofEngineStructuralRules.cmo \ - primitiveTactics.cmo tacticals.cmo ring.cmo \ - fourier.cmo fourierR.cmo proofEngine.cmo \ - doubleTypeInference.cmo cic2acic.cmo cic2Xml.cmo \ - logicalOperations.cmo sequentPp.cmo mQueryGenerator.cmo \ - gTopLevel.cmo +TOPLEVELOBJS = \ + xml2Gdome.cmo doubleTypeInference.cmo cic2acic.cmo cic2Xml.cmo \ + proofEngine.cmo logicalOperations.cmo sequentPp.cmo \ + mQueryLevels2.cmo misc.cmo disambiguate.cmo \ + termEditor.cmo texTermEditor.cmo applyStylesheets.cmo termViewer.cmo \ + invokeTactics.cmo hbugs.cmo gTopLevel.cmo depend: $(OCAMLDEP) $(DEPOBJS) > .depend @@ -43,13 +44,16 @@ gTopLevel.opt: $(TOPLEVELOBJS:.cmo=.cmx) $(LIBRARIES_OPT) $(OCAMLOPT) -linkpkg -o gTopLevel.opt $(TOPLEVELOBJS:.cmo=.cmx) .SUFFIXES: .ml .mli .cmo .cmi .cmx -.ml.cmo: $(LIBRARIES) +.ml.cmo: $(OCAMLC) -c $< -.mli.cmi: $(LIBRARIES) +.mli.cmi: $(OCAMLC) -c $< -.ml.cmx: $(LIBRARIES_OPT) +.ml.cmx: $(OCAMLOPT) -c $< +$(TOPLEVELOBJS): $(LIBRARIES) +$(TOPLEVELOBJS:.cmo=.cmx)): $(LIBRARIES_OPT) + clean: rm -f *.cm[iox] *.o gTopLevel gTopLevel.opt @@ -61,4 +65,6 @@ uninstall: .PHONY: install uninstall clean -include .depend +ifneq ($(MAKECMDGOALS), depend) + include .depend +endif diff --git a/helm/gTopLevel/applyStylesheets.ml b/helm/gTopLevel/applyStylesheets.ml new file mode 100644 index 000000000..3a81e8b86 --- /dev/null +++ b/helm/gTopLevel/applyStylesheets.ml @@ -0,0 +1,167 @@ +(* Copyright (C) 2000-2002, HELM Team. + * + * This file is part of HELM, an Hypertextual, Electronic + * Library of Mathematics, developed at the Computer Science + * Department, University of Bologna, Italy. + * + * HELM is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * HELM is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with HELM; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, + * MA 02111-1307, USA. + * + * For details, see the HELM World-Wide-Web page, + * http://cs.unibo.it/helm/. + *) + +(******************************************************************************) +(* *) +(* PROJECT HELM *) +(* *) +(* Claudio Sacerdoti Coen *) +(* 30/01/2002 *) +(* *) +(* *) +(******************************************************************************) + +(** stylesheets and parameters list **) + +let parseStyle name = + let style = + Misc.domImpl#createDocumentFromURI + (* ~uri:("http://phd.cs.unibo.it:8081/getxslt?uri=" ^ name) ?mode:None *) + ~uri:("styles/" ^ name) () + in + Gdome_xslt.processStylesheet style +;; + +let d_c = parseStyle "drop_coercions.xsl";; +let tc1 = parseStyle "objtheorycontent.xsl";; +let hc2 = parseStyle "content_to_html.xsl";; +let l = parseStyle "link.xsl";; + +let c1 = parseStyle "rootcontent.xsl";; +let g = parseStyle "genmmlid.xsl";; +let c2 = parseStyle "annotatedpres.xsl";; + + +let getterURL = Configuration.getter_url;; +let processorURL = Configuration.processor_url;; + +let mml_styles = [d_c ; c1 ; g ; c2 ; l];; +let mml_args ~explode_all = + ("explodeall",(if explode_all then "true()" else "false()")):: + ["processorURL", "'" ^ processorURL ^ "'" ; + "getterURL", "'" ^ getterURL ^ "'" ; + "draw_graphURL", "'http%3A//phd.cs.unibo.it%3A8083/'" ; + "uri_set_queueURL", "'http%3A//phd.cs.unibo.it%3A8084/'" ; + "UNICODEvsSYMBOL", "'symbol'" ; + "doctype-public", "'-//W3C//DTD%20XHTML%201.0%20Transitional//EN'" ; + "encoding", "'iso-8859-1'" ; + "media-type", "'text/html'" ; + "keys", "'d_c%2CC1%2CG%2CC2%2CL'" ; + "interfaceURL", "'http%3A//phd.cs.unibo.it/helm/html/cic/index.html'" ; + "naturalLanguage", "'yes'" ; + "annotations", "'no'" ; + "URLs_or_URIs", "'URIs'" ; + "topurl", "'http://phd.cs.unibo.it/helm'" ; + "CICURI", "'cic:/Coq/Init/Datatypes/bool_ind.con'" ] +;; + +let sequent_styles = [d_c ; c1 ; g ; c2 ; l];; +let sequent_args = + ["processorURL", "'" ^ processorURL ^ "'" ; + "getterURL", "'" ^ getterURL ^ "'" ; + "draw_graphURL", "'http%3A//phd.cs.unibo.it%3A8083/'" ; + "uri_set_queueURL", "'http%3A//phd.cs.unibo.it%3A8084/'" ; + "UNICODEvsSYMBOL", "'symbol'" ; + "doctype-public", "'-//W3C//DTD%20XHTML%201.0%20Transitional//EN'" ; + "encoding", "'iso-8859-1'" ; + "media-type", "'text/html'" ; + "keys", "'d_c%2CC1%2CG%2CC2%2CL'" ; + "interfaceURL", "'http%3A//phd.cs.unibo.it/helm/html/cic/index.html'" ; + "naturalLanguage", "'no'" ; + "annotations", "'no'" ; + "explodeall", "true()" ; + "URLs_or_URIs", "'URIs'" ; + "topurl", "'http://phd.cs.unibo.it/helm'" ; + "CICURI", "'cic:/Coq/Init/Datatypes/bool_ind.con'" ] +;; + +(** Stylesheets application **) + +let apply_stylesheets input styles args = + List.fold_left (fun i style -> Gdome_xslt.applyStylesheet i style args) + input styles +;; + +let apply_proof_stylesheets proof_doc ~explode_all = + apply_stylesheets proof_doc mml_styles (mml_args ~explode_all) +;; + +let apply_sequent_stylesheets sequent_doc = + apply_stylesheets sequent_doc sequent_styles sequent_args +;; + +(** Utility functions to map objects to MathML Presentation **) + +(*CSC: the getter should handle the innertypes, not the FS *) + +let innertypesfile = + try + Sys.getenv "GTOPLEVEL_INNERTYPESFILE" + with + Not_found -> "/public/innertypes" +;; + +let constanttypefile = + try + Sys.getenv "GTOPLEVEL_CONSTANTTYPEFILE" + with + Not_found -> "/public/constanttype" +;; + +let mml_of_cic_sequent metasenv sequent = + let sequent_gdome,ids_to_terms,ids_to_father_ids,ids_to_hypotheses = + SequentPp.XmlPp.print_sequent metasenv sequent in + let sequent_doc = + Xml2Gdome.document_of_xml Misc.domImpl sequent_gdome in + let sequent_mml = apply_sequent_stylesheets sequent_doc in + sequent_mml,(ids_to_terms,ids_to_father_ids,ids_to_hypotheses) +;; + +let + mml_of_cic_object ~explode_all uri annobj ids_to_inner_sorts ids_to_inner_types += +(*CSC: ????????????????? *) + let xml, bodyxml = + Cic2Xml.print_object uri ~ids_to_inner_sorts ~ask_dtd_to_the_getter:true + annobj + in + let xmlinnertypes = + Cic2Xml.print_inner_types uri ~ids_to_inner_sorts ~ids_to_inner_types + ~ask_dtd_to_the_getter:true + in + let input = + match bodyxml with + None -> Xml2Gdome.document_of_xml Misc.domImpl xml + | Some bodyxml' -> + Xml.pp xml (Some constanttypefile) ; + Xml2Gdome.document_of_xml Misc.domImpl bodyxml' + in +(*CSC: We save the innertypes to disk so that we can retrieve them in the *) +(*CSC: stylesheet. This DOES NOT work when UWOBO and/or the getter are not *) +(*CSC: local. *) + Xml.pp xmlinnertypes (Some innertypesfile) ; + let output = apply_proof_stylesheets input ~explode_all in + output +;; diff --git a/helm/gTopLevel/applyStylesheets.mli b/helm/gTopLevel/applyStylesheets.mli new file mode 100644 index 000000000..b450cd992 --- /dev/null +++ b/helm/gTopLevel/applyStylesheets.mli @@ -0,0 +1,49 @@ +(* Copyright (C) 2000-2002, HELM Team. + * + * This file is part of HELM, an Hypertextual, Electronic + * Library of Mathematics, developed at the Computer Science + * Department, University of Bologna, Italy. + * + * HELM is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * HELM is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with HELM; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, + * MA 02111-1307, USA. + * + * For details, see the HELM World-Wide-Web page, + * http://cs.unibo.it/helm/. + *) + +(******************************************************************************) +(* *) +(* PROJECT HELM *) +(* *) +(* Claudio Sacerdoti Coen *) +(* 15/01/2003 *) +(* *) +(* *) +(******************************************************************************) + +val mml_of_cic_sequent : + Cic.metasenv -> + int * Cic.context * Cic.term -> + Gdome.document * + ((Cic.id, Cic.term) Hashtbl.t * + (Cic.id, Cic.id option) Hashtbl.t * + (string, Cic.hypothesis) Hashtbl.t) + +val mml_of_cic_object : + explode_all:bool -> + UriManager.uri -> + Cic.annobj -> + (string, string) Hashtbl.t -> + (string, Cic2acic.anntypes) Hashtbl.t -> Gdome.document diff --git a/helm/gTopLevel/cic2Xml.ml b/helm/gTopLevel/cic2Xml.ml index 7c674d0ad..564493cb8 100644 --- a/helm/gTopLevel/cic2Xml.ml +++ b/helm/gTopLevel/cic2Xml.ml @@ -27,27 +27,35 @@ exception ImpossiblePossible;; exception NotImplemented;; -let dtdname = "http://localhost:8081/getdtd?url=cic.dtd";; + +let dtdname ~ask_dtd_to_the_getter dtd = + if ask_dtd_to_the_getter then + Configuration.getter_url ^ "getdtd?uri=" ^ dtd + else + "http://mowgli.cs.unibo.it/dtd/" ^ dtd +;; + +let param_attribute_of_params params = + String.concat " " (List.map UriManager.string_of_uri params) +;; (*CSC ottimizzazione: al posto di curi cdepth (vedi codice) *) -let print_term curi ~ids_to_inner_sorts = +let print_term ~ids_to_inner_sorts = let rec aux = let module C = Cic in let module X = Xml in let module U = UriManager in function - C.ARel (id,n,b) -> + C.ARel (id,idref,n,b) -> let sort = Hashtbl.find ids_to_inner_sorts id in X.xml_empty "REL" - ["value",(string_of_int n) ; "binder",b ; "id",id ; "sort",sort] - | C.AVar (id,uri) -> - let vdepth = U.depth_of_uri uri - and cdepth = U.depth_of_uri curi - and sort = Hashtbl.find ids_to_inner_sorts id in - X.xml_empty "VAR" - ["relUri",(string_of_int (cdepth - vdepth)) ^ "," ^ - (U.name_of_uri uri) ; - "id",id ; "sort",sort] + ["value",(string_of_int n) ; "binder",b ; "id",id ; "idref",idref ; + "sort",sort] + | C.AVar (id,uri,exp_named_subst) -> + let sort = Hashtbl.find ids_to_inner_sorts id in + aux_subst uri + (X.xml_empty "VAR" ["uri",U.string_of_uri uri;"id",id;"sort",sort]) + exp_named_subst | C.AMeta (id,n,l) -> let sort = Hashtbl.find ids_to_inner_sorts id in X.xml_nempty "META" ["no",(string_of_int n) ; "id",id ; "sort",sort] @@ -68,65 +76,117 @@ let print_term curi ~ids_to_inner_sorts = in X.xml_empty "SORT" ["value",(string_of_sort s) ; "id",id] | C.AImplicit _ -> raise NotImplemented - | C.AProd (id,C.Anonimous,s,t) -> - let ty = Hashtbl.find ids_to_inner_sorts id in - X.xml_nempty "PROD" ["id",id ; "type",ty] - [< X.xml_nempty "source" [] (aux s) ; - X.xml_nempty "target" [] (aux t) - >] - | C.AProd (xid,C.Name id,s,t) -> - let ty = Hashtbl.find ids_to_inner_sorts xid in - X.xml_nempty "PROD" ["id",xid ; "type",ty] - [< X.xml_nempty "source" [] (aux s) ; - X.xml_nempty "target" ["binder",id] (aux t) - >] + | C.AProd (last_id,_,_,_) as prods -> + let rec eat_prods = + function + C.AProd (id,n,s,t) -> + let prods,t' = eat_prods t in + (id,n,s)::prods,t' + | t -> [],t + in + let prods,t = eat_prods prods in + let sort = Hashtbl.find ids_to_inner_sorts last_id in + X.xml_nempty "PROD" ["type",sort] + [< List.fold_left + (fun i (id,binder,s) -> + let sort = + Hashtbl.find ids_to_inner_sorts (Cic2acic.source_id_of_id id) + in + let attrs = + ("id",id)::("type",sort):: + match binder with + C.Anonymous -> [] + | C.Name b -> ["binder",b] + in + [< i ; X.xml_nempty "decl" attrs (aux s) >] + ) [< >] prods ; + X.xml_nempty "target" [] (aux t) + >] | C.ACast (id,v,t) -> let sort = Hashtbl.find ids_to_inner_sorts id in X.xml_nempty "CAST" ["id",id ; "sort",sort] [< X.xml_nempty "term" [] (aux v) ; X.xml_nempty "type" [] (aux t) >] - | C.ALambda (id,C.Anonimous,s,t) -> - let sort = Hashtbl.find ids_to_inner_sorts id in - X.xml_nempty "LAMBDA" ["id",id ; "sort",sort] - [< X.xml_nempty "source" [] (aux s) ; - X.xml_nempty "target" [] (aux t) - >] - | C.ALambda (xid,C.Name id,s,t) -> - let sort = Hashtbl.find ids_to_inner_sorts xid in - X.xml_nempty "LAMBDA" ["id",xid ; "sort",sort] - [< X.xml_nempty "source" [] (aux s) ; - X.xml_nempty "target" ["binder",id] (aux t) - >] - | C.ALetIn (xid,C.Anonimous,s,t) -> + | C.ALambda (last_id,_,_,_) as lambdas -> + let rec eat_lambdas = + function + C.ALambda (id,n,s,t) -> + let lambdas,t' = eat_lambdas t in + (id,n,s)::lambdas,t' + | t -> [],t + in + let lambdas,t = eat_lambdas lambdas in + let sort = Hashtbl.find ids_to_inner_sorts last_id in + X.xml_nempty "LAMBDA" ["sort",sort] + [< List.fold_left + (fun i (id,binder,s) -> + let sort = + Hashtbl.find ids_to_inner_sorts (Cic2acic.source_id_of_id id) + in + let attrs = + ("id",id)::("type",sort):: + match binder with + C.Anonymous -> [] + | C.Name b -> ["binder",b] + in + [< i ; X.xml_nempty "decl" attrs (aux s) >] + ) [< >] lambdas ; + X.xml_nempty "target" [] (aux t) + >] + | C.ALetIn (xid,C.Anonymous,s,t) -> assert false - | C.ALetIn (xid,C.Name id,s,t) -> - let sort = Hashtbl.find ids_to_inner_sorts xid in - X.xml_nempty "LETIN" ["id",xid ; "sort",sort] - [< X.xml_nempty "term" [] (aux s) ; - X.xml_nempty "letintarget" ["binder",id] (aux t) - >] + | C.ALetIn (last_id,C.Name _,_,_) as letins -> + let rec eat_letins = + function + C.ALetIn (id,n,s,t) -> + let letins,t' = eat_letins t in + (id,n,s)::letins,t' + | t -> [],t + in + let letins,t = eat_letins letins in + let sort = Hashtbl.find ids_to_inner_sorts last_id in + X.xml_nempty "LETIN" ["sort",sort] + [< List.fold_left + (fun i (id,binder,s) -> + let sort = Hashtbl.find ids_to_inner_sorts id in + let attrs = + ("id",id)::("sort",sort):: + match binder with + C.Anonymous -> [] + | C.Name b -> ["binder",b] + in + [< i ; X.xml_nempty "def" attrs (aux s) >] + ) [< >] letins ; + X.xml_nempty "target" [] (aux t) + >] | C.AAppl (id,li) -> let sort = Hashtbl.find ids_to_inner_sorts id in X.xml_nempty "APPLY" ["id",id ; "sort",sort] [< (List.fold_right (fun x i -> [< (aux x) ; i >]) li [<>]) >] - | C.AConst (id,uri,_) -> + | C.AConst (id,uri,exp_named_subst) -> let sort = Hashtbl.find ids_to_inner_sorts id in - X.xml_empty "CONST" - ["uri", (U.string_of_uri uri) ; "id",id ; "sort",sort] - | C.AMutInd (id,uri,_,i) -> - X.xml_empty "MUTIND" - ["uri", (U.string_of_uri uri) ; - "noType",(string_of_int i) ; - "id",id] - | C.AMutConstruct (id,uri,_,i,j) -> + aux_subst uri + (X.xml_empty "CONST" + ["uri", (U.string_of_uri uri) ; "id",id ; "sort",sort] + ) exp_named_subst + | C.AMutInd (id,uri,i,exp_named_subst) -> + aux_subst uri + (X.xml_empty "MUTIND" + ["uri", (U.string_of_uri uri) ; + "noType",(string_of_int i) ; + "id",id] + ) exp_named_subst + | C.AMutConstruct (id,uri,i,j,exp_named_subst) -> let sort = Hashtbl.find ids_to_inner_sorts id in - X.xml_empty "MUTCONSTRUCT" - ["uri", (U.string_of_uri uri) ; - "noType",(string_of_int i) ; "noConstr",(string_of_int j) ; - "id",id ; "sort",sort] - | C.AMutCase (id,uri,_,typeno,ty,te,patterns) -> + aux_subst uri + (X.xml_empty "MUTCONSTRUCT" + ["uri", (U.string_of_uri uri) ; + "noType",(string_of_int i) ; "noConstr",(string_of_int j) ; + "id",id ; "sort",sort] + ) exp_named_subst + | C.AMutCase (id,uri,typeno,ty,te,patterns) -> let sort = Hashtbl.find ids_to_inner_sorts id in X.xml_nempty "MUTCASE" ["uriType",(U.string_of_uri uri) ; @@ -143,9 +203,9 @@ let print_term curi ~ids_to_inner_sorts = X.xml_nempty "FIX" ["noFun", (string_of_int no) ; "id",id ; "sort",sort] [< List.fold_right - (fun (fi,ai,ti,bi) i -> + (fun (id,fi,ai,ti,bi) i -> [< X.xml_nempty "FixFunction" - ["name", fi; "recIndex", (string_of_int ai)] + ["id",id ; "name", fi ; "recIndex", (string_of_int ai)] [< X.xml_nempty "type" [] [< aux ti >] ; X.xml_nempty "body" [] [< aux bi >] >] ; @@ -158,8 +218,8 @@ let print_term curi ~ids_to_inner_sorts = X.xml_nempty "COFIX" ["noFun", (string_of_int no) ; "id",id ; "sort",sort] [< List.fold_right - (fun (fi,ti,bi) i -> - [< X.xml_nempty "CofixFunction" ["name", fi] + (fun (id,fi,ti,bi) i -> + [< X.xml_nempty "CofixFunction" ["id",id ; "name", fi] [< X.xml_nempty "type" [] [< aux ti >] ; X.xml_nempty "body" [] [< aux bi >] >] ; @@ -167,86 +227,202 @@ let print_term curi ~ids_to_inner_sorts = >] ) funs [<>] >] - in - aux + and aux_subst buri target subst = +(*CSC: I have now no way to assign an ID to the explicit named substitution *) + let id = None in + if subst = [] then + target + else + Xml.xml_nempty "instantiate" + (match id with None -> [] | Some id -> ["id",id]) + [< target ; + List.fold_left + (fun i (uri,arg) -> + let relUri = + let buri_frags = + Str.split (Str.regexp "/") (UriManager.string_of_uri buri) in + let uri_frags = + Str.split (Str.regexp "/") (UriManager.string_of_uri uri) in + let rec find_relUri buri_frags uri_frags = + match buri_frags,uri_frags with + [_], _ -> String.concat "/" uri_frags + | he1::tl1, he2::tl2 -> + assert (he1 = he2) ; + find_relUri tl1 tl2 + | _,_ -> assert false (* uri is not relative to buri *) + in + find_relUri buri_frags uri_frags + in + [< i ; Xml.xml_nempty "arg" ["relUri", relUri] (aux arg) >] + ) [<>] subst + >] + in + aux ;; -exception NotImplemented;; - -(*CSC ottimizzazione: al posto di curi cdepth (vedi codice) *) -let print_object curi ~ids_to_inner_sorts = - let rec aux = - let module C = Cic in - let module X = Xml in - let module U = UriManager in - function - C.ACurrentProof (id,n,conjectures,bo,ty) -> - X.xml_nempty "CurrentProof" ["name",n ; "id", id] - [< List.fold_left - (fun i (cid,n,canonical_context,t) -> - [< i ; - X.xml_nempty "Conjecture" - ["id", cid ; "no",(string_of_int n)] - [< List.fold_left - (fun i (hid,t) -> - [< (match t with - Some (n,C.ADecl t) -> - X.xml_nempty "Decl" - (match n with - C.Name n' -> ["id",hid;"name",n'] - | C.Anonimous -> ["id",hid]) - (print_term curi ids_to_inner_sorts t) - | Some (n,C.ADef t) -> - X.xml_nempty "Def" - (match n with - C.Name n' -> ["id",hid;"name",n'] - | C.Anonimous -> ["id",hid]) - (print_term curi ids_to_inner_sorts t) - | None -> X.xml_empty "Hidden" ["id",hid] - ) ; - i - >] - ) [< >] canonical_context ; - X.xml_nempty "Goal" [] - (print_term curi ids_to_inner_sorts t) - >] - >]) - [<>] conjectures ; - X.xml_nempty "body" [] (print_term curi ids_to_inner_sorts bo) ; - X.xml_nempty "type" [] (print_term curi ids_to_inner_sorts ty) >] - | C.ADefinition (id,n,bo,ty,C.Actual params) -> - let params' = - List.fold_right - (fun (_,x) i -> - List.fold_right - (fun x i -> - U.string_of_uri x ^ match i with "" -> "" | i' -> " " ^ i' - ) x "" ^ match i with "" -> "" | i' -> " " ^ i' - ) params "" +let print_object uri ~ids_to_inner_sorts ~ask_dtd_to_the_getter obj = + let module C = Cic in + let module X = Xml in + let module U = UriManager in + let dtdname = dtdname ~ask_dtd_to_the_getter "cic.dtd" in + match obj with + C.ACurrentProof (id,idbody,n,conjectures,bo,ty,params) -> + let params' = param_attribute_of_params params in + let xml_for_current_proof_body = +(*CSC: Should the CurrentProof also have the list of variables it depends on? *) +(*CSC: I think so. Not implemented yet. *) + X.xml_nempty "CurrentProof" + ["of",UriManager.string_of_uri uri ; "id", id] + [< List.fold_left + (fun i (cid,n,canonical_context,t) -> + [< i ; + X.xml_nempty "Conjecture" + ["id", cid ; "no",(string_of_int n)] + [< List.fold_left + (fun i (hid,t) -> + [< (match t with + Some (n,C.ADecl t) -> + X.xml_nempty "Decl" + (match n with + C.Name n' -> ["id",hid;"name",n'] + | C.Anonymous -> ["id",hid]) + (print_term ids_to_inner_sorts t) + | Some (n,C.ADef t) -> + X.xml_nempty "Def" + (match n with + C.Name n' -> ["id",hid;"name",n'] + | C.Anonymous -> ["id",hid]) + (print_term ids_to_inner_sorts t) + | None -> X.xml_empty "Hidden" ["id",hid] + ) ; + i + >] + ) [< >] canonical_context ; + X.xml_nempty "Goal" [] + (print_term ids_to_inner_sorts t) + >] + >]) + [<>] conjectures ; + X.xml_nempty "body" [] (print_term ids_to_inner_sorts bo) >] + in + let xml_for_current_proof_type = + X.xml_nempty "ConstantType" ["name",n ; "params",params' ; "id", id] + (print_term ids_to_inner_sorts ty) + in + let xmlbo = + [< X.xml_cdata "\n" ; + X.xml_cdata ("\n"); + xml_for_current_proof_body + >] in + let xmlty = + [< X.xml_cdata "\n" ; + X.xml_cdata ("\n"); + xml_for_current_proof_type + >] + in + xmlty, Some xmlbo + | C.AConstant (id,idbody,n,bo,ty,params) -> + let params' = param_attribute_of_params params in + let xmlbo = + match bo with + None -> None + | Some bo -> + Some + [< X.xml_cdata + "\n" ; + X.xml_cdata + ("\n") ; + X.xml_nempty "ConstantBody" + ["for",UriManager.string_of_uri uri ; "params",params' ; + "id", id] + [< print_term ids_to_inner_sorts bo >] + >] + in + let xmlty = + [< X.xml_cdata "\n" ; + X.xml_cdata ("\n"); + X.xml_nempty "ConstantType" + ["name",n ; "params",params' ; "id", id] + [< print_term ids_to_inner_sorts ty >] + >] + in + xmlty, xmlbo + | C.AVariable (id,n,bo,ty,params) -> + let params' = param_attribute_of_params params in + let xmlbo = + match bo with + None -> [< >] + | Some bo -> + X.xml_nempty "body" [] [< print_term ids_to_inner_sorts bo >] + in + let aobj = + [< X.xml_cdata "\n" ; + X.xml_cdata ("\n"); + X.xml_nempty "Variable" + ["name",n ; "params",params' ; "id", id] + [< xmlbo ; + X.xml_nempty "type" [] (print_term ids_to_inner_sorts ty) + >] + >] in - X.xml_nempty "Definition" ["name",n ; "params",params' ; "id", id] - [< X.xml_nempty "body" [] (print_term curi ids_to_inner_sorts bo) ; - X.xml_nempty "type" [] (print_term curi ids_to_inner_sorts ty) >] - | C.ADefinition _ -> assert false - | _ -> raise NotImplemented - in - aux + aobj, None + | C.AInductiveDefinition (id,tys,params,nparams) -> + let params' = param_attribute_of_params params in + [< X.xml_cdata "\n" ; + X.xml_cdata + ("\n") ; + X.xml_nempty "InductiveDefinition" + ["noParams",string_of_int nparams ; + "id",id ; + "params",params'] + [< (List.fold_left + (fun i (id,typename,finite,arity,cons) -> + [< i ; + X.xml_nempty "InductiveType" + ["id",id ; "name",typename ; + "inductive",(string_of_bool finite) + ] + [< X.xml_nempty "arity" [] + (print_term ids_to_inner_sorts arity) ; + (List.fold_left + (fun i (name,lc) -> + [< i ; + X.xml_nempty "Constructor" + ["name",name] + (print_term ids_to_inner_sorts lc) + >]) [<>] cons + ) + >] + >] + ) [< >] tys + ) + >] + >], None ;; -let print_inner_types curi ~ids_to_inner_sorts ~ids_to_inner_types = +let + print_inner_types curi ~ids_to_inner_sorts ~ids_to_inner_types + ~ask_dtd_to_the_getter += let module C2A = Cic2acic in let module X = Xml in - X.xml_nempty "InnerTypes" ["of",UriManager.string_of_uri curi] - (Hashtbl.fold - (fun id {C2A.annsynthesized = synty ; C2A.annexpected = expty} x -> - [< x ; - X.xml_nempty "TYPE" ["of",id] - [< print_term curi ids_to_inner_sorts synty ; - match expty with - None -> [<>] - | Some expty' -> print_term curi ids_to_inner_sorts expty' + let dtdname = dtdname ~ask_dtd_to_the_getter "cictypes.dtd" in + [< X.xml_cdata "\n" ; + X.xml_cdata + ("\n") ; + X.xml_nempty "InnerTypes" ["of",UriManager.string_of_uri curi] + (Hashtbl.fold + (fun id {C2A.annsynthesized = synty ; C2A.annexpected = expty} x -> + [< x ; + X.xml_nempty "TYPE" ["of",id] + [< X.xml_nempty "synthesized" [] + [< print_term ids_to_inner_sorts synty >] ; + match expty with + None -> [<>] + | Some expty' -> X.xml_nempty "expected" [] [< print_term ids_to_inner_sorts expty' >] + >] >] - >] - ) ids_to_inner_types [<>] - ) + ) ids_to_inner_types [<>] + ) + >] ;; diff --git a/helm/gTopLevel/cic2Xml.mli b/helm/gTopLevel/cic2Xml.mli index 62a423f58..0891d4996 100644 --- a/helm/gTopLevel/cic2Xml.mli +++ b/helm/gTopLevel/cic2Xml.mli @@ -27,17 +27,18 @@ exception ImpossiblePossible exception NotImplemented val print_term : - UriManager.uri -> ids_to_inner_sorts: (string, string) Hashtbl.t -> Cic.annterm -> Xml.token Stream.t val print_object : UriManager.uri -> ids_to_inner_sorts: (string, string) Hashtbl.t -> - Cic.annobj -> Xml.token Stream.t + ask_dtd_to_the_getter:bool -> + Cic.annobj -> Xml.token Stream.t * Xml.token Stream.t option val print_inner_types : UriManager.uri -> ids_to_inner_sorts: (string, string) Hashtbl.t -> ids_to_inner_types: (string, Cic2acic.anntypes) Hashtbl.t -> + ask_dtd_to_the_getter:bool -> Xml.token Stream.t diff --git a/helm/gTopLevel/cic2acic.ml b/helm/gTopLevel/cic2acic.ml index f08bb877a..c18e7d6a6 100644 --- a/helm/gTopLevel/cic2acic.ml +++ b/helm/gTopLevel/cic2acic.ml @@ -23,21 +23,26 @@ * http://cs.unibo.it/helm/. *) -exception NotImplemented;; - type anntypes = {annsynthesized : Cic.annterm ; annexpected : Cic.annterm option} ;; +let gen_id seed = + let res = "i" ^ string_of_int !seed in + incr seed ; + res +;; + let fresh_id seed ids_to_terms ids_to_father_ids = fun father t -> - let res = "i" ^ string_of_int !seed in - incr seed ; + let res = gen_id seed in Hashtbl.add ids_to_father_ids res father ; Hashtbl.add ids_to_terms res t ; res ;; +let source_id_of_id id = "#source#" ^ id;; + exception NotEnoughElements;; exception NameExpected;; @@ -52,7 +57,7 @@ let rec get_nth l n = ;; let acic_of_cic_context' seed ids_to_terms ids_to_father_ids ids_to_inner_sorts - ids_to_inner_types metasenv context t expectedty + ids_to_inner_types metasenv context idrefs t expectedty = let module D = DoubleTypeInference in let module T = CicTypeChecker in @@ -61,7 +66,7 @@ let acic_of_cic_context' seed ids_to_terms ids_to_father_ids ids_to_inner_sorts let terms_to_types = D.double_type_of metasenv context t expectedty in - let rec aux computeinnertypes father context tt = + let rec aux computeinnertypes father context idrefs tt = let fresh_id'' = fresh_id' father tt in (*CSC: computeinnertypes era true, il che e' proprio sbagliato, no? *) let aux' = aux computeinnertypes (Some fresh_id'') in @@ -100,11 +105,13 @@ let acic_of_cic_context' seed ids_to_terms ids_to_father_ids ids_to_inner_sorts match expected with None -> None,false | Some expectedty' -> - Some (aux false (Some fresh_id'') context expectedty'),true + Some + (aux false (Some fresh_id'') context idrefs expectedty'), + true in Some {annsynthesized = - aux false (Some fresh_id'') context synthesized ; + aux false (Some fresh_id'') context idrefs synthesized ; annexpected = annexpected }, expected_available else @@ -127,12 +134,16 @@ let acic_of_cic_context' seed ids_to_terms ids_to_father_ids ids_to_inner_sorts Hashtbl.add ids_to_inner_sorts fresh_id'' innersort ; if innersort = "Prop" && expected_available then add_inner_type fresh_id'' ; - C.ARel (fresh_id'', n, id) - | C.Var uri -> + C.ARel (fresh_id'', List.nth idrefs (n-1), n, id) + | C.Var (uri,exp_named_subst) -> Hashtbl.add ids_to_inner_sorts fresh_id'' innersort ; if innersort = "Prop" && expected_available then add_inner_type fresh_id'' ; - C.AVar (fresh_id'', uri) + let exp_named_subst' = + List.map + (function i,t -> i, (aux' context idrefs t)) exp_named_subst + in + C.AVar (fresh_id'', uri,exp_named_subst') | C.Meta (n,l) -> let (_,canonical_context,_) = List.find (function (m,_,_) -> n = m) metasenv @@ -145,7 +156,7 @@ let acic_of_cic_context' seed ids_to_terms ids_to_father_ids ids_to_inner_sorts (fun ct t -> match (ct, t) with | None, _ -> None - | _, Some t -> Some (aux' context t) + | _, Some t -> Some (aux' context idrefs t) | Some _, None -> assert false (* due to typing rules *)) canonical_context l)) | C.Sort s -> C.ASort (fresh_id'', s) @@ -154,61 +165,83 @@ let acic_of_cic_context' seed ids_to_terms ids_to_father_ids ids_to_inner_sorts Hashtbl.add ids_to_inner_sorts fresh_id'' innersort ; if innersort = "Prop" then add_inner_type fresh_id'' ; - C.ACast (fresh_id'', aux' context v, aux' context t) + C.ACast (fresh_id'', aux' context idrefs v, aux' context idrefs t) | C.Prod (n,s,t) -> Hashtbl.add ids_to_inner_sorts fresh_id'' (string_of_sort innertype) ; - C.AProd - (fresh_id'', n, aux' context s, - aux' ((Some (n, C.Decl s))::context) t) + let sourcetype = T.type_of_aux' metasenv context s in + Hashtbl.add ids_to_inner_sorts (source_id_of_id fresh_id'') + (string_of_sort sourcetype) ; + C.AProd + (fresh_id'', n, aux' context idrefs s, + aux' ((Some (n, C.Decl s))::context) (fresh_id''::idrefs) t) | C.Lambda (n,s,t) -> Hashtbl.add ids_to_inner_sorts fresh_id'' innersort ; - if innersort = "Prop" then - begin - let father_is_lambda = - match father with - None -> false - | Some father' -> - match Hashtbl.find ids_to_terms father' with - C.Lambda _ -> true - | _ -> false - in - if (not father_is_lambda) || expected_available then - add_inner_type fresh_id'' - end ; - C.ALambda - (fresh_id'',n, aux' context s, - aux' ((Some (n, C.Decl s)::context)) t) + let sourcetype = T.type_of_aux' metasenv context s in + Hashtbl.add ids_to_inner_sorts (source_id_of_id fresh_id'') + (string_of_sort sourcetype) ; + if innersort = "Prop" then + begin + let father_is_lambda = + match father with + None -> false + | Some father' -> + match Hashtbl.find ids_to_terms father' with + C.Lambda _ -> true + | _ -> false + in + if (not father_is_lambda) || expected_available then + add_inner_type fresh_id'' + end ; + C.ALambda + (fresh_id'',n, aux' context idrefs s, + aux' ((Some (n, C.Decl s)::context)) (fresh_id''::idrefs) t) | C.LetIn (n,s,t) -> Hashtbl.add ids_to_inner_sorts fresh_id'' innersort ; if innersort = "Prop" then add_inner_type fresh_id'' ; C.ALetIn - (fresh_id'', n, aux' context s, - aux' ((Some (n, C.Def s))::context) t) + (fresh_id'', n, aux' context idrefs s, + aux' ((Some (n, C.Def s))::context) (fresh_id''::idrefs) t) | C.Appl l -> Hashtbl.add ids_to_inner_sorts fresh_id'' innersort ; if innersort = "Prop" then add_inner_type fresh_id'' ; - C.AAppl (fresh_id'', List.map (aux' context) l) - | C.Const (uri,cn) -> + C.AAppl (fresh_id'', List.map (aux' context idrefs) l) + | C.Const (uri,exp_named_subst) -> Hashtbl.add ids_to_inner_sorts fresh_id'' innersort ; if innersort = "Prop" && expected_available then add_inner_type fresh_id'' ; - C.AConst (fresh_id'', uri, cn) - | C.MutInd (uri,cn,tyno) -> C.AMutInd (fresh_id'', uri, cn, tyno) - | C.MutConstruct (uri,cn,tyno,consno) -> + let exp_named_subst' = + List.map + (function i,t -> i, (aux' context idrefs t)) exp_named_subst + in + C.AConst (fresh_id'', uri, exp_named_subst') + | C.MutInd (uri,tyno,exp_named_subst) -> + let exp_named_subst' = + List.map + (function i,t -> i, (aux' context idrefs t)) exp_named_subst + in + C.AMutInd (fresh_id'', uri, tyno, exp_named_subst') + | C.MutConstruct (uri,tyno,consno,exp_named_subst) -> Hashtbl.add ids_to_inner_sorts fresh_id'' innersort ; if innersort = "Prop" && expected_available then add_inner_type fresh_id'' ; - C.AMutConstruct (fresh_id'', uri, cn, tyno, consno) - | C.MutCase (uri, cn, tyno, outty, term, patterns) -> + let exp_named_subst' = + List.map + (function i,t -> i, (aux' context idrefs t)) exp_named_subst + in + C.AMutConstruct (fresh_id'', uri, tyno, consno, exp_named_subst') + | C.MutCase (uri, tyno, outty, term, patterns) -> Hashtbl.add ids_to_inner_sorts fresh_id'' innersort ; if innersort = "Prop" then add_inner_type fresh_id'' ; - C.AMutCase (fresh_id'', uri, cn, tyno, aux' context outty, - aux' context term, List.map (aux' context) patterns) + C.AMutCase (fresh_id'', uri, tyno, aux' context idrefs outty, + aux' context idrefs term, List.map (aux' context idrefs) patterns) | C.Fix (funno, funs) -> + let fresh_idrefs = + List.map (function _ -> gen_id seed) funs in + let new_idrefs = List.rev fresh_idrefs @ idrefs in let tys = List.map (fun (name,_,ty,_) -> Some (C.Name name, C.Decl ty)) funs in @@ -216,12 +249,16 @@ let acic_of_cic_context' seed ids_to_terms ids_to_father_ids ids_to_inner_sorts if innersort = "Prop" then add_inner_type fresh_id'' ; C.AFix (fresh_id'', funno, - List.map - (fun (name, indidx, ty, bo) -> - (name, indidx, aux' context ty, aux' (tys@context) bo) - ) funs + List.map2 + (fun id (name, indidx, ty, bo) -> + (id, name, indidx, aux' context idrefs ty, + aux' (tys@context) new_idrefs bo) + ) fresh_idrefs funs ) | C.CoFix (funno, funs) -> + let fresh_idrefs = + List.map (function _ -> gen_id seed) funs in + let new_idrefs = List.rev fresh_idrefs @ idrefs in let tys = List.map (fun (name,ty,_) -> Some (C.Name name, C.Decl ty)) funs in @@ -229,23 +266,24 @@ let acic_of_cic_context' seed ids_to_terms ids_to_father_ids ids_to_inner_sorts if innersort = "Prop" then add_inner_type fresh_id'' ; C.ACoFix (fresh_id'', funno, - List.map - (fun (name, ty, bo) -> - (name, aux' context ty, aux' (tys@context) bo) - ) funs + List.map2 + (fun id (name, ty, bo) -> + (id, name, aux' context idrefs ty, + aux' (tys@context) new_idrefs bo) + ) fresh_idrefs funs ) in - aux true None context t + aux true None context idrefs t ;; -let acic_of_cic_context metasenv context t = +let acic_of_cic_context metasenv context idrefs t = let ids_to_terms = Hashtbl.create 503 in let ids_to_father_ids = Hashtbl.create 503 in let ids_to_inner_sorts = Hashtbl.create 503 in let ids_to_inner_types = Hashtbl.create 503 in let seed = ref 0 in acic_of_cic_context' seed ids_to_terms ids_to_father_ids ids_to_inner_sorts - ids_to_inner_types metasenv context t, + ids_to_inner_types metasenv context idrefs t, ids_to_terms, ids_to_father_ids, ids_to_inner_sorts, ids_to_inner_types ;; @@ -263,55 +301,98 @@ let acic_object_of_cic_object obj = let acic_term_of_cic_term_context' = acic_of_cic_context' seed ids_to_terms ids_to_father_ids ids_to_inner_sorts ids_to_inner_types in - let acic_term_of_cic_term' = acic_term_of_cic_term_context' [] [] in + let acic_term_of_cic_term' = acic_term_of_cic_term_context' [] [] [] in let aobj = match obj with - C.Definition (id,bo,ty,params) -> + C.Constant (id,Some bo,ty,params) -> let abo = acic_term_of_cic_term' bo (Some ty) in let aty = acic_term_of_cic_term' ty None in - C.ADefinition ("mettereaposto",id,abo,aty,(Cic.Actual params)) - | C.Axiom (id,ty,params) -> raise NotImplemented - | C.Variable (id,bo,ty) -> raise NotImplemented - | C.CurrentProof (id,conjectures,bo,ty) -> + C.AConstant + ("mettereaposto",Some "mettereaposto2",id,Some abo,aty, params) + | C.Constant (id,None,ty,params) -> + let aty = acic_term_of_cic_term' ty None in + C.AConstant + ("mettereaposto",None,id,None,aty, params) + | C.Variable (id,bo,ty,params) -> + let abo = + match bo with + None -> None + | Some bo -> Some (acic_term_of_cic_term' bo (Some ty)) + in + let aty = acic_term_of_cic_term' ty None in + C.AVariable + ("mettereaposto",id,abo,aty, params) + | C.CurrentProof (id,conjectures,bo,ty,params) -> let aconjectures = List.map (function (i,canonical_context,term) as conjecture -> let cid = "c" ^ string_of_int !conjectures_seed in Hashtbl.add ids_to_conjectures cid conjecture ; incr conjectures_seed ; - let acanonical_context = - let rec aux = + let idrefs',revacanonical_context = + let rec aux context idrefs = function - [] -> [] + [] -> idrefs,[] | hyp::tl -> let hid = "h" ^ string_of_int !hypotheses_seed in + let new_idrefs = hid::idrefs in Hashtbl.add ids_to_hypotheses hid hyp ; incr hypotheses_seed ; match hyp with (Some (n,C.Decl t)) -> + let final_idrefs,atl = + aux (hyp::context) new_idrefs tl in let at = - acic_term_of_cic_term_context' conjectures tl t None + acic_term_of_cic_term_context' + conjectures context idrefs t None in - (hid,Some (n,C.ADecl at))::(aux tl) + final_idrefs,(hid,Some (n,C.ADecl at))::atl | (Some (n,C.Def t)) -> + let final_idrefs,atl = + aux (hyp::context) new_idrefs tl in let at = - acic_term_of_cic_term_context' conjectures tl t None + acic_term_of_cic_term_context' + conjectures context idrefs t None in - (hid,Some (n,C.ADef at))::(aux tl) - | None -> (hid,None)::(aux tl) + final_idrefs,(hid,Some (n,C.ADef at))::atl + | None -> + let final_idrefs,atl = + aux (hyp::context) new_idrefs tl + in + final_idrefs,(hid,None)::atl in - aux canonical_context + aux [] [] (List.rev canonical_context) in let aterm = - acic_term_of_cic_term_context' conjectures canonical_context - term None + acic_term_of_cic_term_context' conjectures + canonical_context idrefs' term None in - (cid,i,acanonical_context,aterm) + (cid,i,(List.rev revacanonical_context),aterm) ) conjectures in - let abo = acic_term_of_cic_term_context' conjectures [] bo (Some ty) in - let aty = acic_term_of_cic_term_context' conjectures [] ty None in - C.ACurrentProof ("mettereaposto",id,aconjectures,abo,aty) - | C.InductiveDefinition (tys,params,paramsno) -> raise NotImplemented + let abo = + acic_term_of_cic_term_context' conjectures [] [] bo (Some ty) in + let aty = acic_term_of_cic_term_context' conjectures [] [] ty None in + C.ACurrentProof + ("mettereaposto","mettereaposto2",id,aconjectures,abo,aty,params) + | C.InductiveDefinition (tys,params,paramsno) -> + let context = + List.map + (fun (name,_,arity,_) -> Some (C.Name name, C.Decl arity)) tys in + let idrefs = List.map (function _ -> gen_id seed) tys in + let atys = + List.map2 + (fun id (name,inductive,ty,cons) -> + let acons = + List.map + (function (name,ty) -> + (name, + acic_term_of_cic_term_context' [] context idrefs ty None) + ) cons + in + (id,name,inductive,acic_term_of_cic_term' ty None,acons) + ) (List.rev idrefs) tys + in + C.AInductiveDefinition ("mettereaposto",atys,params,paramsno) in aobj,ids_to_terms,ids_to_father_ids,ids_to_inner_sorts,ids_to_inner_types, ids_to_conjectures,ids_to_hypotheses diff --git a/helm/gTopLevel/cic2acic.mli b/helm/gTopLevel/cic2acic.mli index a07b9d297..b34d34342 100644 --- a/helm/gTopLevel/cic2acic.mli +++ b/helm/gTopLevel/cic2acic.mli @@ -23,10 +23,11 @@ * http://cs.unibo.it/helm/. *) -exception NotImplemented exception NotEnoughElements exception NameExpected +val source_id_of_id : string -> string + type anntypes = {annsynthesized : Cic.annterm ; annexpected : Cic.annterm option} ;; @@ -39,6 +40,7 @@ val acic_of_cic_context' : (Cic.id, anntypes) Hashtbl.t -> (* ids_to_inner_types *) Cic.metasenv -> (* metasenv *) Cic.context -> (* context *) + Cic.id list -> (* idrefs *) Cic.term -> (* term *) Cic.term option -> (* expected type *) Cic.annterm (* annotated term *) diff --git a/helm/gTopLevel/dictionary-cic.xml b/helm/gTopLevel/dictionary-cic.xml new file mode 100644 index 000000000..29397d45a --- /dev/null +++ b/helm/gTopLevel/dictionary-cic.xml @@ -0,0 +1,37 @@ + + + + + + + + + + + + + diff --git a/helm/gTopLevel/disambiguate.ml b/helm/gTopLevel/disambiguate.ml new file mode 100644 index 000000000..ce41208dd --- /dev/null +++ b/helm/gTopLevel/disambiguate.ml @@ -0,0 +1,284 @@ +(* Copyright (C) 2000-2002, HELM Team. + * + * This file is part of HELM, an Hypertextual, Electronic + * Library of Mathematics, developed at the Computer Science + * Department, University of Bologna, Italy. + * + * HELM is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * HELM is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with HELM; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, + * MA 02111-1307, USA. + * + * For details, see the HELM World-Wide-Web page, + * http://cs.unibo.it/helm/. + *) + +(******************************************************************************) +(* *) +(* PROJECT HELM *) +(* *) +(* Claudio Sacerdoti Coen *) +(* 06/01/2002 *) +(* *) +(* *) +(******************************************************************************) + +(** This module provides a functor to disambiguate the input **) +(** given a set of user-interface call-backs **) + +module type Callbacks = + sig + (* The following two functions are used to save/restore the metasenv *) + (* before/after the parsing. *) + (*CSC: This should be made functional sooner or later! *) + val get_metasenv : unit -> Cic.metasenv + val set_metasenv : Cic.metasenv -> unit + + val output_html : string -> unit + val interactive_user_uri_choice : + selection_mode:[`SINGLE | `EXTENDED] -> + ?ok:string -> + ?enable_button_for_non_vars:bool -> + title:string -> msg:string -> id:string -> string list -> string list + val interactive_interpretation_choice : + (string * string) list list -> int + val input_or_locate_uri : title:string -> UriManager.uri + end +;; + +type domain_and_interpretation = + CicTextualParser0.interpretation_domain_item list * + CicTextualParser0.interpretation +;; + +module Make(C:Callbacks) = + struct + + let locate_one_id mqi_handle id = + let query = MQueryGenerator.locate id in + let result = MQueryInterpreter.execute mqi_handle query in + let uris = + List.map + (function uri,_ -> + MQueryMisc.wrong_xpointer_format_from_wrong_xpointer_format' uri + ) result in + C.output_html "

Locate Query: 

";
+     MQueryUtil.text_of_query C.output_html query ""; 
+     C.output_html "
Result:
";
+     MQueryUtil.text_of_result C.output_html result "
";
+     let uris' =
+      match uris with
+         [] ->
+          [UriManager.string_of_uri
+           (C.input_or_locate_uri
+             ~title:("URI matching \"" ^ id ^ "\" unknown."))]
+       | [uri] -> [uri]
+       | _ ->
+         C.interactive_user_uri_choice
+          ~selection_mode:`EXTENDED
+          ~ok:"Try every selection."
+          ~enable_button_for_non_vars:true
+          ~title:"Ambiguous input."
+          ~msg:
+            ("Ambiguous input \"" ^ id ^
+             "\". Please, choose one or more interpretations:")
+          ~id
+          uris
+     in
+      List.map MQueryMisc.cic_textual_parser_uri_of_string uris'
+
+
+   exception ThereDoesNotExistAnyWellTypedInterpretationOfTheInput
+
+   type test_result =
+      Ok of Cic.term * Cic.metasenv
+    | Ko
+    | Uncertain
+
+   type ambiguous_choices =
+      Uris of CicTextualParser0.uri list
+    | Symbols of (CicTextualParser0.interpretation -> Cic.term) list
+
+   let disambiguate_input mqi_handle context metasenv dom mk_metasenv_and_expr ~id_to_uris=
+    let known_ids,resolve_id = id_to_uris in
+    let dom' =
+     let rec filter =
+      function
+         [] -> []
+       | he::tl ->
+          if List.mem he known_ids then filter tl else he::(filter tl)
+     in
+      filter dom
+    in
+     (* for each id in dom' we get the list of uris associated to it *)
+     let list_of_uris =
+      List.map
+       (function
+           CicTextualParser0.Id id -> Uris (locate_one_id mqi_handle id)
+         | CicTextualParser0.Symbol (descr,choices) ->
+            (* CSC: Implementare la funzione di filtraggio manuale *)
+            (* CSC: corrispondente alla locate_one_id              *)
+            Symbols (List.map snd choices)
+       ) dom' in
+     let tests_no =
+      List.fold_left
+       (fun i uris ->
+         let len =
+          match uris with
+             Uris l -> List.length l
+           | Symbols l -> List.length l
+         in
+          i * len
+       ) 1 list_of_uris
+     in
+      if tests_no > 1 then
+       C.output_html
+        ("
Disambiguation phase started: up to " ^
+          string_of_int tests_no ^ " cases will be tried.") ;
+     (* and now we compute the list of all possible assignments from *)
+     (* id to uris that generate well-typed terms                    *)
+     let resolve_ids =
+      (* function to test if a partial interpretation is so far correct *)
+      let test resolve_id residual_dom =
+       (* We put implicits in place of every identifier that is not *)
+       (* resolved by resolve_id                                    *)
+       let resolve_id' =
+        List.fold_left
+         (fun f id ->
+           function id' ->
+            if id = id' then Some (CicTextualParser0.Implicit) else f id'
+         ) resolve_id residual_dom
+       in
+        (* and we try to refine the term *)
+        let saved_status = C.get_metasenv () in
+        let metasenv',expr = mk_metasenv_and_expr resolve_id' in
+(*CSC: Bug here: we do not try to typecheck also the metasenv' *)
+        (* The parser is imperative ==> we must restore the old status ;-(( *)
+        C.set_metasenv saved_status ;
+         try
+          let term,_,_,metasenv'' =
+           CicRefine.type_of_aux' metasenv' context expr
+          in
+           Ok (term,metasenv'')
+         with
+            CicRefine.MutCaseFixAndCofixRefineNotImplemented ->
+             (try
+               let term = CicTypeChecker.type_of_aux' metasenv' context expr in
+                Ok (term,metasenv')
+              with _ -> Ko
+             )
+          | CicRefine.Uncertain _ ->
+prerr_endline ("%%% UNCERTAIN!!! " ^ CicPp.ppterm expr) ;
+             Uncertain
+          | _ ->
+prerr_endline ("%%% PRUNED!!! " ^ CicPp.ppterm expr) ;
+            Ko
+      in
+      let rec aux resolve_id ids list_of_uris =
+       match ids,list_of_uris with
+          [],[] ->
+           (match test resolve_id [] with
+               Ok (term,metasenv) -> [resolve_id,term,metasenv]
+             | Ko | Uncertain -> [])
+        | id::idtl,uris::uristl ->
+           let rec filter =
+            function
+               [] -> []
+             | (uri : CicTextualParser0.interpretation_codomain_item)::uritl ->
+                let resolve_id' =
+                 function id' -> if id = id' then Some uri else resolve_id id'
+                in
+                 (match test resolve_id' idtl with
+                     Ok (term,metasenv) ->
+                      (* the next three ``if''s are used to avoid the base   *)
+                      (* case where the term would be refined a second time. *)
+                      (if uristl = [] then
+                        [resolve_id',term,metasenv]
+                       else
+                        (aux resolve_id' idtl uristl)
+                      ) @ (filter uritl)
+                   | Uncertain ->
+                      (if uristl = [] then []
+                       else
+                        (aux resolve_id' idtl uristl)
+                      ) @ (filter uritl)
+                   | Ko ->
+                      filter uritl
+                 )
+           in
+            (match uris with
+                Uris uris ->
+                 filter
+                  (List.map (function uri -> CicTextualParser0.Uri uri) uris)
+              | Symbols symbols ->
+                 filter
+                  (List.map
+                    (function sym -> CicTextualParser0.Term sym) symbols))
+        | _,_ -> assert false
+      in
+       aux resolve_id dom' list_of_uris
+     in
+      List.iter
+       (function (resolve,term,newmetasenv) ->
+         (* If metasen <> newmetasenv is a normal condition, we should *)
+         (* be prepared to apply the returned substitution to the      *)
+         (* whole current proof.                                       *)
+         if metasenv <> newmetasenv then
+          begin
+           prerr_endline
+            ("+++++ ASSERTION FAILED: " ^
+             "a refine operation should not modify the metasenv") ;
+           (* an assert would raise an exception that could be caught *)
+           exit 1
+          end
+       ) resolve_ids ;
+      let resolve_id',term,metasenv' =
+       match resolve_ids with
+          [] -> raise ThereDoesNotExistAnyWellTypedInterpretationOfTheInput
+        | [resolve_id] -> resolve_id
+        | _ ->
+          let choices =
+           List.map
+            (function (resolve,_,_) ->
+              List.map
+               (function id ->
+                 (match id with
+                     CicTextualParser0.Id id -> id
+                   | CicTextualParser0.Symbol (descr,_) -> descr
+                 ),
+                  match resolve id with
+                     None -> assert false
+                   | Some (CicTextualParser0.Uri uri) ->
+                      (match uri with
+                          CicTextualParser0.ConUri uri
+                        | CicTextualParser0.VarUri uri ->
+                           UriManager.string_of_uri uri
+                        | CicTextualParser0.IndTyUri (uri,tyno) ->
+                           UriManager.string_of_uri uri ^ "#xpointer(1/" ^
+                            string_of_int (tyno+1) ^ ")"
+                        | CicTextualParser0.IndConUri (uri,tyno,consno) ->
+                           UriManager.string_of_uri uri ^ "#xpointer(1/" ^
+                            string_of_int (tyno+1) ^ "/" ^ string_of_int consno ^                           ")")
+                   | Some (CicTextualParser0.Term term) ->
+                      (* CSC: Implementare resa delle scelte *)
+                      "To be implemented XXX01"
+                   | Some CicTextualParser0.Implicit -> assert false
+               ) dom
+            ) resolve_ids
+          in
+           let index = C.interactive_interpretation_choice choices in
+            List.nth resolve_ids index
+      in
+       (known_ids @ dom', resolve_id'), metasenv',term
+end
+;;
diff --git a/helm/gTopLevel/disambiguate.mli b/helm/gTopLevel/disambiguate.mli
new file mode 100644
index 000000000..9fdfb8993
--- /dev/null
+++ b/helm/gTopLevel/disambiguate.mli
@@ -0,0 +1,73 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(******************************************************************************)
+(*                                                                            *)
+(*                               PROJECT HELM                                 *)
+(*                                                                            *)
+(*                Claudio Sacerdoti Coen                *)
+(*                                 15/01/2003                                 *)
+(*                                                                            *)
+(*                                                                            *)
+(******************************************************************************)
+
+(** This module provides a functor to disambiguate the input **)
+(** given a set of user-interface call-backs                 **)
+
+module type Callbacks =
+  sig
+    (* The following two functions are used to save/restore the metasenv *)
+    (* before/after the parsing.                                         *)
+    (*CSC: This should be made functional sooner or later! *)
+    val get_metasenv : unit -> Cic.metasenv
+    val set_metasenv : Cic.metasenv -> unit
+
+    val output_html : string -> unit
+    val interactive_user_uri_choice :
+      selection_mode:[`SINGLE | `EXTENDED] ->
+      ?ok:string ->
+      ?enable_button_for_non_vars:bool ->
+      title:string -> msg:string -> id:string -> string list -> string list
+    val interactive_interpretation_choice :
+      (string * string) list list -> int
+    val input_or_locate_uri : title:string -> UriManager.uri
+  end
+
+type domain_and_interpretation =
+ CicTextualParser0.interpretation_domain_item list *
+  CicTextualParser0.interpretation
+
+module Make (C : Callbacks) :
+    sig
+      exception ThereDoesNotExistAnyWellTypedInterpretationOfTheInput
+      val disambiguate_input :
+        MQIConn.handle -> 
+        Cic.context ->
+        Cic.metasenv ->
+        CicTextualParser0.interpretation_domain_item list ->
+        (CicTextualParser0.interpretation -> Cic.metasenv * Cic.term) ->
+        id_to_uris:domain_and_interpretation ->
+        domain_and_interpretation * Cic.metasenv * Cic.term
+    end
diff --git a/helm/gTopLevel/doubleTypeInference.ml b/helm/gTopLevel/doubleTypeInference.ml
index b06619c4d..4afe0e475 100644
--- a/helm/gTopLevel/doubleTypeInference.ml
+++ b/helm/gTopLevel/doubleTypeInference.ml
@@ -39,8 +39,12 @@ let rec head_beta_reduce =
  let module S = CicSubstitution in
  let module C = Cic in
   function
-      C.Rel _
-    | C.Var _ as t -> t
+      C.Rel _ as t -> t
+    | C.Var (uri,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map (function (i,t) -> i, head_beta_reduce t) exp_named_subst
+       in
+        C.Var (uri,exp_named_subst)
     | C.Meta (n,l) ->
        C.Meta (n,
         List.map
@@ -64,11 +68,23 @@ let rec head_beta_reduce =
          head_beta_reduce (C.Appl (he'::tl))
     | C.Appl l ->
        C.Appl (List.map head_beta_reduce l)
-    | C.Const _ as t -> t
-    | C.MutInd _
-    | C.MutConstruct _ as t -> t
-    | C.MutCase (sp,cno,i,outt,t,pl) ->
-       C.MutCase (sp,cno,i,head_beta_reduce outt,head_beta_reduce t,
+    | C.Const (uri,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map (function (i,t) -> i, head_beta_reduce t) exp_named_subst
+       in
+        C.Const (uri,exp_named_subst')
+    | C.MutInd (uri,i,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map (function (i,t) -> i, head_beta_reduce t) exp_named_subst
+       in
+        C.MutInd (uri,i,exp_named_subst')
+    | C.MutConstruct (uri,i,j,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map (function (i,t) -> i, head_beta_reduce t) exp_named_subst
+       in
+        C.MutConstruct (uri,i,j,exp_named_subst')
+    | C.MutCase (sp,i,outt,t,pl) ->
+       C.MutCase (sp,i,head_beta_reduce outt,head_beta_reduce t,
         List.map head_beta_reduce pl)
     | C.Fix (i,fl) ->
        let fl' =
@@ -99,11 +115,9 @@ let syntactic_equality t t' =
   if t = t' then true
   else
    match t, t' with
-      C.Rel _, C.Rel _
-    | C.Var _, C.Var _
-    | C.Meta _, C.Meta _
-    | C.Sort _, C.Sort _
-    | C.Implicit, C.Implicit -> false (* we already know that t != t' *)
+      C.Var (uri,exp_named_subst), C.Var (uri',exp_named_subst') ->
+       UriManager.eq uri uri' &&
+        syntactic_equality_exp_named_subst exp_named_subst exp_named_subst'
     | C.Cast (te,ty), C.Cast (te',ty') ->
        syntactic_equality te te' &&
         syntactic_equality ty ty'
@@ -118,12 +132,17 @@ let syntactic_equality t t' =
         syntactic_equality t t'
     | C.Appl l, C.Appl l' ->
        List.fold_left2 (fun b t1 t2 -> b && syntactic_equality t1 t2) true l l'
-    | C.Const (uri,_), C.Const (uri',_) -> UriManager.eq uri uri'
-    | C.MutInd (uri,_,i), C.MutInd (uri',_,i') ->
-       UriManager.eq uri uri' && i = i'
-    | C.MutConstruct (uri,_,i,j), C.MutConstruct (uri',_,i',j') ->
-       UriManager.eq uri uri' && i = i' && j = j'
-    | C.MutCase (sp,_,i,outt,t,pl), C.MutCase (sp',_,i',outt',t',pl') ->
+    | C.Const (uri,exp_named_subst), C.Const (uri',exp_named_subst') ->
+       UriManager.eq uri uri' &&
+        syntactic_equality_exp_named_subst exp_named_subst exp_named_subst'
+    | C.MutInd (uri,i,exp_named_subst), C.MutInd (uri',i',exp_named_subst') ->
+       UriManager.eq uri uri' && i = i' &&
+        syntactic_equality_exp_named_subst exp_named_subst exp_named_subst'
+    | C.MutConstruct (uri,i,j,exp_named_subst),
+      C.MutConstruct (uri',i',j',exp_named_subst') ->
+       UriManager.eq uri uri' && i = i' && j = j' &&
+        syntactic_equality_exp_named_subst exp_named_subst exp_named_subst'
+    | C.MutCase (sp,i,outt,t,pl), C.MutCase (sp',i',outt',t',pl') ->
        UriManager.eq sp sp' && i = i' &&
         syntactic_equality outt outt' &&
          syntactic_equality t t' &&
@@ -143,7 +162,11 @@ let syntactic_equality t t' =
            b &&
             syntactic_equality ty ty' &&
              syntactic_equality bo bo') true fl fl'
-    | _,_ -> false
+    | _, _ -> false (* we already know that t != t' *)
+ and syntactic_equality_exp_named_subst exp_named_subst1 exp_named_subst2 =
+  List.fold_left2
+   (fun b (_,t1) (_,t2) -> b && syntactic_equality t1 t2) true
+   exp_named_subst1 exp_named_subst2
  in
   try
    syntactic_equality t t'
@@ -158,20 +181,19 @@ let rec split l n =
   | (_,_) -> raise ListTooShort
 ;;
 
-let cooked_type_of_constant uri cookingsno =
+let type_of_constant uri =
  let module C = Cic in
  let module R = CicReduction in
  let module U = UriManager in
   let cobj =
-   match CicEnvironment.is_type_checked uri cookingsno with
+   match CicEnvironment.is_type_checked uri with
       CicEnvironment.CheckedObj cobj -> cobj
     | CicEnvironment.UncheckedObj uobj ->
        raise (NotWellTyped "Reference to an unchecked constant")
   in
    match cobj with
-      C.Definition (_,_,ty,_) -> ty
-    | C.Axiom (_,ty,_) -> ty
-    | C.CurrentProof (_,_,_,ty) -> ty
+      C.Constant (_,_,ty,_) -> ty
+    | C.CurrentProof (_,_,_,ty,_) -> ty
     | _ -> raise (WrongUriToConstant (U.string_of_uri uri))
 ;;
 
@@ -179,20 +201,19 @@ let type_of_variable uri =
  let module C = Cic in
  let module R = CicReduction in
  let module U = UriManager in
-  (* 0 because a variable is never cooked => no partial cooking at one level *)
-  match CicEnvironment.is_type_checked uri 0 with
-     CicEnvironment.CheckedObj (C.Variable (_,_,ty)) -> ty
+  match CicEnvironment.is_type_checked uri with
+     CicEnvironment.CheckedObj (C.Variable (_,_,ty,_)) -> ty
    | CicEnvironment.UncheckedObj (C.Variable _) ->
       raise (NotWellTyped "Reference to an unchecked variable")
    |  _ -> raise (WrongUriToVariable (UriManager.string_of_uri uri))
 ;;
 
-let cooked_type_of_mutual_inductive_defs uri cookingsno i =
+let type_of_mutual_inductive_defs uri i =
  let module C = Cic in
  let module R = CicReduction in
  let module U = UriManager in
   let cobj =
-   match CicEnvironment.is_type_checked uri cookingsno with
+   match CicEnvironment.is_type_checked uri with
       CicEnvironment.CheckedObj cobj -> cobj
     | CicEnvironment.UncheckedObj uobj ->
        raise (NotWellTyped "Reference to an unchecked inductive type")
@@ -204,12 +225,12 @@ let cooked_type_of_mutual_inductive_defs uri cookingsno i =
     | _ -> raise (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri))
 ;;
 
-let cooked_type_of_mutual_inductive_constr uri cookingsno i j =
+let type_of_mutual_inductive_constr uri i j =
  let module C = Cic in
  let module R = CicReduction in
  let module U = UriManager in
   let cobj =
-   match CicEnvironment.is_type_checked uri cookingsno with
+   match CicEnvironment.is_type_checked uri with
       CicEnvironment.CheckedObj cobj -> cobj
     | CicEnvironment.UncheckedObj uobj ->
        raise (NotWellTyped "Reference to an unchecked constructor")
@@ -217,7 +238,7 @@ let cooked_type_of_mutual_inductive_constr uri cookingsno i j =
    match cobj with
       C.InductiveDefinition (dl,_,_) ->
        let (_,_,_,cl) = List.nth dl i in
-        let (_,ty,_) = List.nth cl (j-1) in
+        let (_,ty) = List.nth cl (j-1) in
          ty
     | _ -> raise (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri))
 ;;
@@ -253,7 +274,9 @@ let rec type_of_aux' subterms_to_types metasenv context t expectedty =
          with
           _ -> raise (NotWellTyped "Not a close term")
         )
-     | C.Var uri -> type_of_variable uri
+     | C.Var (uri,exp_named_subst) ->
+        visit_exp_named_subst context uri exp_named_subst ;
+        CicSubstitution.subst_vars exp_named_subst (type_of_variable uri)
      | C.Meta (n,l) -> 
         (* Let's visit all the subterms that will not be visited later *)
         let (_,canonical_context,_) =
@@ -355,14 +378,18 @@ let rec type_of_aux' subterms_to_types metasenv context t expectedty =
          in
           eat_prods context hetype tlbody_and_type
      | C.Appl _ -> raise (NotWellTyped "Appl: no arguments")
-     | C.Const (uri,cookingsno) ->
-        cooked_type_of_constant uri cookingsno
-     | C.MutInd (uri,cookingsno,i) ->
-        cooked_type_of_mutual_inductive_defs uri cookingsno i
-     | C.MutConstruct (uri,cookingsno,i,j) ->
-        let cty = cooked_type_of_mutual_inductive_constr uri cookingsno i j in
-         cty
-     | C.MutCase (uri,cookingsno,i,outtype,term,pl) ->
+     | C.Const (uri,exp_named_subst) ->
+        visit_exp_named_subst context uri exp_named_subst ;
+        CicSubstitution.subst_vars exp_named_subst (type_of_constant uri)
+     | C.MutInd (uri,i,exp_named_subst) ->
+        visit_exp_named_subst context uri exp_named_subst ;
+        CicSubstitution.subst_vars exp_named_subst
+         (type_of_mutual_inductive_defs uri i)
+     | C.MutConstruct (uri,i,j,exp_named_subst) ->
+        visit_exp_named_subst context uri exp_named_subst ;
+        CicSubstitution.subst_vars exp_named_subst
+         (type_of_mutual_inductive_constr uri i j)
+     | C.MutCase (uri,i,outtype,term,pl) ->
         let outsort = type_of_aux context outtype None in
         let (need_dummy, k) =
          let rec guess_args context t =
@@ -373,10 +400,9 @@ let rec type_of_aux' subterms_to_types metasenv context t expectedty =
                if n = 0 then
                 (* last prod before sort *)
                 match CicReduction.whd context s with
-                   (*CSC vedi nota delirante su cookingsno in cicReduction.ml *)
-                   C.MutInd (uri',_,i') when U.eq uri' uri && i' = i ->
+                   C.MutInd (uri',i',_) when U.eq uri' uri && i' = i ->
                     (false, 1)
-                 | C.Appl ((C.MutInd (uri',_,i')) :: _)
+                 | C.Appl ((C.MutInd (uri',i',_)) :: _)
                     when U.eq uri' uri && i' = i -> (false, 1)
                  | _ -> (true, 1)
                else
@@ -386,7 +412,7 @@ let rec type_of_aux' subterms_to_types metasenv context t expectedty =
           let (b, k) = guess_args context outsort in
            if not b then (b, k - 1) else (b, k)
         in
-        let (parameters, arguments) =
+        let (parameters, arguments,exp_named_subst) =
          let type_of_term =
           CicTypeChecker.type_of_aux' metasenv context term
          in
@@ -395,18 +421,20 @@ let rec type_of_aux' subterms_to_types metasenv context t expectedty =
             (Some (head_beta_reduce type_of_term)))
           with
              (*CSC manca il caso dei CAST *)
-             C.MutInd (uri',_,i') ->
+             C.MutInd (uri',i',exp_named_subst) ->
               (* Checks suppressed *)
-              [],[]
-           | C.Appl (C.MutInd (uri',_,i') :: tl) ->
+              [],[],exp_named_subst
+           | C.Appl (C.MutInd (uri',i',exp_named_subst) :: tl) ->
+             let params,args =
               split tl (List.length tl - k)
+             in params,args,exp_named_subst
            | _ ->
              raise (NotWellTyped "MutCase: the term is not an inductive one")
         in
          (* Checks suppressed *)
          (* Let's visit all the subterms that will not be visited later *)
          let (cl,parsno) =
-          match CicEnvironment.get_cooked_obj uri cookingsno with
+          match CicEnvironment.get_cooked_obj uri with
              C.InductiveDefinition (tl,_,parsno) ->
               let (_,_,_,cl) = List.nth tl i in (cl,parsno)
            | _ ->
@@ -414,12 +442,12 @@ let rec type_of_aux' subterms_to_types metasenv context t expectedty =
          in
           let _ =
            List.fold_left
-            (fun j (p,(_,c,_)) ->
+            (fun j (p,(_,c)) ->
               let cons =
                if parameters = [] then
-                (C.MutConstruct (uri,cookingsno,i,j))
+                (C.MutConstruct (uri,i,j,exp_named_subst))
                else
-                (C.Appl (C.MutConstruct (uri,cookingsno,i,j)::parameters))
+                (C.Appl (C.MutConstruct (uri,i,j,exp_named_subst)::parameters))
               in
                let expectedtype =
                 type_of_branch context parsno need_dummy outtype cons
@@ -502,6 +530,34 @@ let rec type_of_aux' subterms_to_types metasenv context t expectedty =
       CicHash.add subterms_to_types t types ;
       res
 
+ and visit_exp_named_subst context uri exp_named_subst =
+  let uris_and_types =
+   match CicEnvironment.get_cooked_obj uri with
+      Cic.Constant (_,_,_,params)
+    | Cic.CurrentProof (_,_,_,_,params)
+    | Cic.Variable (_,_,_,params)
+    | Cic.InductiveDefinition (_,params,_) ->
+       List.map
+        (function uri ->
+          match CicEnvironment.get_cooked_obj uri with
+             Cic.Variable (_,None,ty,_) -> uri,ty
+           | _ -> assert false (* the theorem is well-typed *)
+        ) params
+  in
+   let rec check uris_and_types subst =
+    match uris_and_types,subst with
+       _,[] -> []
+     | (uri,ty)::tytl,(uri',t)::substtl when uri = uri' ->
+        ignore (type_of_aux context t (Some ty)) ;
+        let tytl' =
+         List.map
+          (function uri,t' -> uri,(CicSubstitution.subst_vars [uri',t] t')) tytl
+        in
+         check tytl' substtl
+     | _,_ -> assert false (* the theorem is well-typed *)
+   in
+    check uris_and_types exp_named_subst
+
  and sort_of_prod context (name,s) (t1, t2) =
   let module C = Cic in
    let t1' = CicReduction.whd context t1 in
@@ -551,7 +607,7 @@ and type_of_branch context argsno need_dummy outtype term constype =
           C.Appl l -> C.Appl (l@[C.Rel 1])
         | t -> C.Appl [t ; C.Rel 1]
       in
-       C.Prod (C.Anonimous,so,type_of_branch
+       C.Prod (C.Anonymous,so,type_of_branch
         ((Some (name,(C.Decl so)))::context) argsno need_dummy
         (CicSubstitution.lift 1 outtype) term' de)
   | _ -> raise (Impossible 20)
diff --git a/helm/gTopLevel/esempi/and_implies_or2.cic b/helm/gTopLevel/esempi/and_implies_or2.cic
index f693df30c..46cfb9e1b 100644
--- a/helm/gTopLevel/esempi/and_implies_or2.cic
+++ b/helm/gTopLevel/esempi/and_implies_or2.cic
@@ -1,8 +1,8 @@
-alias and  /Coq/Init/Logic/Conjunction/and.ind#1/1
-alias conj /Coq/Init/Logic/Conjunction/and.ind#1/1/1
+alias and  /Coq/Init/Logic/and.ind#1/1
+alias conj /Coq/Init/Logic/and.ind#1/1/1
 
-alias or        /Coq/Init/Logic/Disjunction/or.ind#1/1
-alias or_introl /Coq/Init/Logic/Disjunction/or.ind#1/1/1
-alias or_intror /Coq/Init/Logic/Disjunction/or.ind#1/1/2
+alias or        /Coq/Init/Logic/or.ind#1/1
+alias or_introl /Coq/Init/Logic/or.ind#1/1/1
+alias or_intror /Coq/Init/Logic/or.ind#1/1/2
 
 !A:Prop.!B:Prop.!H:(and A B).(or A B)
diff --git a/helm/gTopLevel/esempi/apply.cic b/helm/gTopLevel/esempi/apply.cic
index fb27e1693..902ae2fbb 100644
--- a/helm/gTopLevel/esempi/apply.cic
+++ b/helm/gTopLevel/esempi/apply.cic
@@ -1,6 +1,6 @@
 alias nat    /Coq/Init/Datatypes/nat.ind#1/1
-alias eq     /Coq/Init/Logic/Equality/eq.ind#1/1
-alias eq_ind /Coq/Init/Logic/Equality/eq_ind.con
+alias eq     /Coq/Init/Logic/eq.ind#1/1
+alias eq_ind /Coq/Init/Logic/eq_ind.con
 alias O      /Coq/Init/Datatypes/nat.ind#1/1/1
 alias S      /Coq/Init/Datatypes/nat.ind#1/1/2
 alias plus   /Coq/Init/Peano/plus.con
@@ -10,7 +10,7 @@ alias lt     /Coq/Init/Peano/lt.con
 alias not    /Coq/Init/Logic/not.con
 (eq nat (\x:nat.\y:nat.O O O) (\x:nat.\y:nat.O O O))
 /Coq/Init/Logic/f_equal2.con
-/Coq/Init/Logic/Equality/eq.ind#1/1/1
+/Coq/Init/Logic/eq.ind#1/1/1
 
 (*
 (le O (S O))
diff --git a/helm/gTopLevel/esempi/bug.cic b/helm/gTopLevel/esempi/bug.cic
index 2f10c572c..cab0f5ff2 100644
--- a/helm/gTopLevel/esempi/bug.cic
+++ b/helm/gTopLevel/esempi/bug.cic
@@ -1,9 +1,9 @@
 alias nat          /Coq/Init/Datatypes/nat.ind#1/1
 alias eqT          /Coq/Init/Logic_Type/eqT.ind#1/1
-alias eq           /Coq/Init/Logic/Equality/eq.ind#1/1
-alias refl_equal   /Coq/Init/Logic/Equality/eq.ind#1/1/1
-alias eq_ind       /Coq/Init/Logic/Equality/eq_ind.con
-alias eq_ind_r     /Coq/Init/Logic/Logic_lemmas/eq_ind_r.con
+alias eq           /Coq/Init/Logic/eq.ind#1/1
+alias refl_equal   /Coq/Init/Logic/eq.ind#1/1/1
+alias eq_ind       /Coq/Init/Logic/eq_ind.con
+alias eq_ind_r     /Coq/Init/Logic/eq_ind_r.con
 alias O            /Coq/Init/Datatypes/nat.ind#1/1/1
 alias S            /Coq/Init/Datatypes/nat.ind#1/1/2
 alias plus         /Coq/Init/Peano/plus.con
@@ -11,12 +11,12 @@ alias mult         /Coq/Init/Peano/mult.con
 alias le           /Coq/Init/Peano/le.ind#1/1
 alias lt           /Coq/Init/Peano/lt.con
 alias not          /Coq/Init/Logic/not.con
-alias f_equal      /Coq/Init/Logic/Logic_lemmas/equality/f_equal.con
+alias f_equal      /Coq/Init/Logic/f_equal.con
 alias le_trans     /Coq/Arith/Le/le_trans.con
 
 alias plus_n_O     /Coq/Init/Peano/plus_n_O.con 
 
-alias or           /Coq/Init/Logic/Disjunction/or.ind#1/1
-alias or_ind       /Coq/Init/Logic/Disjunction/or_ind.con
+alias or           /Coq/Init/Logic/or.ind#1/1
+alias or_ind       /Coq/Init/Logic/or_ind.con
 
 (or (eq nat O O) (eq nat O O)) -> (lt O O)
diff --git a/helm/gTopLevel/esempi/calcolo_proposizioni.cic b/helm/gTopLevel/esempi/calcolo_proposizioni.cic
index 5fe90ed32..a069a8b39 100644
--- a/helm/gTopLevel/esempi/calcolo_proposizioni.cic
+++ b/helm/gTopLevel/esempi/calcolo_proposizioni.cic
@@ -5,13 +5,13 @@ alias True_ind /Coq/Init/Logic/True_ind.con
 alias False     /Coq/Init/Logic/False.ind#1/1
 alias False_ind /Coq/Init/Logic/False_ind.con
 
-alias and     /Coq/Init/Logic/Conjunction/and.ind#1/1
-alias conj    /Coq/Init/Logic/Conjunction/and.ind#1/1/1
-alias and_ind /Coq/Init/Logic/Conjunction/and_ind.con
+alias and     /Coq/Init/Logic/and.ind#1/1
+alias conj    /Coq/Init/Logic/and.ind#1/1/1
+alias and_ind /Coq/Init/Logic/and_ind.con
 
-alias or        /Coq/Init/Logic/Disjunction/or.ind#1/1
-alias or_introl /Coq/Init/Logic/Disjunction/or.ind#1/1/1
-alias or_intror /Coq/Init/Logic/Disjunction/or.ind#1/1/2
-alias or_ind    /Coq/Init/Logic/Disjunction/or_ind.con
+alias or        /Coq/Init/Logic/or.ind#1/1
+alias or_introl /Coq/Init/Logic/or.ind#1/1/1
+alias or_intror /Coq/Init/Logic/or.ind#1/1/2
+alias or_ind    /Coq/Init/Logic/or_ind.con
 
 alias not          /Coq/Init/Logic/not.con
diff --git a/helm/gTopLevel/esempi/conversion.cic b/helm/gTopLevel/esempi/conversion.cic
index 3964f6f12..9114f3aa5 100644
--- a/helm/gTopLevel/esempi/conversion.cic
+++ b/helm/gTopLevel/esempi/conversion.cic
@@ -1,9 +1,9 @@
 alias nat        /Coq/Init/Datatypes/nat.ind#1/1
 alias eqT        /Coq/Init/Logic_Type/eqT.ind#1/1
-alias eq         /Coq/Init/Logic/Equality/eq.ind#1/1
-alias refl_equal /Coq/Init/Logic/Equality/eq.ind#1/1/1
-alias eq_ind     /Coq/Init/Logic/Equality/eq_ind.con
-alias eq_ind_r   /Coq/Init/Logic/Logic_lemmas/eq_ind_r.con
+alias eq         /Coq/Init/Logic/eq.ind#1/1
+alias refl_equal /Coq/Init/Logic/eq.ind#1/1/1
+alias eq_ind     /Coq/Init/Logic/eq_ind.con
+alias eq_ind_r   /Coq/Init/Logic/eq_ind_r.con
 alias O          /Coq/Init/Datatypes/nat.ind#1/1/1
 alias S          /Coq/Init/Datatypes/nat.ind#1/1/2
 alias plus       /Coq/Init/Peano/plus.con
@@ -11,7 +11,7 @@ alias mult       /Coq/Init/Peano/mult.con
 alias le         /Coq/Init/Peano/le.ind#1/1
 alias lt         /Coq/Init/Peano/lt.con
 alias not        /Coq/Init/Logic/not.con
-alias f_equal    /Coq/Init/Logic/Logic_lemmas/equality/f_equal.con
+alias f_equal    /Coq/Init/Logic/f_equal.con
 
 !n:nat.(eq nat (mult (S (S O)) n) O)
 !n:nat.(eq nat (plus O n) (plus n O))
diff --git a/helm/gTopLevel/esempi/decompose.cic b/helm/gTopLevel/esempi/decompose.cic
new file mode 100644
index 000000000..1a06fcba3
--- /dev/null
+++ b/helm/gTopLevel/esempi/decompose.cic
@@ -0,0 +1,8 @@
+!A:Prop.!B:Prop.!C:Prop.(and (sumbool A False) (and (or True B) (or B False))) -> True
+
+!A:Prop.!B:Prop.!C:Prop.(and (sumbool A C) (and (or A B) !D:Prop.(or B D))) -> True
+
+!A:Prop.!B:Prop.!C:Prop.(and (and A C) (and (and A B) (and B C))) -> True
+
+(and True True) -> True
+(and True False) -> True
diff --git a/helm/gTopLevel/esempi/elim.cic b/helm/gTopLevel/esempi/elim.cic
index eb679d686..0ef611ff7 100644
--- a/helm/gTopLevel/esempi/elim.cic
+++ b/helm/gTopLevel/esempi/elim.cic
@@ -1,6 +1,6 @@
 alias nat     /Coq/Init/Datatypes/nat.ind#1/1
-alias eq      /Coq/Init/Logic/Equality/eq.ind#1/1
-alias eq_ind  /Coq/Init/Logic/Equality/eq_ind.con
+alias eq      /Coq/Init/Logic/eq.ind#1/1
+alias eq_ind  /Coq/Init/Logic/eq_ind.con
 alias O       /Coq/Init/Datatypes/nat.ind#1/1/1
 alias S       /Coq/Init/Datatypes/nat.ind#1/1/2
 alias plus    /Coq/Init/Peano/plus.con
@@ -8,6 +8,6 @@ alias mult    /Coq/Init/Peano/mult.con
 alias le      /Coq/Init/Peano/le.ind#1/1
 alias lt      /Coq/Init/Peano/lt.con
 alias not     /Coq/Init/Logic/not.con
-alias f_equal /Coq/Init/Logic/Logic_lemmas/equality/f_equal.con
+alias f_equal /Coq/Init/Logic/f_equal.con
 
 !n:nat.(eq nat (plus O n) (plus n O))
diff --git a/helm/gTopLevel/esempi/elim2.cic b/helm/gTopLevel/esempi/elim2.cic
index da7753966..b7c01b96a 100644
--- a/helm/gTopLevel/esempi/elim2.cic
+++ b/helm/gTopLevel/esempi/elim2.cic
@@ -1,6 +1,6 @@
 alias nat        /Coq/Init/Datatypes/nat.ind#1/1
-alias eq         /Coq/Init/Logic/Equality/eq.ind#1/1
-alias eq_ind     /Coq/Init/Logic/Equality/eq_ind.con
+alias eq         /Coq/Init/Logic/eq.ind#1/1
+alias eq_ind     /Coq/Init/Logic/eq_ind.con
 alias eqT        /Coq/Init/Logic_Type/eqT.ind#1/1
 alias O          /Coq/Init/Datatypes/nat.ind#1/1/1
 alias S          /Coq/Init/Datatypes/nat.ind#1/1/2
@@ -9,15 +9,18 @@ alias mult       /Coq/Init/Peano/mult.con
 alias le         /Coq/Init/Peano/le.ind#1/1
 alias lt         /Coq/Init/Peano/lt.con
 alias not        /Coq/Init/Logic/not.con
-alias and        /Coq/Init/Logic/Conjunction/and.ind#1/1
+alias and        /Coq/Init/Logic/and.ind#1/1
 alias prod       /Coq/Init/Datatypes/prod.ind#1/1 
-alias list       /Coq/Lists/PolyList/Lists/list.ind#1/1
-alias AllS_assoc /Coq/Lists/TheoryList/Lists/Assoc_sec/AllS_assoc.ind#1/1
+alias list       /Coq/Lists/PolyList/list.ind#1/1
+alias AllS_assoc /Coq/Lists/TheoryList/AllS_assoc.ind#1/1
+alias V          /Coq/Lists/PolyList/Lists/A.var
+alias VA         /Coq/Lists/TheoryList/Lists/A.var
+alias VB         /Coq/Lists/TheoryList/Lists/Assoc_sec/B.var
 
-!A:Set.!B:Set.!P:!a:A.Prop.!l:(list (prod A B)).
- !H:(AllS_assoc A B P l).
+!A:Set.!B:Set.!P:!a:A.Prop.!l:list{V := (prod A B)}.
+ !H:(AllS_assoc {VA := A ; VB := B} P l).
   (and
-   (eq (list (prod A B)) l l)
+   (eq list{V := (prod A B)} l l)
    (eqT !n:A.Prop P P))
 
 (* Intros; Elim H:
diff --git a/helm/gTopLevel/esempi/evars.cic b/helm/gTopLevel/esempi/evars.cic
index 9183cb1e4..36ce17e2e 100644
--- a/helm/gTopLevel/esempi/evars.cic
+++ b/helm/gTopLevel/esempi/evars.cic
@@ -1,9 +1,9 @@
 alias nat          /Coq/Init/Datatypes/nat.ind#1/1
 alias eqT          /Coq/Init/Logic_Type/eqT.ind#1/1
-alias eq           /Coq/Init/Logic/Equality/eq.ind#1/1
-alias refl_equal   /Coq/Init/Logic/Equality/eq.ind#1/1/1
-alias eq_ind       /Coq/Init/Logic/Equality/eq_ind.con
-alias eq_ind_r     /Coq/Init/Logic/Logic_lemmas/eq_ind_r.con
+alias eq           /Coq/Init/Logic/eq.ind#1/1
+alias refl_equal   /Coq/Init/Logic/eq.ind#1/1/1
+alias eq_ind       /Coq/Init/Logic/eq_ind.con
+alias eq_ind_r     /Coq/Init/Logic/eq_ind_r.con
 alias O            /Coq/Init/Datatypes/nat.ind#1/1/1
 alias S            /Coq/Init/Datatypes/nat.ind#1/1/2
 alias plus         /Coq/Init/Peano/plus.con
@@ -11,7 +11,7 @@ alias mult         /Coq/Init/Peano/mult.con
 alias le           /Coq/Init/Peano/le.ind#1/1
 alias lt           /Coq/Init/Peano/lt.con
 alias not          /Coq/Init/Logic/not.con
-alias f_equal      /Coq/Init/Logic/Logic_lemmas/equality/f_equal.con
+alias f_equal      /Coq/Init/Logic/f_equal.con
 alias le_trans     /Coq/Arith/Le/le_trans.con
 
 alias le_plus_plus /Coq/Arith/Plus/le_plus_plus.con
diff --git a/helm/gTopLevel/esempi/fourier/fourier.cic b/helm/gTopLevel/esempi/fourier/fourier.cic
new file mode 100644
index 000000000..23062f3bd
--- /dev/null
+++ b/helm/gTopLevel/esempi/fourier/fourier.cic
@@ -0,0 +1,137 @@
+alias Rge       /Coq/Reals/Rdefinitions/Rge.con
+alias Rle       /Coq/Reals/Rdefinitions/Rle.con
+alias Rgt       /Coq/Reals/Rdefinitions/Rgt.con
+alias Rlt       /Coq/Reals/Rdefinitions/Rlt.con
+alias Ropp     /Coq/Reals/Rdefinitions/Ropp.con
+alias Rinv     /Coq/Reals/Rdefinitions/Rinv.con
+alias Rplus     /Coq/Reals/Rdefinitions/Rplus.con
+alias Rminus    /Coq/Reals/Rdefinitions/Rminus.con
+alias Rmult    /Coq/Reals/Rdefinitions/Rmult.con
+alias R1        /Coq/Reals/Rdefinitions/R1.con
+alias R0        /Coq/Reals/Rdefinitions/R0.con
+alias R        /Coq/Reals/Rdefinitions/R.con
+alias eqT	/Coq/Init/Logic_Type/eqT.ind#1/1
+alias not      /Coq/Init/Logic/not.con
+alias or /Coq/Init/Logic/or.ind#1/1
+
+!x:R.
+(Rlt (Rmult(Ropp x)R1)
+R0)
+->(Rlt R0 x)
+
+// test 3x4 -> 35''
+!x:R.!y:R.!z:R.
+(Rge
+(Rplus
+ (Rmult (Ropp (Rplus R1 R1)) x) (Rplus 
+   (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 R1)))) y) (Rplus 
+     (Rmult (Rplus R1 (Rplus R1 R1)) z) R1)
+)) R0)
+->  
+(Rge
+(Rplus
+ (Rmult (Ropp (Rplus R1 (Rplus R1 R1))) x) (Rplus 
+   (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 R1)))))) y) (Rplus 
+      R1 (Rplus R1 R1))
+)) R0)
+->  
+(Rgt
+(Rplus
+  x (Rplus 
+   (Rmult (Rplus R1 R1) y) (Ropp z) )
+) R0)
+-> 
+(Rgt
+(Rplus
+ (Rmult (Rplus R1 (Rplus R1 R1)) x) (Rplus 
+   z (Ropp R1))
+) R0)
+
+-> (Rlt z R1)
+
+// test 6x6 -> 
+
+!x:R.!y:R.!z:R.!t:R.!u:R.!v:R.
+(Rgt
+(Rplus (Ropp x) (Rplus y (Rplus z (Rplus t (Rplus u (Rplus v (Rplus R1 R1)))))))
+  R0)
+->
+(Rgt
+(Rplus x (Rplus (Ropp y) (Rplus (Ropp z) (Rplus (Ropp t) (Rplus (Ropp u) (Rplus R1 R1))))))
+  R0)
+->
+(Rgt
+(Rplus y (Rplus (Ropp z) (Rplus t (Rplus u (Rplus R1 R1)))))
+  R0)
+->
+(Rgt
+(Rplus y (Rplus z (Rplus (Ropp t) (Rplus (Ropp (Rmult (Rplus R1 R1)v)) (Rplus R1 R1)))))
+  R0)
+->
+(Rgt
+(Rplus y (Rplus z (Rplus t (Rplus (Ropp u) (Rplus R1 R1)))))
+  R0)
+->
+(Rlt
+(Rplus (Rmult (Rplus R1 R1) x) (Rplus v y))
+  R0)
+-> (Rlt (Rmult (Rplus R1 R1) x) R0)
+
+
+
+
+
+
+//test base1 ok
+!x:R.!y:R.(Rle x y) -> (Rge (Rplus y R1) (Rminus x R1))
+
+//test base2 ok
+!x:R.!y:R.(Rlt x y) -> (Rgt (Rplus y R1) (Rminus x R1))
+
+//test base3 ok
+!x:R.!y:R.(Rge x y) -> (Rlt (Rplus y R1) (Rplus x (Rplus R1 R1)))
+
+/Coq/fourier/Fourier_util/Rfourier_not_ge_lt.con
+
+intros
+
+/Coq/Init/Logic/False.ind#1/1
+
+(not (Rle (Rplus (Rmult (Rmult R1 (Rinv R1)) (Rplus x (Rplus R1 R1))) (Rmult (Rmult R1 (Rinv R1)) y)) (Rplus (Rmult (Rmult R1 (Rinv R1)) (Rplus y R1)) (Rmult (Rmult R1 (Rinv R1)) x))))
+
+/Coq/fourier/Fourier_util/Rnot_le_le.con
+
+t1=(Rplus (Rmult (Rmult R1 (Rinv R1)) (Rplus x (Rplus R1 R1))) (Rmult (Rmult R1 (Rinv R1)) y))
+
+t2=(Rplus (Rmult (Rmult R1 (Rinv R1)) (Rplus y R1)) (Rmult (Rmult R1 (Rinv R1)) x))
+
+(t1-t2)=(Rminus 
+(Rplus (Rmult (Rmult R1 (Rinv R1)) (Rplus x (Rplus R1 R1))) (Rmult (Rmult R1 (Rinv R1)) y))
+(Rplus (Rmult (Rmult R1 (Rinv R1)) (Rplus y R1)) (Rmult (Rmult R1 (Rinv R1)) x)))
+
+tc=(Rmult (Ropp R1) (Rinv R1))
+
+rewrite=(eqT R (Rminus (Rplus (Rmult (Rmult R1 (Rinv R1)) (Rplus y R1)) (Rmult (Rmult R1 (Rinv R1)) x))
+ (Rplus (Rmult (Rmult R1 (Rinv R1)) (Rplus x (Rplus R1 R1))) (Rmult (Rmult R1 (Rinv R1)) y))) (Rmult (Ropp R1) (Rinv R1)))
+
+change=(not (or 
+(Rlt R0 (Rmult (Ropp R1) (Rinv R1))) 
+(eqT R R0 (Rmult (Ropp R1) (Rinv R1))) 
+))
+
+tac2
+/Coq/fourier/Fourier_util/Rnot_lt0.con
+
+//test base4 ok
+!x:R.!y:R.(Rgt x y) -> (Rle (Rminus y R1) (Rplus x R1))
+
+//test base5 ok
+!x:R.!y:R.(Rlt x ( Rplus y R1 ) ) -> (Rge (Rplus y (Rplus R1 R1)) (Rminus x R0))
+
+//test base6 ok
+!x:R.!y:R.(eqT R x y) -> (Rgt (Rplus y R1) (Rminus x R1))
+
+//test base7 (should fail) ok
+!x:R.!y:R.(Rlt x y) -> (Rlt (Rplus y R1) (Rminus x R1))
+
+
diff --git a/helm/gTopLevel/esempi/fourier/fourier_benchmarks.cic b/helm/gTopLevel/esempi/fourier/fourier_benchmarks.cic
new file mode 100644
index 000000000..68166c149
--- /dev/null
+++ b/helm/gTopLevel/esempi/fourier/fourier_benchmarks.cic
@@ -0,0 +1,170 @@
+!x:R.!y:R.!z:R.!t:R.
+(Rle (Rplus (Rmult  R0 x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) z) (Rplus (Rmult  R1 t) (Ropp R1))))) R0)
+->
+(Rle (Rplus (Rmult  R1 x) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) y) (Rplus (Rmult  R0 z) (Rplus (Rmult (Rplus R1  R1) t) (Ropp R1))))) R0)
+->
+(Rle (Rplus (Rmult  R0 x) (Rplus (Rmult (Rplus R1  R1) y) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) t) (Ropp R1))))) R0)
+->
+(Rle (Rplus (Rmult  R1 x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) z) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) t) (Ropp R1))))) R0)
+->
+(Rle (Rplus (Rmult  R1 x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) z) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) t) (Ropp R1))))) R0)
+
+[1'02'' 363K m=5 n=4 K=8]
+
+------------------------------------------------------------------------------------------------------------
+!x:R.!y:R.!z:R.!t:R.!u:R.!v:R.
+(Rle (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) y) (Rplus (Rmult (Rplus R1  R1) z) (Rplus (Rmult (Rplus R1  R1) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) u) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) v) (Ropp R1))))))) R0)
+->
+(Rle (Rplus (Rmult  R1 x) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1  R1))) y) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) z) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) t) (Rplus (Rmult  R1 u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) v) (Ropp R1))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) x) (Rplus (Rmult  R0 y) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) t) (Rplus (Rmult (Rplus R1  R1) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) v) (Ropp R1))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) z) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) t) (Rplus (Rmult  R0 u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) v) (Ropp R1))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) x) (Rplus (Rmult  R0 y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) t) (Rplus (Rmult (Ropp (Rplus R1  R1)) u) (Rplus (Rmult  R1 v) (Ropp R1))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1  R1) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) y) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) u) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1  R1)))) v) (Ropp R1))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1  R1) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) y) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) u) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1  R1)))) v) (Ropp R1))))))) R0)
+
+[1'25'' 501K m=7 n=6 K=8]
+
+-----------------------------------------------------------------------------------------------------------
+!x:R.!y:R.!z:R.!t:R.!u:R.!v:R.!w:R.!g:R.!h:R.!j:R.
+(Rle (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) x) (Rplus (Rmult  R1 y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) z) (Rplus (Rmult  R1 t) (Rplus (Rmult (Rplus R1  R1) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) v) (Rplus (Rmult  R0 w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) g) (Rplus (Rmult  R0 h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1  R1) x) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1  R1))) y) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) t) (Rplus (Rmult  R0 u) (Rplus (Rmult  R0 v) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) g) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) h) (Rplus (Rmult (Rplus R1  R1) j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult  R1 x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) y) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) v) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) w) (Rplus (Rmult  R0 g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) z) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) t) (Rplus (Rmult  R0 u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) h) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) x) (Rplus (Rmult  R0 y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) t) (Rplus (Rmult  R0 u) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) v) (Rplus (Rmult  R1 w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) g) (Rplus (Rmult  R0 h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult  R1 x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) y) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) t) (Rplus (Rmult  R0 u) (Rplus (Rmult (Ropp  R1) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) w) (Rplus (Rmult  R0 g) (Rplus (Rmult  R1 h) (Rplus (Rmult  R1 j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) y) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) t) (Rplus (Rmult (Rplus R1  R1) u) (Rplus (Rmult (Rplus R1  R1) v) (Rplus (Rmult (Ropp (Rplus R1  R1)) w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) u) (Rplus (Rmult  R0 v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) w) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1  R1) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) z) (Rplus (Rmult  R1 t) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) u) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) w) (Rplus (Rmult (Rplus R1  R1) g) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) h) (Rplus (Rmult  R1 j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult  R0 x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) y) (Rplus (Rmult  R1 z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) v) (Rplus (Rmult  R1 w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) g) (Rplus (Rmult (Rplus R1  R1) h) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1  R1))) j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult  R0 x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) y) (Rplus (Rmult  R1 z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) v) (Rplus (Rmult  R1 w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) g) (Rplus (Rmult (Rplus R1  R1) h) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1  R1))) j) (Ropp R1))))))))))) R0)
+
+[1'50'' 787K m=11 n=10 K=8]
+
+-------------------------------------------------------------------------------------------------------
+
+!x:R.!y:R.!z:R.!t:R.!u:R.!v:R.!w:R.!g:R.!h:R.!j:R.!l:R.!m:R.!n:R.!o:R.!p:R.!q:R.!r:R.!s:R.!a:R.!b:R.
+(Rle (Rplus (Rmult (Ropp (Rplus R1  R1)) x) (Rplus (Rmult  R0 y) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) z) (Rplus (Rmult  R0 t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) w) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) g) (Rplus (Rmult  R1 h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) j) (Rplus (Rmult  R1 l) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) m) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) n) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) o) (Rplus (Rmult  R1 p) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) q) (Rplus (Rmult (Rplus R1  R1) r) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) s) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) a) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) x) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) y) (Rplus (Rmult (Rplus R1  R1) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) u) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) w) (Rplus (Rmult (Rplus R1  R1) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) h) (Rplus (Rmult (Rplus R1  R1) j) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) l) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) m) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) n) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) o) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) p) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) q) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) r) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) s) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) a) (Rplus (Rmult  R0 b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult  R1 x) (Rplus (Rmult  R1 y) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) t) (Rplus (Rmult  R1 u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) v) (Rplus (Rmult  R0 w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) g) (Rplus (Rmult  R0 h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) j) (Rplus (Rmult (Rplus R1  R1) l) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) m) (Rplus (Rmult  R1 n) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) o) (Rplus (Rmult  R1 p) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) q) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) r) (Rplus (Rmult  R0 s) (Rplus (Rmult (Rplus R1  R1) a) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) x) (Rplus (Rmult  R1 y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) z) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) t) (Rplus (Rmult (Rplus R1  R1) u) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) w) (Rplus (Rmult  R0 g) (Rplus (Rmult (Rplus R1  R1) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) j) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) l) (Rplus (Rmult (Rplus R1  R1) m) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) n) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) o) (Rplus (Rmult  R0 p) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) q) (Rplus (Rmult  R1 r) (Rplus (Rmult  R1 s) (Rplus (Rmult  R0 a) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) t) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) v) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) j) (Rplus (Rmult  R1 l) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) m) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) n) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) o) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) p) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) q) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) r) (Rplus (Rmult  R0 s) (Rplus (Rmult (Rplus R1  R1) a) (Rplus (Rmult (Rplus R1  R1) b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult  R1 x) (Rplus (Rmult (Rplus R1  R1) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) u) (Rplus (Rmult (Ropp  R1) v) (Rplus (Rmult (Rplus R1  R1) w) (Rplus (Rmult  R1 g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) h) (Rplus (Rmult  R1 j) (Rplus (Rmult (Rplus R1  R1) l) (Rplus (Rmult  R0 m) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) n) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) o) (Rplus (Rmult (Rplus R1  R1) p) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) q) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) r) (Rplus (Rmult (Rplus R1  R1) s) (Rplus (Rmult (Rplus R1  R1) a) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) y) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) z) (Rplus (Rmult  R1 t) (Rplus (Rmult  R1 u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) v) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) w) (Rplus (Rmult  R1 g) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) h) (Rplus (Rmult  R1 j) (Rplus (Rmult  R1 l) (Rplus (Rmult (Rplus R1  R1) m) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) n) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) o) (Rplus (Rmult  R1 p) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) q) (Rplus (Rmult  R0 r) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) s) (Rplus (Rmult  R0 a) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) t) (Rplus (Rmult (Rplus R1  R1) u) (Rplus (Rmult (Rplus R1  R1) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) w) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1  R1)))) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) j) (Rplus (Rmult  R0 l) (Rplus (Rmult  R1 m) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) n) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) o) (Rplus (Rmult (Rplus R1  R1) p) (Rplus (Rmult (Rplus R1  R1) q) (Rplus (Rmult  R0 r) (Rplus (Rmult  R1 s) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) a) (Rplus (Rmult  R1 b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1  R1) x) (Rplus (Rmult (Rplus R1  R1) y) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) u) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) v) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) g) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1  R1)))) h) (Rplus (Rmult  R1 j) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) l) (Rplus (Rmult  R1 m) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) n) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) o) (Rplus (Rmult  R0 p) (Rplus (Rmult  R0 q) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) r) (Rplus (Rmult  R0 s) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) a) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) y) (Rplus (Rmult (Rplus R1  R1) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) u) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) w) (Rplus (Rmult (Rplus R1  R1) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) h) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) j) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) l) (Rplus (Rmult  R1 m) (Rplus (Rmult  R0 n) (Rplus (Rmult (Rplus R1  R1) o) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) p) (Rplus (Rmult (Rplus R1  R1) q) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) r) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) s) (Rplus (Rmult  R0 a) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) x) (Rplus (Rmult  R0 y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) z) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) u) (Rplus (Rmult  R0 v) (Rplus (Rmult  R1 w) (Rplus (Rmult  R0 g) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) j) (Rplus (Rmult  R0 l) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) m) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) n) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) o) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) p) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) q) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) r) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) s) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) a) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult  R1 x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) t) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) v) (Rplus (Rmult (Rplus R1  R1) w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) h) (Rplus (Rmult  R0 j) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) l) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) m) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) n) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) o) (Rplus (Rmult  R0 p) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) q) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) r) (Rplus (Rmult (Rplus R1  R1) s) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) a) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) x) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) z) (Rplus (Rmult (Rplus R1  R1) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) u) (Rplus (Rmult (Rplus R1  R1) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) w) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) j) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) l) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) m) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) n) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) o) (Rplus (Rmult  R0 p) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) q) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) r) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) s) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) a) (Rplus (Rmult  R1 b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) z) (Rplus (Rmult (Rplus R1  R1) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) v) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) w) (Rplus (Rmult  R0 g) (Rplus (Rmult  R1 h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) j) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) l) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) m) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) n) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1  R1)))) o) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) p) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) q) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) r) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) s) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) a) (Rplus (Rmult  R1 b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult  R1 x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) y) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) z) (Rplus (Rmult (Rplus R1  R1) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) j) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) l) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) m) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) n) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) o) (Rplus (Rmult (Ropp  R1) p) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) q) (Rplus (Rmult (Rplus R1  R1) r) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) s) (Rplus (Rmult  R1 a) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) u) (Rplus (Rmult  R0 v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) g) (Rplus (Rmult (Rplus R1  R1) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) j) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) l) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) m) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) n) (Rplus (Rmult  R0 o) (Rplus (Rmult (Rplus R1  R1) p) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1  R1)))) q) (Rplus (Rmult  R1 r) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) s) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) a) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) x) (Rplus (Rmult  R1 y) (Rplus (Rmult (Rplus R1  R1) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) t) (Rplus (Rmult  R0 u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) w) (Rplus (Rmult  R0 g) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) j) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) l) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) m) (Rplus (Rmult  R0 n) (Rplus (Rmult (Rplus R1  R1) o) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) p) (Rplus (Rmult  R0 q) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) r) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) s) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) a) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult  R1 x) (Rplus (Rmult  R0 y) (Rplus (Rmult (Rplus R1  R1) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) u) (Rplus (Rmult  R1 v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) j) (Rplus (Rmult  R1 l) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) m) (Rplus (Rmult  R0 n) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) o) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) p) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) q) (Rplus (Rmult  R0 r) (Rplus (Rmult (Ropp  R1) s) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) a) (Rplus (Rmult  R1 b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) x) (Rplus (Rmult  R1 y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) z) (Rplus (Rmult (Rplus R1  R1) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) u) (Rplus (Rmult (Rplus R1  R1) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) w) (Rplus (Rmult  R0 g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) j) (Rplus (Rmult (Rplus R1  R1) l) (Rplus (Rmult (Rplus R1  R1) m) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) n) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) o) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) p) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) q) (Rplus (Rmult (Rplus R1  R1) r) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) s) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) a) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1  R1) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) z) (Rplus (Rmult (Rplus R1  R1) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) u) (Rplus (Rmult  R0 v) (Rplus (Rmult  R0 w) (Rplus (Rmult  R0 g) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) h) (Rplus (Rmult (Rplus R1  R1) j) (Rplus (Rmult  R0 l) (Rplus (Rmult  R1 m) (Rplus (Rmult  R0 n) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) o) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) p) (Rplus (Rmult  R0 q) (Rplus (Rmult (Rplus R1  R1) r) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) s) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) a) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) b) (Ropp R1))))))))))))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1  R1) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) z) (Rplus (Rmult (Rplus R1  R1) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) u) (Rplus (Rmult  R0 v) (Rplus (Rmult  R0 w) (Rplus (Rmult  R0 g) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) h) (Rplus (Rmult (Rplus R1  R1) j) (Rplus (Rmult  R0 l) (Rplus (Rmult  R1 m) (Rplus (Rmult  R0 n) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) o) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) p) (Rplus (Rmult  R0 q) (Rplus (Rmult (Rplus R1  R1) r) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) s) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) a) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) b) (Ropp R1))))))))))))))))))))) R0)
+
+
+[19'30'' 1.9M m=21 n=20 K=8 ty=13'35'']
+
+--------------------------------------------------------------------------------------------------------
+
+!x:R.!y:R.!z:R.!t:R.!u:R.!v:R.!w:R.!g:R.!h:R.!j:R.
+(Rle (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))))))) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))) w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) x) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))))))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) v) (Rplus (Rmult  R0 w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))) j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult  R1 x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))) y) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))))))) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))) w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))) h) (Rplus (Rmult (Rplus R1  R1) j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))))))) z) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) u) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) g) (Rplus (Rmult  R0 h) (Rplus (Rmult  R1 j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) y) (Rplus (Rmult  R0 z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))))))) t) (Rplus (Rmult (Ropp (Rplus R1  R1)) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))))))) w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))))) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))))) y) (Rplus (Rmult  R0 z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) u) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))))))) w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))))) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))))) h) (Rplus (Rmult  R0 j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult  R1 x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))) v) (Rplus (Rmult (Ropp  R1) w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))))) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))) v) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) w) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))) j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) u) (Rplus (Rmult (Rplus R1  R1) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))) w) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) g) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))))) h) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))) j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) y) (Rplus (Rmult  R1 z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))))) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) h) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))))))) j) (Ropp R1))))))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) y) (Rplus (Rmult  R1 z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))))) v) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) w) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) g) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) h) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))))))) j) (Ropp R1))))))))))) R0)
+
+[ K m=11 n=10 K=18 ty=] (TRASH)
+
+
+----------------------------------------------
+
+!x:R.!y:R.!z:R.!t:R.!u:R.!v:R.
+(Rle (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) t) (Rplus (Rmult (Rplus R1  R1) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) v) (Ropp R1))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) x) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) y) (Rplus (Rmult  R0 z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1  R1))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))) u) (Rplus (Rmult  R0 v) (Ropp R1))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1  R1) x) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) y) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) v) (Ropp R1))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))) x) (Rplus (Rmult  R0 y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))) z) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) u) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) v) (Ropp R1))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1  R1) x) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) t) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))) u) (Rplus (Rmult (Rplus R1 (Rplus R1  R1)) v) (Ropp R1))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))))) x) (Rplus (Rmult  R1 y) (Rplus (Rmult  R1 z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) u) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) v) (Ropp R1))))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))))) x) (Rplus (Rmult  R1 y) (Rplus (Rmult  R1 z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))) t) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) u) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))) v) (Ropp R1))))))) R0)
+
+[4'  658K m=7 n=6 K=13 ty=50'']
+
+----------------------------------------------------------------
+
+!x:R.!y:R.!z:R.!t:R.
+(Rle (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))))) t) (Ropp R1))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))) x) (Rplus (Rmult (Ropp (Rplus R1  R1)) y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))) z) (Rplus (Rmult (Rplus R1  R1) t) (Ropp R1))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1  R1) x) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))) y) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))))) z) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))))))))) t) (Ropp R1))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1  R1) x) (Rplus (Rmult  R1 y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) z) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))) t) (Ropp R1))))) R0)
+->
+(Rle (Rplus (Rmult (Rplus R1  R1) x) (Rplus (Rmult  R1 y) (Rplus (Rmult (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1)))) z) (Rplus (Rmult (Ropp (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1 (Rplus R1  R1))))))))))) t) (Ropp R1))))) R0)
+
+[3':20''  658K m=5 n=4 K=13 ty=41'']
+
+
+
+
diff --git a/helm/gTopLevel/esempi/fourier/fourier_make_benchmarks.ml b/helm/gTopLevel/esempi/fourier/fourier_make_benchmarks.ml
new file mode 100644
index 000000000..d783089a2
--- /dev/null
+++ b/helm/gTopLevel/esempi/fourier/fourier_make_benchmarks.ml
@@ -0,0 +1,61 @@
+let rec int_to_cic n =
+   if n < 0 then 
+     "(Ropp "^int_to_cic (-n)^")"
+   else
+      match n with
+      0 -> " R0"
+      |1 -> " R1"
+      |k -> "(Rplus R1 " ^ int_to_cic (n-1) ^")"
+;;
+
+let dimx = ref 3;;
+let dimy = ref 3;;
+let kmax = ref 5;;
+let vl = [|"x";"y";"z";"t";"u";"v";"w";"g";"h";"j";"l";"m";"n";"o";"p";"q";"r";"s";"a";"b";"c";"d"|]
+;;
+
+let nth_inc n =
+  vl.(n)
+;;
+
+let preamble () = 
+  for i = 0 to !dimx do
+   print_string ("!"^nth_inc i^":R.");
+  done;
+  print_string "\n";
+;;
+
+let main () =
+  print_string "Immetti m : ";dimy := (read_int ()) - 1;
+  print_string "Immetti n : ";dimx := (read_int ()) - 1;
+  print_string "Immetti K : ";kmax := (read_int ()) + 1;
+  print_string ("Genero un sistema di "^
+   string_of_int (!dimy+1)^" disequazioni in "^
+   string_of_int (!dimx+1)^" incognite con coefficenti "^string_of_int !kmax^"\n\n");
+  Random.self_init ();
+  preamble ();
+  let max = ref 0 in
+  for i=0 to !dimy do
+     begin
+     print_string "(Rle ";
+     for o=0 to !dimx do
+       let k = ref ((Random.int !kmax)) in 
+       if !k > !max then max := !k;
+       if i=o then 
+         k := - !k
+       else
+     	 k := !k;
+       print_string ("(Rplus (Rmult "^int_to_cic !k^" "^nth_inc o^") ");
+     done;
+     print_string "(Ropp R1)";
+     for o=0 to !dimx  do
+       print_string (")");
+     done;
+     print_string (" R0)\n->\n");
+     end
+  done;
+  print_string ("\n\nIl massimo K e' "^string_of_int !max^".\nLa tesi la puoi scegliere tu, ma se ricopi una ipotesi vai tranquillo.\n");
+;;
+
+
+main ();;
diff --git a/helm/gTopLevel/esempi/prova.cic b/helm/gTopLevel/esempi/prova.cic
index 6ca06a862..3f65458d2 100644
--- a/helm/gTopLevel/esempi/prova.cic
+++ b/helm/gTopLevel/esempi/prova.cic
@@ -1,4 +1,4 @@
-alias eq   /Coq/Init/Logic/Equality/eq.ind#1/1
+alias eq   /Coq/Init/Logic/eq.ind#1/1
 alias nat  /Coq/Init/Datatypes/nat.ind#1/1
 alias O    /Coq/Init/Datatypes/nat.ind#1/1/1
 alias S    /Coq/Init/Datatypes/nat.ind#1/1/2
diff --git a/helm/gTopLevel/esempi/sets.cic b/helm/gTopLevel/esempi/sets.cic
index 156e231a2..5bd913e72 100644
--- a/helm/gTopLevel/esempi/sets.cic
+++ b/helm/gTopLevel/esempi/sets.cic
@@ -1,15 +1,17 @@
 Open:
-/Coq/Sets/Powerset_facts/Sets_as_an_algebra/Union_commutative.con
+/Coq/Sets/Powerset_facts/Union_commutative.con
 
 We prove the conjunction again:
 
-alias Ensemble /Coq/Sets/Ensembles/Ensembles/Ensemble.con
-alias Union    /Coq/Sets/Ensembles/Ensembles/Union.ind#1/1
-alias Included /Coq/Sets/Ensembles/Ensembles/Included.con
-alias and      /Coq/Init/Logic/Conjunction/and.ind#1/1
+alias U /Coq/Sets/Ensembles/Ensembles/U.var
+alias V /Coq/Sets/Powerset_facts/Sets_as_an_algebra/U.var
+alias Ensemble /Coq/Sets/Ensembles/Ensemble.con
+alias Union    /Coq/Sets/Ensembles/Union.ind#1/1
+alias Included /Coq/Sets/Ensembles/Included.con
+alias and      /Coq/Init/Logic/and.ind#1/1
 
 The two parts of the conjunction can be proved in the same way. So we
 can make a Cut:
 
-!V:Set.!C:(Ensemble V).!D:(Ensemble V).(Included V (Union V C D)
-(Union V D C))
+!C:Ensemble{U:=V}.!D:Ensemble{U:=V}.
+ (Included{U:=V} (Union{U:=V} C D) (Union{U:=V} D C))
diff --git a/helm/gTopLevel/esempi/various.cic b/helm/gTopLevel/esempi/various.cic
new file mode 100644
index 000000000..11141d4ab
--- /dev/null
+++ b/helm/gTopLevel/esempi/various.cic
@@ -0,0 +1,7 @@
+
+!n:nat.(eq nat n n)
+
+!n:nat.!m:nat.(eq nat n m)->(eq nat m n)
+
+!n:nat.!m:nat.!p:nat.(eq nat n p)->(eq nat p m)->(eq nat n m)
+
diff --git a/helm/gTopLevel/gTopLevel.ml b/helm/gTopLevel/gTopLevel.ml
index 83d959ca3..e3f498931 100644
--- a/helm/gTopLevel/gTopLevel.ml
+++ b/helm/gTopLevel/gTopLevel.ml
@@ -33,21 +33,20 @@
 (*                                                                            *)
 (******************************************************************************)
 
+open Printf;;
 
-(* CSC: quick fix: a function from [uri#xpointer(path)] to [uri#path] *)
-let wrong_xpointer_format_from_wrong_xpointer_format' uri =
- try
-  let index_sharp =  String.index uri '#' in
-  let index_rest = index_sharp + 10 in
-   let baseuri = String.sub uri 0 index_sharp in
-   let rest = String.sub uri index_rest (String.length uri - index_rest - 1) in
-    baseuri ^ "#" ^ rest
- with Not_found -> uri
-;;
+(* DEBUGGING *)
+
+module MQI  = MQueryInterpreter
+module MQIC = MQIConn
+module MQG  = MQueryGenerator
 
 (* GLOBAL CONSTANTS *)
 
-let helmns = Gdome.domString "http://www.cs.unibo.it/helm";;
+let mqi_flags = [] (* default MathQL interpreter options *)
+let mqi_handle = MQIC.init mqi_flags prerr_string
+
+let xlinkns = Gdome.domString "http://www.w3.org/1999/xlink";;
 
 let htmlheader =
  "" ^
@@ -59,23 +58,71 @@ let htmlfooter =
  ""
 ;;
 
-(*
-let prooffile = "/home/tassi/miohelm/tmp/currentproof";;
-*)
-let prooffile = "/public/sacerdot/currentproof";;
-(*CSC: the getter should handle the innertypes, not the FS *)
-(*
-let innertypesfile = "/home/tassi/miohelm/tmp/innertypes";;
-*)
-let innertypesfile = "/public/sacerdot/innertypes";;
+let prooffile =
+ try
+  Sys.getenv "GTOPLEVEL_PROOFFILE"
+ with
+  Not_found -> "/public/currentproof"
+;;
+
+let prooffiletype =
+ try
+  Sys.getenv "GTOPLEVEL_PROOFFILETYPE"
+ with
+  Not_found -> "/public/currentprooftype"
+;;
 
 (* GLOBAL REFERENCES (USED BY CALLBACKS) *)
 
 let htmlheader_and_content = ref htmlheader;;
 
-let current_cic_infos = ref None;;
-let current_goal_infos = ref None;;
-let current_scratch_infos = ref None;;
+let check_term = ref (fun _ _ _ -> assert false);;
+
+exception RenderingWindowsNotInitialized;;
+
+let set_rendering_window,rendering_window =
+ let rendering_window_ref = ref None in
+  (function rw -> rendering_window_ref := Some rw),
+  (function () ->
+    match !rendering_window_ref with
+       None -> raise RenderingWindowsNotInitialized
+     | Some rw -> rw
+  )
+;;
+
+exception SettingsWindowsNotInitialized;;
+
+let set_settings_window,settings_window =
+ let settings_window_ref = ref None in
+  (function rw -> settings_window_ref := Some rw),
+  (function () ->
+    match !settings_window_ref with
+       None -> raise SettingsWindowsNotInitialized
+     | Some rw -> rw
+  )
+;;
+
+exception OutputHtmlNotInitialized;;
+
+let set_outputhtml,outputhtml =
+ let outputhtml_ref = ref None in
+  (function rw -> outputhtml_ref := Some rw),
+  (function () ->
+    match !outputhtml_ref with
+       None -> raise OutputHtmlNotInitialized
+     | Some outputhtml -> outputhtml
+  )
+;;
+
+exception QedSetSensitiveNotInitialized;;
+let qed_set_sensitive =
+ ref (function _ -> raise QedSetSensitiveNotInitialized)
+;;
+
+exception SaveSetSensitiveNotInitialized;;
+let save_set_sensitive =
+ ref (function _ -> raise SaveSetSensitiveNotInitialized)
+;;
 
 (* COMMAND LINE OPTIONS *)
 
@@ -88,165 +135,492 @@ let argspec =
 in
 Arg.parse argspec ignore ""
 
-
 (* MISC FUNCTIONS *)
 
-let domImpl = Gdome.domImplementation ();;
+let term_of_cic_textual_parser_uri uri =
+ let module C = Cic in
+ let module CTP = CicTextualParser0 in
+  match uri with
+     CTP.ConUri uri -> C.Const (uri,[])
+   | CTP.VarUri uri -> C.Var (uri,[])
+   | CTP.IndTyUri (uri,tyno) -> C.MutInd (uri,tyno,[])
+   | CTP.IndConUri (uri,tyno,consno) -> C.MutConstruct (uri,tyno,consno,[])
+;;
 
-let parseStyle name =
- let style =
-  domImpl#createDocumentFromURI
-(*
-   ~uri:("http://phd.cs.unibo.it:8081/getxslt?uri=" ^ name) ?mode:None
-*)
-   ~uri:("styles/" ^ name) ()
+let string_of_cic_textual_parser_uri uri =
+ let module C = Cic in
+ let module CTP = CicTextualParser0 in
+  let uri' =
+   match uri with
+      CTP.ConUri uri -> UriManager.string_of_uri uri
+    | CTP.VarUri uri -> UriManager.string_of_uri uri
+    | CTP.IndTyUri (uri,tyno) ->
+       UriManager.string_of_uri uri ^ "#1/" ^ string_of_int (tyno + 1)
+    | CTP.IndConUri (uri,tyno,consno) ->
+       UriManager.string_of_uri uri ^ "#1/" ^ string_of_int (tyno + 1) ^ "/" ^
+        string_of_int consno
+  in
+   (* 4 = String.length "cic:" *)
+   String.sub uri' 4 (String.length uri' - 4)
+;;
+
+let output_html outputhtml msg =
+ htmlheader_and_content := !htmlheader_and_content ^ msg ;
+ outputhtml#source (!htmlheader_and_content ^ htmlfooter) ;
+ outputhtml#set_topline (-1)
+;;
+
+(* UTILITY FUNCTIONS TO DISAMBIGUATE AN URI *)
+
+(* Check window *)
+
+let check_window outputhtml uris =
+ let window =
+  GWindow.window
+   ~width:800 ~modal:true ~title:"Check" ~border_width:2 () in
+ let notebook =
+  GPack.notebook ~scrollable:true ~packing:window#add () in
+ window#show () ;
+ let render_terms =
+  List.map
+   (function uri ->
+     let scrolled_window =
+      GBin.scrolled_window ~border_width:10
+       ~packing:
+         (notebook#append_page ~tab_label:((GMisc.label ~text:uri ())#coerce))
+       ()
+     in
+      lazy 
+       (let mmlwidget =
+         TermViewer.sequent_viewer
+          ~packing:scrolled_window#add ~width:400 ~height:280 () in
+        let expr =
+         let term =
+          term_of_cic_textual_parser_uri
+           (MQueryMisc.cic_textual_parser_uri_of_string uri)
+         in
+          (Cic.Cast (term, CicTypeChecker.type_of_aux' [] [] term))
+        in
+         try
+          mmlwidget#load_sequent [] (111,[],expr)
+         with
+          e ->
+           output_html outputhtml
+            ("
" ^ Printexc.to_string e ^ "
")
+       )
+   ) uris
  in
-  Gdome_xslt.processStylesheet style
+  ignore
+   (notebook#connect#switch_page
+     (function i -> Lazy.force (List.nth render_terms i)))
 ;;
 
-let d_c = parseStyle "drop_coercions.xsl";;
-let tc1 = parseStyle "objtheorycontent.xsl";;
-let hc2 = parseStyle "content_to_html.xsl";;
-let l   = parseStyle "link.xsl";;
-
-let c1 = parseStyle "rootcontent.xsl";;
-let g  = parseStyle "genmmlid.xsl";;
-let c2 = parseStyle "annotatedpres.xsl";;
-
-
-let getterURL = Configuration.getter_url;;
-let processorURL = Configuration.processor_url;;
-
-let mml_styles = [d_c ; c1 ; g ; c2 ; l];;
-let mml_args =
- ["processorURL", "'" ^ processorURL ^ "'" ;
-  "getterURL", "'" ^ getterURL ^ "'" ;
-  "draw_graphURL", "'http%3A//phd.cs.unibo.it%3A8083/'" ;
-  "uri_set_queueURL", "'http%3A//phd.cs.unibo.it%3A8084/'" ;
-  "UNICODEvsSYMBOL", "'symbol'" ;
-  "doctype-public", "'-//W3C//DTD%20XHTML%201.0%20Transitional//EN'" ;
-  "encoding", "'iso-8859-1'" ;
-  "media-type", "'text/html'" ;
-  "keys", "'d_c%2CC1%2CG%2CC2%2CL'" ;
-  "interfaceURL", "'http%3A//phd.cs.unibo.it/helm/html/cic/index.html'" ;
-  "naturalLanguage", "'yes'" ;
-  "annotations", "'no'" ;
-  "explodeall", "'true()'" ;
-  "topurl", "'http://phd.cs.unibo.it/helm'" ;
-  "CICURI", "'cic:/Coq/Init/Datatypes/bool_ind.con'" ]
+exception NoChoice;;
+
+let
+ interactive_user_uri_choice ~(selection_mode:[`SINGLE|`EXTENDED]) ?(ok="Ok")
+  ?(enable_button_for_non_vars=false) ~title ~msg uris
+=
+ let choices = ref [] in
+ let chosen = ref false in
+ let use_only_constants = ref false in
+ let window =
+  GWindow.dialog ~modal:true ~title ~width:600 () in
+ let lMessage =
+  GMisc.label ~text:msg
+   ~packing:(window#vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let scrolled_window =
+  GBin.scrolled_window ~border_width:10
+   ~packing:(window#vbox#pack ~expand:true ~fill:true ~padding:5) () in
+ let clist =
+  let expected_height = 18 * List.length uris in
+   let height = if expected_height > 400 then 400 else expected_height in
+    GList.clist ~columns:1 ~packing:scrolled_window#add
+     ~height ~selection_mode:(selection_mode :> Gtk.Tags.selection_mode) () in
+ let _ = List.map (function x -> clist#append [x]) uris in
+ let hbox2 =
+  GPack.hbox ~border_width:0
+   ~packing:(window#vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let explain_label =
+  GMisc.label ~text:"None of the above. Try this one:"
+   ~packing:(hbox2#pack ~expand:false ~fill:false ~padding:5) () in
+ let manual_input =
+  GEdit.entry ~editable:true
+   ~packing:(hbox2#pack ~expand:true ~fill:true ~padding:5) () in
+ let hbox =
+  GPack.hbox ~border_width:0 ~packing:window#action_area#add () in
+ let okb =
+  GButton.button ~label:ok
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let _ = okb#misc#set_sensitive false in
+ let nonvarsb =
+  GButton.button
+   ~packing:
+    (function w ->
+      if enable_button_for_non_vars then
+       hbox#pack ~expand:false ~fill:false ~padding:5 w)
+   ~label:"Try constants only" () in
+ let checkb =
+  GButton.button ~label:"Check"
+   ~packing:(hbox#pack ~padding:5) () in
+ let _ = checkb#misc#set_sensitive false in
+ let cancelb =
+  GButton.button ~label:"Abort"
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ (* actions *)
+ let check_callback () =
+  assert (List.length !choices > 0) ;
+  check_window (outputhtml ()) !choices
+ in
+  ignore (window#connect#destroy GMain.Main.quit) ;
+  ignore (cancelb#connect#clicked window#destroy) ;
+  ignore
+   (okb#connect#clicked (function () -> chosen := true ; window#destroy ())) ;
+  ignore
+   (nonvarsb#connect#clicked
+     (function () ->
+       use_only_constants := true ;
+       chosen := true ;
+       window#destroy ()
+   )) ;
+  ignore (checkb#connect#clicked check_callback) ;
+  ignore
+   (clist#connect#select_row
+     (fun ~row ~column ~event ->
+       checkb#misc#set_sensitive true ;
+       okb#misc#set_sensitive true ;
+       choices := (List.nth uris row)::!choices)) ;
+  ignore
+   (clist#connect#unselect_row
+     (fun ~row ~column ~event ->
+       choices :=
+        List.filter (function uri -> uri != (List.nth uris row)) !choices)) ;
+  ignore
+   (manual_input#connect#changed
+     (fun _ ->
+       if manual_input#text = "" then
+        begin
+         choices := [] ;
+         checkb#misc#set_sensitive false ;
+         okb#misc#set_sensitive false ;
+         clist#misc#set_sensitive true
+        end
+       else
+        begin
+         choices := [manual_input#text] ;
+         clist#unselect_all () ;
+         checkb#misc#set_sensitive true ;
+         okb#misc#set_sensitive true ;
+         clist#misc#set_sensitive false
+        end));
+  window#set_position `CENTER ;
+  window#show () ;
+  GtkThread.main ();
+  if !chosen then
+   if !use_only_constants then
+    List.filter
+     (function uri -> not (String.sub uri (String.length uri - 4) 4 = ".var"))
+     uris
+   else
+    if List.length !choices > 0 then !choices else raise NoChoice
+  else
+   raise NoChoice
 ;;
 
-let sequent_styles = [d_c ; c1 ; g ; c2 ; l];;
-let sequent_args =
- ["processorURL", "'" ^ processorURL ^ "'" ;
-  "getterURL", "'" ^ getterURL ^ "'" ;
-  "draw_graphURL", "'http%3A//phd.cs.unibo.it%3A8083/'" ;
-  "uri_set_queueURL", "'http%3A//phd.cs.unibo.it%3A8084/'" ;
-  "UNICODEvsSYMBOL", "'symbol'" ;
-  "doctype-public", "'-//W3C//DTD%20XHTML%201.0%20Transitional//EN'" ;
-  "encoding", "'iso-8859-1'" ;
-  "media-type", "'text/html'" ;
-  "keys", "'d_c%2CC1%2CG%2CC2%2CL'" ;
-  "interfaceURL", "'http%3A//phd.cs.unibo.it/helm/html/cic/index.html'" ;
-  "naturalLanguage", "'no'" ;
-  "annotations", "'no'" ;
-  "explodeall", "'true()'" ;
-  "topurl", "'http://phd.cs.unibo.it/helm'" ;
-  "CICURI", "'cic:/Coq/Init/Datatypes/bool_ind.con'" ]
+let interactive_interpretation_choice interpretations =
+ let chosen = ref None in
+ let window =
+  GWindow.window
+   ~modal:true ~title:"Ambiguous well-typed input." ~border_width:2 () in
+ let vbox = GPack.vbox ~packing:window#add () in
+ let lMessage =
+  GMisc.label
+   ~text:
+    ("Ambiguous input since there are many well-typed interpretations." ^
+     " Please, choose one of them.")
+   ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let notebook =
+  GPack.notebook ~scrollable:true
+   ~packing:(vbox#pack ~expand:true ~fill:true ~padding:5) () in
+ let _ =
+  List.map
+   (function interpretation ->
+     let clist =
+      let expected_height = 18 * List.length interpretation in
+       let height = if expected_height > 400 then 400 else expected_height in
+        GList.clist ~columns:2 ~packing:notebook#append_page ~height
+         ~titles:["id" ; "URI"] ()
+     in
+      ignore
+       (List.map
+         (function (id,uri) ->
+           let n = clist#append [id;uri] in
+            clist#set_row ~selectable:false n
+         ) interpretation
+       ) ;
+      clist#columns_autosize ()
+   ) interpretations in
+ let hbox =
+  GPack.hbox ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let okb =
+  GButton.button ~label:"Ok"
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let cancelb =
+  GButton.button ~label:"Abort"
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ (* actions *)
+ ignore (window#connect#destroy GMain.Main.quit) ;
+ ignore (cancelb#connect#clicked window#destroy) ;
+ ignore
+  (okb#connect#clicked
+    (function () -> chosen := Some notebook#current_page ; window#destroy ())) ;
+ window#set_position `CENTER ;
+ window#show () ;
+ GtkThread.main ();
+ match !chosen with
+    None -> raise NoChoice
+  | Some n -> n
 ;;
 
-let parse_file filename =
- let inch = open_in filename in
-  let rec read_lines () =
-   try
-    let line = input_line inch in
-     line ^ read_lines ()
-   with
-    End_of_file -> ""
+
+(* MISC FUNCTIONS *)
+
+let
+ save_object_to_disk uri annobj ids_to_inner_sorts ids_to_inner_types pathname
+=
+ let name =
+  let struri = UriManager.string_of_uri uri in
+  let idx = (String.rindex struri '/') + 1 in
+   String.sub struri idx (String.length struri - idx)
+ in
+  let path = pathname ^ "/" ^ name in
+  let xml, bodyxml =
+   Cic2Xml.print_object uri ~ids_to_inner_sorts ~ask_dtd_to_the_getter:false
+    annobj 
   in
-   read_lines ()
+  let xmlinnertypes =
+   Cic2Xml.print_inner_types uri ~ids_to_inner_sorts ~ids_to_inner_types
+    ~ask_dtd_to_the_getter:false
+  in
+   (* innertypes *)
+   let innertypesuri = UriManager.innertypesuri_of_uri uri in
+    Xml.pp ~quiet:true xmlinnertypes (Some (path ^ ".types.xml")) ;
+    Getter.register innertypesuri
+     (Configuration.annotations_url ^
+       Str.replace_first (Str.regexp "^cic:") ""
+        (UriManager.string_of_uri innertypesuri) ^ ".xml"
+     ) ;
+    (* constant type / variable / mutual inductive types definition *)
+    Xml.pp ~quiet:true xml (Some (path ^ ".xml")) ;
+    Getter.register uri
+     (Configuration.annotations_url ^
+       Str.replace_first (Str.regexp "^cic:") ""
+        (UriManager.string_of_uri uri) ^ ".xml"
+     ) ;
+    match bodyxml with
+       None -> ()
+     | Some bodyxml' ->
+        (* constant body *)
+        let bodyuri =
+         match UriManager.bodyuri_of_uri uri with
+            None -> assert false
+          | Some bodyuri -> bodyuri
+        in
+         Xml.pp ~quiet:true bodyxml' (Some (path ^ ".body.xml")) ;
+         Getter.register bodyuri
+          (Configuration.annotations_url ^
+            Str.replace_first (Str.regexp "^cic:") ""
+             (UriManager.string_of_uri bodyuri) ^ ".xml"
+          )
+;;
+
+
+(* CALLBACKS *)
+
+exception OpenConjecturesStillThere;;
+exception WrongProof;;
+
+let pathname_of_annuri uristring =
+ Configuration.annotations_dir ^    
+  Str.replace_first (Str.regexp "^cic:") "" uristring
 ;;
 
-let applyStylesheets input styles args =
- List.fold_left (fun i style -> Gdome_xslt.applyStylesheet i style args)
-  input styles
+let make_dirs dirpath =
+ ignore (Unix.system ("mkdir -p " ^ dirpath))
 ;;
 
-let mml_of_cic_object uri annobj ids_to_inner_sorts ids_to_inner_types =
- let xml =
-  Cic2Xml.print_object uri ~ids_to_inner_sorts annobj 
+let save_obj uri obj =
+ let
+  (acic,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 xmlinnertypes =
-  Cic2Xml.print_inner_types uri ~ids_to_inner_sorts
-   ~ids_to_inner_types
- in
-  let input = Xml2Gdome.document_of_xml domImpl xml in
-(*CSC: We save the innertypes to disk so that we can retrieve them in the  *)
-(*CSC: stylesheet. This DOES NOT work when UWOBO and/or the getter are not *)
-(*CSC: local.                                                              *)
-   Xml.pp xmlinnertypes (Some innertypesfile) ;
-   let output = applyStylesheets input mml_styles mml_args in
-    output
+  (* let's save the theorem and register it to the getter *) 
+  let pathname = pathname_of_annuri (UriManager.buri_of_uri uri) in
+   make_dirs pathname ;
+   save_object_to_disk uri acic ids_to_inner_sorts ids_to_inner_types
+    pathname
+;;
+
+let qed () =
+ match !ProofEngine.proof with
+    None -> assert false
+  | Some (uri,[],bo,ty) ->
+     if
+      CicReduction.are_convertible []
+       (CicTypeChecker.type_of_aux' [] [] bo) ty
+     then
+      begin
+       (*CSC: Wrong: [] is just plainly wrong *)
+       let proof = Cic.Constant (UriManager.name_of_uri uri,Some bo,ty,[]) in
+       let (acic,ids_to_inner_types,ids_to_inner_sorts) =
+        (rendering_window ())#output#load_proof uri proof
+       in
+        !qed_set_sensitive false ;
+        (* let's save the theorem and register it to the getter *) 
+        let pathname = pathname_of_annuri (UriManager.buri_of_uri uri) in
+         make_dirs pathname ;
+         save_object_to_disk uri acic ids_to_inner_sorts ids_to_inner_types
+          pathname
+      end
+     else
+      raise WrongProof
+  | _ -> raise OpenConjecturesStillThere
 ;;
 
+  (** save an unfinished proof on the filesystem *)
+let save_unfinished_proof () =
+ let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
+ let (xml, bodyxml) = ProofEngine.get_current_status_as_xml () in
+ Xml.pp ~quiet:true xml (Some prooffiletype) ;
+ output_html outputhtml
+  ("
Current proof type saved to " ^
+   prooffiletype ^ "
") ;
+ Xml.pp ~quiet:true bodyxml (Some prooffile) ;
+ output_html outputhtml
+  ("
Current proof body saved to " ^
+   prooffile ^ "
")
+;;
 
-(* CALLBACKS *)
+(* Used to typecheck the loaded proofs *)
+let typecheck_loaded_proof metasenv bo ty =
+ let module T = CicTypeChecker in
+  ignore (
+   List.fold_left
+    (fun metasenv ((_,context,ty) as conj) ->
+      ignore (T.type_of_aux' metasenv context ty) ;
+      metasenv @ [conj]
+    ) [] metasenv) ;
+  ignore (T.type_of_aux' metasenv [] ty) ;
+  ignore (T.type_of_aux' metasenv [] bo)
+;;
 
-exception RefreshSequentException of exn;;
-exception RefreshProofException of exn;;
+let decompose_uris_choice_callback uris = 
+(* N.B.: in questo passaggio perdo l'informazione su exp_named_subst !!!! *)
+  let module U = UriManager in 
+   List.map 
+    (function uri ->
+      match MQueryMisc.cic_textual_parser_uri_of_string uri with
+         CicTextualParser0.IndTyUri (uri,typeno) -> (uri,typeno,[])
+       | _ -> assert false)
+    (interactive_user_uri_choice 
+      ~selection_mode:`EXTENDED ~ok:"Ok" ~enable_button_for_non_vars:false 
+      ~title:"Decompose" ~msg:"Please, select the Inductive Types to decompose" 
+      (List.map 
+        (function (uri,typeno,_) ->
+          U.string_of_uri uri ^ "#1/" ^ string_of_int (typeno+1)
+        ) uris)
+    ) 
+;;
 
-let refresh_proof (output : GMathView.math_view) =
+let mk_fresh_name_callback context name ~typ =
+ let fresh_name =
+  match ProofEngineHelpers.mk_fresh_name context name ~typ with
+     Cic.Name fresh_name -> fresh_name
+   | Cic.Anonymous -> assert false
+ in
+  match
+   GToolbox.input_string ~title:"Enter a fresh hypothesis name" ~text:fresh_name
+    ("Enter a fresh name for the hypothesis " ^
+      CicPp.pp typ
+       (List.map (function None -> None | Some (n,_) -> Some n) context))
+  with
+     Some fresh_name' -> Cic.Name fresh_name'
+   | None -> raise NoChoice
+;;
+
+let refresh_proof (output : TermViewer.proof_viewer) =
  try
   let uri,currentproof =
    match !ProofEngine.proof with
       None -> assert false
     | Some (uri,metasenv,bo,ty) ->
-       uri,(Cic.CurrentProof (UriManager.name_of_uri uri, metasenv, bo, ty))
+       if List.length metasenv = 0 then
+        begin
+         !qed_set_sensitive true ;
+prerr_endline "CSC: ###### REFRESH_PROOF, Hbugs.clear ()" ;
+         Hbugs.clear ()
+        end
+       else
+begin
+prerr_endline "CSC: ###### REFRESH_PROOF, Hbugs.notify ()" ;
+        Hbugs.notify () ;
+end ;
+       (*CSC: Wrong: [] is just plainly wrong *)
+       uri,
+        (Cic.CurrentProof (UriManager.name_of_uri uri, metasenv, bo, ty, []))
   in
-   let
-    (acic,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 currentproof
-   in
-    let mml =
-     mml_of_cic_object uri acic ids_to_inner_sorts ids_to_inner_types
-    in
-     output#load_tree mml ;
-     current_cic_infos :=
-      Some (ids_to_terms,ids_to_father_ids,ids_to_conjectures,ids_to_hypotheses)
+   ignore (output#load_proof uri currentproof)
  with
   e ->
  match !ProofEngine.proof with
     None -> assert false
   | Some (uri,metasenv,bo,ty) ->
-prerr_endline ("Offending proof: " ^ CicPp.ppobj (Cic.CurrentProof ("questa",metasenv,bo,ty))) ; flush stderr ;
-   raise (RefreshProofException e)
-;;
+prerr_endline ("Offending proof: " ^ CicPp.ppobj (Cic.CurrentProof ("questa",metasenv,bo,ty,[]))) ; flush stderr ;
+   raise (InvokeTactics.RefreshProofException e)
 
-let refresh_sequent (proofw : GMathView.math_view) =
+let refresh_goals ?(empty_notebook=true) notebook =
  try
   match !ProofEngine.goal with
-     None -> proofw#unload
+     None ->
+      if empty_notebook then
+       begin 
+        notebook#remove_all_pages ~skip_switch_page_event:false ;
+        notebook#set_empty_page
+       end
+      else
+       notebook#proofw#unload
    | Some metano ->
       let metasenv =
        match !ProofEngine.proof with
           None -> assert false
         | Some (_,metasenv,_,_) -> metasenv
       in
-      let currentsequent = List.find (function (m,_,_) -> m=metano) metasenv in
-       let sequent_gdome,ids_to_terms,ids_to_father_ids,ids_to_hypotheses =
-        SequentPp.XmlPp.print_sequent metasenv currentsequent
-       in
-        let sequent_doc =
-         Xml2Gdome.document_of_xml domImpl sequent_gdome
-        in
-         let sequent_mml =
-          applyStylesheets sequent_doc sequent_styles sequent_args
+      let currentsequent =
+       List.find (function (m,_,_) -> m=metano) metasenv
+      in
+        let regenerate_notebook () = 
+         let skip_switch_page_event =
+          match metasenv with
+             (m,_,_)::_ when m = metano -> false
+           | _ -> true
          in
-          proofw#load_tree ~dom:sequent_mml ;
-          current_goal_infos :=
-           Some (ids_to_terms,ids_to_father_ids,ids_to_hypotheses)
+          notebook#remove_all_pages ~skip_switch_page_event ;
+          List.iter (function (m,_,_) -> notebook#add_page m) metasenv ;
+        in
+          if empty_notebook then
+           begin
+            regenerate_notebook () ;
+            notebook#set_current_page
+             ~may_skip_switch_page_event:false metano
+           end
+          else
+           begin
+            notebook#set_current_page
+             ~may_skip_switch_page_event:true metano ;
+            notebook#proofw#load_sequent metasenv currentsequent
+           end
  with
   e ->
 let metano =
@@ -259,574 +633,943 @@ let metasenv =
     None -> assert false
   | Some (_,metasenv,_,_) -> metasenv
 in
+try
 let currentsequent = List.find (function (m,_,_) -> m=metano) metasenv in
-prerr_endline ("Offending sequent: " ^ SequentPp.TextualPp.print_sequent currentsequent) ; flush stderr ;
-   raise (RefreshSequentException e)
-;;
+   prerr_endline ("Offending sequent: " ^ SequentPp.TextualPp.print_sequent currentsequent) ; flush stderr ;
+      raise (InvokeTactics.RefreshSequentException e)
+with Not_found -> prerr_endline ("Offending sequent " ^ string_of_int metano ^ " unknown."); raise (InvokeTactics.RefreshSequentException e)
+
+module InvokeTacticsCallbacks =
+ struct
+  let sequent_viewer () = (rendering_window ())#notebook#proofw
+  let term_editor () = (rendering_window ())#inputt
+  let scratch_window () = (rendering_window ())#scratch_window
+
+  let refresh_proof () =
+   let output = ((rendering_window ())#output : TermViewer.proof_viewer) in
+    refresh_proof output
 
-(*
-ignore(domImpl#saveDocumentToFile ~doc:sequent_doc
- ~name:"/home/galata/miohelm/guruguru1" ~indent:true ()) ;
-*)
+  let refresh_goals () =
+   let notebook = (rendering_window ())#notebook in
+    refresh_goals notebook
 
-let mml_of_cic_term metano term =
- let metasenv =
-  match !ProofEngine.proof with
-     None -> []
-   | Some (_,metasenv,_,_) -> metasenv
- in
- let context =
-  match !ProofEngine.goal with
-     None -> []
-   | Some metano ->
-      let (_,canonical_context,_) =
-       List.find (function (m,_,_) -> m=metano) metasenv
-      in
-       canonical_context
- in
-   let sequent_gdome,ids_to_terms,ids_to_father_ids,ids_to_hypotheses =
-    SequentPp.XmlPp.print_sequent metasenv (metano,context,term)
-   in
-    let sequent_doc =
-     Xml2Gdome.document_of_xml domImpl sequent_gdome
+  let decompose_uris_choice_callback = decompose_uris_choice_callback
+  let mk_fresh_name_callback = mk_fresh_name_callback
+  let output_html msg = output_html (outputhtml ()) msg
+ end
+;;
+module InvokeTactics' = InvokeTactics.Make (InvokeTacticsCallbacks);;
+(* Just to initialize the Hbugs module *)
+module Ignore = Hbugs.Initialize (InvokeTactics');;
+
+  (** load an unfinished proof from filesystem *)
+let load_unfinished_proof () =
+ let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
+ let output = ((rendering_window ())#output : TermViewer.proof_viewer) in
+ let notebook = (rendering_window ())#notebook in
+  try
+   match 
+    GToolbox.input_string ~title:"Load Unfinished Proof" ~text:"/dummy.con"
+     "Choose an URI:"
+   with
+      None -> raise NoChoice
+    | Some uri0 ->
+       let uri = UriManager.uri_of_string ("cic:" ^ uri0) in
+        match CicParser.obj_of_xml prooffiletype (Some prooffile) with
+           Cic.CurrentProof (_,metasenv,bo,ty,_) ->
+            typecheck_loaded_proof metasenv bo ty ;
+            ProofEngine.proof :=
+             Some (uri, metasenv, bo, ty) ;
+            ProofEngine.goal :=
+             (match metasenv with
+                 [] -> None
+               | (metano,_,_)::_ -> Some metano
+             ) ;
+            refresh_proof output ;
+            refresh_goals notebook ;
+             output_html outputhtml
+              ("
Current proof type loaded from " ^
+                prooffiletype ^ "
") ;
+             output_html outputhtml
+              ("
Current proof body loaded from " ^
+                prooffile ^ "
") ;
+            !save_set_sensitive true;
+         | _ -> assert false
+  with
+     InvokeTactics.RefreshSequentException e ->
+      output_html outputhtml
+       ("
Exception raised during the refresh of the " ^
+        "sequent: " ^ Printexc.to_string e ^ "
")
+   | InvokeTactics.RefreshProofException e ->
+      output_html outputhtml
+       ("
Exception raised during the refresh of the " ^
+        "proof: " ^ Printexc.to_string e ^ "
")
+   | e ->
+      output_html outputhtml
+       ("
" ^ Printexc.to_string e ^ "
") ;
+;;
+
+let edit_aliases () =
+ let inputt = ((rendering_window ())#inputt : TermEditor.term_editor) in
+ let id_to_uris = inputt#id_to_uris in
+ let chosen = ref false in
+ let window =
+  GWindow.window
+   ~width:400 ~modal:true ~title:"Edit Aliases..." ~border_width:2 () in
+ let vbox =
+  GPack.vbox ~border_width:0 ~packing:window#add () in
+ let scrolled_window =
+  GBin.scrolled_window ~border_width:10
+   ~packing:(vbox#pack ~expand:true ~fill:true ~padding:5) () in
+ let input = GEdit.text ~editable:true ~width:400 ~height:100
+   ~packing:scrolled_window#add () in
+ let hbox =
+  GPack.hbox ~border_width:0
+   ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let okb =
+  GButton.button ~label:"Ok"
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let cancelb =
+  GButton.button ~label:"Cancel"
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ ignore (window#connect#destroy GMain.Main.quit) ;
+ ignore (cancelb#connect#clicked window#destroy) ;
+ ignore
+  (okb#connect#clicked (function () -> chosen := true ; window#destroy ())) ;
+ let dom,resolve_id = !id_to_uris in
+  ignore
+   (input#insert_text ~pos:0
+    (String.concat "\n"
+      (List.map
+        (function v ->
+          let uri =
+           match resolve_id v with
+              None -> assert false
+            | Some (CicTextualParser0.Uri uri) -> uri
+            | Some (CicTextualParser0.Term _)
+            | Some CicTextualParser0.Implicit -> assert false
+          in
+           "alias " ^
+            (match v with
+                CicTextualParser0.Id id -> id
+              | CicTextualParser0.Symbol (descr,_) ->
+                 (* CSC: To be implemented *)
+                 assert false
+            )^ " " ^ (string_of_cic_textual_parser_uri uri)
+        ) dom))) ;
+  window#show () ;
+  GtkThread.main ();
+  if !chosen then
+   let dom,resolve_id =
+    let inputtext = input#get_chars 0 input#length in
+    let regexpr =
+     let alfa = "[a-zA-Z_-]" in
+     let digit = "[0-9]" in
+     let ident = alfa ^ "\(" ^ alfa ^ "\|" ^ digit ^ "\)*" in
+     let blanks = "\( \|\t\|\n\)+" in
+     let nonblanks = "[^ \t\n]+" in
+     let uri = "/\(" ^ ident ^ "/\)*" ^ nonblanks in (* not very strict check *)
+      Str.regexp
+       ("alias" ^ blanks ^ "\(" ^ ident ^ "\)" ^ blanks ^ "\(" ^ uri ^ "\)")
     in
-     let res =
-      applyStylesheets sequent_doc sequent_styles sequent_args ;
+     let rec aux n =
+      try
+       let n' = Str.search_forward regexpr inputtext n in
+        let id = CicTextualParser0.Id (Str.matched_group 2 inputtext) in
+        let uri =
+         MQueryMisc.cic_textual_parser_uri_of_string
+          ("cic:" ^ (Str.matched_group 5 inputtext))
+        in
+         let dom,resolve_id = aux (n' + 1) in
+          if List.mem id dom then
+           dom,resolve_id
+          else
+           id::dom,
+            (function id' ->
+              if id = id' then
+               Some (CicTextualParser0.Uri uri)
+              else resolve_id id')
+      with
+       Not_found -> TermEditor.empty_id_to_uris
      in
-      current_scratch_infos :=
-       Some (term,ids_to_terms,ids_to_father_ids,ids_to_hypotheses) ;
-      res
+      aux 0
+   in
+    id_to_uris := (dom,resolve_id)
 ;;
 
-let output_html outputhtml msg =
- htmlheader_and_content := !htmlheader_and_content ^ msg ;
- outputhtml#source (!htmlheader_and_content ^ htmlfooter) ;
- outputhtml#set_topline (-1)
+let proveit () =
+ let module L = LogicalOperations in
+ let module G = Gdome in
+ let notebook = (rendering_window ())#notebook in
+ let output = (rendering_window ())#output in
+ let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
+  try
+   output#make_sequent_of_selected_term ;
+   refresh_proof output ;
+   refresh_goals notebook
+  with
+     InvokeTactics.RefreshSequentException e ->
+      output_html outputhtml
+       ("
Exception raised during the refresh of the " ^
+        "sequent: " ^ Printexc.to_string e ^ "
")
+   | InvokeTactics.RefreshProofException e ->
+      output_html outputhtml
+       ("
Exception raised during the refresh of the " ^
+        "proof: " ^ Printexc.to_string e ^ "
")
+   | e ->
+      output_html outputhtml
+       ("
" ^ Printexc.to_string e ^ "
")
 ;;
 
-(***********************)
-(*       TACTICS       *)
-(***********************)
+let focus () =
+ let module L = LogicalOperations in
+ let module G = Gdome in
+ let notebook = (rendering_window ())#notebook in
+ let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
+ let output = (rendering_window ())#output in
+  try
+   output#focus_sequent_of_selected_term ;
+   refresh_goals notebook
+  with
+     InvokeTactics.RefreshSequentException e ->
+      output_html outputhtml
+       ("
Exception raised during the refresh of the " ^
+        "sequent: " ^ Printexc.to_string e ^ "
")
+   | InvokeTactics.RefreshProofException e ->
+      output_html outputhtml
+       ("
Exception raised during the refresh of the " ^
+        "proof: " ^ Printexc.to_string e ^ "
")
+   | e ->
+      output_html outputhtml
+       ("
" ^ Printexc.to_string e ^ "
")
+;;
 
-let call_tactic tactic rendering_window () =
- let proofw = (rendering_window#proofw : GMathView.math_view) in
- let output = (rendering_window#output : GMathView.math_view) in
- let outputhtml = (rendering_window#outputhtml : GHtml.xmhtml) in
- let savedproof = !ProofEngine.proof in
- let savedgoal  = !ProofEngine.goal in
-  begin
+exception NoPrevGoal;;
+exception NoNextGoal;;
+
+let setgoal metano =
+ let module L = LogicalOperations in
+ let module G = Gdome in
+ let notebook = (rendering_window ())#notebook in
+ let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
+  let metasenv =
+   match !ProofEngine.proof with
+      None -> assert false
+    | Some (_,metasenv,_,_) -> metasenv
+  in
    try
-    tactic () ;
-    refresh_sequent proofw ;
-    refresh_proof output
+    refresh_goals ~empty_notebook:false notebook
    with
-      RefreshSequentException e ->
-       output_html outputhtml
-        ("
Exception raised during the refresh of the " ^
-         "sequent: " ^ Printexc.to_string e ^ "
") ;
-       ProofEngine.proof := savedproof ;
-       ProofEngine.goal := savedgoal ;
-       refresh_sequent proofw
-    | RefreshProofException e ->
+      InvokeTactics.RefreshSequentException e ->
        output_html outputhtml
         ("
Exception raised during the refresh of the " ^
-         "proof: " ^ Printexc.to_string e ^ "
") ;
-       ProofEngine.proof := savedproof ;
-       ProofEngine.goal := savedgoal ;
-       refresh_sequent proofw ;
-       refresh_proof output
+         "sequent: " ^ Printexc.to_string e ^ "
")
     | e ->
        output_html outputhtml
-        ("
" ^ Printexc.to_string e ^ "
") ;
-       ProofEngine.proof := savedproof ;
-       ProofEngine.goal := savedgoal ;
-  end
+        ("
" ^ Printexc.to_string e ^ "
")
 ;;
 
-let call_tactic_with_input tactic rendering_window () =
- let proofw = (rendering_window#proofw : GMathView.math_view) in
- let output = (rendering_window#output : GMathView.math_view) in
- let outputhtml = (rendering_window#outputhtml : GHtml.xmhtml) in
- let inputt = (rendering_window#inputt : GEdit.text) in
- let savedproof = !ProofEngine.proof in
- let savedgoal  = !ProofEngine.goal in
-(*CSC: Gran cut&paste da sotto... *)
-  let inputlen = inputt#length in
-  let input = inputt#get_chars 0 inputlen ^ "\n" in
-   let lexbuf = Lexing.from_string input in
-   let curi =
-    match !ProofEngine.proof with
-       None -> assert false
-     | Some (curi,_,_,_) -> curi
-   in
-   let uri,metasenv,bo,ty =
-    match !ProofEngine.proof with
-       None -> assert false
-     | Some (uri,metasenv,bo,ty) -> uri,metasenv,bo,ty
-   in
-   let context =
-    List.map
-     (function
-         Some (n,_) -> Some n
-       | None -> None)
-     (match !ProofEngine.goal with
-         None -> assert false
-       | Some metano ->
-          let (_,canonical_context,_) =
-           List.find (function (m,_,_) -> m=metano) metasenv
-          in
-           canonical_context
-     )
-   in
+let
+ show_in_show_window_obj, show_in_show_window_uri, show_in_show_window_callback
+=
+ let window =
+  GWindow.window ~width:800 ~border_width:2 () in
+ let scrolled_window =
+  GBin.scrolled_window ~border_width:10 ~packing:window#add () in
+ let mmlwidget =
+  GMathViewAux.single_selection_math_view
+    ~packing:scrolled_window#add ~width:600 ~height:400 ()
+ in
+ let _ = window#event#connect#delete (fun _ -> window#misc#hide () ; true ) in
+ let href = Gdome.domString "href" in
+  let show_in_show_window_obj uri obj =
+   let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
     try
-     while true do
+     let
+      (acic,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 mml =
+       ApplyStylesheets.mml_of_cic_object
+        ~explode_all:false uri acic ids_to_inner_sorts ids_to_inner_types
+      in
+       window#set_title (UriManager.string_of_uri uri) ;
+       window#misc#hide () ; window#show () ;
+       mmlwidget#load_doc mml ;
+    with
+     e ->
+      output_html outputhtml
+       ("
" ^ Printexc.to_string e ^ "
") ;
+  in
+  let show_in_show_window_uri uri =
+   let obj = CicEnvironment.get_obj uri in
+    show_in_show_window_obj uri obj
+  in
+   let show_in_show_window_callback mmlwidget (n : Gdome.element option) _ =
+    match n with
+       None -> ()
+     | Some n' ->
+        if n'#hasAttributeNS ~namespaceURI:xlinkns ~localName:href then
+         let uri =
+          (n'#getAttributeNS ~namespaceURI:xlinkns ~localName:href)#to_string
+         in 
+          show_in_show_window_uri (UriManager.uri_of_string uri)
+        else
+         ignore (mmlwidget#action_toggle n')
+   in
+    let _ =
+     mmlwidget#connect#click (show_in_show_window_callback mmlwidget)
+    in
+     show_in_show_window_obj, show_in_show_window_uri,
+      show_in_show_window_callback
+;;
+
+exception NoObjectsLocated;;
+
+let user_uri_choice ~title ~msg uris =
+ let uri =
+  match uris with
+     [] -> raise NoObjectsLocated
+   | [uri] -> uri
+   | uris ->
       match
-       CicTextualParserContext.main
-        curi context metasenv CicTextualLexer.token lexbuf
+       interactive_user_uri_choice ~selection_mode:`SINGLE ~title ~msg uris
       with
-         None -> ()
-       | Some (metasenv',expr) ->
-          ProofEngine.proof := Some (uri,metasenv',bo,ty) ;
-          tactic expr ;
-          refresh_sequent proofw ;
-          refresh_proof output
-     done
+         [uri] -> uri
+       | _ -> assert false
+ in
+  String.sub uri 4 (String.length uri - 4)
+;;
+
+let locate_callback id =
+ let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
+ let out = output_html outputhtml in
+ let query = MQG.locate id in
+ let result = MQI.execute mqi_handle query in
+ let uris =
+  List.map
+   (function uri,_ ->
+     MQueryMisc.wrong_xpointer_format_from_wrong_xpointer_format' uri)
+   result in
+  out "
Locate Query: 
";
+  MQueryUtil.text_of_query out query ""; 
+  out "
Result:
";
+  MQueryUtil.text_of_result out result "
";
+  user_uri_choice ~title:"Ambiguous input."
+   ~msg:
+     ("Ambiguous input \"" ^ id ^
+      "\". Please, choose one interpetation:")
+   uris
+;;
+
+
+let input_or_locate_uri ~title =
+ let uri = ref None in
+ let window =
+  GWindow.window
+   ~width:400 ~modal:true ~title ~border_width:2 () in
+ let vbox = GPack.vbox ~packing:window#add () in
+ let hbox1 =
+  GPack.hbox ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let _ =
+  GMisc.label ~text:"Enter a valid URI:" ~packing:(hbox1#pack ~padding:5) () in
+ let manual_input =
+  GEdit.entry ~editable:true
+   ~packing:(hbox1#pack ~expand:true ~fill:true ~padding:5) () in
+ let checkb =
+  GButton.button ~label:"Check"
+   ~packing:(hbox1#pack ~expand:false ~fill:false ~padding:5) () in
+ let _ = checkb#misc#set_sensitive false in
+ let hbox2 =
+  GPack.hbox ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let _ =
+  GMisc.label ~text:"You can also enter an indentifier to locate:"
+   ~packing:(hbox2#pack ~padding:5) () in
+ let locate_input =
+  GEdit.entry ~editable:true
+   ~packing:(hbox2#pack ~expand:true ~fill:true ~padding:5) () in
+ let locateb =
+  GButton.button ~label:"Locate"
+   ~packing:(hbox2#pack ~expand:false ~fill:false ~padding:5) () in
+ let _ = locateb#misc#set_sensitive false in
+ let hbox3 =
+  GPack.hbox ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let okb =
+  GButton.button ~label:"Ok"
+   ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
+ let _ = okb#misc#set_sensitive false in
+ let cancelb =
+  GButton.button ~label:"Cancel"
+   ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) ()
+ in
+  ignore (window#connect#destroy GMain.Main.quit) ;
+  ignore
+   (cancelb#connect#clicked (function () -> uri := None ; window#destroy ())) ;
+  let check_callback () =
+   let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
+   let uri = "cic:" ^ manual_input#text in
+    try
+      ignore (Getter.resolve (UriManager.uri_of_string uri)) ;
+      output_html outputhtml "
OK
" ;
+      true
     with
-       CicTextualParser0.Eof ->
-        inputt#delete_text 0 inputlen
-     | RefreshSequentException e ->
+       Getter.Unresolved ->
         output_html outputhtml
-         ("
Exception raised during the refresh of the " ^
-          "sequent: " ^ Printexc.to_string e ^ "
") ;
-        ProofEngine.proof := savedproof ;
-        ProofEngine.goal := savedgoal ;
-        refresh_sequent proofw
-     | RefreshProofException e ->
+         ("
URI " ^ uri ^
+          " does not correspond to any object.
") ;
+        false
+     | UriManager.IllFormedUri _ ->
         output_html outputhtml
-         ("
Exception raised during the refresh of the " ^
-          "proof: " ^ Printexc.to_string e ^ "
") ;
-        ProofEngine.proof := savedproof ;
-        ProofEngine.goal := savedgoal ;
-        refresh_sequent proofw ;
-        refresh_proof output
+         ("
URI " ^ uri ^ " is not well-formed.
") ;
+        false
      | e ->
         output_html outputhtml
-         ("
" ^ Printexc.to_string e ^ "
") ;
-        ProofEngine.proof := savedproof ;
-        ProofEngine.goal := savedgoal ;
-;;
-
-let call_tactic_with_goal_input tactic rendering_window () =
- let module L = LogicalOperations in
- let module G = Gdome in
-  let proofw = (rendering_window#proofw : GMathView.math_view) in
-  let output = (rendering_window#output : GMathView.math_view) in
-  let outputhtml = (rendering_window#outputhtml : GHtml.xmhtml) in
-  let savedproof = !ProofEngine.proof in
-  let savedgoal  = !ProofEngine.goal in
-   match proofw#get_selection with
-     Some node ->
-      let xpath =
-       ((node : Gdome.element)#getAttributeNS
-         ~namespaceURI:helmns
-         ~localName:(G.domString "xref"))#to_string
-      in
-       if xpath = "" then assert false (* "ERROR: No xref found!!!" *)
-       else
+         ("
" ^ Printexc.to_string e ^ "
") ;
+        false
+  in
+  ignore
+   (okb#connect#clicked
+     (function () ->
+       if check_callback () then
         begin
-         try
-          match !current_goal_infos with
-             Some (ids_to_terms, ids_to_father_ids,_) ->
-              let id = xpath in
-               tactic (Hashtbl.find ids_to_terms id) ;
-               refresh_sequent rendering_window#proofw ;
-               refresh_proof rendering_window#output
-           | None -> assert false (* "ERROR: No current term!!!" *)
-         with
-            RefreshSequentException e ->
-             output_html outputhtml
-              ("
Exception raised during the refresh of the " ^
-               "sequent: " ^ Printexc.to_string e ^ "
") ;
-             ProofEngine.proof := savedproof ;
-             ProofEngine.goal := savedgoal ;
-             refresh_sequent proofw
-          | RefreshProofException e ->
-             output_html outputhtml
-              ("
Exception raised during the refresh of the " ^
-               "proof: " ^ Printexc.to_string e ^ "
") ;
-             ProofEngine.proof := savedproof ;
-             ProofEngine.goal := savedgoal ;
-             refresh_sequent proofw ;
-             refresh_proof output
-          | e ->
-             output_html outputhtml
-              ("
" ^ Printexc.to_string e ^ "
") ;
-             ProofEngine.proof := savedproof ;
-             ProofEngine.goal := savedgoal ;
+         uri := Some manual_input#text ;
+         window#destroy ()
         end
-   | None ->
-      output_html outputhtml
-       ("
No term selected
")
-;;
-
-let call_tactic_with_input_and_goal_input tactic rendering_window () =
- let module L = LogicalOperations in
- let module G = Gdome in
-  let proofw = (rendering_window#proofw : GMathView.math_view) in
-  let output = (rendering_window#output : GMathView.math_view) in
-  let outputhtml = (rendering_window#outputhtml : GHtml.xmhtml) in
-  let inputt = (rendering_window#inputt : GEdit.text) in
-  let savedproof = !ProofEngine.proof in
-  let savedgoal  = !ProofEngine.goal in
-   match proofw#get_selection with
-     Some node ->
-      let xpath =
-       ((node : Gdome.element)#getAttributeNS
-         ~namespaceURI:helmns
-         ~localName:(G.domString "xref"))#to_string
-      in
-       if xpath = "" then assert false (* "ERROR: No xref found!!!" *)
-       else
+   )) ;
+  ignore (checkb#connect#clicked (function () -> ignore (check_callback ()))) ;
+  ignore
+   (manual_input#connect#changed
+     (fun _ ->
+       if manual_input#text = "" then
         begin
-         try
-          match !current_goal_infos with
-             Some (ids_to_terms, ids_to_father_ids,_) ->
-              let id = xpath in
-               (* Let's parse the input *)
-               let inputlen = inputt#length in
-               let input = inputt#get_chars 0 inputlen ^ "\n" in
-                let lexbuf = Lexing.from_string input in
-                let curi =
-                 match !ProofEngine.proof with
-                    None -> assert false
-                  | Some (curi,_,_,_) -> curi
-                in
-                let uri,metasenv,bo,ty =
-                 match !ProofEngine.proof with
-                    None -> assert false
-                  | Some (uri,metasenv,bo,ty) -> uri,metasenv,bo,ty
-                in
-                let context =
-                 List.map
-                  (function
-                      Some (n,_) -> Some n
-                    | None -> None)
-                  (match !ProofEngine.goal with
-                      None -> assert false
-                    | Some metano ->
-                       let (_,canonical_context,_) =
-                        List.find (function (m,_,_) -> m=metano) metasenv
-                       in
-                        canonical_context
-                  )
-                in
-                 begin
-                  try
-                   while true do
-                    match
-                     CicTextualParserContext.main curi context metasenv
-                      CicTextualLexer.token lexbuf
-                    with
-                       None -> ()
-                     | Some (metasenv',expr) ->
-                        ProofEngine.proof := Some (uri,metasenv',bo,ty) ;
-                        tactic ~goal_input:(Hashtbl.find ids_to_terms id)
-                         ~input:expr ;
-                        refresh_sequent proofw ;
-                        refresh_proof output
-                   done
-                  with
-                     CicTextualParser0.Eof ->
-                      inputt#delete_text 0 inputlen
-                 end
-           | None -> assert false (* "ERROR: No current term!!!" *)
-         with
-            RefreshSequentException e ->
-             output_html outputhtml
-              ("
Exception raised during the refresh of the " ^
-               "sequent: " ^ Printexc.to_string e ^ "
") ;
-             ProofEngine.proof := savedproof ;
-             ProofEngine.goal := savedgoal ;
-             refresh_sequent proofw
-          | RefreshProofException e ->
-             output_html outputhtml
-              ("
Exception raised during the refresh of the " ^
-               "proof: " ^ Printexc.to_string e ^ "
") ;
-             ProofEngine.proof := savedproof ;
-             ProofEngine.goal := savedgoal ;
-             refresh_sequent proofw ;
-             refresh_proof output
-          | e ->
-             output_html outputhtml
-              ("
" ^ Printexc.to_string e ^ "
") ;
-             ProofEngine.proof := savedproof ;
-             ProofEngine.goal := savedgoal ;
+         checkb#misc#set_sensitive false ;
+         okb#misc#set_sensitive false
         end
-   | None ->
-      output_html outputhtml
-       ("
No term selected
")
-;;
-
-let call_tactic_with_goal_input_in_scratch tactic scratch_window () =
- let module L = LogicalOperations in
- let module G = Gdome in
-  let mmlwidget = (scratch_window#mmlwidget : GMathView.math_view) in
-  let outputhtml = (scratch_window#outputhtml : GHtml.xmhtml) in
-  let savedproof = !ProofEngine.proof in
-  let savedgoal  = !ProofEngine.goal in
-   match mmlwidget#get_selection with
-     Some node ->
-      let xpath =
-       ((node : Gdome.element)#getAttributeNS
-         ~namespaceURI:helmns
-         ~localName:(G.domString "xref"))#to_string
-      in
-       if xpath = "" then assert false (* "ERROR: No xref found!!!" *)
        else
         begin
-         try
-          match !current_scratch_infos with
-             (* term is the whole goal in the scratch_area *)
-             Some (term,ids_to_terms, ids_to_father_ids,_) ->
-              let id = xpath in
-               let expr = tactic term (Hashtbl.find ids_to_terms id) in
-                let mml = mml_of_cic_term 111 expr in
-                 scratch_window#show () ;
-                 scratch_window#mmlwidget#load_tree ~dom:mml
-           | None -> assert false (* "ERROR: No current term!!!" *)
-         with
-          e ->
-           output_html outputhtml
-            ("
" ^ Printexc.to_string e ^ "
")
-        end
-   | None ->
-      output_html outputhtml
-       ("
No term selected
")
+         checkb#misc#set_sensitive true ;
+         okb#misc#set_sensitive true
+        end));
+  ignore
+   (locate_input#connect#changed
+     (fun _ -> locateb#misc#set_sensitive (locate_input#text <> ""))) ;
+  ignore
+   (locateb#connect#clicked
+     (function () ->
+       let id = locate_input#text in
+        manual_input#set_text (locate_callback id) ;
+        locate_input#delete_text 0 (String.length id)
+   )) ;
+  window#show () ;
+  GtkThread.main ();
+  match !uri with
+     None -> raise NoChoice
+   | Some uri -> UriManager.uri_of_string ("cic:" ^ uri)
 ;;
 
-let call_tactic_with_hypothesis_input tactic rendering_window () =
- let module L = LogicalOperations in
- let module G = Gdome in
-  let proofw = (rendering_window#proofw : GMathView.math_view) in
-  let output = (rendering_window#output : GMathView.math_view) in
-  let outputhtml = (rendering_window#outputhtml : GHtml.xmhtml) in
-  let savedproof = !ProofEngine.proof in
-  let savedgoal  = !ProofEngine.goal in
-   match proofw#get_selection with
-     Some node ->
-      let xpath =
-       ((node : Gdome.element)#getAttributeNS
-         ~namespaceURI:helmns
-         ~localName:(G.domString "xref"))#to_string
-      in
-       if xpath = "" then assert false (* "ERROR: No xref found!!!" *)
-       else
-        begin
-         try
-          match !current_goal_infos with
-             Some (_,_,ids_to_hypotheses) ->
-              let id = xpath in
-               tactic (Hashtbl.find ids_to_hypotheses id) ;
-               refresh_sequent rendering_window#proofw ;
-               refresh_proof rendering_window#output
-           | None -> assert false (* "ERROR: No current term!!!" *)
-         with
-            RefreshSequentException e ->
-             output_html outputhtml
-              ("
Exception raised during the refresh of the " ^
-               "sequent: " ^ Printexc.to_string e ^ "
") ;
-             ProofEngine.proof := savedproof ;
-             ProofEngine.goal := savedgoal ;
-             refresh_sequent proofw
-          | RefreshProofException e ->
-             output_html outputhtml
-              ("
Exception raised during the refresh of the " ^
-               "proof: " ^ Printexc.to_string e ^ "
") ;
-             ProofEngine.proof := savedproof ;
-             ProofEngine.goal := savedgoal ;
-             refresh_sequent proofw ;
-             refresh_proof output
-          | e ->
-             output_html outputhtml
-              ("
" ^ Printexc.to_string e ^ "
") ;
-             ProofEngine.proof := savedproof ;
-             ProofEngine.goal := savedgoal ;
-        end
-   | None ->
-      output_html outputhtml
-       ("
No term selected
")
-;;
+exception AmbiguousInput;;
 
+(* A WIDGET TO ENTER CIC TERMS *)
 
-let intros rendering_window = call_tactic ProofEngine.intros rendering_window;;
-let exact rendering_window =
- call_tactic_with_input ProofEngine.exact rendering_window
-;;
-let apply rendering_window =
- call_tactic_with_input ProofEngine.apply rendering_window
-;;
-let elimintrossimpl rendering_window =
- call_tactic_with_input ProofEngine.elim_intros_simpl rendering_window
-;;
-let elimtype rendering_window =
- call_tactic_with_input ProofEngine.elim_type rendering_window
-;;
-let whd rendering_window =
- call_tactic_with_goal_input ProofEngine.whd rendering_window
-;;
-let reduce rendering_window =
- call_tactic_with_goal_input ProofEngine.reduce rendering_window
-;;
-let simpl rendering_window =
- call_tactic_with_goal_input ProofEngine.simpl rendering_window
-;;
-let fold rendering_window =
- call_tactic_with_input ProofEngine.fold rendering_window
-;;
-let cut rendering_window =
- call_tactic_with_input ProofEngine.cut rendering_window
-;;
-let change rendering_window =
- call_tactic_with_input_and_goal_input ProofEngine.change rendering_window
-;;
-let letin rendering_window =
- call_tactic_with_input ProofEngine.letin rendering_window
-;;
-let ring rendering_window = call_tactic ProofEngine.ring rendering_window;;
-let clearbody rendering_window =
- call_tactic_with_hypothesis_input ProofEngine.clearbody rendering_window
-;;
-let clear rendering_window =
- call_tactic_with_hypothesis_input ProofEngine.clear rendering_window
-;;
-let fourier rendering_window =
- call_tactic ProofEngine.fourier rendering_window
-;;
-let rewritesimpl rendering_window =
- call_tactic_with_input ProofEngine.rewrite_simpl rendering_window
+module ChosenTermEditor  = TexTermEditor;;
+module ChosenTextualParser0 = TexCicTextualParser0;;
+(*
+module ChosenTermEditor = TermEditor;;
+module ChosenTextualParser0 = CicTextualParser0;;
+*)
+
+module Callbacks =
+ struct
+  let get_metasenv () = !ChosenTextualParser0.metasenv
+  let set_metasenv metasenv = ChosenTextualParser0.metasenv := metasenv
+
+  let output_html msg = output_html (outputhtml ()) msg;;
+  let interactive_user_uri_choice =
+   fun ~selection_mode ?ok ?enable_button_for_non_vars ~title ~msg ~id ->
+    interactive_user_uri_choice ~selection_mode ?ok
+     ?enable_button_for_non_vars ~title ~msg;;
+  let interactive_interpretation_choice = interactive_interpretation_choice;;
+  let input_or_locate_uri = input_or_locate_uri;;
+ end
 ;;
 
+module TexTermEditor' = ChosenTermEditor.Make(Callbacks);;
 
+(* OTHER FUNCTIONS *)
 
-let whd_in_scratch scratch_window =
- call_tactic_with_goal_input_in_scratch ProofEngine.whd_in_scratch
-  scratch_window
-;;
-let reduce_in_scratch scratch_window =
- call_tactic_with_goal_input_in_scratch ProofEngine.reduce_in_scratch
-  scratch_window
-;;
-let simpl_in_scratch scratch_window =
- call_tactic_with_goal_input_in_scratch ProofEngine.simpl_in_scratch
-  scratch_window
+let locate () =
+ let inputt = ((rendering_window ())#inputt : TermEditor.term_editor) in
+ let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
+   try
+    match
+     GToolbox.input_string ~title:"Locate" "Enter an identifier to locate:"
+    with
+       None -> raise NoChoice
+     | Some input ->
+        let uri = locate_callback input in
+         inputt#set_term uri
+   with
+    e ->
+     output_html outputhtml
+      ("
" ^ Printexc.to_string e ^ "
")
 ;;
 
 
+exception UriAlreadyInUse;;
+exception NotAUriToAConstant;;
 
-(**********************)
-(*   END OF TACTICS   *)
-(**********************)
-
-exception OpenConjecturesStillThere;;
-exception WrongProof;;
+let new_inductive () =
+ let inputt = ((rendering_window ())#inputt : TermEditor.term_editor) in
+ let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
+ let output = ((rendering_window ())#output : TermViewer.proof_viewer) in
+ let notebook = (rendering_window ())#notebook in
 
-let qed rendering_window () =
- match !ProofEngine.proof with
-    None -> assert false
-  | Some (uri,[],bo,ty) ->
-     if
-      CicReduction.are_convertible []
-       (CicTypeChecker.type_of_aux' [] [] bo) ty
-     then
-      begin
-       (*CSC: Wrong: [] is just plainly wrong *)
-       let proof = Cic.Definition (UriManager.name_of_uri uri,bo,ty,[]) in
-        let
-         (acic,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 proof
-        in
-         let mml =
-          mml_of_cic_object uri acic ids_to_inner_sorts ids_to_inner_types
-         in
-          (rendering_window#output : GMathView.math_view)#load_tree mml ;
-          current_cic_infos :=
-           Some
-            (ids_to_terms,ids_to_father_ids,ids_to_conjectures,
-             ids_to_hypotheses)
-      end
-     else
-      raise WrongProof
-  | _ -> raise OpenConjecturesStillThere
-;;
-
-(*????
-let dtdname = "http://www.cs.unibo.it/helm/dtd/cic.dtd";;
-*)
-let dtdname = "/home/tassi/miohelm/helm/dtd/cic.dtd";;
-
-let save rendering_window () =
- let outputhtml = (rendering_window#outputhtml : GHtml.xmhtml) in
-  match !ProofEngine.proof with
-     None -> assert false
-   | Some (uri, metasenv, bo, ty) ->
-      let currentproof =
-       Cic.CurrentProof (UriManager.name_of_uri uri,metasenv,bo,ty)
+ let chosen = ref false in
+ let inductive = ref true in
+ let paramsno = ref 0 in
+ let get_uri = ref (function _ -> assert false) in
+ let get_base_uri = ref (function _ -> assert false) in
+ let get_names = ref (function _ -> assert false) in
+ let get_types_and_cons = ref (function _ -> assert false) in
+ let get_context_and_subst = ref (function _ -> assert false) in 
+ let window =
+  GWindow.window
+   ~width:600 ~modal:true ~position:`CENTER
+   ~title:"New Block of Mutual (Co)Inductive Definitions"
+   ~border_width:2 () in
+ let vbox = GPack.vbox ~packing:window#add () in
+ let hbox =
+  GPack.hbox ~border_width:0
+   ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let _ =
+  GMisc.label ~text:"Enter the URI for the new block:"
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let uri_entry =
+  GEdit.entry ~editable:true
+   ~packing:(hbox#pack ~expand:true ~fill:true ~padding:5) () in
+ let hbox0 =
+  GPack.hbox ~border_width:0
+   ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let _ =
+  GMisc.label
+   ~text:
+     "Enter the number of left parameters in every arity and constructor type:"
+   ~packing:(hbox0#pack ~expand:false ~fill:false ~padding:5) () in
+ let paramsno_entry =
+  GEdit.entry ~editable:true ~text:"0"
+   ~packing:(hbox0#pack ~expand:true ~fill:true ~padding:5) () in
+ let hbox1 =
+  GPack.hbox ~border_width:0
+   ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let _ =
+  GMisc.label ~text:"Are the definitions inductive or coinductive?"
+   ~packing:(hbox1#pack ~expand:false ~fill:false ~padding:5) () in
+ let inductiveb =
+  GButton.radio_button ~label:"Inductive"
+   ~packing:(hbox1#pack ~expand:false ~fill:false ~padding:5) () in
+ let coinductiveb =
+  GButton.radio_button ~label:"Coinductive"
+   ~group:inductiveb#group
+   ~packing:(hbox1#pack ~expand:false ~fill:false ~padding:5) () in
+ let hbox2 =
+  GPack.hbox ~border_width:0
+   ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let _ =
+  GMisc.label ~text:"Enter the list of the names of the types:"
+   ~packing:(hbox2#pack ~expand:false ~fill:false ~padding:5) () in
+ let names_entry =
+  GEdit.entry ~editable:true
+   ~packing:(hbox2#pack ~expand:true ~fill:true ~padding:5) () in
+ let hboxn =
+  GPack.hbox ~border_width:0
+   ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let okb =
+  GButton.button ~label:"> Next"
+   ~packing:(hboxn#pack ~expand:false ~fill:false ~padding:5) () in
+ let _ = okb#misc#set_sensitive true in
+ let cancelb =
+  GButton.button ~label:"Abort"
+   ~packing:(hboxn#pack ~expand:false ~fill:false ~padding:5) () in
+ ignore (window#connect#destroy GMain.Main.quit) ;
+ ignore (cancelb#connect#clicked window#destroy) ;
+ (* First phase *)
+ let rec phase1 () =
+  ignore
+   (okb#connect#clicked
+     (function () ->
+       try
+        let uristr = "cic:" ^ uri_entry#text in
+        let namesstr = names_entry#text in
+        let paramsno' = int_of_string (paramsno_entry#text) in
+         match Str.split (Str.regexp " +") namesstr with
+            [] -> assert false
+          | (he::tl) as names ->
+             let uri = UriManager.uri_of_string (uristr ^ "/" ^ he ^ ".ind") in
+              begin
+               try
+                ignore (Getter.resolve uri) ;
+                raise UriAlreadyInUse
+               with
+                Getter.Unresolved ->
+                 get_uri := (function () -> uri) ; 
+                 get_names := (function () -> names) ;
+                 inductive := inductiveb#active ;
+                 paramsno := paramsno' ;
+                 phase2 ()
+              end
+       with
+        e ->
+         output_html outputhtml
+          ("
" ^ Printexc.to_string e ^ "
") ;
+     ))
+ (* Second phase *)
+ and phase2 () =
+  let type_widgets =
+   List.map
+    (function name ->
+      let frame =
+       GBin.frame ~label:name
+        ~packing:(vbox#pack ~expand:true ~fill:true ~padding:5) () in
+      let vbox = GPack.vbox ~packing:frame#add () in
+      let hbox = GPack.hbox ~packing:(vbox#pack ~expand:false ~fill:false) () in
+      let _ =
+       GMisc.label ~text:("Enter its type:")
+        ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+      let scrolled_window =
+       GBin.scrolled_window ~border_width:5
+        ~packing:(vbox#pack ~expand:true ~padding:0) () in
+      let newinputt =
+       TexTermEditor'.term_editor
+        mqi_handle
+        ~width:400 ~height:20 ~packing:scrolled_window#add 
+        ~share_id_to_uris_with:inputt ()
+        ~isnotempty_callback:
+         (function b ->
+           (*non_empty_type := b ;*)
+           okb#misc#set_sensitive true) (*(b && uri_entry#text <> ""))*)
       in
-       let (acurrentproof,_,_,ids_to_inner_sorts,_,_,_) =
-        Cic2acic.acic_object_of_cic_object currentproof
-       in
-        let xml = Cic2Xml.print_object uri ~ids_to_inner_sorts acurrentproof in
-         let xml' =
-          [< Xml.xml_cdata "\n" ;
-             Xml.xml_cdata
-              ("\n\n") ;
-             xml
-          >]
+      let hbox =
+       GPack.hbox ~border_width:0
+        ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+      let _ =
+       GMisc.label ~text:("Enter the list of its constructors:")
+        ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+      let cons_names_entry =
+       GEdit.entry ~editable:true
+        ~packing:(hbox#pack ~expand:true ~fill:true ~padding:5) () in
+      (newinputt,cons_names_entry)
+    ) (!get_names ())
+  in
+   vbox#remove hboxn#coerce ;
+   let hboxn =
+    GPack.hbox ~border_width:0
+     ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+   let okb =
+    GButton.button ~label:"> Next"
+     ~packing:(hboxn#pack ~expand:false ~fill:false ~padding:5) () in
+   let cancelb =
+    GButton.button ~label:"Abort"
+     ~packing:(hboxn#pack ~expand:false ~fill:false ~padding:5) () in
+   ignore (cancelb#connect#clicked window#destroy) ;
+   ignore
+    (okb#connect#clicked
+      (function () ->
+        try
+         let names = !get_names () in
+         let types_and_cons =
+          List.map2
+           (fun name (newinputt,cons_names_entry) ->
+             let consnamesstr = cons_names_entry#text in
+             let cons_names = Str.split (Str.regexp " +") consnamesstr in
+             let metasenv,expr =
+              newinputt#get_metasenv_and_term ~context:[] ~metasenv:[]
+             in
+              match metasenv with
+                 [] -> expr,cons_names
+               | _ -> raise AmbiguousInput
+           ) names type_widgets
          in
-          Xml.pp ~quiet:true xml' (Some prooffile) ;
+          let uri = !get_uri () in
+          let _ =
+           (* Let's see if so far the definition is well-typed *)
+           let params = [] in
+           let paramsno = 0 in
+           (* To test if the arities of the inductive types are well *)
+           (* typed, we check the inductive block definition where   *)
+           (* no constructor is given to each type.                  *)
+           let tys =
+            List.map2
+             (fun name (ty,cons) -> (name, !inductive, ty, []))
+             names types_and_cons
+           in
+            CicTypeChecker.typecheck_mutual_inductive_defs uri
+             (tys,params,paramsno)
+          in
+           get_context_and_subst :=
+            (function () ->
+              let i = ref 0 in
+               List.fold_left2
+                (fun (context,subst) name (ty,_) ->
+                  let res =
+                   (Some (Cic.Name name, Cic.Decl ty))::context,
+                    (Cic.MutInd (uri,!i,[]))::subst
+                  in
+                   incr i ; res
+                ) ([],[]) names types_and_cons) ;
+           let types_and_cons' =
+            List.map2
+             (fun name (ty,cons) -> (name, !inductive, ty, phase3 name cons))
+             names types_and_cons
+           in
+            get_types_and_cons := (function () -> types_and_cons') ;
+            chosen := true ;
+            window#destroy ()
+        with
+         e ->
           output_html outputhtml
-           ("
Current proof saved to " ^
-            prooffile ^ "
")
+           ("
" ^ Printexc.to_string e ^ "
") ;
+      ))
+ (* Third phase *)
+ and phase3 name cons =
+  let get_cons_types = ref (function () -> assert false) in
+  let window2 =
+   GWindow.window
+    ~width:600 ~modal:true ~position:`CENTER
+    ~title:(name ^ " Constructors")
+    ~border_width:2 () in
+  let vbox = GPack.vbox ~packing:window2#add () in
+  let cons_type_widgets =
+   List.map
+    (function consname ->
+      let hbox =
+       GPack.hbox ~border_width:0
+        ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+      let _ =
+       GMisc.label ~text:("Enter the type of " ^ consname ^ ":")
+        ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+      let scrolled_window =
+       GBin.scrolled_window ~border_width:5
+        ~packing:(vbox#pack ~expand:true ~padding:0) () in
+      let newinputt =
+       TexTermEditor'.term_editor
+        mqi_handle
+        ~width:400 ~height:20 ~packing:scrolled_window#add
+        ~share_id_to_uris_with:inputt ()
+        ~isnotempty_callback:
+         (function b ->
+           (* (*non_empty_type := b ;*)
+           okb#misc#set_sensitive true) (*(b && uri_entry#text <> ""))*) *)())
+      in
+       newinputt
+    ) cons in
+  let hboxn =
+   GPack.hbox ~border_width:0
+    ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+  let okb =
+   GButton.button ~label:"> Next"
+    ~packing:(hboxn#pack ~expand:false ~fill:false ~padding:5) () in
+  let _ = okb#misc#set_sensitive true in
+  let cancelb =
+   GButton.button ~label:"Abort"
+    ~packing:(hboxn#pack ~expand:false ~fill:false ~padding:5) () in
+  ignore (window2#connect#destroy GMain.Main.quit) ;
+  ignore (cancelb#connect#clicked window2#destroy) ;
+  ignore
+   (okb#connect#clicked
+     (function () ->
+       try
+        chosen := true ;
+        let context,subst= !get_context_and_subst () in
+        let cons_types =
+         List.map2
+          (fun name inputt ->
+            let metasenv,expr =
+             inputt#get_metasenv_and_term ~context ~metasenv:[]
+            in
+             match metasenv with
+                [] ->
+                 let undebrujined_expr =
+                  List.fold_left
+                   (fun expr t -> CicSubstitution.subst t expr) expr subst
+                 in
+                  name, undebrujined_expr
+              | _ -> raise AmbiguousInput
+          ) cons cons_type_widgets
+        in
+         get_cons_types := (function () -> cons_types) ;
+         window2#destroy ()
+       with
+        e ->
+         output_html outputhtml
+          ("
" ^ Printexc.to_string e ^ "
") ;
+     )) ;
+  window2#show () ;
+  GtkThread.main ();
+  let okb_pressed = !chosen in
+   chosen := false ;
+   if (not okb_pressed) then
+    begin
+     window#destroy () ;
+     assert false (* The control never reaches this point *)
+    end
+   else
+    (!get_cons_types ())
+ in
+  phase1 () ;
+  (* No more phases left or Abort pressed *) 
+  window#show () ;
+  GtkThread.main ();
+  window#destroy () ;
+  if !chosen then
+   try
+    let uri = !get_uri () in
+(*CSC: Da finire *)
+    let params = [] in
+    let tys = !get_types_and_cons () in
+     let obj = Cic.InductiveDefinition tys params !paramsno in
+      begin
+       try
+        prerr_endline (CicPp.ppobj obj) ;
+        CicTypeChecker.typecheck_mutual_inductive_defs uri
+         (tys,params,!paramsno) ;
+        with
+         e ->
+          prerr_endline "Offending mutual (co)inductive type declaration:" ;
+          prerr_endline (CicPp.ppobj obj) ;
+      end ;
+      (* We already know that obj is well-typed. We need to add it to the  *)
+      (* environment in order to compute the inner-types without having to *)
+      (* debrujin it or having to modify lots of other functions to avoid  *)
+      (* asking the environment for the MUTINDs we are defining now.       *)
+      CicEnvironment.put_inductive_definition uri obj ;
+      save_obj uri obj ;
+      show_in_show_window_obj uri obj
+   with
+    e ->
+     output_html outputhtml
+      ("
" ^ Printexc.to_string e ^ "
") ;
 ;;
 
-(* Used to typecheck the loaded proofs *)
-let typecheck_loaded_proof metasenv bo ty =
- let module T = CicTypeChecker in
-  (*CSC: bisogna controllare anche il metasenv!!! *)
-  ignore (T.type_of_aux' metasenv [] ty) ;
-  ignore (T.type_of_aux' metasenv [] bo)
-;;
+let new_proof () =
+ let inputt = ((rendering_window ())#inputt : TermEditor.term_editor) in
+ let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
+ let output = ((rendering_window ())#output : TermViewer.proof_viewer) in
+ let notebook = (rendering_window ())#notebook in
 
-let load rendering_window () =
- let outputhtml = (rendering_window#outputhtml : GHtml.xmhtml) in
- let output = (rendering_window#output : GMathView.math_view) in
- let proofw = (rendering_window#proofw : GMathView.math_view) in
+ let chosen = ref false in
+ let get_metasenv_and_term = ref (function _ -> assert false) in
+ let get_uri = ref (function _ -> assert false) in
+ let non_empty_type = ref false in
+ let window =
+  GWindow.window
+   ~width:600 ~modal:true ~title:"New Proof or Definition"
+   ~border_width:2 () in
+ let vbox = GPack.vbox ~packing:window#add () in
+ let hbox =
+  GPack.hbox ~border_width:0
+   ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let _ =
+  GMisc.label ~text:"Enter the URI for the new theorem or definition:"
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let uri_entry =
+  GEdit.entry ~editable:true
+   ~packing:(hbox#pack ~expand:true ~fill:true ~padding:5) () in
+ let hbox1 =
+  GPack.hbox ~border_width:0
+   ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let _ =
+  GMisc.label ~text:"Enter the theorem or definition type:"
+   ~packing:(hbox1#pack ~expand:false ~fill:false ~padding:5) () in
+ let scrolled_window =
+  GBin.scrolled_window ~border_width:5
+   ~packing:(vbox#pack ~expand:true ~padding:0) () in
+ (* the content of the scrolled_window is moved below (see comment) *)
+ let hbox =
+  GPack.hbox ~border_width:0
+   ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let okb =
+  GButton.button ~label:"Ok"
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let _ = okb#misc#set_sensitive false in
+ let cancelb =
+  GButton.button ~label:"Cancel"
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ (* moved here to have visibility of the ok button *)
+ let newinputt =
+  TexTermEditor'.term_editor
+   mqi_handle
+   ~width:400 ~height:100 ~packing:scrolled_window#add
+   ~share_id_to_uris_with:inputt ()
+   ~isnotempty_callback:
+    (function b ->
+      non_empty_type := b ;
+      okb#misc#set_sensitive (b && uri_entry#text <> ""))
+ in
+ let _ =
+let xxx = inputt#get_as_string in
+prerr_endline ("######################## " ^ xxx) ;
+  newinputt#set_term xxx ;
+(*
+  newinputt#set_term inputt#get_as_string ;
+*)
+  inputt#reset in
+ let _ =
+  uri_entry#connect#changed
+   (function () ->
+     okb#misc#set_sensitive (!non_empty_type && uri_entry#text <> ""))
+ in
+ ignore (window#connect#destroy GMain.Main.quit) ;
+ ignore (cancelb#connect#clicked window#destroy) ;
+ ignore
+  (okb#connect#clicked
+    (function () ->
+      chosen := true ;
+      try
+       let metasenv,parsed = newinputt#get_metasenv_and_term [] [] in
+       let uristr = "cic:" ^ uri_entry#text in
+       let uri = UriManager.uri_of_string uristr in
+        if String.sub uristr (String.length uristr - 4) 4 <> ".con" then
+         raise NotAUriToAConstant
+        else
+         begin
+          try
+           ignore (Getter.resolve uri) ;
+           raise UriAlreadyInUse
+          with
+           Getter.Unresolved ->
+            get_metasenv_and_term := (function () -> metasenv,parsed) ;
+            get_uri := (function () -> uri) ; 
+            window#destroy ()
+         end
+      with
+       e ->
+        output_html outputhtml
+         ("
" ^ Printexc.to_string e ^ "
") ;
+  )) ;
+ window#show () ;
+ GtkThread.main ();
+ if !chosen then
   try
-   let uri = UriManager.uri_of_string "cic:/dummy.con" in
-    match CicParser.obj_of_xml prooffile uri with
-       Cic.CurrentProof (_,metasenv,bo,ty) ->
-        typecheck_loaded_proof metasenv bo ty ;
-        ProofEngine.proof :=
-         Some (uri, metasenv, bo, ty) ;
-        ProofEngine.goal :=
-         (match metasenv with
-             [] -> None
-           | (metano,_,_)::_ -> Some metano
-         ) ;
-        refresh_proof output ;
-        refresh_sequent proofw ;
-         output_html outputhtml
-          ("
Current proof loaded from " ^
-            prooffile ^ "
")
-     | _ -> assert false
+   let metasenv,expr = !get_metasenv_and_term () in
+    let _  = CicTypeChecker.type_of_aux' metasenv [] expr in
+     ProofEngine.proof :=
+      Some (!get_uri (), (1,[],expr)::metasenv, Cic.Meta (1,[]), expr) ;
+     ProofEngine.goal := Some 1 ;
+     refresh_goals notebook ;
+     refresh_proof output ;
+     !save_set_sensitive true ;
+     inputt#reset ;
+     ProofEngine.intros ~mk_fresh_name_callback () ;
+     refresh_goals notebook ;
+     refresh_proof output
   with
-     RefreshSequentException e ->
+     InvokeTactics.RefreshSequentException e ->
       output_html outputhtml
        ("
Exception raised during the refresh of the " ^
         "sequent: " ^ Printexc.to_string e ^ "
")
-   | RefreshProofException e ->
+   | InvokeTactics.RefreshProofException e ->
       output_html outputhtml
        ("
Exception raised during the refresh of the " ^
         "proof: " ^ Printexc.to_string e ^ "
")
@@ -835,173 +1578,85 @@ let load rendering_window () =
        ("
" ^ Printexc.to_string e ^ "
") ;
 ;;
 
-let proveit rendering_window () =
- let module L = LogicalOperations in
- let module G = Gdome in
- let outputhtml = (rendering_window#outputhtml : GHtml.xmhtml) in
-  match rendering_window#output#get_selection with
-    Some node ->
-     let xpath =
-      ((node : Gdome.element)#getAttributeNS
-      (*CSC: OCAML DIVERGE
-      ((element : G.element)#getAttributeNS
-      *)
-        ~namespaceURI:helmns
-        ~localName:(G.domString "xref"))#to_string
-     in
-      if xpath = "" then assert false (* "ERROR: No xref found!!!" *)
-      else
-       begin
-        try
-         match !current_cic_infos with
-            Some (ids_to_terms, ids_to_father_ids, _, _) ->
-             let id = xpath in
-              L.to_sequent id ids_to_terms ids_to_father_ids ;
-              refresh_proof rendering_window#output ;
-              refresh_sequent rendering_window#proofw
-          | None -> assert false (* "ERROR: No current term!!!" *)
-        with
-           RefreshSequentException e ->
-            output_html outputhtml
-             ("
Exception raised during the refresh of the " ^
-              "sequent: " ^ Printexc.to_string e ^ "
")
-         | RefreshProofException e ->
-            output_html outputhtml
-             ("
Exception raised during the refresh of the " ^
-              "proof: " ^ Printexc.to_string e ^ "
")
-         | e ->
-            output_html outputhtml
-             ("
" ^ Printexc.to_string e ^ "
")
-       end
-  | None -> assert false (* "ERROR: No selection!!!" *)
-;;
-
-let focus rendering_window () =
- let module L = LogicalOperations in
- let module G = Gdome in
- let outputhtml = (rendering_window#outputhtml : GHtml.xmhtml) in
-  match rendering_window#output#get_selection with
-    Some node ->
-     let xpath =
-      ((node : Gdome.element)#getAttributeNS
-      (*CSC: OCAML DIVERGE
-      ((element : G.element)#getAttributeNS
-      *)
-        ~namespaceURI:helmns
-        ~localName:(G.domString "xref"))#to_string
-     in
-      if xpath = "" then assert false (* "ERROR: No xref found!!!" *)
-      else
-       begin
-        try
-         match !current_cic_infos with
-            Some (ids_to_terms, ids_to_father_ids, _, _) ->
-             let id = xpath in
-              L.focus id ids_to_terms ids_to_father_ids ;
-              refresh_sequent rendering_window#proofw
-          | None -> assert false (* "ERROR: No current term!!!" *)
-        with
-           RefreshSequentException e ->
-            output_html outputhtml
-             ("
Exception raised during the refresh of the " ^
-              "sequent: " ^ Printexc.to_string e ^ "
")
-         | RefreshProofException e ->
-            output_html outputhtml
-             ("
Exception raised during the refresh of the " ^
-              "proof: " ^ Printexc.to_string e ^ "
")
-         | e ->
-            output_html outputhtml
-             ("
" ^ Printexc.to_string e ^ "
")
-       end
-  | None -> assert false (* "ERROR: No selection!!!" *)
-;;
-
-exception NoPrevGoal;;
-exception NoNextGoal;;
-
-let prevgoal metasenv metano =
- let rec aux =
-  function
-     [] -> assert false
-   | [(m,_,_)] -> raise NoPrevGoal
-   | (n,_,_)::(m,_,_)::_ when m=metano -> n
-   | _::tl -> aux tl
- in
-  aux metasenv
-;;
-
-let nextgoal metasenv metano =
- let rec aux =
-  function
-     [] -> assert false
-   | [(m,_,_)] when m = metano -> raise NoNextGoal
-   | (m,_,_)::(n,_,_)::_ when m=metano -> n
-   | _::tl -> aux tl
- in
-  aux metasenv
+let check_term_in_scratch scratch_window metasenv context expr = 
+ try
+  let ty = CicTypeChecker.type_of_aux' metasenv context expr in
+  let expr = Cic.Cast (expr,ty) in
+   scratch_window#show () ;
+   scratch_window#set_term expr ;
+   scratch_window#set_context context ;
+   scratch_window#set_metasenv metasenv ;
+   scratch_window#sequent_viewer#load_sequent metasenv (111,context,expr)
+ with
+  e ->
+   print_endline ("? " ^ CicPp.ppterm expr) ;
+   raise e
 ;;
 
-let prev_or_next_goal select_goal rendering_window () =
- let module L = LogicalOperations in
- let module G = Gdome in
- let outputhtml = (rendering_window#outputhtml : GHtml.xmhtml) in
+let check scratch_window () =
+ let inputt = ((rendering_window ())#inputt : TermEditor.term_editor) in
+ let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
   let metasenv =
    match !ProofEngine.proof with
-      None -> assert false
+      None -> []
     | Some (_,metasenv,_,_) -> metasenv
   in
-  let metano =
+  let context =
    match !ProofEngine.goal with
-      None -> assert false
-    | Some m -> m
+      None -> []
+    | Some metano ->
+       let (_,canonical_context,_) =
+        List.find (function (m,_,_) -> m=metano) metasenv
+       in
+        canonical_context
   in
    try
-    ProofEngine.goal := Some (select_goal metasenv metano) ;
-    refresh_sequent rendering_window#proofw
+    let metasenv',expr = inputt#get_metasenv_and_term context metasenv in
+     check_term_in_scratch scratch_window metasenv' context expr
    with
-      RefreshSequentException e ->
-       output_html outputhtml
-        ("
Exception raised during the refresh of the " ^
-         "sequent: " ^ Printexc.to_string e ^ "
")
-    | e ->
-       output_html outputhtml
-        ("
" ^ Printexc.to_string e ^ "
")
+    e ->
+     output_html outputhtml
+      ("
" ^ Printexc.to_string e ^ "
") ;
+;;
+
+let show () =
+ let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
+  try
+   show_in_show_window_uri (input_or_locate_uri ~title:"Show")
+  with
+   e ->
+    output_html outputhtml
+     ("
" ^ Printexc.to_string e ^ "
") ;
 ;;
 
 exception NotADefinition;;
 
-let open_ rendering_window () =
- let inputt = (rendering_window#inputt : GEdit.text) in
- let oldinputt = (rendering_window#oldinputt : GEdit.text) in
- let outputhtml = (rendering_window#outputhtml : GHtml.xmhtml) in
- let output = (rendering_window#output : GMathView.math_view) in
- let proofw = (rendering_window#proofw : GMathView.math_view) in
-  let inputlen = inputt#length in
-  let input = inputt#get_chars 0 inputlen ^ "\n" in
+let open_ () =
+ let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
+ let output = ((rendering_window ())#output : TermViewer.proof_viewer) in
+ let notebook = (rendering_window ())#notebook in
    try
-    let uri = UriManager.uri_of_string ("cic:" ^ input) in
+    let uri = input_or_locate_uri ~title:"Open" in
      CicTypeChecker.typecheck uri ;
      let metasenv,bo,ty =
-      match CicEnvironment.get_cooked_obj uri 0 with
-         Cic.Definition (_,bo,ty,_) -> [],bo,ty
-       | Cic.CurrentProof (_,metasenv,bo,ty) -> metasenv,bo,ty
-       | Cic.Axiom _
+      match CicEnvironment.get_cooked_obj uri with
+         Cic.Constant (_,Some bo,ty,_) -> [],bo,ty
+       | Cic.CurrentProof (_,metasenv,bo,ty,_) -> metasenv,bo,ty
+       | Cic.Constant _
        | Cic.Variable _
        | Cic.InductiveDefinition _ -> raise NotADefinition
      in
       ProofEngine.proof :=
        Some (uri, metasenv, bo, ty) ;
       ProofEngine.goal := None ;
-      refresh_sequent proofw ;
-      refresh_proof output ;
-      inputt#delete_text 0 inputlen ;
-      ignore(oldinputt#insert_text input oldinputt#length)
+      refresh_goals notebook ;
+      refresh_proof output
    with
-      RefreshSequentException e ->
+      InvokeTactics.RefreshSequentException e ->
        output_html outputhtml
         ("
Exception raised during the refresh of the " ^
          "sequent: " ^ Printexc.to_string e ^ "
")
-    | RefreshProofException e ->
+    | InvokeTactics.RefreshProofException e ->
        output_html outputhtml
         ("
Exception raised during the refresh of the " ^
          "proof: " ^ Printexc.to_string e ^ "
")
@@ -1010,208 +1665,514 @@ let open_ rendering_window () =
         ("
" ^ Printexc.to_string e ^ "
") ;
 ;;
 
-let state rendering_window () =
- let inputt = (rendering_window#inputt : GEdit.text) in
- let oldinputt = (rendering_window#oldinputt : GEdit.text) in
- let outputhtml = (rendering_window#outputhtml : GHtml.xmhtml) in
- let output = (rendering_window#output : GMathView.math_view) in
- let proofw = (rendering_window#proofw : GMathView.math_view) in
-  let inputlen = inputt#length in
-  let input = inputt#get_chars 0 inputlen ^ "\n" in
-   (* Do something interesting *)
-   let lexbuf = Lexing.from_string input in
-    try
-     while true do
-      (* Execute the actions *)
-      match CicTextualParser.main CicTextualLexer.token lexbuf with
-         None -> ()
-       | Some expr ->
-          let _  = CicTypeChecker.type_of_aux' [] [] expr in
-           ProofEngine.proof :=
-            Some (UriManager.uri_of_string "cic:/dummy.con",
-                   [1,[],expr], Cic.Meta (1,[]), expr) ;
-           ProofEngine.goal := Some 1 ;
-           refresh_sequent proofw ;
-           refresh_proof output ;
-     done
-    with
-       CicTextualParser0.Eof ->
-        inputt#delete_text 0 inputlen ;
-        ignore(oldinputt#insert_text input oldinputt#length)
-     | RefreshSequentException e ->
-        output_html outputhtml
-         ("
Exception raised during the refresh of the " ^
-          "sequent: " ^ Printexc.to_string e ^ "
")
-     | RefreshProofException e ->
-        output_html outputhtml
-         ("
Exception raised during the refresh of the " ^
-          "proof: " ^ Printexc.to_string e ^ "
")
-     | e ->
-        output_html outputhtml
-         ("
" ^ Printexc.to_string e ^ "
") ;
+let show_query_results results =
+ let window =
+  GWindow.window
+   ~modal:false ~title:"Query results." ~border_width:2 () in
+ let vbox = GPack.vbox ~packing:window#add () in
+ let hbox =
+  GPack.hbox ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let lMessage =
+  GMisc.label
+   ~text:"Click on a URI to show that object"
+   ~packing:hbox#add () in
+ let scrolled_window =
+  GBin.scrolled_window ~border_width:10 ~height:400 ~width:600
+   ~packing:(vbox#pack ~expand:true ~fill:true ~padding:5) () in
+ let clist = GList.clist ~columns:1 ~packing:scrolled_window#add () in
+  ignore
+   (List.map
+     (function (uri,_) ->
+       let n =
+        clist#append [uri]
+       in
+        clist#set_row ~selectable:false n
+     ) results
+   ) ;
+  clist#columns_autosize () ;
+  ignore
+   (clist#connect#select_row
+     (fun ~row ~column ~event ->
+       let (uristr,_) = List.nth results row in
+        match
+         MQueryMisc.cic_textual_parser_uri_of_string
+          (MQueryMisc.wrong_xpointer_format_from_wrong_xpointer_format'
+            uristr)
+        with
+           CicTextualParser0.ConUri uri
+         | CicTextualParser0.VarUri uri
+         | CicTextualParser0.IndTyUri (uri,_)
+         | CicTextualParser0.IndConUri (uri,_,_) ->
+            show_in_show_window_uri uri
+     )
+   ) ;
+  window#show ()
 ;;
 
-let check rendering_window scratch_window () =
- let inputt = (rendering_window#inputt : GEdit.text) in
- let outputhtml = (rendering_window#outputhtml : GHtml.xmhtml) in
- let output = (rendering_window#output : GMathView.math_view) in
- let proofw = (rendering_window#proofw : GMathView.math_view) in
-  let inputlen = inputt#length in
-  let input = inputt#get_chars 0 inputlen ^ "\n" in
-  let curi,metasenv =
-   match !ProofEngine.proof with
-      None -> UriManager.uri_of_string "cic:/dummy.con", []
-    | Some (curi,metasenv,_,_) -> curi,metasenv
-  in
-  let context,names_context =
-   let context =
-    match !ProofEngine.goal with
-       None -> []
-     | Some metano ->
-        let (_,canonical_context,_) =
-         List.find (function (m,_,_) -> m=metano) metasenv
-        in
-         canonical_context
+let refine_constraints (must_obj,must_rel,must_sort) =
+ let chosen = ref false in
+ let use_only = ref false in
+ let window =
+  GWindow.window
+   ~modal:true ~title:"Constraints refinement."
+   ~width:800 ~border_width:2 () in
+ let vbox = GPack.vbox ~packing:window#add () in
+ let hbox =
+  GPack.hbox ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let lMessage =
+  GMisc.label
+   ~text: "\"Only\" constraints can be enforced or not."
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let onlyb =
+  GButton.toggle_button ~label:"Enforce \"only\" constraints"
+   ~active:false ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) ()
+ in
+  ignore
+   (onlyb#connect#toggled (function () -> use_only := onlyb#active)) ;
+ (* Notebook for the constraints choice *)
+ let notebook =
+  GPack.notebook ~scrollable:true
+   ~packing:(vbox#pack ~expand:true ~fill:true ~padding:5) () in
+ (* Rel constraints *)
+ let label =
+  GMisc.label
+   ~text: "Constraints on Rels" () in
+ let vbox' =
+  GPack.vbox ~packing:(notebook#append_page ~tab_label:label#coerce)
+   () in
+ let hbox =
+  GPack.hbox ~packing:(vbox'#pack ~expand:false ~fill:false ~padding:5) () in
+ let lMessage =
+  GMisc.label
+   ~text: "You can now specify the constraints on Rels."
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let expected_height = 25 * (List.length must_rel + 2) in
+ let height = if expected_height > 400 then 400 else expected_height in
+ let scrolled_window =
+  GBin.scrolled_window ~border_width:10 ~height ~width:600
+   ~packing:(vbox'#pack ~expand:true ~fill:true ~padding:5) () in
+ let scrolled_vbox = GPack.vbox ~packing:scrolled_window#add_with_viewport () in
+ let rel_constraints =
+  List.map
+   (function (position,depth) ->
+     let hbox =
+      GPack.hbox
+       ~packing:(scrolled_vbox#pack ~expand:false ~fill:false ~padding:5) () in
+     let lMessage =
+      GMisc.label
+       ~text:position
+       ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+     match depth with
+        None -> position, ref None
+      | Some depth' ->
+         let mutable_ref = ref (Some depth') in
+         let depthb =
+          GButton.toggle_button
+           ~label:("depth = " ^ string_of_int depth') ~active:true
+           ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) ()
+         in
+          ignore
+           (depthb#connect#toggled
+             (function () ->
+               let sel_depth = if depthb#active then Some depth' else None in
+                mutable_ref := sel_depth
+            )) ;
+          position, mutable_ref
+   ) must_rel in
+ (* Sort constraints *)
+ let label =
+  GMisc.label
+   ~text: "Constraints on Sorts" () in
+ let vbox' =
+  GPack.vbox ~packing:(notebook#append_page ~tab_label:label#coerce)
+   () in
+ let hbox =
+  GPack.hbox ~packing:(vbox'#pack ~expand:false ~fill:false ~padding:5) () in
+ let lMessage =
+  GMisc.label
+   ~text: "You can now specify the constraints on Sorts."
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let expected_height = 25 * (List.length must_sort + 2) in
+ let height = if expected_height > 400 then 400 else expected_height in
+ let scrolled_window =
+  GBin.scrolled_window ~border_width:10 ~height ~width:600
+   ~packing:(vbox'#pack ~expand:true ~fill:true ~padding:5) () in
+ let scrolled_vbox = GPack.vbox ~packing:scrolled_window#add_with_viewport () in
+ let sort_constraints =
+  List.map
+   (function (position,depth,sort) ->
+     let hbox =
+      GPack.hbox
+       ~packing:(scrolled_vbox#pack ~expand:false ~fill:false ~padding:5) () in
+     let lMessage =
+      GMisc.label
+       ~text:(sort ^ " " ^ position)
+       ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+     match depth with
+        None -> position, ref None, sort
+      | Some depth' ->
+         let mutable_ref = ref (Some depth') in
+         let depthb =
+          GButton.toggle_button ~label:("depth = " ^ string_of_int depth')
+           ~active:true
+           ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) ()
+         in
+          ignore
+           (depthb#connect#toggled
+             (function () ->
+               let sel_depth = if depthb#active then Some depth' else None in
+                mutable_ref := sel_depth
+            )) ;
+          position, mutable_ref, sort
+   ) must_sort in
+ (* Obj constraints *)
+ let label =
+  GMisc.label
+   ~text: "Constraints on constants" () in
+ let vbox' =
+  GPack.vbox ~packing:(notebook#append_page ~tab_label:label#coerce)
+   () in
+ let hbox =
+  GPack.hbox ~packing:(vbox'#pack ~expand:false ~fill:false ~padding:5) () in
+ let lMessage =
+  GMisc.label
+   ~text: "You can now specify the constraints on constants."
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let expected_height = 25 * (List.length must_obj + 2) in
+ let height = if expected_height > 400 then 400 else expected_height in
+ let scrolled_window =
+  GBin.scrolled_window ~border_width:10 ~height ~width:600
+   ~packing:(vbox'#pack ~expand:true ~fill:true ~padding:5) () in
+ let scrolled_vbox = GPack.vbox ~packing:scrolled_window#add_with_viewport () in
+ let obj_constraints =
+  List.map
+   (function (uri,position,depth) ->
+     let hbox =
+      GPack.hbox
+       ~packing:(scrolled_vbox#pack ~expand:false ~fill:false ~padding:5) () in
+     let lMessage =
+      GMisc.label
+       ~text:(uri ^ " " ^ position)
+       ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+     match depth with
+        None -> uri, position, ref None
+      | Some depth' ->
+         let mutable_ref = ref (Some depth') in
+         let depthb =
+          GButton.toggle_button ~label:("depth = " ^ string_of_int depth')
+           ~active:true
+           ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) ()
+         in
+          ignore
+           (depthb#connect#toggled
+             (function () ->
+               let sel_depth = if depthb#active then Some depth' else None in
+                mutable_ref := sel_depth
+            )) ;
+          uri, position, mutable_ref
+   ) must_obj in
+ (* Confirm/abort buttons *)
+ let hbox =
+  GPack.hbox ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let okb =
+  GButton.button ~label:"Ok"
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let cancelb =
+  GButton.button ~label:"Abort"
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) ()
+ in
+  ignore (window#connect#destroy GMain.Main.quit) ;
+  ignore (cancelb#connect#clicked window#destroy) ;
+  ignore
+   (okb#connect#clicked (function () -> chosen := true ; window#destroy ()));
+  window#set_position `CENTER ;
+  window#show () ;
+  GtkThread.main ();
+  if !chosen then
+   let chosen_must_rel =
+    List.map
+     (function (position,ref_depth) -> position,!ref_depth) rel_constraints in
+   let chosen_must_sort =
+    List.map
+     (function (position,ref_depth,sort) -> position,!ref_depth,sort)
+     sort_constraints
    in
-    context,
+   let chosen_must_obj =
     List.map
-     (function
-         Some (n,_) -> Some n
-       | None -> None
-     ) context
-  in
-   (* Do something interesting *)
-   let lexbuf = Lexing.from_string input in
-    try
-     while true do
-      (* Execute the actions *)
-      match
-       CicTextualParserContext.main curi names_context metasenv
-        CicTextualLexer.token lexbuf
-      with
-         None -> ()
-       | Some (metasenv',expr) ->
-          try
-           let ty  = CicTypeChecker.type_of_aux' metasenv' context expr in
-            let mml = mml_of_cic_term 111 (Cic.Cast (expr,ty)) in
-             scratch_window#show () ;
-             scratch_window#mmlwidget#load_tree ~dom:mml
-          with
-           e ->
-            print_endline ("? " ^ CicPp.ppterm expr) ;
-            raise e
-     done
-    with
-       CicTextualParser0.Eof -> ()
-     | e ->
-       output_html outputhtml
-        ("
" ^ Printexc.to_string e ^ "
") ;
+     (function (uri,position,ref_depth) -> uri,position,!ref_depth)
+     obj_constraints
+   in
+    (chosen_must_obj,chosen_must_rel,chosen_must_sort),
+     (if !use_only then
+(*CSC: ???????????????????????? I assume that must and only are the same... *)
+       Some chosen_must_obj,Some chosen_must_rel,Some chosen_must_sort
+      else
+       None,None,None
+     )
+  else
+   raise NoChoice
 ;;
 
-exception NoObjectsLocated;;
-
-let user_uri_choice uris =
- let uri =
-  match uris with
-     [] -> raise NoObjectsLocated
-   | [uri] -> uri
-   | uris ->
-      let choice =
-       GToolbox.question_box ~title:"Ambiguous result."
-        ~buttons:uris ~default:1
-        "Ambiguous result. Please, choose one."
-      in
-       List.nth uris (choice-1)
- in
-  String.sub uri 4 (String.length uri - 4)
+let completeSearchPattern () =
+ let inputt = ((rendering_window ())#inputt : TermEditor.term_editor) in
+ let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
+  try
+   let metasenv,expr = inputt#get_metasenv_and_term ~context:[] ~metasenv:[] in
+   let must = MQueryLevels2.get_constraints expr in
+   let must',only = refine_constraints must in
+   let query = MQG.query_of_constraints None must' only in
+   let results = MQI.execute mqi_handle query in 
+    show_query_results results
+  with
+   e ->
+    output_html outputhtml
+     ("
" ^ Printexc.to_string e ^ "
") ;
 ;;
 
-(* CSC: IMPERATIVE AND NOT VERY CLEAN, TO GET THE LAST ISSUED QUERY *)
-let get_last_query = 
- let query = ref "" in
-  MQueryGenerator.set_confirm_query
-   (function q -> query := MQueryUtil.text_of_query q ; true) ;
-  function result -> !query ^ " 
Result:
 " ^ MQueryUtil.text_of_result result "
"
+let insertQuery () =
+ let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
+  try
+   let chosen = ref None in
+   let window =
+    GWindow.window
+     ~modal:true ~title:"Insert Query (Experts Only)" ~border_width:2 () in
+   let vbox = GPack.vbox ~packing:window#add () in
+   let label =
+    GMisc.label ~text:"Insert Query. For Experts Only."
+     ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+   let scrolled_window =
+    GBin.scrolled_window ~border_width:10 ~height:400 ~width:600
+     ~packing:(vbox#pack ~expand:true ~fill:true ~padding:5) () in
+   let input = GEdit.text ~editable:true
+    ~packing:scrolled_window#add () in
+   let hbox =
+    GPack.hbox ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+   let okb =
+    GButton.button ~label:"Ok"
+     ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+   let loadb =
+    GButton.button ~label:"Load from file..."
+     ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+   let cancelb =
+    GButton.button ~label:"Abort"
+     ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+   ignore (window#connect#destroy GMain.Main.quit) ;
+   ignore (cancelb#connect#clicked window#destroy) ;
+   ignore
+    (okb#connect#clicked
+      (function () ->
+        chosen := Some (input#get_chars 0 input#length) ; window#destroy ())) ;
+   ignore
+    (loadb#connect#clicked
+      (function () ->
+        match
+         GToolbox.select_file ~title:"Select Query File" ()
+        with
+           None -> ()
+         | Some filename ->
+            let inch = open_in filename in
+             let rec read_file () =
+              try
+               let line = input_line inch in
+                line ^ "\n" ^ read_file ()
+              with
+               End_of_file -> ""
+             in
+              let text = read_file () in
+               input#delete_text 0 input#length ;
+               ignore (input#insert_text text ~pos:0))) ;
+   window#set_position `CENTER ;
+   window#show () ;
+   GtkThread.main ();
+   match !chosen with
+      None -> ()
+    | Some q ->
+       let results =
+        MQI.execute mqi_handle (MQueryUtil.query_of_text (Lexing.from_string q))
+       in
+        show_query_results results
+  with
+   e ->
+    output_html outputhtml
+     ("
" ^ Printexc.to_string e ^ "
") ;
 ;;
 
-let locate rendering_window () =
- let inputt = (rendering_window#inputt : GEdit.text) in
- let outputhtml = (rendering_window#outputhtml : GHtml.xmhtml) in
-  let inputlen = inputt#length in
-  let input = inputt#get_chars 0 inputlen in
-   try
-    match Str.split (Str.regexp "[ \t]+") input with
-       [] -> ()
-     | head :: tail ->
-        inputt#delete_text 0 inputlen ;
-        let result = MQueryGenerator.locate head in
-	let uris =
-         List.map
-          (function uri,_ -> wrong_xpointer_format_from_wrong_xpointer_format' uri)
-          result in
-	let html = (" 
Locate Query: 
" ^ get_last_query result ^ "
") in
-         output_html outputhtml html ;
-         let uri' = user_uri_choice uris in
-          ignore ((inputt#insert_text uri') ~pos:0)
-   with
-    e ->
-     output_html outputhtml
-      ("
" ^ Printexc.to_string e ^ "
")
+let choose_must list_of_must only =
+ let chosen = ref None in
+ let user_constraints = ref [] in
+ let window =
+  GWindow.window
+   ~modal:true ~title:"Query refinement." ~border_width:2 () in
+ let vbox = GPack.vbox ~packing:window#add () in
+ let hbox =
+  GPack.hbox ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let lMessage =
+  GMisc.label
+   ~text:
+    ("You can now specify the genericity of the query. " ^
+     "The more generic the slower.")
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let hbox =
+  GPack.hbox ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let lMessage =
+  GMisc.label
+   ~text:
+    "Suggestion: start with faster queries before moving to more generic ones."
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let notebook =
+  GPack.notebook ~scrollable:true
+   ~packing:(vbox#pack ~expand:true ~fill:true ~padding:5) () in
+ let _ =
+  let page = ref 0 in
+  let last = List.length list_of_must in
+  List.map
+   (function must ->
+     incr page ;
+     let label =
+      GMisc.label ~text:
+       (if !page = 1 then "More generic" else
+         if !page = last then "More precise" else "          ") () in
+     let expected_height = 25 * (List.length must + 2) in
+     let height = if expected_height > 400 then 400 else expected_height in
+     let scrolled_window =
+      GBin.scrolled_window ~border_width:10 ~height ~width:600
+       ~packing:(notebook#append_page ~tab_label:label#coerce) () in
+     let clist =
+        GList.clist ~columns:2 ~packing:scrolled_window#add
+         ~titles:["URI" ; "Position"] ()
+     in
+      ignore
+       (List.map
+         (function (uri,position) ->
+           let n =
+            clist#append 
+             [uri; if position then "MainConclusion" else "Conclusion"]
+           in
+            clist#set_row ~selectable:false n
+         ) must
+       ) ;
+      clist#columns_autosize ()
+   ) list_of_must in
+ let _ =
+  let label = GMisc.label ~text:"User provided" () in
+  let vbox =
+   GPack.vbox ~packing:(notebook#append_page ~tab_label:label#coerce) () in
+  let hbox =
+   GPack.hbox ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+  let lMessage =
+   GMisc.label
+   ~text:"Select the constraints that must be satisfied and press OK."
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+  let expected_height = 25 * (List.length only + 2) in
+  let height = if expected_height > 400 then 400 else expected_height in
+  let scrolled_window =
+   GBin.scrolled_window ~border_width:10 ~height ~width:600
+    ~packing:(vbox#pack ~expand:true ~fill:true ~padding:5) () in
+  let clist =
+   GList.clist ~columns:2 ~packing:scrolled_window#add
+    ~selection_mode:`EXTENDED
+    ~titles:["URI" ; "Position"] ()
+  in
+   ignore
+    (List.map
+      (function (uri,position) ->
+        let n =
+         clist#append 
+          [uri; if position then "MainConclusion" else "Conclusion"]
+        in
+         clist#set_row ~selectable:true n
+      ) only
+    ) ;
+   clist#columns_autosize () ;
+   ignore
+    (clist#connect#select_row
+      (fun ~row ~column ~event ->
+        user_constraints := (List.nth only row)::!user_constraints)) ;
+   ignore
+    (clist#connect#unselect_row
+      (fun ~row ~column ~event ->
+        user_constraints :=
+         List.filter
+          (function uri -> uri != (List.nth only row)) !user_constraints)) ;
+ in
+ let hbox =
+  GPack.hbox ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let okb =
+  GButton.button ~label:"Ok"
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ let cancelb =
+  GButton.button ~label:"Abort"
+   ~packing:(hbox#pack ~expand:false ~fill:false ~padding:5) () in
+ (* actions *)
+ ignore (window#connect#destroy GMain.Main.quit) ;
+ ignore (cancelb#connect#clicked window#destroy) ;
+ ignore
+  (okb#connect#clicked
+    (function () -> chosen := Some notebook#current_page ; window#destroy ())) ;
+ window#set_position `CENTER ;
+ window#show () ;
+ GtkThread.main ();
+ match !chosen with
+    None -> raise NoChoice
+  | Some n ->
+     if n = List.length list_of_must then
+      (* user provided constraints *)
+      !user_constraints
+     else
+      List.nth list_of_must n
 ;;
 
-let backward rendering_window () =
- let outputhtml = (rendering_window#outputhtml : GHtml.xmhtml) in
- let inputt = (rendering_window#inputt : GEdit.text) in
-  let inputlen = inputt#length in
-  let input = inputt#get_chars 0 inputlen in
-  let level = int_of_string input in
-  let metasenv =
-   match !ProofEngine.proof with
-      None -> assert false
-    | Some (_,metasenv,_,_) -> metasenv
-  in
-   try
-    match !ProofEngine.goal with
-       None -> ()
-     | Some metano ->
-        let (_, ey ,ty) = List.find (function (m,_,_) -> m=metano) metasenv in
-         let result = MQueryGenerator.backward metasenv ey ty level in
-         let uris =
-          List.map
-           (function uri,_ -> wrong_xpointer_format_from_wrong_xpointer_format' uri)
-           result in
-         let html =
-	  " 
Backward Query: 
" ^
-	  " 
Levels: 
 " ^
-	   MQueryGenerator.string_of_levels (MQueryGenerator.levels_of_term metasenv ey ty) "
" ^
-	   " 
" ^ get_last_query result ^ "
" in
-          output_html outputhtml html ;
-          let uri' = user_uri_choice uris in
-           inputt#delete_text 0 inputlen ;
-           ignore ((inputt#insert_text uri') ~pos:0)
-    with
-     e -> 
-      output_html outputhtml 
-       ("
" ^ Printexc.to_string e ^ "
")
+let searchPattern () =
+ let inputt = ((rendering_window ())#inputt : TermEditor.term_editor) in
+ let outputhtml = ((rendering_window ())#outputhtml : GHtml.xmhtml) in
+  try
+    let proof =
+     match !ProofEngine.proof with
+        None -> assert false
+      | Some proof -> proof
+    in
+     match !ProofEngine.goal with
+      | None -> ()
+      | Some metano ->
+         let uris' =
+           TacticChaser.searchPattern
+	    mqi_handle
+            ~output_html:(output_html outputhtml) ~choose_must ()
+            ~status:(proof, metano)
+         in
+         let uri' =
+          user_uri_choice ~title:"Ambiguous input."
+          ~msg: "Many lemmas can be successfully applied. Please, choose one:"
+           uris'
+         in
+          inputt#set_term uri' ;
+          InvokeTactics'.apply ()
+  with
+   e -> 
+    output_html outputhtml 
+     ("
" ^ Printexc.to_string e ^ "
")
 ;;
       
-let choose_selection
-     (mmlwidget : GMathView.math_view) (element : Gdome.element option)
-=
+let choose_selection mmlwidget (element : Gdome.element option) =
  let module G = Gdome in
   let rec aux element =
    if element#hasAttributeNS
-       ~namespaceURI:helmns
+       ~namespaceURI:Misc.helmns
        ~localName:(G.domString "xref")
    then
      mmlwidget#set_selection (Some element)
    else
+    try
       match element#get_parentNode with
          None -> assert false
        (*CSC: OCAML DIVERGES!
        | Some p -> aux (new G.element_of_node p)
        *)
        | Some p -> aux (new Gdome.element_of_node p)
+    with
+       GdomeInit.DOMCastException _ ->
+        prerr_endline
+         "******* trying to select above the document root ********"
   in
    match element with
      Some x -> aux x
@@ -1222,30 +2183,37 @@ let choose_selection
 
 (* Stuff for the widget settings *)
 
-let export_to_postscript (output : GMathView.math_view) () =
- output#export_to_postscript ~filename:"output.ps" ();
+let export_to_postscript output =
+ let lastdir = ref (Unix.getcwd ()) in
+  function () ->
+   match
+    GToolbox.select_file ~title:"Export to PostScript"
+     ~dir:lastdir ~filename:"screenshot.ps" ()
+   with
+      None -> ()
+    | Some filename ->
+       (output :> GMathView.math_view)#export_to_postscript
+         ~filename:filename ();
 ;;
 
-let activate_t1 (output : GMathView.math_view) button_set_anti_aliasing
- button_set_kerning button_set_transparency button_export_to_postscript
+let activate_t1 output button_set_anti_aliasing
+ button_set_transparency export_to_postscript_menu_item
  button_t1 ()
 =
  let is_set = button_t1#active in
   output#set_font_manager_type
-   (if is_set then `font_manager_t1 else `font_manager_gtk) ;
+   ~fm_type:(if is_set then `font_manager_t1 else `font_manager_gtk) ;
   if is_set then
    begin
     button_set_anti_aliasing#misc#set_sensitive true ;
-    button_set_kerning#misc#set_sensitive true ;
     button_set_transparency#misc#set_sensitive true ;
-    button_export_to_postscript#misc#set_sensitive true ;
+    export_to_postscript_menu_item#misc#set_sensitive true ;
    end
   else
    begin
     button_set_anti_aliasing#misc#set_sensitive false ;
-    button_set_kerning#misc#set_sensitive false ;
     button_set_transparency#misc#set_sensitive false ;
-    button_export_to_postscript#misc#set_sensitive false ;
+    export_to_postscript_menu_item#misc#set_sensitive false ;
    end
 ;;
 
@@ -1253,10 +2221,6 @@ let set_anti_aliasing output button_set_anti_aliasing () =
  output#set_anti_aliasing button_set_anti_aliasing#active
 ;;
 
-let set_kerning output button_set_kerning () =
- output#set_kerning button_set_kerning#active
-;;
-
 let set_transparency output button_set_transparency () =
  output#set_transparency button_set_transparency#active
 ;;
@@ -1269,8 +2233,8 @@ let set_log_verbosity output log_verbosity_spinb () =
  output#set_log_verbosity log_verbosity_spinb#value_as_int
 ;;
 
-class settings_window (output : GMathView.math_view) sw
- button_export_to_postscript selection_changed_callback
+class settings_window output sw
+ export_to_postscript_menu_item selection_changed_callback
 =
  let settings_window = GWindow.window ~title:"GtkMathView settings" () in
  let vbox =
@@ -1285,9 +2249,6 @@ class settings_window (output : GMathView.math_view) sw
  let button_set_anti_aliasing =
   GButton.toggle_button ~label:"set_anti_aliasing"
    ~packing:(table#attach ~left:0 ~top:1) () in
- let button_set_kerning =
-  GButton.toggle_button ~label:"set_kerning"
-   ~packing:(table#attach ~left:1 ~top:1) () in
  let button_set_transparency =
   GButton.toggle_button ~label:"set_transparency"
    ~packing:(table#attach ~left:2 ~top:1) () in
@@ -1322,17 +2283,14 @@ object(self)
  method show = settings_window#show
  initializer
   button_set_anti_aliasing#misc#set_sensitive false ;
-  button_set_kerning#misc#set_sensitive false ;
   button_set_transparency#misc#set_sensitive false ;
   (* Signals connection *)
   ignore(button_t1#connect#clicked
-   (activate_t1 output button_set_anti_aliasing button_set_kerning
-    button_set_transparency button_export_to_postscript button_t1)) ;
+   (activate_t1 output button_set_anti_aliasing
+    button_set_transparency export_to_postscript_menu_item button_t1)) ;
   ignore(font_size_spinb#connect#changed (changefont output font_size_spinb)) ;
   ignore(button_set_anti_aliasing#connect#toggled
    (set_anti_aliasing output button_set_anti_aliasing));
-  ignore(button_set_kerning#connect#toggled
-   (set_kerning output button_set_kerning)) ;
   ignore(button_set_transparency#connect#toggled
    (set_transparency output button_set_transparency)) ;
   ignore(log_verbosity_spinb#connect#changed
@@ -1342,9 +2300,11 @@ end;;
 
 (* Scratch window *)
 
-class scratch_window outputhtml =
+class scratch_window =
  let window =
-  GWindow.window ~title:"MathML viewer" ~border_width:2 () in
+  GWindow.window
+    ~title:"MathML viewer"
+    ~border_width:2 () in
  let vbox =
   GPack.vbox ~packing:window#add () in
  let hbox =
@@ -1361,293 +2321,540 @@ class scratch_window outputhtml =
  let scrolled_window =
   GBin.scrolled_window ~border_width:10
    ~packing:(vbox#pack ~expand:true ~padding:5) () in
- let mmlwidget =
-  GMathView.math_view
+ let sequent_viewer =
+  TermViewer.sequent_viewer
    ~packing:(scrolled_window#add) ~width:400 ~height:280 () in
 object(self)
- method outputhtml = outputhtml
- method mmlwidget = mmlwidget
+ val mutable term = Cic.Rel 1                 (* dummy value *)
+ val mutable context = ([] : Cic.context)     (* dummy value *)
+ val mutable metasenv = ([] : Cic.metasenv)   (* dummy value *)
+ method sequent_viewer = sequent_viewer
  method show () = window#misc#hide () ; window#show ()
+ method term = term
+ method set_term t = term <- t
+ method context = context
+ method set_context t = context <- t
+ method metasenv = metasenv
+ method set_metasenv t = metasenv <- t
  initializer
-  ignore(mmlwidget#connect#selection_changed (choose_selection mmlwidget)) ;
+  ignore
+   (sequent_viewer#connect#selection_changed (choose_selection sequent_viewer));
   ignore(window#event#connect#delete (fun _ -> window#misc#hide () ; true )) ;
-  ignore(whdb#connect#clicked (whd_in_scratch self)) ;
-  ignore(reduceb#connect#clicked (reduce_in_scratch self)) ;
-  ignore(simplb#connect#clicked (simpl_in_scratch self))
+  ignore(whdb#connect#clicked InvokeTactics'.whd_in_scratch) ;
+  ignore(reduceb#connect#clicked InvokeTactics'.reduce_in_scratch) ;
+  ignore(simplb#connect#clicked InvokeTactics'.simpl_in_scratch)
 end;;
 
+let open_contextual_menu_for_selected_terms mmlwidget infos =
+ let button = GdkEvent.Button.button infos in 
+ let terms_selected = List.length mmlwidget#get_selections > 0 in
+  if button = 3 then
+   begin
+    let time = GdkEvent.Button.time infos in
+    let menu = GMenu.menu () in
+    let f = new GMenu.factory menu in
+    let whd_menu_item =
+     f#add_item "Whd" ~key:GdkKeysyms._W ~callback:InvokeTactics'.whd in
+    let reduce_menu_item =
+     f#add_item "Reduce" ~key:GdkKeysyms._R ~callback:InvokeTactics'.reduce in
+    let simpl_menu_item =
+     f#add_item "Simpl" ~key:GdkKeysyms._S ~callback:InvokeTactics'.simpl in
+    let _ = f#add_separator () in
+    let generalize_menu_item =
+     f#add_item "Generalize"
+      ~key:GdkKeysyms._G ~callback:InvokeTactics'.generalize in
+    let _ = f#add_separator () in
+    let clear_menu_item =
+     f#add_item "Clear" ~key:GdkKeysyms._C ~callback:InvokeTactics'.clear in
+    let clearbody_menu_item =
+     f#add_item "ClearBody"
+      ~key:GdkKeysyms._B ~callback:InvokeTactics'.clearbody
+    in
+     whd_menu_item#misc#set_sensitive terms_selected ; 
+     reduce_menu_item#misc#set_sensitive terms_selected ; 
+     simpl_menu_item#misc#set_sensitive terms_selected ;
+     generalize_menu_item#misc#set_sensitive terms_selected ;
+     clear_menu_item#misc#set_sensitive terms_selected ;
+     clearbody_menu_item#misc#set_sensitive terms_selected ;
+     menu#popup ~button ~time
+   end ;
+  true
+;;
+
+class page () =
+ let vbox1 = GPack.vbox () in
+object(self)
+ val mutable proofw_ref = None
+ val mutable compute_ref = None
+ method proofw =
+  Lazy.force self#compute ;
+  match proofw_ref with
+     None -> assert false
+   | Some proofw -> proofw
+ method content = vbox1
+ method compute =
+  match compute_ref with
+     None -> assert false
+   | Some compute -> compute
+ initializer
+  compute_ref <-
+   Some (lazy (
+   let scrolled_window1 =
+    GBin.scrolled_window ~border_width:10
+     ~packing:(vbox1#pack ~expand:true ~padding:5) () in
+   let proofw =
+    TermViewer.sequent_viewer ~width:400 ~height:275
+     ~packing:(scrolled_window1#add) () in
+   let _ = proofw_ref <- Some proofw in
+   let hbox3 =
+    GPack.hbox ~packing:(vbox1#pack ~expand:false ~fill:false ~padding:5) () in
+   let ringb =
+    GButton.button ~label:"Ring"
+     ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
+   let fourierb =
+    GButton.button ~label:"Fourier"
+     ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
+   let reflexivityb =
+    GButton.button ~label:"Reflexivity"
+     ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
+   let symmetryb =
+    GButton.button ~label:"Symmetry"
+     ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
+   let assumptionb =
+    GButton.button ~label:"Assumption"
+     ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
+   let contradictionb =
+    GButton.button ~label:"Contradiction"
+     ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
+   let hbox4 =
+    GPack.hbox ~packing:(vbox1#pack ~expand:false ~fill:false ~padding:5) () in
+   let existsb =
+    GButton.button ~label:"Exists"
+     ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in
+   let splitb =
+    GButton.button ~label:"Split"
+     ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in
+   let leftb =
+    GButton.button ~label:"Left"
+     ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in
+   let rightb =
+    GButton.button ~label:"Right"
+     ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in
+   let searchpatternb =
+    GButton.button ~label:"SearchPattern_Apply"
+     ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in
+   let hbox5 =
+    GPack.hbox ~packing:(vbox1#pack ~expand:false ~fill:false ~padding:5) () in
+   let exactb =
+    GButton.button ~label:"Exact"
+     ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in
+   let introsb =
+    GButton.button ~label:"Intros"
+     ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in
+   let applyb =
+    GButton.button ~label:"Apply"
+     ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in
+   let elimintrossimplb =
+    GButton.button ~label:"ElimIntrosSimpl"
+     ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in
+   let elimtypeb =
+    GButton.button ~label:"ElimType"
+     ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in
+   let foldwhdb =
+    GButton.button ~label:"Fold_whd"
+     ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in
+   let foldreduceb =
+    GButton.button ~label:"Fold_reduce"
+     ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in
+   let hbox6 =
+    GPack.hbox ~packing:(vbox1#pack ~expand:false ~fill:false ~padding:5) () in
+   let foldsimplb =
+    GButton.button ~label:"Fold_simpl"
+     ~packing:(hbox6#pack ~expand:false ~fill:false ~padding:5) () in
+   let cutb =
+    GButton.button ~label:"Cut"
+     ~packing:(hbox6#pack ~expand:false ~fill:false ~padding:5) () in
+   let changeb =
+    GButton.button ~label:"Change"
+     ~packing:(hbox6#pack ~expand:false ~fill:false ~padding:5) () in
+   let letinb =
+    GButton.button ~label:"Let ... In"
+     ~packing:(hbox6#pack ~expand:false ~fill:false ~padding:5) () in
+   let rewritesimplb =
+    GButton.button ~label:"RewriteSimpl ->"
+     ~packing:(hbox6#pack ~expand:false ~fill:false ~padding:5) () in
+   let rewritebacksimplb =
+    GButton.button ~label:"RewriteSimpl <-"
+     ~packing:(hbox6#pack ~expand:false ~fill:false ~padding:5) () in
+   let hbox7 =
+    GPack.hbox ~packing:(vbox1#pack ~expand:false ~fill:false ~padding:5) () in
+   let absurdb =
+    GButton.button ~label:"Absurd"
+     ~packing:(hbox7#pack ~expand:false ~fill:false ~padding:5) () in
+   let decomposeb =
+    GButton.button ~label:"Decompose"
+     ~packing:(hbox7#pack ~expand:false ~fill:false ~padding:5) () in
+   let transitivityb =
+    GButton.button ~label:"Transitivity"
+     ~packing:(hbox7#pack ~expand:false ~fill:false ~padding:5) () in
+   let replaceb =
+    GButton.button ~label:"Replace"
+     ~packing:(hbox7#pack ~expand:false ~fill:false ~padding:5) () in
+   let injectionb =
+    GButton.button ~label:"Injection"
+     ~packing:(hbox7#pack ~expand:false ~fill:false ~padding:5) () in
+   let discriminateb =
+    GButton.button ~label:"Discriminate"
+     ~packing:(hbox7#pack ~expand:false ~fill:false ~padding:5) () in
+(* Zack: spostare in una toolbar
+   let generalizeb =
+    GButton.button ~label:"Generalize"
+     ~packing:(hbox7#pack ~expand:false ~fill:false ~padding:5) () in
+   let clearbodyb =
+    GButton.button ~label:"ClearBody"
+     ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in
+   let clearb =
+    GButton.button ~label:"Clear"
+     ~packing:(hbox5#pack ~expand:false ~fill:false ~padding:5) () in
+   let whdb =
+    GButton.button ~label:"Whd"
+     ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
+   let reduceb =
+    GButton.button ~label:"Reduce"
+     ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
+   let simplb =
+    GButton.button ~label:"Simpl"
+     ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
+*)
+
+   ignore(exactb#connect#clicked InvokeTactics'.exact) ;
+   ignore(applyb#connect#clicked InvokeTactics'.apply) ;
+   ignore(elimintrossimplb#connect#clicked InvokeTactics'.elimintrossimpl) ;
+   ignore(elimtypeb#connect#clicked InvokeTactics'.elimtype) ;
+   ignore(foldwhdb#connect#clicked InvokeTactics'.fold_whd) ;
+   ignore(foldreduceb#connect#clicked InvokeTactics'.fold_reduce) ;
+   ignore(foldsimplb#connect#clicked InvokeTactics'.fold_simpl) ;
+   ignore(cutb#connect#clicked InvokeTactics'.cut) ;
+   ignore(changeb#connect#clicked InvokeTactics'.change) ;
+   ignore(letinb#connect#clicked InvokeTactics'.letin) ;
+   ignore(ringb#connect#clicked InvokeTactics'.ring) ;
+   ignore(fourierb#connect#clicked InvokeTactics'.fourier) ;
+   ignore(rewritesimplb#connect#clicked InvokeTactics'.rewritesimpl) ;
+   ignore(rewritebacksimplb#connect#clicked InvokeTactics'.rewritebacksimpl) ;
+   ignore(replaceb#connect#clicked InvokeTactics'.replace) ;
+   ignore(reflexivityb#connect#clicked InvokeTactics'.reflexivity) ;
+   ignore(symmetryb#connect#clicked InvokeTactics'.symmetry) ;
+   ignore(transitivityb#connect#clicked InvokeTactics'.transitivity) ;
+   ignore(existsb#connect#clicked InvokeTactics'.exists) ;
+   ignore(splitb#connect#clicked InvokeTactics'.split) ;
+   ignore(leftb#connect#clicked InvokeTactics'.left) ;
+   ignore(rightb#connect#clicked InvokeTactics'.right) ;
+   ignore(assumptionb#connect#clicked InvokeTactics'.assumption) ;
+   ignore(absurdb#connect#clicked InvokeTactics'.absurd) ;
+   ignore(contradictionb#connect#clicked InvokeTactics'.contradiction) ;
+   ignore(introsb#connect#clicked InvokeTactics'.intros) ;
+   ignore(decomposeb#connect#clicked InvokeTactics'.decompose) ;
+   ignore(searchpatternb#connect#clicked searchPattern) ;
+   ignore(injectionb#connect#clicked InvokeTactics'.injection) ;
+   ignore(discriminateb#connect#clicked InvokeTactics'.discriminate) ;
+(* Zack: spostare in una toolbar
+   ignore(whdb#connect#clicked whd) ;
+   ignore(reduceb#connect#clicked reduce) ;
+   ignore(simplb#connect#clicked simpl) ;
+   ignore(clearbodyb#connect#clicked clearbody) ;
+   ignore(clearb#connect#clicked clear) ;
+   ignore(generalizeb#connect#clicked generalize) ;
+*)
+   ignore(proofw#connect#selection_changed (choose_selection proofw)) ;
+   ignore
+     ((new GObj.event_ops proofw#as_widget)#connect#button_press
+        (open_contextual_menu_for_selected_terms proofw)) ;
+  ))
+end
+;;
+
+class empty_page =
+ let vbox1 = GPack.vbox () in
+ let scrolled_window1 =
+  GBin.scrolled_window ~border_width:10
+   ~packing:(vbox1#pack ~expand:true ~padding:5) () in
+ let proofw =
+  TermViewer.sequent_viewer ~width:400 ~height:275
+   ~packing:(scrolled_window1#add) () in
+object(self)
+ method proofw = (assert false : TermViewer.sequent_viewer)
+ method content = vbox1
+ method compute = (assert false : unit)
+end
+;;
+
+let empty_page = new empty_page;;
+
+class notebook =
+object(self)
+ val notebook = GPack.notebook ()
+ val pages = ref []
+ val mutable skip_switch_page_event = false 
+ val mutable empty = true
+ method notebook = notebook
+ method add_page n =
+  let new_page = new page () in
+   empty <- false ;
+   pages := !pages @ [n,lazy (setgoal n),new_page] ;
+   notebook#append_page
+    ~tab_label:((GMisc.label ~text:("?" ^ string_of_int n) ())#coerce)
+    new_page#content#coerce
+ method remove_all_pages ~skip_switch_page_event:skip =
+  if empty then
+   notebook#remove_page 0 (* let's remove the empty page *)
+  else
+   List.iter (function _ -> notebook#remove_page 0) !pages ;
+  pages := [] ;
+  skip_switch_page_event <- skip
+ method set_current_page ~may_skip_switch_page_event n =
+  let (_,_,page) = List.find (function (m,_,_) -> m=n) !pages in
+   let new_page = notebook#page_num page#content#coerce in
+    if may_skip_switch_page_event && new_page <> notebook#current_page then
+     skip_switch_page_event <- true ;
+    notebook#goto_page new_page
+ method set_empty_page =
+  empty <- true ;
+  pages := [] ;
+  notebook#append_page
+   ~tab_label:((GMisc.label ~text:"No proof in progress" ())#coerce)
+   empty_page#content#coerce
+ method proofw =
+  let (_,_,page) = List.nth !pages notebook#current_page in
+   page#proofw
+ initializer
+  ignore
+   (notebook#connect#switch_page
+    (function i ->
+      let skip = skip_switch_page_event in
+       skip_switch_page_event <- false ;
+       if not skip then
+        try
+         let (metano,setgoal,page) = List.nth !pages i in
+          ProofEngine.goal := Some metano ;
+          Lazy.force (page#compute) ;
+          Lazy.force setgoal
+        with _ -> ()
+    ))
+end
+;;
+
 (* Main window *)
 
-class rendering_window output proofw (label : GMisc.label) =
+class rendering_window output (notebook : notebook) =
+ let scratch_window = new scratch_window in
  let window =
-  GWindow.window ~title:"MathML viewer" ~border_width:2 () in
+  GWindow.window
+   ~title:"gTopLevel - Helm's Proof Assistant"
+   ~border_width:0 ~allow_shrink:false () in
+ let vbox_for_menu = GPack.vbox ~packing:window#add () in
+ (* menus *)
+ let handle_box = GBin.handle_box ~border_width:2
+  ~packing:(vbox_for_menu#pack ~padding:0) () in
+ let menubar = GMenu.menu_bar ~packing:handle_box#add () in
+ let factory0 = new GMenu.factory menubar in
+ let accel_group = factory0#accel_group in
+ (* file menu *)
+ let file_menu = factory0#add_submenu "File" in
+ let factory1 = new GMenu.factory file_menu ~accel_group in
+ let export_to_postscript_menu_item =
+  begin
+   let _ =
+    factory1#add_item "New Block of (Co)Inductive Definitions..."
+     ~key:GdkKeysyms._B ~callback:new_inductive
+   in
+   let _ =
+    factory1#add_item "New Proof or Definition..." ~key:GdkKeysyms._N
+     ~callback:new_proof
+   in
+   let reopen_menu_item =
+    factory1#add_item "Reopen a Finished Proof..." ~key:GdkKeysyms._R
+     ~callback:open_
+   in
+   let qed_menu_item =
+    factory1#add_item "Qed" ~key:GdkKeysyms._E ~callback:qed in
+   ignore (factory1#add_separator ()) ;
+   ignore
+    (factory1#add_item "Load Unfinished Proof..." ~key:GdkKeysyms._L
+      ~callback:load_unfinished_proof) ;
+   let save_menu_item =
+    factory1#add_item "Save Unfinished Proof" ~key:GdkKeysyms._S
+      ~callback:save_unfinished_proof
+   in
+   ignore
+    (save_set_sensitive := function b -> save_menu_item#misc#set_sensitive b);
+   ignore (!save_set_sensitive false);
+   ignore (qed_set_sensitive:=function b -> qed_menu_item#misc#set_sensitive b);
+   ignore (!qed_set_sensitive false);
+   ignore (factory1#add_separator ()) ;
+   let export_to_postscript_menu_item =
+    factory1#add_item "Export to PostScript..."
+     ~callback:(export_to_postscript output) in
+   ignore (factory1#add_separator ()) ;
+   ignore
+    (factory1#add_item "Exit" ~key:GdkKeysyms._Q ~callback:GMain.Main.quit) ;
+   export_to_postscript_menu_item
+  end in
+ (* edit menu *)
+ let edit_menu = factory0#add_submenu "Edit Current Proof" in
+ let factory2 = new GMenu.factory edit_menu ~accel_group in
+ let focus_and_proveit_set_sensitive = ref (function _ -> assert false) in
+ let proveit_menu_item =
+  factory2#add_item "Prove It" ~key:GdkKeysyms._I
+   ~callback:(function () -> proveit ();!focus_and_proveit_set_sensitive false)
+ in
+ let focus_menu_item =
+  factory2#add_item "Focus" ~key:GdkKeysyms._F
+   ~callback:(function () -> focus () ; !focus_and_proveit_set_sensitive false)
+ in
+ let _ =
+  focus_and_proveit_set_sensitive :=
+   function b ->
+    proveit_menu_item#misc#set_sensitive b ;
+    focus_menu_item#misc#set_sensitive b
+ in
+ let _ = !focus_and_proveit_set_sensitive false in
+ (* edit term menu *)
+ let edit_term_menu = factory0#add_submenu "Edit Term" in
+ let factory5 = new GMenu.factory edit_term_menu ~accel_group in
+ let check_menu_item =
+  factory5#add_item "Check Term" ~key:GdkKeysyms._C
+   ~callback:(check scratch_window) in
+ let _ = check_menu_item#misc#set_sensitive false in
+ (* search menu *)
+ let search_menu = factory0#add_submenu "Search" in
+ let factory4 = new GMenu.factory search_menu ~accel_group in
+ let _ =
+  factory4#add_item "Locate..." ~key:GdkKeysyms._T
+   ~callback:locate in
+ let searchPattern_menu_item =
+  factory4#add_item "SearchPattern..." ~key:GdkKeysyms._D
+   ~callback:completeSearchPattern in
+ let _ = searchPattern_menu_item#misc#set_sensitive false in
+ let show_menu_item =
+  factory4#add_item "Show..." ~key:GdkKeysyms._H ~callback:show
+ in
+ let insert_query_item =
+  factory4#add_item "Insert Query (Experts Only)..." ~key:GdkKeysyms._Y
+   ~callback:insertQuery in
+ (* hbugs menu *)
+ let hbugs_menu = factory0#add_submenu "HBugs" in
+ let factory6 = new GMenu.factory hbugs_menu ~accel_group in
+ let toggle_hbugs_menu_item =
+  factory6#add_check_item
+    ~active:false ~key:GdkKeysyms._F5 ~callback:Hbugs.toggle "HBugs enabled"
+ in
+ (* settings menu *)
+ let settings_menu = factory0#add_submenu "Settings" in
+ let factory3 = new GMenu.factory settings_menu ~accel_group in
+ let _ =
+  factory3#add_item "Edit Aliases" ~key:GdkKeysyms._A
+   ~callback:edit_aliases in
+ let _ = factory3#add_separator () in
+ let _ =
+  factory3#add_item "MathML Widget Preferences..." ~key:GdkKeysyms._P
+   ~callback:(function _ -> (settings_window ())#show ()) in
+ (* accel group *)
+ let _ = window#add_accel_group accel_group in
+ (* end of menus *)
  let hbox0 =
-  GPack.hbox ~packing:window#add () in
+  GPack.hbox
+   ~packing:(vbox_for_menu#pack ~expand:true ~fill:true ~padding:5) () in
  let vbox =
-  GPack.vbox ~packing:(hbox0#pack ~expand:false ~fill:false ~padding:5) () in
- let _ = vbox#pack ~expand:false ~fill:false ~padding:5 label#coerce in
+  GPack.vbox ~packing:(hbox0#pack ~expand:true ~fill:true ~padding:5) () in
  let scrolled_window0 =
   GBin.scrolled_window ~border_width:10
    ~packing:(vbox#pack ~expand:true ~padding:5) () in
  let _ = scrolled_window0#add output#coerce in
- let hbox1 =
-  GPack.hbox ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
- let settingsb =
-  GButton.button ~label:"Settings"
-   ~packing:(hbox1#pack ~expand:false ~fill:false ~padding:5) () in
- let button_export_to_postscript =
-  GButton.button ~label:"export_to_postscript"
-  ~packing:(hbox1#pack ~expand:false ~fill:false ~padding:5) () in
- let qedb =
-  GButton.button ~label:"Qed"
-   ~packing:(hbox1#pack ~expand:false ~fill:false ~padding:5) () in
- let saveb =
-  GButton.button ~label:"Save"
-   ~packing:(hbox1#pack ~expand:false ~fill:false ~padding:5) () in
- let loadb =
-  GButton.button ~label:"Load"
-   ~packing:(hbox1#pack ~expand:false ~fill:false ~padding:5) () in
- let closeb =
-  GButton.button ~label:"Close"
-   ~packing:(hbox1#pack ~expand:false ~fill:false ~padding:5) () in
- let hbox2 =
-  GPack.hbox ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
- let proveitb =
-  GButton.button ~label:"Prove It"
-   ~packing:(hbox2#pack ~expand:false ~fill:false ~padding:5) () in
- let focusb =
-  GButton.button ~label:"Focus"
-   ~packing:(hbox2#pack ~expand:false ~fill:false ~padding:5) () in
- let prevgoalb =
-  GButton.button ~label:"<"
-   ~packing:(hbox2#pack ~expand:false ~fill:false ~padding:5) () in
- let nextgoalb =
-  GButton.button ~label:">"
-   ~packing:(hbox2#pack ~expand:false ~fill:false ~padding:5) () in
- let oldinputt = GEdit.text ~editable:false ~width:400 ~height:180
-   ~packing:(vbox#pack ~padding:5) () in
- let hbox4 =
-  GPack.hbox ~packing:(vbox#pack ~expand:false ~fill:false ~padding:5) () in
- let stateb =
-  GButton.button ~label:"State"
-   ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in
- let openb =
-  GButton.button ~label:"Open"
-   ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in
- let checkb =
-  GButton.button ~label:"Check"
-   ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in
- let locateb =
-  GButton.button ~label:"Locate"
-   ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in
- let backwardb =
-  GButton.button ~label:"Backward"
-   ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in
- let inputt = GEdit.text ~editable:true ~width:400 ~height: 100
-   ~packing:(vbox#pack ~padding:5) () in
- let vbox1 =
-  GPack.vbox ~packing:(hbox0#pack ~expand:false ~fill:false ~padding:5) () in
+ let frame =
+  GBin.frame ~label:"Insert Term"
+   ~packing:(vbox#pack ~expand:true ~fill:true ~padding:5) () in
  let scrolled_window1 =
-  GBin.scrolled_window ~border_width:10
-   ~packing:(vbox1#pack ~expand:true ~padding:5) () in
- let _ = scrolled_window1#add proofw#coerce in
- let hbox3 =
-  GPack.hbox ~packing:(vbox1#pack ~expand:false ~fill:false ~padding:5) () in
- let exactb =
-  GButton.button ~label:"Exact"
-   ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
- let introsb =
-  GButton.button ~label:"Intros"
-   ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
- let applyb =
-  GButton.button ~label:"Apply"
-   ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
- let elimintrossimplb =
-  GButton.button ~label:"ElimIntrosSimpl"
-   ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
- let elimtypeb =
-  GButton.button ~label:"ElimType"
-   ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
- let whdb =
-  GButton.button ~label:"Whd"
-   ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
- let reduceb =
-  GButton.button ~label:"Reduce"
-   ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
- let simplb =
-  GButton.button ~label:"Simpl"
-   ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
- let foldb =
-  GButton.button ~label:"Fold"
-   ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
- let cutb =
-  GButton.button ~label:"Cut"
-   ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
- let changeb =
-  GButton.button ~label:"Change"
-   ~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
- let hbox4 =
-  GPack.hbox ~packing:(vbox1#pack ~expand:false ~fill:false ~padding:5) () in
- let letinb =
-  GButton.button ~label:"Let ... In"
-   ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in
- let ringb =
-  GButton.button ~label:"Ring"
-   ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in
- let clearbodyb =
-  GButton.button ~label:"ClearBody"
-   ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in
- let clearb =
-  GButton.button ~label:"Clear"
-   ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in
- let fourierb =
-  GButton.button ~label:"Fourier"
-   ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in
- let rewritesimplb =
-  GButton.button ~label:"RewriteSimpl ->"
-   ~packing:(hbox4#pack ~expand:false ~fill:false ~padding:5) () in
+  GBin.scrolled_window ~border_width:5
+   ~packing:frame#add () in
+ let inputt =
+  TexTermEditor'.term_editor
+   mqi_handle
+   ~width:400 ~height:100 ~packing:scrolled_window1#add ()
+   ~isnotempty_callback:
+    (function b ->
+      check_menu_item#misc#set_sensitive b ;
+      searchPattern_menu_item#misc#set_sensitive b) in
+ let vboxl =
+  GPack.vbox ~packing:(hbox0#pack ~expand:true ~fill:true ~padding:5) () in
+ let _ =
+  vboxl#pack ~expand:true ~fill:true ~padding:5 notebook#notebook#coerce in
+ let frame =
+  GBin.frame ~shadow_type:`IN ~packing:(vboxl#pack ~expand:true ~padding:5) ()
+ in
  let outputhtml =
   GHtml.xmhtml
    ~source:""
-   ~width:400 ~height: 200
-   ~packing:(vbox1#pack ~expand:false ~fill:false ~padding:5)
+   ~width:400 ~height: 100
+   ~border_width:20
+   ~packing:frame#add
    ~show:true () in
- let scratch_window = new scratch_window outputhtml in
-object(self)
+object
  method outputhtml = outputhtml
- method oldinputt = oldinputt
  method inputt = inputt
- method output = (output : GMathView.math_view)
- method proofw = (proofw : GMathView.math_view)
+ method output = (output : TermViewer.proof_viewer)
+ method scratch_window = scratch_window
+ method notebook = notebook
  method show = window#show
  initializer
-  button_export_to_postscript#misc#set_sensitive false ;
+  notebook#set_empty_page ;
+  export_to_postscript_menu_item#misc#set_sensitive false ;
+  check_term := (check_term_in_scratch scratch_window) ;
 
   (* signal handlers here *)
   ignore(output#connect#selection_changed
-   (function elem -> proofw#unload ; choose_selection output elem)) ;
-  ignore(proofw#connect#selection_changed (choose_selection proofw)) ;
-  ignore(closeb#connect#clicked (fun _ -> GMain.Main.quit ())) ;
+   (function elem ->
+     choose_selection output elem ;
+     !focus_and_proveit_set_sensitive true
+   )) ;
+  ignore (output#connect#click (show_in_show_window_callback output)) ;
   let settings_window = new settings_window output scrolled_window0
-   button_export_to_postscript (choose_selection output) in
-  ignore(settingsb#connect#clicked settings_window#show) ;
-  ignore(button_export_to_postscript#connect#clicked (export_to_postscript output)) ;
-  ignore(qedb#connect#clicked (qed self)) ;
-  ignore(saveb#connect#clicked (save self)) ;
-  ignore(loadb#connect#clicked (load self)) ;
-  ignore(proveitb#connect#clicked (proveit self)) ;
-  ignore(focusb#connect#clicked (focus self)) ;
-  ignore(prevgoalb#connect#clicked (prev_or_next_goal prevgoal self)) ;
-  ignore(nextgoalb#connect#clicked (prev_or_next_goal nextgoal self)) ;
+   export_to_postscript_menu_item (choose_selection output) in
+  set_settings_window settings_window ;
+  set_outputhtml outputhtml ;
   ignore(window#event#connect#delete (fun _ -> GMain.Main.quit () ; true )) ;
-  ignore(stateb#connect#clicked (state self)) ;
-  ignore(openb#connect#clicked (open_ self)) ;
-  ignore(checkb#connect#clicked (check self scratch_window)) ;
-  ignore(locateb#connect#clicked (locate self)) ;
-  ignore(backwardb#connect#clicked (backward self)) ;
-  ignore(exactb#connect#clicked (exact self)) ;
-  ignore(applyb#connect#clicked (apply self)) ;
-  ignore(elimintrossimplb#connect#clicked (elimintrossimpl self)) ;
-  ignore(elimtypeb#connect#clicked (elimtype self)) ;
-  ignore(whdb#connect#clicked (whd self)) ;
-  ignore(reduceb#connect#clicked (reduce self)) ;
-  ignore(simplb#connect#clicked (simpl self)) ;
-  ignore(foldb#connect#clicked (fold self)) ;
-  ignore(cutb#connect#clicked (cut self)) ;
-  ignore(changeb#connect#clicked (change self)) ;
-  ignore(letinb#connect#clicked (letin self)) ;
-  ignore(ringb#connect#clicked (ring self)) ;
-  ignore(clearbodyb#connect#clicked (clearbody self)) ;
-  ignore(clearb#connect#clicked (clear self)) ;
-  ignore(fourierb#connect#clicked (fourier self)) ;
-  ignore(rewritesimplb#connect#clicked (rewritesimpl self)) ;
-  ignore(introsb#connect#clicked (intros self)) ;
   Logger.log_callback :=
    (Logger.log_to_html ~print_and_flush:(output_html outputhtml))
 end;;
 
 (* MAIN *)
 
-let rendering_window = ref None;;
-
 let initialize_everything () =
  let module U = Unix in
-  let output = GMathView.math_view ~width:350 ~height:280 ()
-  and proofw = GMathView.math_view ~width:400 ~height:275 ()
-  and label = GMisc.label ~text:"gTopLevel" () in
-    let rendering_window' =
-     new rendering_window output proofw label
+  let output = TermViewer.proof_viewer ~width:350 ~height:280 () in
+  let notebook = new notebook in
+   let rendering_window' = new rendering_window output notebook in
+    set_rendering_window rendering_window' ;
+    let print_error_as_html prefix msg =
+     output_html (outputhtml ())
+      ("
" ^ prefix ^ msg ^ "
")
     in
-     rendering_window := Some rendering_window' ;
+     Gdome_xslt.setErrorCallback (Some (print_error_as_html "XSLT Error: "));
+     Gdome_xslt.setDebugCallback
+      (Some (print_error_as_html "XSLT Debug Message: "));
      rendering_window'#show () ;
-     GMain.Main.main ()
+(*      Hbugs.toggle true; *)
+     GtkThread.main ()
 ;;
 
-let _ =
- CicCooking.init () ;
- if !usedb then
-  begin
-   Mqint.init "host=mowgli.cs.unibo.it dbname=helm user=helm" ;
-   CicTextualParser0.set_locate_object
-    (function id ->
-      let result = MQueryGenerator.locate id in
-      let uris =
-       List.map
-        (function uri,_ -> wrong_xpointer_format_from_wrong_xpointer_format' uri)
-        result in
-      let html = (" 
Locate Query: 
" ^ get_last_query result ^ "
") in
-       begin
-        match !rendering_window with
-           None -> assert false
-         | Some rw -> output_html rw#outputhtml html ;
-       end ;
-       let uri = 
-        match uris with
-           [] ->
-            (match
-              (GToolbox.input_string ~title:"Unknown input"
-               ("No URI matching \"" ^ id ^ "\" found. Please enter its URI"))
-             with
-                None -> None
-              | Some uri -> Some ("cic:" ^ uri)
-            )
-         | [uri] -> Some uri
-         | _ ->
-           let choice =
-            GToolbox.question_box ~title:"Ambiguous input."
-             ~buttons:uris ~default:1 "Ambiguous input. Please, choose one."
-           in
-            if choice > 0 then
-             Some (List.nth uris (choice - 1))
-            else
-             (* No choice from the user *)
-             None
-       in
-        match uri with
-           Some uri' ->
-            (* Constant *)
-            if String.sub uri' (String.length uri' - 4) 4 = ".con" then
-(*CSC: what cooking number? Here I always use 0, which may be bugged *)
-             Some (Cic.Const (UriManager.uri_of_string uri',0))
-            else
-             (try
-               (* Inductive Type *)
-               let uri'',typeno = CicTextualLexer.indtyuri_of_uri uri' in
-(*CSC: what cooking number? Here I always use 0, which may be bugged *)
-                Some (Cic.MutInd (uri'',0,typeno))
-              with
-               _ ->
-                (* Constructor of an Inductive Type *)
-                let uri'',typeno,consno =
-                 CicTextualLexer.indconuri_of_uri uri'
-                in
-(*CSC: what cooking number? Here I always use 0, which may be bugged *)
-                 Some (Cic.MutConstruct (uri'',0,typeno,consno))
-             )
-         | None -> None
-    )
-  end ;
+let main () =
  ignore (GtkMain.Main.init ()) ;
  initialize_everything () ;
- if !usedb then Mqint.close ();
+ MQIC.close mqi_handle;
+ Hbugs.quit ()
 ;;
+
+try
+  Sys.catch_break true;
+  main ();
+with Sys.Break -> ()  (* exit nicely, invoking at_exit functions *)
+
diff --git a/helm/gTopLevel/hbugs.ml b/helm/gTopLevel/hbugs.ml
new file mode 100644
index 000000000..753f3fc78
--- /dev/null
+++ b/helm/gTopLevel/hbugs.ml
@@ -0,0 +1,133 @@
+(*
+ * Copyright (C) 2003:
+ *    Stefano Zacchiroli 
+ *    for the HELM Team http://helm.cs.unibo.it/
+ *
+ *  This file is part of HELM, an Hypertextual, Electronic
+ *  Library of Mathematics, developed at the Computer Science
+ *  Department, University of Bologna, Italy.
+ *
+ *  HELM is free software; you can redistribute it and/or
+ *  modify it under the terms of the GNU General Public License
+ *  as published by the Free Software Foundation; either version 2
+ *  of the License, or (at your option) any later version.
+ *
+ *  HELM is distributed in the hope that it will be useful,
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ *  GNU General Public License for more details.
+ *
+ *  You should have received a copy of the GNU General Public License
+ *  along with HELM; if not, write to the Free Software
+ *  Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ *  MA  02111-1307, USA.
+ *
+ *  For details, see the HELM World-Wide-Web page,
+ *  http://helm.cs.unibo.it/
+ *)
+
+open Hbugs_types;;
+open Printf;;
+
+let debug_print = 
+  let debug = true in
+  fun s -> prerr_endline (sprintf "DEBUG: %s" s)
+;;
+
+exception NoProofInProgress;;
+
+let hbugs_client = ref None
+let use_hint_callback = ref ignore
+
+let quit () =
+	match !hbugs_client with
+	| Some c -> c#unregisterFromBroker ()
+	| None -> ()
+
+let hbugs_enabled = ref false
+
+let get_hbugs_client () =
+	match !hbugs_client with
+	| Some c -> c
+	| None -> assert false
+
+let disable () =
+	match !hbugs_client with None -> () | Some c -> c#hide ()
+
+	(** send current proof assistant state to hbugs broker *)
+let notify () =
+	try
+		if !hbugs_enabled then begin
+			let client = get_hbugs_client () in
+			let goal =
+				match !ProofEngine.goal with
+				| Some g -> g
+				| None -> raise NoProofInProgress
+			in
+			let (type_string, body_string) =
+				let (type_xml, body_xml) = ProofEngine.get_current_status_as_xml () in
+				(Xml.pp_to_string type_xml, Xml.pp_to_string body_xml)
+			in
+			let new_state =
+				(Misc.strip_xml_headings type_string,
+				 Misc.strip_xml_headings body_string,
+				 goal)
+			in
+			client#stateChange (Some new_state)
+		end
+	with NoProofInProgress -> ()
+
+let clear () =
+ if !hbugs_enabled then
+  begin
+	 let client = get_hbugs_client () in
+	  client#stateChange None
+  end
+
+let rec enable () =
+	(match !hbugs_client with
+	| None -> (* create an hbugs client and show its window *)
+			hbugs_client :=
+				(try
+					Some (new Hbugs_client.hbugsClient
+            ~use_hint_callback:!use_hint_callback ())
+				with e ->
+					prerr_endline (sprintf "Can't start HBugs client: %s"
+						(Printexc.to_string e));
+					None);
+			(match !hbugs_client with
+			|Some client ->
+					client#show ();
+					client#subscribeAll ()
+			| None -> ())
+	| Some c -> (* show hbugs client window *)
+			c#show ())
+
+let toggle state =
+	if state <> !hbugs_enabled then (* status has been changed *)
+		(if state then enable () else disable ());
+	hbugs_enabled := state
+
+module type Unit = sig end
+
+module Initialize (Tactics: InvokeTactics.Tactics) : Unit =
+  struct
+    let use_hint = function
+      | Use_ring_Luke -> Tactics.ring ()
+      | Use_fourier_Luke -> Tactics.fourier ()
+      | Use_reflexivity_Luke -> Tactics.reflexivity ()
+      | Use_symmetry_Luke -> Tactics.symmetry ()
+      | Use_assumption_Luke -> Tactics.assumption ()
+      | Use_contradiction_Luke -> Tactics.contradiction ()
+      | Use_exists_Luke -> Tactics.exists ()
+      | Use_split_Luke -> Tactics.split ()
+      | Use_left_Luke -> Tactics.left ()
+      | Use_right_Luke -> Tactics.right ()
+      | Use_apply_Luke term ->
+         (* we remove the "cic:" prefix *)
+         let term' = String.sub term 4 (String.length term - 4) in
+          Tactics.apply ~term:term' ()
+      | Hints _ -> assert false
+
+    let _ = use_hint_callback := use_hint
+  end
diff --git a/helm/gTopLevel/hbugs.mli b/helm/gTopLevel/hbugs.mli
new file mode 100644
index 000000000..022bbf43a
--- /dev/null
+++ b/helm/gTopLevel/hbugs.mli
@@ -0,0 +1,40 @@
+(*
+ * Copyright (C) 2003:
+ *    Stefano Zacchiroli 
+ *    for the HELM Team http://helm.cs.unibo.it/
+ *
+ *  This file is part of HELM, an Hypertextual, Electronic
+ *  Library of Mathematics, developed at the Computer Science
+ *  Department, University of Bologna, Italy.
+ *
+ *  HELM is free software; you can redistribute it and/or
+ *  modify it under the terms of the GNU General Public License
+ *  as published by the Free Software Foundation; either version 2
+ *  of the License, or (at your option) any later version.
+ *
+ *  HELM is distributed in the hope that it will be useful,
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ *  GNU General Public License for more details.
+ *
+ *  You should have received a copy of the GNU General Public License
+ *  along with HELM; if not, write to the Free Software
+ *  Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ *  MA  02111-1307, USA.
+ *
+ *  For details, see the HELM World-Wide-Web page,
+ *  http://helm.cs.unibo.it/
+ *)
+
+val enable: unit -> unit
+val disable: unit -> unit
+val toggle: bool -> unit
+
+val quit: unit -> unit
+
+val notify: unit -> unit
+val clear: unit -> unit
+
+module type Unit = sig end
+
+module Initialize (Tactics: InvokeTactics.Tactics) : Unit
diff --git a/helm/gTopLevel/invokeTactics.ml b/helm/gTopLevel/invokeTactics.ml
new file mode 100644
index 000000000..318042909
--- /dev/null
+++ b/helm/gTopLevel/invokeTactics.ml
@@ -0,0 +1,472 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(******************************************************************************)
+(*                                                                            *)
+(*                               PROJECT HELM                                 *)
+(*                                                                            *)
+(*                Claudio Sacerdoti Coen                *)
+(*                                 29/01/2003                                 *)
+(*                                                                            *)
+(*                                                                            *)
+(******************************************************************************)
+
+exception RefreshSequentException of exn;;
+exception RefreshProofException of exn;;
+
+module type Callbacks =
+  sig
+    (* input widgets *)
+    val sequent_viewer : unit -> TermViewer.sequent_viewer
+    val term_editor : unit -> TermEditor.term_editor
+    val scratch_window :
+     unit ->
+      < sequent_viewer: TermViewer.sequent_viewer ;
+        show: unit -> unit ;
+        term: Cic.term ;
+        set_term : Cic.term -> unit ;
+        metasenv: Cic.metasenv ;
+        set_metasenv : Cic.metasenv -> unit ;
+        context: Cic.context ;
+        set_context : Cic.context -> unit >
+    (* output messages *)
+    val output_html : string -> unit
+    (* GUI refresh functions *)
+    val refresh_proof : unit -> unit
+    val refresh_goals : unit -> unit
+    (* callbacks for user-tactics interaction *)
+    val decompose_uris_choice_callback :
+      (UriManager.uri * int * 'a) list ->
+      (UriManager.uri * int * 'b list) list
+    val mk_fresh_name_callback :
+      Cic.context -> Cic.name -> typ:Cic.term -> Cic.name
+  end
+;;
+
+module type Tactics =
+  sig
+   val intros : unit -> unit
+   val exact : ?term:string -> unit -> unit
+   val apply : ?term:string -> unit -> unit
+   val elimintrossimpl : ?term:string -> unit -> unit
+   val elimtype : ?term:string -> unit -> unit
+   val whd : unit -> unit
+   val reduce : unit -> unit
+   val simpl : unit -> unit
+   val fold_whd : ?term:string -> unit -> unit
+   val fold_reduce : ?term:string -> unit -> unit
+   val fold_simpl : ?term:string -> unit -> unit
+   val cut : ?term:string -> unit -> unit
+   val change : unit -> unit
+   val letin : ?term:string -> unit -> unit
+   val ring : unit -> unit
+   val clearbody : unit -> unit
+   val clear : unit -> unit
+   val fourier : unit -> unit
+   val rewritesimpl : ?term:string -> unit -> unit
+   val rewritebacksimpl : ?term:string -> unit -> unit
+   val replace : unit -> unit
+   val reflexivity : unit -> unit
+   val symmetry : unit -> unit
+   val transitivity : ?term:string -> unit -> unit
+   val exists : unit -> unit
+   val split : unit -> unit
+   val left : unit -> unit
+   val right : unit -> unit
+   val assumption : unit -> unit
+   val generalize : unit -> unit
+   val absurd : ?term:string -> unit -> unit
+   val contradiction : unit -> unit
+   val decompose : ?term:string -> unit -> unit
+   val injection : ?term:string -> unit -> unit
+   val discriminate : ?term:string -> unit -> unit
+   val whd_in_scratch : unit -> unit
+   val reduce_in_scratch : unit -> unit
+   val simpl_in_scratch : unit -> unit
+  end
+
+module Make (C: Callbacks) : Tactics =
+  struct
+
+   let call_tactic tactic () =
+    let savedproof = !ProofEngine.proof in
+    let savedgoal  = !ProofEngine.goal in
+     begin
+      try
+       tactic () ;
+       C.refresh_goals () ;
+       C.refresh_proof ()
+      with
+         RefreshSequentException e ->
+          C.output_html
+           ("
Exception raised during the refresh of the " ^
+            "sequent: " ^ Printexc.to_string e ^ "
") ;
+          ProofEngine.proof := savedproof ;
+          ProofEngine.goal := savedgoal ;
+          C.refresh_goals ()
+       | RefreshProofException e ->
+          C.output_html
+           ("
Exception raised during the refresh of the " ^
+            "proof: " ^ Printexc.to_string e ^ "
") ;
+          ProofEngine.proof := savedproof ;
+          ProofEngine.goal := savedgoal ;
+          C.refresh_goals () ;
+          C.refresh_proof ()
+       | e ->
+          C.output_html
+           ("
" ^ Printexc.to_string e ^ "
") ;
+          ProofEngine.proof := savedproof ;
+          ProofEngine.goal := savedgoal
+     end
+
+   let call_tactic_with_input tactic ?term () =
+    let savedproof = !ProofEngine.proof in
+    let savedgoal  = !ProofEngine.goal in
+     let uri,metasenv,bo,ty =
+      match !ProofEngine.proof with
+         None -> assert false
+       | Some (uri,metasenv,bo,ty) -> uri,metasenv,bo,ty
+     in
+      let canonical_context =
+       match !ProofEngine.goal with
+          None -> assert false
+        | Some metano ->
+           let (_,canonical_context,_) =
+            List.find (function (m,_,_) -> m=metano) metasenv
+           in
+            canonical_context
+      in
+       try
+        let metasenv',expr =
+         (match term with
+         | None -> ()
+         | Some t -> (C.term_editor ())#set_term t);
+         (C.term_editor ())#get_metasenv_and_term canonical_context metasenv
+        in
+         ProofEngine.proof := Some (uri,metasenv',bo,ty) ;
+         tactic expr ;
+         C.refresh_goals () ;
+         C.refresh_proof () ;
+         (C.term_editor ())#reset
+       with
+          RefreshSequentException e ->
+           C.output_html
+            ("
Exception raised during the refresh of the " ^
+             "sequent: " ^ Printexc.to_string e ^ "
") ;
+           ProofEngine.proof := savedproof ;
+           ProofEngine.goal := savedgoal ;
+           C.refresh_goals ()
+        | RefreshProofException e ->
+           C.output_html
+            ("
Exception raised during the refresh of the " ^
+             "proof: " ^ Printexc.to_string e ^ "
") ;
+           ProofEngine.proof := savedproof ;
+           ProofEngine.goal := savedgoal ;
+           C.refresh_goals () ;
+           C.refresh_proof ()
+        | e ->
+           C.output_html
+            ("
" ^ Printexc.to_string e ^ "
") ;
+           ProofEngine.proof := savedproof ;
+           ProofEngine.goal := savedgoal
+
+  let call_tactic_with_goal_input tactic () =
+   let module L = LogicalOperations in
+   let module G = Gdome in
+    let savedproof = !ProofEngine.proof in
+    let savedgoal  = !ProofEngine.goal in
+     match (C.sequent_viewer ())#get_selected_terms with
+       [term] ->
+         begin
+          try
+           tactic term ;
+           C.refresh_goals () ;
+           C.refresh_proof ()
+          with
+             RefreshSequentException e ->
+              C.output_html
+               ("
Exception raised during the refresh of " ^
+                "the sequent: " ^ Printexc.to_string e ^ "
") ;
+              ProofEngine.proof := savedproof ;
+              ProofEngine.goal := savedgoal ;
+              C.refresh_goals ()
+           | RefreshProofException e ->
+              C.output_html
+               ("
Exception raised during the refresh of " ^
+                "the proof: " ^ Printexc.to_string e ^ "
") ;
+              ProofEngine.proof := savedproof ;
+              ProofEngine.goal := savedgoal ;
+              C.refresh_goals () ;
+              C.refresh_proof ()
+           | e ->
+              C.output_html
+               ("
" ^ Printexc.to_string e ^ "
") ;
+              ProofEngine.proof := savedproof ;
+              ProofEngine.goal := savedgoal ;
+         end
+     | [] ->
+        C.output_html
+         ("
No term selected
")
+     | _ ->
+        C.output_html
+         ("
Many terms selected
")
+
+  let call_tactic_with_goal_inputs tactic () =
+   let module L = LogicalOperations in
+   let module G = Gdome in
+    let savedproof = !ProofEngine.proof in
+    let savedgoal  = !ProofEngine.goal in
+     try
+      match (C.sequent_viewer ())#get_selected_terms with
+         [] ->
+          C.output_html
+           ("
No term selected
")
+       | terms ->
+          tactic terms ;
+          C.refresh_goals () ;
+          C.refresh_proof () ;
+     with
+        RefreshSequentException e ->
+         C.output_html
+          ("
Exception raised during the refresh of the " ^
+           "sequent: " ^ Printexc.to_string e ^ "
") ;
+         ProofEngine.proof := savedproof ;
+         ProofEngine.goal := savedgoal ;
+         C.refresh_goals ()
+      | RefreshProofException e ->
+         C.output_html
+          ("
Exception raised during the refresh of the " ^
+           "proof: " ^ Printexc.to_string e ^ "
") ;
+         ProofEngine.proof := savedproof ;
+         ProofEngine.goal := savedgoal ;
+         C.refresh_goals () ;
+         C.refresh_proof ()
+      | e ->
+         C.output_html
+          ("
" ^ Printexc.to_string e ^ "
") ;
+         ProofEngine.proof := savedproof ;
+         ProofEngine.goal := savedgoal
+
+  let call_tactic_with_input_and_goal_input tactic () =
+   let module L = LogicalOperations in
+   let module G = Gdome in
+    let savedproof = !ProofEngine.proof in
+    let savedgoal  = !ProofEngine.goal in
+     match (C.sequent_viewer ())#get_selected_terms with
+       [term] ->
+         begin
+          try
+           let uri,metasenv,bo,ty =
+            match !ProofEngine.proof with
+               None -> assert false
+             | Some (uri,metasenv,bo,ty) -> uri,metasenv,bo,ty
+           in
+            let canonical_context =
+             match !ProofEngine.goal with
+                None -> assert false
+              | Some metano ->
+                 let (_,canonical_context,_) =
+                  List.find (function (m,_,_) -> m=metano) metasenv
+                 in
+                  canonical_context in
+            let (metasenv',expr) =
+             (C.term_editor ())#get_metasenv_and_term canonical_context metasenv
+            in
+             ProofEngine.proof := Some (uri,metasenv',bo,ty) ;
+             tactic ~goal_input:term ~input:expr ;
+             C.refresh_goals () ;
+             C.refresh_proof () ;
+             (C.term_editor ())#reset
+          with
+             RefreshSequentException e ->
+              C.output_html
+               ("
Exception raised during the refresh of " ^
+                "the sequent: " ^ Printexc.to_string e ^ "
") ;
+              ProofEngine.proof := savedproof ;
+              ProofEngine.goal := savedgoal ;
+              C.refresh_goals ()
+           | RefreshProofException e ->
+              C.output_html
+               ("
Exception raised during the refresh of " ^
+                "the proof: " ^ Printexc.to_string e ^ "
") ;
+              ProofEngine.proof := savedproof ;
+              ProofEngine.goal := savedgoal ;
+              C.refresh_goals () ;
+              C.refresh_proof ()
+           | e ->
+              C.output_html
+               ("
" ^ Printexc.to_string e ^ "
") ;
+              ProofEngine.proof := savedproof ;
+              ProofEngine.goal := savedgoal ;
+         end
+     | [] ->
+        C.output_html
+         ("
No term selected
")
+     | _ ->
+        C.output_html
+         ("
Many terms selected
")
+
+  let call_tactic_with_goal_input_in_scratch tactic () =
+   let module L = LogicalOperations in
+   let module G = Gdome in
+    let scratch_window = C.scratch_window () in
+     match scratch_window#sequent_viewer#get_selected_terms with
+       [term] ->
+         begin
+          try
+           let expr = tactic term scratch_window#term in
+            scratch_window#sequent_viewer#load_sequent
+             scratch_window#metasenv (111,scratch_window#context,expr) ;
+            scratch_window#set_term expr ;
+            scratch_window#show () ;
+          with
+           e ->
+            C.output_html
+             ("
" ^ Printexc.to_string e ^ "
")
+         end
+     | [] ->
+        C.output_html
+         ("
No term selected
")
+     | _ ->
+        C.output_html
+         ("
Many terms selected
")
+
+  let call_tactic_with_goal_inputs_in_scratch tactic () =
+   let module L = LogicalOperations in
+   let module G = Gdome in
+    let scratch_window = C.scratch_window () in
+     match scratch_window#sequent_viewer#get_selected_terms with
+        [] ->
+         C.output_html
+          ("
No terms selected
")
+      | terms ->
+         try
+          let expr = tactic terms scratch_window#term in
+           scratch_window#sequent_viewer#load_sequent
+            scratch_window#metasenv (111,scratch_window#context,expr) ;
+           scratch_window#set_term expr ;
+           scratch_window#show () ;
+         with
+          e ->
+           C.output_html
+            ("
" ^ Printexc.to_string e ^ "
")
+
+  let call_tactic_with_hypothesis_input tactic () =
+   let module L = LogicalOperations in
+   let module G = Gdome in
+    let savedproof = !ProofEngine.proof in
+    let savedgoal  = !ProofEngine.goal in
+     match (C.sequent_viewer ())#get_selected_hypotheses with
+       [hypothesis] ->
+         begin
+          try
+           tactic hypothesis ;
+           C.refresh_goals () ;
+           C.refresh_proof ()
+          with
+             RefreshSequentException e ->
+              C.output_html
+               ("
Exception raised during the refresh of " ^
+                "the sequent: " ^ Printexc.to_string e ^ "
") ;
+              ProofEngine.proof := savedproof ;
+              ProofEngine.goal := savedgoal ;
+              C.refresh_goals ()
+           | RefreshProofException e ->
+              C.output_html
+               ("
Exception raised during the refresh of " ^
+                "the proof: " ^ Printexc.to_string e ^ "
") ;
+              ProofEngine.proof := savedproof ;
+              ProofEngine.goal := savedgoal ;
+              C.refresh_goals () ;
+              C.refresh_proof ()
+           | e ->
+              C.output_html
+               ("
" ^ Printexc.to_string e ^ "
") ;
+              ProofEngine.proof := savedproof ;
+              ProofEngine.goal := savedgoal ;
+         end
+     | [] ->
+        C.output_html
+         ("
No hypothesis selected
")
+     | _ ->
+        C.output_html
+         ("
Many hypothesis selected
")
+
+
+  let intros =
+   call_tactic
+    (ProofEngine.intros ~mk_fresh_name_callback:C.mk_fresh_name_callback)
+  let exact = call_tactic_with_input ProofEngine.exact
+  let apply = call_tactic_with_input ProofEngine.apply
+  let elimintrossimpl = call_tactic_with_input ProofEngine.elim_intros_simpl
+  let elimtype = call_tactic_with_input ProofEngine.elim_type
+  let whd = call_tactic_with_goal_inputs ProofEngine.whd
+  let reduce = call_tactic_with_goal_inputs ProofEngine.reduce
+  let simpl = call_tactic_with_goal_inputs ProofEngine.simpl
+  let fold_whd = call_tactic_with_input ProofEngine.fold_whd
+  let fold_reduce = call_tactic_with_input ProofEngine.fold_reduce
+  let fold_simpl = call_tactic_with_input ProofEngine.fold_simpl
+  let cut =
+   call_tactic_with_input
+    (ProofEngine.cut ~mk_fresh_name_callback:C.mk_fresh_name_callback)
+  let change = call_tactic_with_input_and_goal_input ProofEngine.change
+  let letin =
+   call_tactic_with_input
+    (ProofEngine.letin ~mk_fresh_name_callback:C.mk_fresh_name_callback)
+  let ring = call_tactic ProofEngine.ring
+  let clearbody = call_tactic_with_hypothesis_input ProofEngine.clearbody
+  let clear = call_tactic_with_hypothesis_input ProofEngine.clear
+  let fourier = call_tactic ProofEngine.fourier
+  let rewritesimpl = call_tactic_with_input ProofEngine.rewrite_simpl
+  let rewritebacksimpl = call_tactic_with_input ProofEngine.rewrite_back_simpl
+  let replace = call_tactic_with_input_and_goal_input ProofEngine.replace
+  let reflexivity = call_tactic ProofEngine.reflexivity
+  let symmetry = call_tactic ProofEngine.symmetry
+  let transitivity = call_tactic_with_input ProofEngine.transitivity
+  let exists = call_tactic ProofEngine.exists
+  let split = call_tactic ProofEngine.split
+  let left = call_tactic ProofEngine.left
+  let right = call_tactic ProofEngine.right
+  let assumption = call_tactic ProofEngine.assumption
+  let injection = call_tactic_with_input ProofEngine.injection
+  let discriminate = call_tactic_with_input ProofEngine.discriminate
+  let generalize =
+   call_tactic_with_goal_inputs
+    (ProofEngine.generalize ~mk_fresh_name_callback:C.mk_fresh_name_callback)
+  let absurd = call_tactic_with_input ProofEngine.absurd
+  let contradiction = call_tactic ProofEngine.contradiction
+  let decompose =
+   call_tactic_with_input
+    (ProofEngine.decompose
+      ~uris_choice_callback:C.decompose_uris_choice_callback)
+  let whd_in_scratch =
+   call_tactic_with_goal_inputs_in_scratch ProofEngine.whd_in_scratch
+  let reduce_in_scratch =
+   call_tactic_with_goal_inputs_in_scratch ProofEngine.reduce_in_scratch
+  let simpl_in_scratch =
+   call_tactic_with_goal_inputs_in_scratch ProofEngine.simpl_in_scratch
+  
+end
+;;
diff --git a/helm/gTopLevel/invokeTactics.mli b/helm/gTopLevel/invokeTactics.mli
new file mode 100644
index 000000000..2c11fb3d3
--- /dev/null
+++ b/helm/gTopLevel/invokeTactics.mli
@@ -0,0 +1,110 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(******************************************************************************)
+(*                                                                            *)
+(*                               PROJECT HELM                                 *)
+(*                                                                            *)
+(*                Claudio Sacerdoti Coen                *)
+(*                                 30/01/2003                                 *)
+(*                                                                            *)
+(*                                                                            *)
+(******************************************************************************)
+
+exception RefreshSequentException of exn
+exception RefreshProofException of exn
+
+module type Callbacks =
+  sig
+    (* input widgets *)
+    val sequent_viewer : unit -> TermViewer.sequent_viewer
+    val term_editor : unit -> TermEditor.term_editor
+    val scratch_window :
+     unit ->
+      < sequent_viewer: TermViewer.sequent_viewer ;
+        show: unit -> unit ;
+        term: Cic.term ;
+        set_term : Cic.term -> unit ;
+        metasenv: Cic.metasenv ;
+        set_metasenv : Cic.metasenv -> unit ;
+        context: Cic.context ;
+        set_context : Cic.context -> unit >
+    (* output messages *)
+    val output_html : string -> unit
+    (* GUI refresh functions *)
+    val refresh_proof : unit -> unit
+    val refresh_goals : unit -> unit
+    (* callbacks for user-tactics interaction *)
+    val decompose_uris_choice_callback :
+      (UriManager.uri * int * 'a) list ->
+      (UriManager.uri * int * 'b list) list
+    val mk_fresh_name_callback :
+      Cic.context -> Cic.name -> typ:Cic.term -> Cic.name
+  end
+
+module type Tactics =
+ sig
+   val intros : unit -> unit
+   val exact : ?term:string -> unit -> unit
+   val apply : ?term:string -> unit -> unit
+   val elimintrossimpl : ?term:string -> unit -> unit
+   val elimtype : ?term:string -> unit -> unit
+   val whd : unit -> unit
+   val reduce : unit -> unit
+   val simpl : unit -> unit
+   val fold_whd : ?term:string -> unit -> unit
+   val fold_reduce : ?term:string -> unit -> unit
+   val fold_simpl : ?term:string -> unit -> unit
+   val cut : ?term:string -> unit -> unit
+   val change : unit -> unit
+   val letin : ?term:string -> unit -> unit
+   val ring : unit -> unit
+   val clearbody : unit -> unit
+   val clear : unit -> unit
+   val fourier : unit -> unit
+   val rewritesimpl : ?term:string -> unit -> unit
+   val rewritebacksimpl : ?term:string -> unit -> unit
+   val replace : unit -> unit
+   val reflexivity : unit -> unit
+   val symmetry : unit -> unit
+   val transitivity : ?term:string -> unit -> unit
+   val exists : unit -> unit
+   val split : unit -> unit
+   val left : unit -> unit
+   val right : unit -> unit
+   val assumption : unit -> unit
+   val generalize : unit -> unit
+   val absurd : ?term:string -> unit -> unit
+   val contradiction : unit -> unit
+   val decompose : ?term:string -> unit -> unit
+   val injection : ?term:string -> unit -> unit
+   val discriminate : ?term:string -> unit -> unit
+   val whd_in_scratch : unit -> unit
+   val reduce_in_scratch : unit -> unit
+   val simpl_in_scratch : unit -> unit
+ end
+
+module Make (C : Callbacks) : Tactics
+
diff --git a/helm/gTopLevel/mQueryGenerator.mli b/helm/gTopLevel/misc.ml
similarity index 66%
rename from helm/gTopLevel/mQueryGenerator.mli
rename to helm/gTopLevel/misc.ml
index 57137974f..e42a0c5f7 100644
--- a/helm/gTopLevel/mQueryGenerator.mli
+++ b/helm/gTopLevel/misc.ml
@@ -1,4 +1,4 @@
-(* Copyright (C) 2000, HELM Team.
+(* Copyright (C) 2000-2002, HELM Team.
  * 
  * This file is part of HELM, an Hypertextual, Electronic
  * Library of Mathematics, developed at the Computer Science
@@ -27,29 +27,21 @@
 (*                                                                            *)
 (*                               PROJECT HELM                                 *)
 (*                                                                            *)
-(*                     Ferruccio Guidi                    *)
-(*                                 30/04/2002                                 *)
+(*                Claudio Sacerdoti Coen                *)
+(*                                 06/01/2002                                 *)
 (*                                                                            *)
 (*                                                                            *)
 (******************************************************************************)
 
-exception Discard  
+let domImpl = Gdome.domImplementation ();;
+let helmns = Gdome.domString "http://www.cs.unibo.it/helm";;
 
-type levels_spec = (string * bool * int) list
+  (* 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
+;;
 
-val levels_of_term    : Cic.metasenv -> Cic.context -> Cic.term -> levels_spec
-
-val string_of_levels  : levels_spec -> string -> string
-
-val set_log_file      : string -> unit
-
-(* the callback function must return false iff the query must be skipped *)
-val set_confirm_query : (MathQL.query -> bool) -> unit
-
-val execute_query     : MathQL.query -> MathQL.result
-
-val locate            : string -> MathQL.result
-
-val backward          : Cic.metasenv -> Cic.context -> Cic.term -> int -> MathQL.result
-
-val get_query_info    : unit -> string list
diff --git a/helm/gTopLevel/misc.mli b/helm/gTopLevel/misc.mli
new file mode 100644
index 000000000..65ad26c6f
--- /dev/null
+++ b/helm/gTopLevel/misc.mli
@@ -0,0 +1,40 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(******************************************************************************)
+(*                                                                            *)
+(*                               PROJECT HELM                                 *)
+(*                                                                            *)
+(*                Claudio Sacerdoti Coen                *)
+(*                                 15/01/2003                                 *)
+(*                                                                            *)
+(*                                                                            *)
+(******************************************************************************)
+
+val domImpl : Gdome.domImplementation
+val helmns : Gdome.domString
+
+val strip_xml_headings: string -> string
+
diff --git a/helm/gTopLevel/proofEngine.ml b/helm/gTopLevel/proofEngine.ml
index 5f0ba8aaa..491fe5224 100644
--- a/helm/gTopLevel/proofEngine.ml
+++ b/helm/gTopLevel/proofEngine.ml
@@ -31,21 +31,44 @@ open ProofEngineTypes
 let proof = ref (None : proof option)
 let goal = ref (None : goal option)
 
-let apply_tactic ~tactic:tactic =
+let get_current_status_as_xml () =
+  match !proof with
+     None -> assert false
+   | Some (uri, metasenv, bo, ty) ->
+      let currentproof =
+       (*CSC: Wrong: [] is just plainly wrong *)
+       Cic.CurrentProof (UriManager.name_of_uri uri,metasenv,bo,ty,[])
+      in
+       let (acurrentproof,_,_,ids_to_inner_sorts,_,_,_) =
+        Cic2acic.acic_object_of_cic_object currentproof
+       in
+        let xml, bodyxml =
+         match
+          Cic2Xml.print_object uri ~ids_to_inner_sorts
+           ~ask_dtd_to_the_getter:true acurrentproof
+         with
+            xml,Some bodyxml -> xml,bodyxml
+          | _,None -> assert false
+        in
+         (xml, bodyxml)
+;;
+
+let apply_tactic ~tactic =
  match !proof,!goal with
-    None,_
+  | None,_
   | _,None -> assert false
   | Some proof', Some goal' ->
      let (newproof, newgoals) = tactic ~status:(proof', goal') in
-     proof := Some newproof;
-     goal :=
-      (match newgoals, newproof with
-          goal::_, _ -> Some goal
-        | [], (_,(goal,_,_)::_,_,_) ->
-           (* the tactic left no open goal ; let's choose the first open goal *)
-(*CSC: here we could implement and use a proof-tree like notion... *)
-           Some goal
-        | _, _ -> None)
+      proof := Some newproof;
+      goal :=
+       (match newgoals, newproof with
+           goal::_, _ -> Some goal
+         | [], (_,(goal,_,_)::_,_,_) ->
+         (* the tactic left no open goal ; let's choose the first open goal *)
+         (*CSC: here we could implement and use a proof-tree like notion... *)
+            Some goal
+         | _, _ -> None)
+;;
 
 (* metas_in_term term                                                *)
 (* Returns the ordered list of the metas that occur in [term].       *)
@@ -54,8 +77,7 @@ let metas_in_term term =
  let module C = Cic in
   let rec aux =
    function
-      C.Rel _
-    | C.Var _ -> []
+      C.Rel _ -> []
     | C.Meta (n,_) -> [n]
     | C.Sort _
     | C.Implicit -> []
@@ -64,15 +86,17 @@ let metas_in_term term =
     | C.Lambda (_,s,t) -> (aux s) @ (aux t)
     | C.LetIn (_,s,t) -> (aux s) @ (aux t)
     | C.Appl l -> List.fold_left (fun i t -> i @ (aux t)) [] l
-    | C.Const _
-    | C.MutInd _
-    | C.MutConstruct _ -> []
-    | C.MutCase (sp,cookingsno,i,outt,t,pl) ->
+    | C.Var (_,exp_named_subst)
+    | C.Const (_,exp_named_subst)
+    | C.MutInd (_,_,exp_named_subst)
+    | C.MutConstruct (_,_,_,exp_named_subst) ->
+       List.fold_left (fun i (_,t) -> i @ (aux t)) [] exp_named_subst
+    | C.MutCase (_,_,outt,t,pl) ->
        (aux outt) @ (aux t) @
         (List.fold_left (fun i t -> i @ (aux t)) [] pl)
-    | C.Fix (i,fl) ->
+    | C.Fix (_,fl) ->
         List.fold_left (fun i (_,_,ty,bo) -> i @ (aux bo) @ (aux ty)) [] fl
-    | C.CoFix (i,fl) ->
+    | C.CoFix (_,fl) ->
         List.fold_left (fun i (_,ty,bo) -> i @ (aux bo) @ (aux ty)) [] fl
   in
    let metas = aux term in
@@ -101,7 +125,7 @@ let perforate context term ty =
         let irl = identity_relocation_list_for_metavariable context in
 (*CSC: Bug: se ci sono due term uguali nella prova dovrei bucarne uno solo!!!*)
         let bo' =
-         ProofEngineReduction.replace (==) term (C.Meta (newmeta,irl)) bo
+         ProofEngineReduction.replace (==) [term] [C.Meta (newmeta,irl)] bo
         in
         (* It may be possible that some metavariables occurred only in *)
         (* the term we are perforating and they now occurs no more. We *)
@@ -121,66 +145,8 @@ let perforate context term ty =
 (*                  Some easy tactics.                      *)
 (************************************************************)
 
-(*CSC: generatore di nomi? Chiedere il nome? *)
-let fresh_name =
- let next_fresh_index = ref 0
-in
- function () ->
-  incr next_fresh_index ;
-  "fresh_name" ^ string_of_int !next_fresh_index
-
-let reduction_tactic reduction_function term =
- let curi,metasenv,pbo,pty =
-  match !proof with
-     None -> assert false
-   | Some (curi,metasenv,bo,ty) -> curi,metasenv,bo,ty
- in
- let metano,context,ty =
-  match !goal with
-     None -> assert false
-   | Some metano -> List.find (function (m,_,_) -> m=metano) metasenv
- in
-  (* We don't know if [term] is a subterm of [ty] or a subterm of *)
-  (* the type of one metavariable. So we replace it everywhere.   *)
-  (*CSC: Il vero problema e' che non sapendo dove sia il term non *)
-  (*CSC: sappiamo neppure quale sia il suo contesto!!!! Insomma,  *)
-  (*CSC: e' meglio prima cercare il termine e scoprirne il        *)
-  (*CSC: contesto, poi ridurre e infine rimpiazzare.              *)
-   let replace context where=
-(*CSC: Per il momento se la riduzione fallisce significa solamente che *)
-(*CSC: siamo nel contesto errato. Metto il try, ma che schifo!!!!      *)
-(*CSC: Anche perche' cosi' catturo anche quelle del replace che non dovrei *)
-   try
-    let term' = reduction_function context term in
-     ProofEngineReduction.replace ~equality:(==) ~what:term ~with_what:term'
-      ~where:where
-   with
-    _ -> where
-   in
-    let ty' = replace context ty in
-    let context' =
-     List.fold_right
-      (fun entry context ->
-        match entry with
-           Some (name,Cic.Def  t) ->
-            (Some (name,Cic.Def  (replace context t)))::context
-         | Some (name,Cic.Decl t) ->
-            (Some (name,Cic.Decl (replace context t)))::context
-         | None -> None::context
-      ) context []
-    in
-     let metasenv' = 
-      List.map
-       (function
-           (n,_,_) when n = metano -> (metano,context',ty')
-         | _ as t -> t
-       ) metasenv
-     in
-      proof := Some (curi,metasenv',pbo,pty) ;
-      goal := Some metano
-
 (* Reduces [term] using [reduction_function] in the current scratch goal [ty] *)
-let reduction_tactic_in_scratch reduction_function term ty =
+let reduction_tactic_in_scratch reduction_function terms ty =
  let metasenv =
   match !proof with
      None -> []
@@ -191,61 +157,14 @@ let reduction_tactic_in_scratch reduction_function term ty =
      None -> assert false
    | Some metano -> List.find (function (m,_,_) -> m=metano) metasenv
  in
-  let term' = reduction_function context term in
+  let terms' = List.map (reduction_function context) terms in
    ProofEngineReduction.replace
-    ~equality:(==) ~what:term ~with_what:term' ~where:ty
-
-let whd    = reduction_tactic CicReduction.whd
-let reduce = reduction_tactic ProofEngineReduction.reduce
-let simpl  = reduction_tactic ProofEngineReduction.simpl
+    ~equality:(==) ~what:terms ~with_what:terms' ~where:ty
+;;
 
 let whd_in_scratch    = reduction_tactic_in_scratch CicReduction.whd
-let reduce_in_scratch =
- reduction_tactic_in_scratch ProofEngineReduction.reduce
-let simpl_in_scratch  =
- reduction_tactic_in_scratch ProofEngineReduction.simpl
-
-(* It is just the opposite of whd. The code should probably be merged. *)
-let fold term =
- let curi,metasenv,pbo,pty =
-  match !proof with
-     None -> assert false
-   | Some (curi,metasenv,bo,ty) -> curi,metasenv,bo,ty
- in
- let metano,context,ty =
-  match !goal with
-     None -> assert false
-   | Some metano -> List.find (function (m,_,_) -> m=metano) metasenv
- in
-  let term' = CicReduction.whd context term in
-   (* We don't know if [term] is a subterm of [ty] or a subterm of *)
-   (* the type of one metavariable. So we replace it everywhere.   *)
-   (*CSC: ma si potrebbe ovviare al problema. Ma non credo *)
-   (*CSC: che si guadagni nulla in fatto di efficienza.    *) 
-   let replace =
-    ProofEngineReduction.replace
-     ~equality:
-      (ProofEngineReduction.syntactic_equality ~alpha_equivalence:false)
-     ~what:term' ~with_what:term
-   in
-    let ty' = replace ty in
-    let context' =
-     List.map
-      (function
-          Some (n,Cic.Decl t) -> Some (n,Cic.Decl (replace t))
-        | Some (n,Cic.Def t)  -> Some (n,Cic.Def  (replace t))
-        | None -> None
-      ) context
-    in
-     let metasenv' = 
-      List.map
-       (function
-           (n,_,_) when n = metano -> (metano,context',ty')
-         | _ as t -> t
-       ) metasenv
-     in
-      proof := Some (curi,metasenv',pbo,pty) ;
-      goal := Some metano
+let reduce_in_scratch = reduction_tactic_in_scratch ProofEngineReduction.reduce
+let simpl_in_scratch  = reduction_tactic_in_scratch ProofEngineReduction.simpl
 
 (************************************************************)
 (*              Tactics defined elsewhere                   *)
@@ -254,10 +173,12 @@ let fold term =
   (* primitive tactics *)
 
 let apply term = apply_tactic (PrimitiveTactics.apply_tac ~term)
-let intros () =
-  apply_tactic (PrimitiveTactics.intros_tac ~name:(fresh_name ()))
-let cut term = apply_tactic (PrimitiveTactics.cut_tac ~term)
-let letin term = apply_tactic (PrimitiveTactics.letin_tac ~term)
+let intros ?mk_fresh_name_callback () =
+ apply_tactic (PrimitiveTactics.intros_tac ?mk_fresh_name_callback ())
+let cut ?mk_fresh_name_callback term =
+ apply_tactic (PrimitiveTactics.cut_tac ?mk_fresh_name_callback term)
+let letin ?mk_fresh_name_callback term =
+ apply_tactic (PrimitiveTactics.letin_tac ?mk_fresh_name_callback term)
 let exact term = apply_tactic (PrimitiveTactics.exact_tac ~term)
 let elim_intros_simpl term =
   apply_tactic (PrimitiveTactics.elim_intros_simpl_tac ~term)
@@ -269,9 +190,68 @@ let change ~goal_input:what ~input:with_what =
 let clearbody hyp = apply_tactic (ProofEngineStructuralRules.clearbody ~hyp)
 let clear hyp = apply_tactic (ProofEngineStructuralRules.clear ~hyp)
 
+  (* reduction tactics *)
+
+let whd terms =
+ apply_tactic
+  (ReductionTactics.whd_tac ~also_in_hypotheses:true ~terms:(Some terms))
+let reduce terms =
+ apply_tactic
+  (ReductionTactics.reduce_tac ~also_in_hypotheses:true ~terms:(Some terms))
+let simpl terms =
+ apply_tactic
+  (ReductionTactics.simpl_tac ~also_in_hypotheses:true ~terms:(Some terms))
+
+let fold_whd term =
+ apply_tactic
+  (ReductionTactics.fold_tac ~reduction:CicReduction.whd
+    ~also_in_hypotheses:true ~term)
+let fold_reduce term =
+ apply_tactic
+  (ReductionTactics.fold_tac ~reduction:ProofEngineReduction.reduce
+    ~also_in_hypotheses:true ~term)
+let fold_simpl term =
+ apply_tactic
+  (ReductionTactics.fold_tac ~reduction:ProofEngineReduction.simpl
+    ~also_in_hypotheses:true ~term)
+
   (* other tactics *)
 
-let elim_type term = apply_tactic (Ring.elim_type_tac ~term)
+let elim_type term = apply_tactic (EliminationTactics.elim_type_tac ~term)
 let ring () = apply_tactic Ring.ring_tac
 let fourier () = apply_tactic FourierR.fourier_tac
-let rewrite_simpl term = apply_tactic (FourierR.rewrite_simpl_tac ~term)
+
+let rewrite_simpl term = apply_tactic (EqualityTactics.rewrite_simpl_tac ~term)
+let rewrite_back_simpl term = apply_tactic (EqualityTactics.rewrite_back_simpl_tac ~term)
+let replace ~goal_input:what ~input:with_what = 
+  apply_tactic (EqualityTactics.replace_tac ~what ~with_what)
+
+let reflexivity () = apply_tactic EqualityTactics.reflexivity_tac
+let symmetry () = apply_tactic EqualityTactics.symmetry_tac
+let transitivity term = apply_tactic (EqualityTactics.transitivity_tac ~term)
+
+let exists () = apply_tactic IntroductionTactics.exists_tac
+let split () = apply_tactic IntroductionTactics.split_tac 
+let left () = apply_tactic IntroductionTactics.left_tac
+let right () = apply_tactic IntroductionTactics.right_tac
+
+let assumption () = apply_tactic VariousTactics.assumption_tac
+
+let generalize ?mk_fresh_name_callback terms =
+ apply_tactic (VariousTactics.generalize_tac ?mk_fresh_name_callback terms)
+
+let absurd term = apply_tactic (NegationTactics.absurd_tac ~term)
+let contradiction () = apply_tactic NegationTactics.contradiction_tac
+
+let decompose ~uris_choice_callback term =
+ apply_tactic (EliminationTactics.decompose_tac ~uris_choice_callback term)
+
+let injection term = apply_tactic (DiscriminationTactics.injection_tac ~term)
+let discriminate term = apply_tactic (DiscriminationTactics.discriminate_tac ~term)
+let decide_equality () = apply_tactic DiscriminationTactics.decide_equality_tac
+let compare term = apply_tactic (DiscriminationTactics.compare_tac ~term)
+
+(*
+let prova_tatticali () = apply_tactic Tacticals.prova_tac
+*)
+
diff --git a/helm/gTopLevel/proofEngine.mli b/helm/gTopLevel/proofEngine.mli
index f5c31067f..4b7db8fe6 100644
--- a/helm/gTopLevel/proofEngine.mli
+++ b/helm/gTopLevel/proofEngine.mli
@@ -27,25 +27,34 @@
 val proof : ProofEngineTypes.proof option ref
 val goal : ProofEngineTypes.goal option ref
 
+  (** return a pair of "xml" (as defined in Xml module) representing the current
+  proof type and body, respectively *)
+val get_current_status_as_xml : unit -> Xml.token Stream.t * Xml.token Stream.t
+
   (* start a new goal undoing part of the proof *)
 val perforate : Cic.context -> Cic.term -> Cic.term -> unit
 
   (* reduction tactics *)
-val whd : Cic.term -> unit
-val reduce : Cic.term -> unit
-val simpl : Cic.term -> unit
-val fold : Cic.term -> unit
+val whd : Cic.term list -> unit
+val reduce : Cic.term list -> unit
+val simpl : Cic.term list -> unit
+val fold_whd : Cic.term -> unit
+val fold_reduce : Cic.term -> unit
+val fold_simpl : Cic.term -> unit
 
   (* scratch area reduction tactics *)
-val whd_in_scratch : Cic.term -> Cic.term -> Cic.term
-val reduce_in_scratch : Cic.term -> Cic.term -> Cic.term
-val simpl_in_scratch : Cic.term -> Cic.term -> Cic.term
+val whd_in_scratch : Cic.term list -> Cic.term -> Cic.term
+val reduce_in_scratch : Cic.term list -> Cic.term -> Cic.term
+val simpl_in_scratch : Cic.term list -> Cic.term -> Cic.term
 
   (* "primitive" tactics *)
 val apply : Cic.term -> unit
-val intros : unit -> unit
-val cut : Cic.term -> unit
-val letin : Cic.term -> unit
+val intros :
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type -> unit -> unit
+val cut :
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type -> Cic.term -> unit
+val letin :
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type -> Cic.term -> unit
 val exact : Cic.term -> unit
 val elim_intros_simpl : Cic.term -> unit
 val change : goal_input:Cic.term -> input:Cic.term -> unit
@@ -59,3 +68,39 @@ val elim_type : Cic.term -> unit
 val ring : unit -> unit
 val fourier : unit -> unit
 val rewrite_simpl : Cic.term -> unit
+val rewrite_back_simpl : Cic.term -> unit
+val replace : goal_input:Cic.term -> input:Cic.term -> unit
+
+val reflexivity : unit -> unit
+val symmetry : unit -> unit
+val transitivity : Cic.term -> unit
+
+val exists : unit -> unit
+val split : unit -> unit
+val left : unit -> unit
+val right : unit -> unit
+
+val assumption : unit -> unit
+
+val generalize :
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
+  Cic.term list -> unit
+
+val absurd : Cic.term -> unit
+val contradiction : unit -> unit
+
+val decompose :
+ uris_choice_callback:
+  ((UriManager.uri * int * (UriManager.uri * Cic.term) list) list ->
+   (UriManager.uri * int * (UriManager.uri * Cic.term) list) list) ->
+ Cic.term -> unit
+
+val injection : Cic.term -> unit
+val discriminate : Cic.term -> unit
+val decide_equality : unit -> unit
+val compare : Cic.term -> unit
+
+
+(*
+val prova_tatticali : unit -> unit
+*)
diff --git a/helm/gTopLevel/proofEngineReduction.ml b/helm/gTopLevel/proofEngineReduction.ml
deleted file mode 100644
index bb724fc75..000000000
--- a/helm/gTopLevel/proofEngineReduction.ml
+++ /dev/null
@@ -1,678 +0,0 @@
-(* Copyright (C) 2002, HELM Team.
- * 
- * This file is part of HELM, an Hypertextual, Electronic
- * Library of Mathematics, developed at the Computer Science
- * Department, University of Bologna, Italy.
- * 
- * HELM is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- * 
- * HELM is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with HELM; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- * MA  02111-1307, USA.
- * 
- * For details, see the HELM World-Wide-Web page,
- * http://cs.unibo.it/helm/.
- *)
-
-(******************************************************************************)
-(*                                                                            *)
-(*                               PROJECT HELM                                 *)
-(*                                                                            *)
-(*                Claudio Sacerdoti Coen                *)
-(*                                 12/04/2002                                 *)
-(*                                                                            *)
-(*                                                                            *)
-(******************************************************************************)
-
-
-(* The code of this module is derived from the code of CicReduction *)
-
-exception Impossible of int;;
-exception ReferenceToDefinition;;
-exception ReferenceToAxiom;;
-exception ReferenceToVariable;;
-exception ReferenceToCurrentProof;;
-exception ReferenceToInductiveDefinition;;
-exception WrongUriToInductiveDefinition;;
-exception RelToHiddenHypothesis;;
-
-(* syntactic_equality up to cookingsno for uris *)
-(* (which is often syntactically irrilevant)    *)
-let syntactic_equality ~alpha_equivalence =
- let module C = Cic in
-  let rec aux t t' =
-   if t = t' then true
-   else
-    match t,t' with
-       C.Rel _, C.Rel _
-     | C.Var _, C.Var _
-     | C.Meta _, C.Meta _
-     | C.Sort _, C.Sort _
-     | C.Implicit, C.Implicit -> false (* we already know that t != t' *)
-     | C.Cast (te,ty), C.Cast (te',ty') ->
-        aux te te' && aux ty ty'
-     | C.Prod (n,s,t), C.Prod (n',s',t') ->
-        (alpha_equivalence || n = n') && aux s s' && aux t t'
-     | C.Lambda (n,s,t), C.Lambda (n',s',t') ->
-        (alpha_equivalence || n = n') && aux s s' && aux t t'
-     | C.LetIn (n,s,t), C.LetIn(n',s',t') ->
-        (alpha_equivalence || n = n') && aux s s' && aux t t'
-     | C.Appl l, C.Appl l' ->
-        (try
-          List.fold_left2
-           (fun b t1 t2 -> b && aux t1 t2) true l l'
-         with
-          Invalid_argument _ -> false)
-     | C.Const (uri,_), C.Const (uri',_) -> UriManager.eq uri uri'
-     | C.MutInd (uri,_,i), C.MutInd (uri',_,i') ->
-        UriManager.eq uri uri' && i = i'
-     | C.MutConstruct (uri,_,i,j), C.MutConstruct (uri',_,i',j') ->
-        UriManager.eq uri uri' && i = i' && j = j'
-     | C.MutCase (sp,_,i,outt,t,pl), C.MutCase (sp',_,i',outt',t',pl') ->
-        UriManager.eq sp sp' && i = i' &&
-         aux outt outt' && aux t t' &&
-          (try
-            List.fold_left2
-             (fun b t1 t2 -> b && aux t1 t2) true pl pl'
-           with
-            Invalid_argument _ -> false)
-     | C.Fix (i,fl), C.Fix (i',fl') ->
-        i = i' &&
-        (try
-          List.fold_left2
-           (fun b (name,i,ty,bo) (name',i',ty',bo') ->
-             b && (alpha_equivalence || name = name') && i = i' &&
-              aux ty ty' && aux bo bo') true fl fl'
-         with
-          Invalid_argument _ -> false)
-     | C.CoFix (i,fl), C.CoFix (i',fl') ->
-        i = i' &&
-        (try
-          List.fold_left2
-           (fun b (name,ty,bo) (name',ty',bo') ->
-             b && (alpha_equivalence || name = name') &&
-              aux ty ty' && aux bo bo') true fl fl'
-         with
-          Invalid_argument _ -> false)
-     | _,_ -> false
- in
-  aux
-;;
-
-(* "textual" replacement of a subterm with another one *)
-let replace ~equality ~what ~with_what ~where =
- let module C = Cic in
-  let rec aux =
-   function
-      t when (equality t what) -> with_what
-    | C.Rel _ as t -> t
-    | C.Var _ as t  -> t
-    | C.Meta _ as t -> t
-    | C.Sort _ as t -> t
-    | C.Implicit as t -> t
-    | C.Cast (te,ty) -> C.Cast (aux te, aux ty)
-    | C.Prod (n,s,t) -> C.Prod (n, aux s, aux t)
-    | C.Lambda (n,s,t) -> C.Lambda (n, aux s, aux t)
-    | C.LetIn (n,s,t) -> C.LetIn (n, aux s, aux t)
-    | C.Appl l ->
-       (* Invariant enforced: no application of an application *)
-       (match List.map aux l with
-           (C.Appl l')::tl -> C.Appl (l'@tl)
-         | l' -> C.Appl l')
-    | C.Const _ as t -> t
-    | C.MutInd _ as t -> t
-    | C.MutConstruct _ as t -> t
-    | C.MutCase (sp,cookingsno,i,outt,t,pl) ->
-       C.MutCase (sp,cookingsno,i,aux outt, aux t,
-        List.map aux pl)
-    | C.Fix (i,fl) ->
-       let substitutedfl =
-        List.map
-         (fun (name,i,ty,bo) -> (name, i, aux ty, aux bo))
-          fl
-       in
-        C.Fix (i, substitutedfl)
-    | C.CoFix (i,fl) ->
-       let substitutedfl =
-        List.map
-         (fun (name,ty,bo) -> (name, aux ty, aux bo))
-          fl
-       in
-        C.CoFix (i, substitutedfl)
-  in
-   aux where
-;;
-
-(* replaces in a term a term with another one. *)
-(* Lifting are performed as usual.             *)
-let replace_lifting ~equality ~what ~with_what ~where =
- let rec substaux k what =
-  let module C = Cic in
-  let module S = CicSubstitution in
-   function
-      t when (equality t what) -> S.lift (k-1) with_what
-    | C.Rel n as t -> t
-    | C.Var _ as t  -> t
-    | C.Meta (i, l) as t -> 
-       let l' =
-        List.map
-         (function
-             None -> None
-           | Some t -> Some (substaux k what t)
-         ) l
-       in
-        C.Meta(i,l')
-    | C.Sort _ as t -> t
-    | C.Implicit as t -> t
-    | C.Cast (te,ty) -> C.Cast (substaux k what te, substaux k what ty)
-    | C.Prod (n,s,t) ->
-       C.Prod (n, substaux k what s, substaux (k + 1) (S.lift 1 what) t)
-    | C.Lambda (n,s,t) ->
-       C.Lambda (n, substaux k what s, substaux (k + 1) (S.lift 1 what) t)
-    | C.LetIn (n,s,t) ->
-       C.LetIn (n, substaux k what s, substaux (k + 1) (S.lift 1 what) t)
-    | C.Appl (he::tl) ->
-       (* Invariant: no Appl applied to another Appl *)
-       let tl' = List.map (substaux k what) tl in
-        begin
-         match substaux k what he with
-            C.Appl l -> C.Appl (l@tl')
-          | _ as he' -> C.Appl (he'::tl')
-        end
-    | C.Appl _ -> assert false
-    | C.Const _ as t -> t
-    | C.MutInd _ as t -> t
-    | C.MutConstruct _ as t -> t
-    | C.MutCase (sp,cookingsno,i,outt,t,pl) ->
-       C.MutCase (sp,cookingsno,i,substaux k what outt, substaux k what t,
-        List.map (substaux k what) pl)
-    | C.Fix (i,fl) ->
-       let len = List.length fl in
-       let substitutedfl =
-        List.map
-         (fun (name,i,ty,bo) ->
-           (name, i, substaux k what ty, substaux (k+len) (S.lift len what) bo))
-          fl
-       in
-        C.Fix (i, substitutedfl)
-    | C.CoFix (i,fl) ->
-       let len = List.length fl in
-       let substitutedfl =
-        List.map
-         (fun (name,ty,bo) ->
-           (name, substaux k what ty, substaux (k+len) (S.lift len what) bo))
-          fl
-       in
-        C.CoFix (i, substitutedfl)
- in
-  substaux 1 what where
-;;
-
-(* Takes a well-typed term and fully reduces it. *)
-(*CSC: It does not perform reduction in a Case *)
-let reduce context =
- let rec reduceaux context l =
-  let module C = Cic in
-  let module S = CicSubstitution in
-   function
-      C.Rel n as t ->
-       (match List.nth context (n-1) with
-           Some (_,C.Decl _) -> if l = [] then t else C.Appl (t::l)
-         | Some (_,C.Def bo) -> reduceaux context l (S.lift n bo)
-	 | None -> raise RelToHiddenHypothesis
-       )
-    | C.Var uri as t ->
-       (match CicEnvironment.get_cooked_obj uri 0 with
-           C.Definition _ -> raise ReferenceToDefinition
-         | C.Axiom _ -> raise ReferenceToAxiom
-         | C.CurrentProof _ -> raise ReferenceToCurrentProof
-         | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
-         | C.Variable (_,None,_) -> if l = [] then t else C.Appl (t::l)
-         | C.Variable (_,Some body,_) -> reduceaux context l body
-       )
-    | C.Meta _ as t -> if l = [] then t else C.Appl (t::l)
-    | C.Sort _ as t -> t (* l should be empty *)
-    | C.Implicit as t -> t
-    | C.Cast (te,ty) ->
-       C.Cast (reduceaux context l te, reduceaux context l ty)
-    | C.Prod (name,s,t) ->
-       assert (l = []) ;
-       C.Prod (name,
-        reduceaux context [] s,
-        reduceaux ((Some (name,C.Decl s))::context) [] t)
-    | C.Lambda (name,s,t) ->
-       (match l with
-           [] ->
-            C.Lambda (name,
-             reduceaux context [] s,
-             reduceaux ((Some (name,C.Decl s))::context) [] t)
-         | he::tl -> reduceaux context tl (S.subst he t)
-           (* when name is Anonimous the substitution should be superfluous *)
-       )
-    | C.LetIn (n,s,t) ->
-       reduceaux context l (S.subst (reduceaux context [] s) t)
-    | C.Appl (he::tl) ->
-       let tl' = List.map (reduceaux context []) tl in
-        reduceaux context (tl'@l) he
-    | C.Appl [] -> raise (Impossible 1)
-    | C.Const (uri,cookingsno) as t ->
-       (match CicEnvironment.get_cooked_obj uri cookingsno with
-           C.Definition (_,body,_,_) -> reduceaux context l body
-         | C.Axiom _ -> if l = [] then t else C.Appl (t::l)
-         | C.Variable _ -> raise ReferenceToVariable
-         | C.CurrentProof (_,_,body,_) -> reduceaux context l body
-         | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
-       )
-    | C.MutInd (uri,_,_) as t -> if l = [] then t else C.Appl (t::l)
-    | C.MutConstruct (uri,_,_,_) as t -> if l = [] then t else C.Appl (t::l)
-    | C.MutCase (mutind,cookingsno,i,outtype,term,pl) ->
-       let decofix =
-        function
-           C.CoFix (i,fl) as t ->
-            let tys =
-             List.map (function (name,ty,_) -> Some (C.Name name, C.Decl ty)) fl
-            in
-             let (_,_,body) = List.nth fl i in
-              let body' =
-               let counter = ref (List.length fl) in
-                List.fold_right
-                 (fun _ -> decr counter ; S.subst (C.CoFix (!counter,fl)))
-                 fl
-                 body
-              in
-               reduceaux (tys@context) [] body'
-         | C.Appl (C.CoFix (i,fl) :: tl) ->
-            let tys =
-             List.map (function (name,ty,_) -> Some (C.Name name, C.Decl ty)) fl
-            in
-             let (_,_,body) = List.nth fl i in
-              let body' =
-               let counter = ref (List.length fl) in
-                List.fold_right
-                 (fun _ -> decr counter ; S.subst (C.CoFix (!counter,fl)))
-                 fl
-                 body
-              in
-               let tl' = List.map (reduceaux context []) tl in
-                reduceaux (tys@context) tl' body'
-         | t -> t
-       in
-        (match decofix (reduceaux context [] term) with
-            C.MutConstruct (_,_,_,j) -> reduceaux context l (List.nth pl (j-1))
-          | C.Appl (C.MutConstruct (_,_,_,j) :: tl) ->
-             let (arity, r, num_ingredients) =
-              match CicEnvironment.get_obj mutind with
-                 C.InductiveDefinition (tl,ingredients,r) ->
-                   let (_,_,arity,_) = List.nth tl i
-                   and num_ingredients =
-                    List.fold_right
-                     (fun (k,l) i ->
-                       if k < cookingsno then i + List.length l else i
-                     ) ingredients 0
-                   in
-                    (arity,r,num_ingredients)
-               | _ -> raise WrongUriToInductiveDefinition
-             in
-              let ts =
-               let num_to_eat = r + num_ingredients in
-                let rec eat_first =
-                 function
-                    (0,l) -> l
-                  | (n,he::tl) when n > 0 -> eat_first (n - 1, tl)
-                  | _ -> raise (Impossible 5)
-                in
-                 eat_first (num_to_eat,tl)
-              in
-               reduceaux context (ts@l) (List.nth pl (j-1))
-         | C.Cast _ | C.Implicit ->
-            raise (Impossible 2) (* we don't trust our whd ;-) *)
-         | _ ->
-           let outtype' = reduceaux context [] outtype in
-           let term' = reduceaux context [] term in
-           let pl' = List.map (reduceaux context []) pl in
-            let res =
-             C.MutCase (mutind,cookingsno,i,outtype',term',pl')
-            in
-             if l = [] then res else C.Appl (res::l)
-       )
-    | C.Fix (i,fl) ->
-       let tys =
-        List.map (function (name,_,ty,_) -> Some (C.Name name, C.Decl ty)) fl
-       in
-        let t' () =
-         let fl' =
-          List.map
-           (function (n,recindex,ty,bo) ->
-             (n,recindex,reduceaux context [] ty, reduceaux (tys@context) [] bo)
-           ) fl
-         in
-          C.Fix (i, fl')
-        in
-         let (_,recindex,_,body) = List.nth fl i in
-          let recparam =
-           try
-            Some (List.nth l recindex)
-           with
-            _ -> None
-          in
-           (match recparam with
-               Some recparam ->
-                (match reduceaux context [] recparam with
-                    C.MutConstruct _
-                  | C.Appl ((C.MutConstruct _)::_) ->
-                     let body' =
-                      let counter = ref (List.length fl) in
-                       List.fold_right
-                        (fun _ -> decr counter ; S.subst (C.Fix (!counter,fl)))
-                        fl
-                        body
-                     in
-                      (* Possible optimization: substituting whd recparam in l*)
-                      reduceaux context l body'
-                  | _ -> if l = [] then t' () else C.Appl ((t' ())::l)
-                )
-             | None -> if l = [] then t' () else C.Appl ((t' ())::l)
-           )
-    | C.CoFix (i,fl) ->
-       let tys =
-        List.map (function (name,ty,_) -> Some (C.Name name, C.Decl ty)) fl
-       in
-        let t' =
-         let fl' =
-          List.map
-           (function (n,ty,bo) ->
-             (n,reduceaux context [] ty, reduceaux (tys@context) [] bo)
-           ) fl
-         in
-          C.CoFix (i, fl')
-        in
-         if l = [] then t' else C.Appl (t'::l)
- in
-  reduceaux context []
-;;
-
-exception WrongShape;;
-exception AlreadySimplified;;
-
-(*CSC: I fear it is still weaker than Coq's one. For example, Coq is *)
-(*CSCS: able to simpl (foo (S n) (S n)) to (foo (S O) n) where       *)
-(*CSC:  Fix foo                                                      *)
-(*CSC:   {foo [n,m:nat]:nat :=                                       *)
-(*CSC:     Cases m of O => n | (S p) => (foo (S O) p) end            *)
-(*CSC:   }                                                           *)
-(* Takes a well-typed term and                                               *)
-(*  1) Performs beta-iota-zeta reduction until delta reduction is needed     *)
-(*  2) Attempts delta-reduction. If the residual is a Fix lambda-abstracted  *)
-(*     w.r.t. zero or more variables and if the Fix can be reduced, than it  *)
-(*     is reduced, the delta-reduction is succesfull and the whole algorithm *)
-(*     is applied again to the new redex; Step 3) is applied to the result   *)
-(*     of the recursive simplification. Otherwise, if the Fix can not be     *)
-(*     reduced, than the delta-reductions fails and the delta-redex is       *)
-(*     not reduced. Otherwise, if the delta-residual is not the              *)
-(*     lambda-abstraction of a Fix, then it is reduced and the result is     *)
-(*     directly returned, without performing step 3).                        *) 
-(*  3) Folds the application of the constant to the arguments that did not   *)
-(*     change in every iteration, i.e. to the actual arguments for the       *)
-(*     lambda-abstractions that precede the Fix.                             *)
-(*CSC: It does not perform simplification in a Case *)
-let simpl context =
- (* reduceaux is equal to the reduceaux locally defined inside *)
- (*reduce, but for the const case.                             *) 
- (**** Step 1 ****)
- let rec reduceaux context l =
-  let module C = Cic in
-  let module S = CicSubstitution in
-   function
-      C.Rel n as t ->
-       (match List.nth context (n-1) with
-           Some (_,C.Decl _) -> if l = [] then t else C.Appl (t::l)
-         | Some (_,C.Def bo) -> reduceaux context l (S.lift n bo)
-	 | None -> raise RelToHiddenHypothesis
-       )
-    | C.Var uri as t ->
-       (match CicEnvironment.get_cooked_obj uri 0 with
-           C.Definition _ -> raise ReferenceToDefinition
-         | C.Axiom _ -> raise ReferenceToAxiom
-         | C.CurrentProof _ -> raise ReferenceToCurrentProof
-         | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
-         | C.Variable (_,None,_) -> if l = [] then t else C.Appl (t::l)
-         | C.Variable (_,Some body,_) -> reduceaux context l body
-       )
-    | C.Meta _ as t -> if l = [] then t else C.Appl (t::l)
-    | C.Sort _ as t -> t (* l should be empty *)
-    | C.Implicit as t -> t
-    | C.Cast (te,ty) ->
-       C.Cast (reduceaux context l te, reduceaux context l ty)
-    | C.Prod (name,s,t) ->
-       assert (l = []) ;
-       C.Prod (name,
-        reduceaux context [] s,
-        reduceaux ((Some (name,C.Decl s))::context) [] t)
-    | C.Lambda (name,s,t) ->
-       (match l with
-           [] ->
-            C.Lambda (name,
-             reduceaux context [] s,
-             reduceaux ((Some (name,C.Decl s))::context) [] t)
-         | he::tl -> reduceaux context tl (S.subst he t)
-           (* when name is Anonimous the substitution should be superfluous *)
-       )
-    | C.LetIn (n,s,t) ->
-       reduceaux context l (S.subst (reduceaux context [] s) t)
-    | C.Appl (he::tl) ->
-       let tl' = List.map (reduceaux context []) tl in
-        reduceaux context (tl'@l) he
-    | C.Appl [] -> raise (Impossible 1)
-    | C.Const (uri,cookingsno) as t ->
-       (match CicEnvironment.get_cooked_obj uri cookingsno with
-           C.Definition (_,body,_,_) ->
-            begin
-             try
-              (**** Step 2 ****)
-              let res,constant_args =
-               let rec aux rev_constant_args l =
-                function
-                   C.Lambda (name,s,t) as t' ->
-                    begin
-                     match l with
-                        [] -> raise WrongShape
-                      | he::tl ->
-                         (* when name is Anonimous the substitution should be *)
-                         (* superfluous                                       *)
-                         aux (he::rev_constant_args) tl (S.subst he t)
-                    end
-                 | C.LetIn (_,s,t) ->
-                    aux rev_constant_args l (S.subst s t)
-                 | C.Fix (i,fl) as t ->
-                    let tys =
-                     List.map (function (name,_,ty,_) ->
-                      Some (C.Name name, C.Decl ty)) fl
-                    in
-                     let (_,recindex,_,body) = List.nth fl i in
-                      let recparam =
-                       try
-                        List.nth l recindex
-                       with
-                        _ -> raise AlreadySimplified
-                      in
-                       (match CicReduction.whd context recparam with
-                           C.MutConstruct _
-                         | C.Appl ((C.MutConstruct _)::_) ->
-                            let body' =
-                             let counter = ref (List.length fl) in
-                              List.fold_right
-                               (function _ ->
-                                 decr counter ; S.subst (C.Fix (!counter,fl))
-                               ) fl body
-                            in
-                             (* Possible optimization: substituting whd *)
-                             (* recparam in l                           *)
-                             reduceaux (tys@context) l body',
-                              List.rev rev_constant_args
-                         | _ -> raise AlreadySimplified
-                       )
-                 | _ -> raise WrongShape
-               in
-                aux [] l body
-              in
-               (**** Step 3 ****)
-               let term_to_fold =
-                match constant_args with
-                   [] -> C.Const (uri,cookingsno)
-                 | _ -> C.Appl ((C.Const (uri,cookingsno))::constant_args)
-               in
-                let reduced_term_to_fold = reduce context term_to_fold in
-                 replace (=) reduced_term_to_fold term_to_fold res
-             with
-                WrongShape ->
-                 (* The constant does not unfold to a Fix lambda-abstracted   *)
-                 (* w.r.t. zero or more variables. We just perform reduction. *)
-                 reduceaux context l body
-              | AlreadySimplified ->
-                 (* If we performed delta-reduction, we would find a Fix   *)
-                 (* not applied to a constructor. So, we refuse to perform *)
-                 (* delta-reduction.                                       *)
-                 if l = [] then
-                    t
-                 else
-                  C.Appl (t::l)
-            end
-         | C.Axiom _ -> if l = [] then t else C.Appl (t::l)
-         | C.Variable _ -> raise ReferenceToVariable
-         | C.CurrentProof (_,_,body,_) -> reduceaux context l body
-         | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
-       )
-    | C.MutInd (uri,_,_) as t -> if l = [] then t else C.Appl (t::l)
-    | C.MutConstruct (uri,_,_,_) as t -> if l = [] then t else C.Appl (t::l)
-    | C.MutCase (mutind,cookingsno,i,outtype,term,pl) ->
-       let decofix =
-        function
-           C.CoFix (i,fl) as t ->
-            let tys =
-             List.map (function (name,ty,_) -> Some (C.Name name, C.Decl ty)) fl            in
-             let (_,_,body) = List.nth fl i in
-              let body' =
-               let counter = ref (List.length fl) in
-                List.fold_right
-                 (fun _ -> decr counter ; S.subst (C.CoFix (!counter,fl)))
-                 fl
-                 body
-              in
-               reduceaux (tys@context) [] body'
-         | C.Appl (C.CoFix (i,fl) :: tl) ->
-            let tys =
-             List.map (function (name,ty,_) -> Some (C.Name name, C.Decl ty)) fl            in
-             let (_,_,body) = List.nth fl i in
-              let body' =
-               let counter = ref (List.length fl) in
-                List.fold_right
-                 (fun _ -> decr counter ; S.subst (C.CoFix (!counter,fl)))
-                 fl
-                 body
-              in
-               let tl' = List.map (reduceaux context []) tl in
-                reduceaux (tys@context) tl body'
-         | t -> t
-       in
-        (match decofix (reduceaux context [] term) with
-            C.MutConstruct (_,_,_,j) -> reduceaux context l (List.nth pl (j-1))
-          | C.Appl (C.MutConstruct (_,_,_,j) :: tl) ->
-             let (arity, r, num_ingredients) =
-              match CicEnvironment.get_obj mutind with
-                 C.InductiveDefinition (tl,ingredients,r) ->
-                   let (_,_,arity,_) = List.nth tl i
-                   and num_ingredients =
-                    List.fold_right
-                     (fun (k,l) i ->
-                       if k < cookingsno then i + List.length l else i
-                     ) ingredients 0
-                   in
-                    (arity,r,num_ingredients)
-               | _ -> raise WrongUriToInductiveDefinition
-             in
-              let ts =
-               let num_to_eat = r + num_ingredients in
-                let rec eat_first =
-                 function
-                    (0,l) -> l
-                  | (n,he::tl) when n > 0 -> eat_first (n - 1, tl)
-                  | _ -> raise (Impossible 5)
-                in
-                 eat_first (num_to_eat,tl)
-              in
-               reduceaux context (ts@l) (List.nth pl (j-1))
-         | C.Cast _ | C.Implicit ->
-            raise (Impossible 2) (* we don't trust our whd ;-) *)
-         | _ ->
-           let outtype' = reduceaux context [] outtype in
-           let term' = reduceaux context [] term in
-           let pl' = List.map (reduceaux context []) pl in
-            let res =
-             C.MutCase (mutind,cookingsno,i,outtype',term',pl')
-            in
-             if l = [] then res else C.Appl (res::l)
-       )
-    | C.Fix (i,fl) ->
-       let tys =
-        List.map (function (name,_,ty,_) -> Some (C.Name name, C.Decl ty)) fl
-       in
-        let t' () =
-         let fl' =
-          List.map
-           (function (n,recindex,ty,bo) ->
-             (n,recindex,reduceaux context [] ty, reduceaux (tys@context) [] bo)
-           ) fl
-         in
-          C.Fix (i, fl')
-        in
-         let (_,recindex,_,body) = List.nth fl i in
-          let recparam =
-           try
-            Some (List.nth l recindex)
-           with
-            _ -> None
-          in
-           (match recparam with
-               Some recparam ->
-                (match reduceaux context [] recparam with
-                    C.MutConstruct _
-                  | C.Appl ((C.MutConstruct _)::_) ->
-                     let body' =
-                      let counter = ref (List.length fl) in
-                       List.fold_right
-                        (fun _ -> decr counter ; S.subst (C.Fix (!counter,fl)))
-                        fl
-                        body
-                     in
-                      (* Possible optimization: substituting whd recparam in l*)
-                      reduceaux context l body'
-                  | _ -> if l = [] then t' () else C.Appl ((t' ())::l)
-                )
-             | None -> if l = [] then t' () else C.Appl ((t' ())::l)
-           )
-    | C.CoFix (i,fl) ->
-       let tys =
-        List.map (function (name,ty,_) -> Some (C.Name name, C.Decl ty)) fl
-       in
-        let t' =
-         let fl' =
-          List.map
-           (function (n,ty,bo) ->
-             (n,reduceaux context [] ty, reduceaux (tys@context) [] bo)
-           ) fl
-         in
-         C.CoFix (i, fl')
-       in
-         if l = [] then t' else C.Appl (t'::l)
- in
-  reduceaux context []
-;;
diff --git a/helm/gTopLevel/proofEngineStructuralRules.mli b/helm/gTopLevel/proofEngineStructuralRules.mli
deleted file mode 100644
index f6ee6a529..000000000
--- a/helm/gTopLevel/proofEngineStructuralRules.mli
+++ /dev/null
@@ -1,2 +0,0 @@
-val clearbody: hyp: Cic.hypothesis -> ProofEngineTypes.tactic
-val clear: hyp: Cic.hypothesis -> ProofEngineTypes.tactic
diff --git a/helm/gTopLevel/sequentPp.ml b/helm/gTopLevel/sequentPp.ml
index d0430162e..8cce6e1e3 100644
--- a/helm/gTopLevel/sequentPp.ml
+++ b/helm/gTopLevel/sequentPp.ml
@@ -30,7 +30,7 @@ module TextualPp =
     let print_name =
      function
         Cic.Name n -> n
-      | Cic.Anonimous -> "_"
+      | Cic.Anonymous -> "_"
     in
      List.fold_right
       (fun i (output,context) ->
@@ -50,18 +50,19 @@ module TextualPp =
   exception NotImplemented;;
 
   let print_sequent (metano,context,goal) =
-   let module P = ProofEngine in
-    "\n" ^
-     let (output,pretty_printer_context_of_context) = print_context context in
-      output ^
-       "---------------------- ?" ^ string_of_int metano ^ "\n" ^
-        CicPp.pp goal pretty_printer_context_of_context
+   "\n" ^
+    let (output,pretty_printer_context_of_context) = print_context context in
+     output ^
+      "---------------------- ?" ^ string_of_int metano ^ "\n" ^
+       CicPp.pp goal pretty_printer_context_of_context
   ;;
  end
 ;;
 
 module XmlPp =
  struct
+  let dtdname = "http://localhost:8081/getdtd?uri=cic.dtd";;
+
   let print_sequent metasenv (metano,context,goal) =
    let module X = Xml in
     let ids_to_terms = Hashtbl.create 503 in
@@ -70,41 +71,43 @@ module XmlPp =
     let ids_to_inner_types = Hashtbl.create 503 in
     let ids_to_hypotheses = Hashtbl.create 11 in
     let hypotheses_seed = ref 0 in
-    let seed = ref 0 in
+    let sequent_id = "i0" in
+    let seed = ref 1 in  (* 'i0' is used for the whole sequent *)
      let acic_of_cic_context =
       Cic2acic.acic_of_cic_context' seed ids_to_terms ids_to_father_ids
        ids_to_inner_sorts ids_to_inner_types metasenv
      in
-      let final_s,_ =
+      let final_s,_,final_idrefs =
        (List.fold_right
-         (fun binding (s,context) ->
+         (fun binding (s,context,idrefs) ->
            let hid = "h" ^ string_of_int !hypotheses_seed in
             Hashtbl.add ids_to_hypotheses hid binding ;
             incr hypotheses_seed ;
             match binding with
                (Some (n,(Cic.Def t as b)) as entry)
              | (Some (n,(Cic.Decl t as b)) as entry) ->
-                let acic = acic_of_cic_context context t None in
+                let acic = acic_of_cic_context context idrefs t None in
                  [< s ;
                     X.xml_nempty
                      (match b with Cic.Decl _ -> "Decl" | Cic.Def _ -> "Def")
                      ["name",(match n with Cic.Name n -> n | _ -> assert false);
                       "id",hid]
-                     (Cic2Xml.print_term
-                       (UriManager.uri_of_string "cic:/dummy.con")
-                       ~ids_to_inner_sorts acic)
-                 >], (entry::context)
+                     (Cic2Xml.print_term ~ids_to_inner_sorts acic)
+                 >], (entry::context), (hid::idrefs)
              | None ->
-                [< s ; X.xml_empty "Hidden" [] >], (None::context)
-         ) context ([<>],[])
+                (* Invariant: "" is never looked up *)
+                [< s ; X.xml_empty "Hidden" [] >], (None::context), ""::idrefs
+         ) context ([<>],[],[])
        )
       in
-       let acic = acic_of_cic_context context goal None in
-        X.xml_nempty "Sequent" ["no",string_of_int metano]
-         [< final_s ;
-            Xml.xml_nempty "Goal" []
-             (Cic2Xml.print_term (UriManager.uri_of_string "cic:/dummy.con")
-               ~ids_to_inner_sorts acic)
+       let acic = acic_of_cic_context context final_idrefs goal None in
+         [< X.xml_cdata "\n" ;
+            X.xml_cdata ("\n");
+            X.xml_nempty "Sequent" ["no",string_of_int metano;"id",sequent_id]
+             [< final_s ;
+                Xml.xml_nempty "Goal" []
+                 (Cic2Xml.print_term ~ids_to_inner_sorts acic)
+             >]
          >],
          ids_to_terms,ids_to_father_ids,ids_to_hypotheses
   ;;
diff --git a/helm/gTopLevel/tacticals.ml b/helm/gTopLevel/tacticals.ml
deleted file mode 100644
index f3cd13b44..000000000
--- a/helm/gTopLevel/tacticals.ml
+++ /dev/null
@@ -1,89 +0,0 @@
-(* Copyright (C) 2002, HELM Team.
- * 
- * This file is part of HELM, an Hypertextual, Electronic
- * Library of Mathematics, developed at the Computer Science
- * Department, University of Bologna, Italy.
- * 
- * HELM is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- * 
- * HELM is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with HELM; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- * MA  02111-1307, USA.
- * 
- * For details, see the HELM World-Wide-Web page,
- * http://cs.unibo.it/helm/.
- *)
-
-open CicReduction
-open PrimitiveTactics
-open ProofEngineTypes
-open UriManager
-
-(** DEBUGGING *)
-
-  (** perform debugging output? *)
-let debug = false
-
-  (** debugging print *)
-let warn s =
-  if debug then
-    prerr_endline ("TACTICALS WARNING: " ^ s)
-
-(** AUX TACTIC{,AL}S *)
-
-  (**
-    naive implementation of ORELSE tactical, try a sequence of tactics in turn:
-    if one fails pass to the next one and so on, eventually raises (failure "no
-    tactics left")
-    TODO warning: not tail recursive due to "try .. with" boxing
-  *)
-let rec try_tactics ~(tactics: (string * tactic) list) ~status =
-  warn "in Ring.try_tactics";
-  match tactics with
-  | (descr, tac)::tactics ->
-      warn ("Ring.try_tactics IS TRYING " ^ descr);
-      (try
-        let res = tac ~status in
-        warn ("Ring.try_tactics: " ^ descr ^ " succedeed!!!");
-        res
-       with
-        e ->
-         match e with
-            (Fail _)
-          | (CicTypeChecker.NotWellTyped _)
-          | (CicUnification.UnificationFailed) ->
-              warn (
-                "Ring.try_tactics failed with exn: " ^
-                Printexc.to_string e);
-              try_tactics ~tactics ~status
-        | _ -> raise e (* [e] must not be caught ; let's re-raise it *)
-      )
-  | [] -> raise (Fail "try_tactics: no tactics left")
-
-let thens ~start ~continuations ~status =
- let (proof,new_goals) = start ~status in
-  try
-   List.fold_left2
-    (fun (proof,goals) goal tactic ->
-      let (proof',new_goals') = tactic ~status:(proof,goal) in
-       (proof',goals@new_goals')
-    ) (proof,[]) new_goals continuations
-  with
-   Invalid_argument _ -> raise (Fail "thens: wrong number of new goals")
-
-let then_ ~start ~continuation ~status =
- let (proof,new_goals) = start ~status in
-  List.fold_left
-   (fun (proof,goals) goal ->
-     let (proof',new_goals') = continuation ~status:(proof,goal) in
-      (proof',goals@new_goals')
-   ) (proof,[]) new_goals
diff --git a/helm/gTopLevel/termEditor.ml b/helm/gTopLevel/termEditor.ml
new file mode 100644
index 000000000..310efd176
--- /dev/null
+++ b/helm/gTopLevel/termEditor.ml
@@ -0,0 +1,113 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(******************************************************************************)
+(*                                                                            *)
+(*                               PROJECT HELM                                 *)
+(*                                                                            *)
+(*                Claudio Sacerdoti Coen                *)
+(*                                 06/01/2002                                 *)
+(*                                                                            *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* A WIDGET TO ENTER CIC TERMS *)
+
+class type term_editor =
+ object
+   method coerce : GObj.widget
+   (* get_as_string returns the unquoted string *)
+   method get_as_string : string
+   method get_metasenv_and_term :
+     context:Cic.context ->
+     metasenv:Cic.metasenv -> Cic.metasenv * Cic.term
+   method reset : unit
+   (* The input of set_term is unquoted *)
+   method set_term : string -> unit
+   method id_to_uris : Disambiguate.domain_and_interpretation ref
+ end
+;;
+
+let empty_id_to_uris = ([],function _ -> None);;
+
+module Make(C:Disambiguate.Callbacks) =
+  struct
+
+   module Disambiguate' = Disambiguate.Make(C);;
+
+   class term_editor_impl mqi_handle ?packing ?width ?height ?isnotempty_callback
+    ?share_id_to_uris_with () : term_editor
+   =
+    let id_to_uris =
+     match share_id_to_uris_with with
+        None -> ref empty_id_to_uris
+      | Some obj -> obj#id_to_uris
+    in
+    let input = GEdit.text ~editable:true ?width ?height ?packing () in
+    let _ =
+     match isnotempty_callback with
+        None -> ()
+      | Some callback ->
+         ignore(input#connect#changed
+          (function () -> callback (input#length > 0)))
+    in
+     object(self)
+      method coerce = input#coerce
+      method reset =
+       input#delete_text 0 input#length
+      (* CSC: txt is now a string, but should be of type Cic.term *)
+      method set_term txt =
+       self#reset ;
+       ignore ((input#insert_text txt) ~pos:0)
+      (* CSC: this method should disappear *)
+      (* get_as_string returns the unquoted string *)
+      method get_as_string =
+       input#get_chars 0 input#length
+      method get_metasenv_and_term ~context ~metasenv =
+       let name_context =
+        List.map
+         (function
+             Some (n,_) -> Some n
+           | None -> None
+         ) context
+       in
+        let lexbuf = Lexing.from_string (input#get_chars 0 input#length) in
+         let dom,mk_metasenv_and_expr =
+          CicTextualParserContext.main
+           ~context:name_context ~metasenv CicTextualLexer.token lexbuf
+         in
+          let id_to_uris',metasenv,expr =
+           Disambiguate'.disambiguate_input mqi_handle
+            context metasenv dom mk_metasenv_and_expr ~id_to_uris:!id_to_uris
+          in
+           id_to_uris := id_to_uris' ;
+           metasenv,expr
+      method id_to_uris = id_to_uris
+   end
+
+   let term_editor = new term_editor_impl
+
+end
+;;
diff --git a/helm/gTopLevel/termEditor.mli b/helm/gTopLevel/termEditor.mli
new file mode 100644
index 000000000..ce51bdbe8
--- /dev/null
+++ b/helm/gTopLevel/termEditor.mli
@@ -0,0 +1,51 @@
+(* 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/.
+ *)
+
+class type term_editor =
+ object
+   method coerce : GObj.widget
+   (* get_as_string returns the unquoted string *)
+   method get_as_string : string
+   method get_metasenv_and_term :
+     context:Cic.context ->
+     metasenv:Cic.metasenv -> Cic.metasenv * Cic.term
+   method reset : unit
+   method set_term : string -> unit
+   method id_to_uris : Disambiguate.domain_and_interpretation ref
+ end
+
+val empty_id_to_uris : Disambiguate.domain_and_interpretation
+
+module Make (C : Disambiguate.Callbacks) :
+   sig
+    val term_editor :
+     MQIConn.handle ->
+     ?packing:(GObj.widget -> unit) ->
+     ?width:int ->
+     ?height:int ->
+     ?isnotempty_callback:(bool -> unit) ->
+     ?share_id_to_uris_with:term_editor ->
+     unit -> term_editor
+   end
diff --git a/helm/gTopLevel/termViewer.ml b/helm/gTopLevel/termViewer.ml
new file mode 100644
index 000000000..c35cdb377
--- /dev/null
+++ b/helm/gTopLevel/termViewer.ml
@@ -0,0 +1,228 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(******************************************************************************)
+(*                                                                            *)
+(*                               PROJECT HELM                                 *)
+(*                                                                            *)
+(*                Claudio Sacerdoti Coen                *)
+(*                                 29/01/2003                                 *)
+(*                                                                            *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* List utility functions *)
+exception Skip;;
+
+let list_map_fail f =
+ let rec aux =
+  function
+     [] -> []
+   | he::tl ->
+      try
+       let he' = f he in
+        he'::(aux tl)
+      with Skip ->
+       (aux tl)
+ in
+  aux
+;;
+(* End of the list utility functions *)
+
+(** A widget to render sequents **)
+
+class sequent_viewer obj =
+ object(self)
+
+  inherit GMathViewAux.multi_selection_math_view obj
+
+  val mutable current_infos = None
+
+  (* returns the list of selected terms         *)
+  (* selections which are not terms are ignored *)
+  method get_selected_terms =
+   let selections = self#get_selections in
+    list_map_fail
+     (function node ->
+       let xpath =
+        ((node : Gdome.element)#getAttributeNS
+          ~namespaceURI:Misc.helmns
+          ~localName:(Gdome.domString "xref"))#to_string
+       in
+        if xpath = "" then assert false (* "ERROR: No xref found!!!" *)
+        else
+         match current_infos with
+            Some (ids_to_terms,_,_) ->
+             let id = xpath in
+              (try
+                Hashtbl.find ids_to_terms id
+               with _ -> raise Skip)
+          | None -> assert false (* "ERROR: No current term!!!" *)
+     ) selections
+
+  (* returns the list of selected hypotheses         *)
+  (* selections which are not hypotheses are ignored *)
+  method get_selected_hypotheses =
+   let selections = self#get_selections in
+    list_map_fail
+     (function node ->
+       let xpath =
+        ((node : Gdome.element)#getAttributeNS
+          ~namespaceURI:Misc.helmns
+          ~localName:(Gdome.domString "xref"))#to_string
+       in
+        if xpath = "" then assert false (* "ERROR: No xref found!!!" *)
+        else
+         match current_infos with
+            Some (_,_,ids_to_hypotheses) ->
+             let id = xpath in
+              (try
+                Hashtbl.find ids_to_hypotheses id
+               with _ -> raise Skip)
+          | None -> assert false (* "ERROR: No current term!!!" *)
+     ) selections
+  
+  method load_sequent metasenv sequent =
+   let sequent_mml,(ids_to_terms,ids_to_father_ids,ids_to_hypotheses) =
+    ApplyStylesheets.mml_of_cic_sequent metasenv sequent
+   in
+    self#load_doc ~dom:sequent_mml ;
+    current_infos <-
+     Some (ids_to_terms,ids_to_father_ids,ids_to_hypotheses)
+ end
+;;
+
+let sequent_viewer ?adjustmenth ?adjustmentv ?font_size ?font_manager
+ ?border_width ?width ?height ?packing ?show () =
+ let w =
+   GtkMathView.MathView.create
+    ?adjustmenth:(Gaux.may_map ~f:GData.as_adjustment adjustmenth)
+    ?adjustmentv:(Gaux.may_map ~f:GData.as_adjustment adjustmentv)
+    ()
+ in
+  GtkBase.Container.set w ?border_width ?width ?height;
+ let mathview = GObj.pack_return (new sequent_viewer w) ~packing ~show in
+ begin
+    match font_size with
+    | Some size -> mathview#set_font_size size
+    | None      -> ()
+  end;
+  begin
+    match font_manager with
+    | Some manager -> mathview#set_font_manager_type ~fm_type:manager
+    | None         -> ()
+  end;
+  mathview
+;;
+
+
+(** A widget to render proofs **)
+
+class proof_viewer obj =
+ object(self)
+
+  inherit GMathViewAux.single_selection_math_view obj
+
+  val mutable current_infos = None
+
+  method make_sequent_of_selected_term =
+   match self#get_selection with
+      Some node ->
+       let xpath =
+        ((node : Gdome.element)#getAttributeNS
+          ~namespaceURI:Misc.helmns
+          ~localName:(Gdome.domString "xref"))#to_string
+       in
+        if xpath = "" then assert false (* "ERROR: No xref found!!!" *)
+        else
+         begin
+          match current_infos with
+             Some (ids_to_terms, ids_to_father_ids, _, _) ->
+              let id = xpath in
+               LogicalOperations.to_sequent id ids_to_terms ids_to_father_ids
+           | None -> assert false (* "ERROR: No current term!!!" *)
+         end
+    | None -> assert false (* "ERROR: No selection!!!" *)
+
+  method focus_sequent_of_selected_term =
+   match self#get_selection with
+      Some node ->
+       let xpath =
+        ((node : Gdome.element)#getAttributeNS
+          ~namespaceURI:Misc.helmns
+          ~localName:(Gdome.domString "xref"))#to_string
+       in
+        if xpath = "" then assert false (* "ERROR: No xref found!!!" *)
+        else
+         begin
+          match current_infos with
+             Some (ids_to_terms, ids_to_father_ids, _, _) ->
+              let id = xpath in
+               LogicalOperations.focus id ids_to_terms ids_to_father_ids
+           | None -> assert false (* "ERROR: No current term!!!" *)
+         end
+    | None -> assert false (* "ERROR: No selection!!!" *)
+
+  method load_proof uri currentproof =
+   let
+    (acic,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 currentproof
+   in
+    let mml =
+     ApplyStylesheets.mml_of_cic_object
+      ~explode_all:true uri acic ids_to_inner_sorts ids_to_inner_types
+    in
+     self#load_doc ~dom:mml ;
+     current_infos <-
+      Some
+       (ids_to_terms,ids_to_father_ids,ids_to_conjectures,ids_to_hypotheses) ;
+     (acic, ids_to_inner_types, ids_to_inner_sorts)
+ end
+;;
+
+let proof_viewer ?adjustmenth ?adjustmentv ?font_size ?font_manager
+ ?border_width ?width ?height ?packing ?show () =
+ let w =
+   GtkMathView.MathView.create
+    ?adjustmenth:(Gaux.may_map ~f:GData.as_adjustment adjustmenth)
+    ?adjustmentv:(Gaux.may_map ~f:GData.as_adjustment adjustmentv)
+    ()
+ in
+  GtkBase.Container.set w ?border_width ?width ?height;
+ let mathview = GObj.pack_return (new proof_viewer w) ~packing ~show in
+ begin
+    match font_size with
+    | Some size -> mathview#set_font_size size
+    | None      -> ()
+  end;
+  begin
+    match font_manager with
+    | Some manager -> mathview#set_font_manager_type ~fm_type:manager
+    | None         -> ()
+  end;
+  mathview
+;;
diff --git a/helm/gTopLevel/termViewer.mli b/helm/gTopLevel/termViewer.mli
new file mode 100644
index 000000000..c043f5cb6
--- /dev/null
+++ b/helm/gTopLevel/termViewer.mli
@@ -0,0 +1,100 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(******************************************************************************)
+(*                                                                            *)
+(*                               PROJECT HELM                                 *)
+(*                                                                            *)
+(*                Claudio Sacerdoti Coen                *)
+(*                                 29/01/2003                                 *)
+(*                                                                            *)
+(*                                                                            *)
+(******************************************************************************)
+
+(** A widget to render sequents **)
+
+class sequent_viewer :
+  Gtk_mathview.math_view Gtk.obj ->
+  object
+    inherit GMathViewAux.multi_selection_math_view
+
+    (* returns the list of selected terms         *)
+    (* selections which are not terms are ignored *)
+    method get_selected_terms : Cic.term list
+
+    (* returns the list of selected hypotheses         *)
+    (* selections which are not hypotheses are ignored *)
+    method get_selected_hypotheses : Cic.hypothesis list
+
+    method load_sequent : Cic.metasenv -> Cic.conjecture -> unit
+  end
+
+val sequent_viewer :
+  ?adjustmenth:GData.adjustment ->
+  ?adjustmentv:GData.adjustment ->
+  ?font_size:int ->
+  ?font_manager:[ `font_manager_gtk | `font_manager_t1] ->
+  ?border_width:int ->
+  ?width:int ->
+  ?height:int ->
+  ?packing:(GObj.widget -> unit) ->
+  ?show:bool ->
+  unit -> sequent_viewer
+
+(** A widget to render proofs **)
+
+class proof_viewer :
+  Gtk_mathview.math_view Gtk.obj ->
+  object
+    inherit GMathViewAux.single_selection_math_view
+
+    (* the new current sequent becomes the one obtained *)
+    (* perforating the proof where the selection is     *)
+    method make_sequent_of_selected_term : unit
+
+    (* the new current sequent becomes the one obtained *)
+    (* focusing the proof on the selected metavariable  *)
+    method focus_sequent_of_selected_term : unit
+
+    (* load_proof also returns the annotated cic term and the *)
+    (* ids_to_inner_types and ids_to_inner_sorts maps.        *)
+    method load_proof :
+     UriManager.uri -> Cic.obj ->
+      Cic.annobj * (Cic.id, Cic2acic.anntypes) Hashtbl.t *
+       (Cic.id, string) Hashtbl.t
+
+  end
+
+val proof_viewer :
+  ?adjustmenth:GData.adjustment ->
+  ?adjustmentv:GData.adjustment ->
+  ?font_size:int ->
+  ?font_manager:[ `font_manager_gtk | `font_manager_t1] ->
+  ?border_width:int ->
+  ?width:int ->
+  ?height:int ->
+  ?packing:(GObj.widget -> unit) ->
+  ?show:bool ->
+  unit -> proof_viewer
diff --git a/helm/gTopLevel/texTermEditor.ml b/helm/gTopLevel/texTermEditor.ml
new file mode 100644
index 000000000..d97eb51c4
--- /dev/null
+++ b/helm/gTopLevel/texTermEditor.ml
@@ -0,0 +1,208 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(******************************************************************************)
+(*                                                                            *)
+(*                               PROJECT HELM                                 *)
+(*                                                                            *)
+(*                Claudio Sacerdoti Coen                *)
+(*                                 06/01/2002                                 *)
+(*                                                                            *)
+(*                                                                            *)
+(******************************************************************************)
+
+(* A WIDGET TO ENTER CIC TERMS *)
+
+class type term_editor =
+ object
+   method coerce : GObj.widget
+   (* get_as_string returns the unquoted string *)
+   method get_as_string : string
+   method get_metasenv_and_term :
+     context:Cic.context ->
+     metasenv:Cic.metasenv -> Cic.metasenv * Cic.term
+   method reset : unit
+   (* The input of set_term is unquoted *)
+   method set_term : string -> unit
+   method id_to_uris : Disambiguate.domain_and_interpretation ref
+ end
+;;
+
+let empty_id_to_uris = ([],function _ -> None);;
+
+module Make(C:Disambiguate.Callbacks) =
+  struct
+
+   module Disambiguate' = Disambiguate.Make(C);;
+
+   class term_editor_impl
+    mqi_handle
+    ?packing ?width ?height
+    ?isnotempty_callback ?share_id_to_uris_with () : term_editor
+   =
+    let mmlwidget =
+     GMathViewAux.single_selection_math_view
+      ?packing ?width ?height () in
+    let drawing_area = mmlwidget#get_drawing_area in
+    let _ = drawing_area#misc#set_can_focus true in
+    let _ = drawing_area#misc#grab_focus () in
+    let logger =
+     fun l s -> prerr_endline ("TERM_EDITOR (" ^ string_of_int l ^ "): " ^ s) in
+    let tex_editor =
+     Mathml_editor.create
+      ~alt_lexer:true
+      ~dictionary_uri:"dictionary-cic.xml"
+      ~mml_uri:Mathml_editor.default_mathml_stylesheet_path
+(*CSC: togliere il path assoluto
+      ~tml_uri:Mathml_editor.default_tex_stylesheet_path
+*)
+      ~tml_uri:"/usr/share/editex/tml-litex.xsl"
+      ~log:logger
+    in
+    let _ =
+     (new GObj.event_ops mmlwidget#coerce#as_widget)#connect#button_press
+      ~callback:(fun _ -> drawing_area#misc#grab_focus () ; true) in
+    let _ =
+     (new GObj.event_ops drawing_area#coerce#as_widget)#connect#focus_in
+       ~callback:
+         (fun _ ->
+           mmlwidget#freeze ;
+           Mathml_editor.cursor_show ~editor:tex_editor ;
+           mmlwidget#thaw ;
+           true) in
+    let _ =
+     (new GObj.event_ops drawing_area#coerce#as_widget)#connect#focus_out
+       ~callback:
+         (fun _ ->
+           mmlwidget#freeze ;
+           Mathml_editor.cursor_hide ~editor:tex_editor ;
+           mmlwidget#thaw ;
+           true) in
+    let _ = Mathml_editor.push tex_editor '$' in
+    let dom_tree = Mathml_editor.get_mml tex_editor in
+    let _ = mmlwidget#load_doc dom_tree in
+    let _ = 
+     drawing_area#event#connect#key_press
+      (function e ->
+        let key = GdkEvent.Key.keyval e in
+         mmlwidget#freeze ;
+         if
+          key >= 32 && key < 256 &&
+           (GdkEvent.Key.state e = [] || GdkEvent.Key.state e = [`SHIFT])
+         then
+          Mathml_editor.push tex_editor (Char.chr key)
+         else if key = GdkKeysyms._u then
+          begin
+           mmlwidget#freeze ;
+           ignore (Mathml_editor.freeze tex_editor) ;
+           Mathml_editor.reset tex_editor ;
+           Mathml_editor.push tex_editor '$' ;
+           ignore (Mathml_editor.thaw tex_editor) ;
+           mmlwidget#thaw
+          end
+         else if key = GdkKeysyms._BackSpace then
+          Mathml_editor.drop tex_editor false ;
+         mmlwidget#thaw ;
+         false) in
+    let id_to_uris =
+     match share_id_to_uris_with with
+        None -> ref empty_id_to_uris
+      | Some obj -> obj#id_to_uris
+    in
+    let _ =
+     match isnotempty_callback with
+        None -> ()
+      | Some callback ->
+         (* This approximation of the test that checks if the tree is empty *)
+         (* is utterly unprecise. We assume a tree to look as an empty tree *)
+         (* iff it is made of just one node m:mtext (which should be the    *)
+         (* cursor).                                                        *)
+         let is_empty_tree () =
+          let root = dom_tree#get_documentElement in
+           match root#get_firstChild with
+              None -> true
+            | Some n -> n#get_nodeName#to_string = "m:mtext"
+         in
+          dom_tree#addEventListener
+           ~typ:(Gdome.domString "DOMSubtreeModified")
+           ~listener:
+             (Gdome.eventListener
+               (function _ -> callback (not (is_empty_tree ()))))
+           ~useCapture:false
+    in
+     object(self)
+      method coerce = mmlwidget#coerce
+      method reset =
+       mmlwidget#freeze ;
+       ignore (Mathml_editor.freeze tex_editor) ;
+       Mathml_editor.reset tex_editor ;
+       Mathml_editor.push tex_editor '$' ;
+       ignore (Mathml_editor.thaw tex_editor) ;
+       mmlwidget#thaw
+
+      (* The input of set_term is unquoted *)
+      method set_term txt =
+       mmlwidget#freeze ;
+       ignore (Mathml_editor.freeze tex_editor) ;
+       self#reset ;
+       let txt' = Str.global_replace (Str.regexp "_") "\\_" txt in
+        String.iter (fun ch -> Mathml_editor.push tex_editor ch) txt' ;
+        ignore (Mathml_editor.thaw tex_editor) ;
+        mmlwidget#thaw
+
+      (* get_as_string returns the unquoted string *)
+      method get_as_string =
+       let term = Mathml_editor.get_tex tex_editor in
+        Str.global_replace (Str.regexp "^\\$\\$?") ""
+         (Str.global_replace (Str.regexp "\\$\\$?$") ""
+           (Str.global_replace (Str.regexp "\\\\_") "_" term))
+
+      method get_metasenv_and_term ~context ~metasenv =
+       let name_context =
+        List.map
+         (function
+             Some (n,_) -> Some n
+           | None -> None
+         ) context
+       in
+prerr_endline ("###CSC: " ^ (Mathml_editor.get_tex tex_editor)) ;
+        let lexbuf = Lexing.from_string (Mathml_editor.get_tex tex_editor) in
+         let dom,mk_metasenv_and_expr =
+          TexCicTextualParserContext.main
+           ~context:name_context ~metasenv TexCicTextualLexer.token lexbuf
+         in
+          let id_to_uris',metasenv,expr =
+           Disambiguate'.disambiguate_input mqi_handle 
+            context metasenv dom mk_metasenv_and_expr ~id_to_uris:!id_to_uris
+          in
+           id_to_uris := id_to_uris' ;
+           metasenv,expr
+      method id_to_uris = id_to_uris
+   end
+
+   let term_editor = new term_editor_impl
+
+end
+;;
diff --git a/helm/gTopLevel/texTermEditor.mli b/helm/gTopLevel/texTermEditor.mli
new file mode 100644
index 000000000..beb21ec85
--- /dev/null
+++ b/helm/gTopLevel/texTermEditor.mli
@@ -0,0 +1,52 @@
+(* 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/.
+ *)
+
+class type term_editor =
+ object
+   method coerce : GObj.widget
+   (* get_as_string returns the unquoted string *)
+   method get_as_string : string
+   method get_metasenv_and_term :
+     context:Cic.context ->
+     metasenv:Cic.metasenv -> Cic.metasenv * Cic.term
+   method reset : unit
+   (* The input of set_term is unquoted *)
+   method set_term : string -> unit
+   method id_to_uris : Disambiguate.domain_and_interpretation ref
+ end
+
+val empty_id_to_uris : Disambiguate.domain_and_interpretation
+
+module Make (C : Disambiguate.Callbacks) :
+   sig
+    val term_editor :
+     MQIConn.handle ->
+     ?packing:(GObj.widget -> unit) ->
+     ?width:int ->
+     ?height:int ->
+     ?isnotempty_callback:(bool -> unit) ->
+     ?share_id_to_uris_with:term_editor ->
+     unit -> term_editor
+   end
diff --git a/helm/gTopLevel/topLevel/.depend b/helm/gTopLevel/topLevel/.depend
deleted file mode 100644
index e69de29bb..000000000
diff --git a/helm/gTopLevel/topLevel/Makefile b/helm/gTopLevel/topLevel/Makefile
deleted file mode 100644
index 01dd0e173..000000000
--- a/helm/gTopLevel/topLevel/Makefile
+++ /dev/null
@@ -1,47 +0,0 @@
-BIN_DIR = /usr/local/bin
-REQUIRES = helm-urimanager helm-cic_textual_parser helm-cic_proof_checking helm-mathql helm-mathql_interpreter
-PREDICATES =
-OCAMLOPTIONS = -I .. -package "$(REQUIRES)" -predicates "$(PREDICATES)"
-OCAMLC = ocamlfind ocamlc $(OCAMLOPTIONS)
-OCAMLOPT = ocamlfind ocamlopt $(OCAMLOPTIONS)
-OCAMLDEP = ocamldep
-
-LIBRARIES = $(shell ocamlfind query -recursive -predicates "byte $(PREDICATES)" -format "%d/%a" $(REQUIRES))
-LIBRARIES_OPT = $(shell ocamlfind query -recursive -predicates "native $(PREDICATES)" -format "%d/%a" $(REQUIRES))
-
-all: topLevel
-opt: topLevel.opt
-
-DEPOBJS = topLevel.ml
-
-TOPLEVELOBJS = ../mQueryGenerator.cmo topLevel.cmo
-
-depend:
-	$(OCAMLDEP) $(DEPOBJS) > .depend
-
-topLevel: $(TOPLEVELOBJS) $(LIBRARIES)
-	$(OCAMLC)  -linkpkg -o topLevel $(TOPLEVELOBJS)
-
-topLevel.opt: $(TOPLEVELOBJS:.cmo=.cmx) $(LIBRARIES_OPT)
-	$(OCAMLOPT) -linkpkg -o topLevel.opt $(TOPLEVELOBJS:.cmo=.cmx)
-
-.SUFFIXES: .ml .mli .cmo .cmi .cmx
-.ml.cmo: $(LIBRARIES)
-	$(OCAMLC) -c $<
-.mli.cmi: $(LIBRARIES)
-	$(OCAMLC) -c $<
-.ml.cmx: $(LIBRARIES_OPT)
-	$(OCAMLOPT) -c $<
-
-clean:
-	rm -f *.cm[iox] *.o topLevel topLevel.opt
-
-install:
-	cp topLevel topLevel.opt $(BIN_DIR)
-
-uninstall:
-	rm -f $(BIN_DIR)/topLevel $(BIN_DIR)/topLevel.opt
-
-.PHONY: install uninstall clean
-
-include .depend
diff --git a/helm/gTopLevel/topLevel/esempi.cic b/helm/gTopLevel/topLevel/esempi.cic
deleted file mode 100644
index 38e5f3333..000000000
--- a/helm/gTopLevel/topLevel/esempi.cic
+++ /dev/null
@@ -1,125 +0,0 @@
-alias BV                 /Sophia-Antipolis/HARDWARE/GENE/BV/BV.con
-alias BV_increment       /Sophia-Antipolis/HARDWARE/ADDER/IncrDecr/BV_increment.con
-alias BV_increment_carry /Sophia-Antipolis/HARDWARE/ADDER/IncrDecr/BV_increment_carry.con
-alias BV_to_nat          /Sophia-Antipolis/HARDWARE/GENE/BV/BV_to_nat.con
-alias Exp                /Eindhoven/POCKLINGTON/exp/Exp.con
-alias IZR                /Coq/Reals/Raxioms/IZR.con
-alias Int_part           /Coq/Reals/R_Ifp/Int_part.con
-alias Mod                /Eindhoven/POCKLINGTON/mod/Mod.con
-alias NEG                /Coq/ZArith/fast_integer/fast_integers/Z.ind#1/1/3
-alias O                  /Coq/Init/Datatypes/nat.ind#1/1/1
-alias POS                /Coq/ZArith/fast_integer/fast_integers/Z.ind#1/1/2
-alias Prime              /Eindhoven/POCKLINGTON/prime/Prime.con
-alias R                  /Coq/Reals/Rdefinitions/R.con
-alias R0                 /Coq/Reals/Rdefinitions/R0.con
-alias R1                 /Coq/Reals/Rdefinitions/R1.con
-alias Rgt                /Coq/Reals/Rdefinitions/Rgt.con
-alias Rinv               /Coq/Reals/Rdefinitions/Rinv.con
-alias Rle                /Coq/Reals/Rdefinitions/Rle.con
-alias Rlt                /Coq/Reals/Rdefinitions/Rlt.con
-alias Rminus             /Coq/Reals/Rdefinitions/Rminus.con
-alias Rmult              /Coq/Reals/Rdefinitions/Rmult.con
-alias Ropp               /Coq/Reals/Rdefinitions/Ropp.con
-alias Rplus              /Coq/Reals/Rdefinitions/Rplus.con
-alias S                  /Coq/Init/Datatypes/nat.ind#1/1/2
-alias Z                  /Coq/ZArith/fast_integer/fast_integers/Z.ind#1/1
-alias ZERO               /Coq/ZArith/fast_integer/fast_integers/Z.ind#1/1/1
-alias ZExp               /Eindhoven/POCKLINGTON/exp/ZExp.con
-alias Zdiv2              /Coq/ZArith/Zmisc/arith/Zdiv2.con
-alias Zge                /Coq/ZArith/zarith_aux/Zge.con
-alias Zle                /Coq/ZArith/zarith_aux/Zle.con
-alias Zlt                /Coq/ZArith/zarith_aux/Zlt.con
-alias Zminus             /Coq/ZArith/zarith_aux/Zminus.con
-alias Zmult              /Coq/ZArith/fast_integer/fast_integers/Zmult.con
-alias Zodd               /Coq/ZArith/Zmisc/arith/Zodd.con
-alias Zplus              /Coq/ZArith/fast_integer/fast_integers/Zplus.con
-alias Zpower_nat         /Coq/omega/Zpower/section1/Zpower_nat.con
-alias Zpower_pos         /Coq/omega/Zpower/section1/Zpower_pos.con
-alias Zpred              /Coq/ZArith/zarith_aux/Zpred.con
-alias Zs                 /Coq/ZArith/zarith_aux/Zs.con
-alias ad                 /Coq/IntMap/Addr/ad.ind#1/1
-alias ad_bit             /Coq/IntMap/Addr/ad_bit.con
-alias ad_double_plus_un  /Coq/IntMap/Addr/ad_double_plus_un.con
-alias ad_x               /Coq/IntMap/Addr/ad.ind#1/1/2
-alias ad_xor             /Coq/IntMap/Addr/ad_xor.con
-alias allex              /Eindhoven/POCKLINGTON/fermat/allex.con
-alias and                /Coq/Init/Logic/Conjunction/and.ind#1/1
-alias appbv              /Sophia-Antipolis/HARDWARE/GENE/BV/appbv.con
-alias bool               /Coq/Init/Datatypes/bool.ind#1/1
-alias consbv             /Sophia-Antipolis/HARDWARE/GENE/BV/consbv.con
-alias convert            /Coq/ZArith/fast_integer/fast_integers/convert.con
-alias div2               /Coq/Arith/Div2/div2.con
-alias double             /Coq/Arith/Div2/double.con
-alias eq                 /Coq/Init/Logic/Equality/eq.ind#1/1
-alias eq_ind             /Coq/Init/Logic/Equality/eq_ind.con
-alias eq_ind_r           /Coq/Init/Logic/Logic_lemmas/eq_ind_r.con
-alias eqT                /Coq/Init/Logic_Type/eqT.ind#1/1
-alias even               /Coq/Arith/Even/even.ind#1/1
-alias ex                 /Coq/Init/Logic/First_order_quantifiers/ex.ind#1/1
-alias f_equal            /Coq/Init/Logic/Logic_lemmas/equality/f_equal.con
-alias iff                /Coq/Init/Logic/Equivalence/iff.con
-alias le                 /Coq/Init/Peano/le.ind#1/1
-alias lengthbv           /Sophia-Antipolis/HARDWARE/GENE/BV/lengthbv.con
-alias lift_rec_r         /Rocq/LAMBDA/Substitution/lift_rec_r.con
-alias log_inf            /Coq/omega/Zlogarithm/Log_pos/log_inf.con
-alias log_sup            /Coq/omega/Zlogarithm/Log_pos/log_sup.con
-alias lt                 /Coq/Init/Peano/lt.con
-alias mapmult            /Eindhoven/POCKLINGTON/list/mapmult.con
-alias minus              /Coq/Arith/Minus/minus.con
-alias mult               /Coq/Init/Peano/mult.con
-alias nat                /Coq/Init/Datatypes/nat.ind#1/1
-alias nat_of_ad          /Coq/IntMap/Adalloc/AdAlloc/nat_of_ad.con 
-alias negb               /Coq/Bool/Bool/negb.con
-alias nilbv              /Sophia-Antipolis/HARDWARE/GENE/BV/nilbv.con
-alias not                /Coq/Init/Logic/not.con
-alias odd                /Coq/Arith/Even/even.ind#1/2
-alias or                 /Coq/Init/Logic/Disjunction/or.ind#1/1
-alias permmod            /Eindhoven/POCKLINGTON/fermat/permmod.con
-alias plus               /Coq/Init/Peano/plus.con
-alias positive           /Coq/ZArith/fast_integer/fast_integers/positive.ind#1/1
-alias power2             /Sophia-Antipolis/HARDWARE/GENE/Arith_compl/power2.con
-alias pred               /Coq/Init/Peano/pred.con
-alias redexes            /Rocq/LAMBDA/Redexes/redexes.ind#1/1
-alias shift_nat          /Coq/omega/Zpower/Powers_of_2/shift_nat.con
-alias shift_pos          /Coq/omega/Zpower/Powers_of_2/shift_pos.con
-alias subst_rec_r        /Rocq/LAMBDA/Substitution/subst_rec_r.con
-alias two_p              /Coq/omega/Zpower/Powers_of_2/two_p.con
-alias until              /Eindhoven/POCKLINGTON/fermat/until.con
-alias xH                 /Coq/ZArith/fast_integer/fast_integers/positive.ind#1/1/3
-alias xI                 /Coq/ZArith/fast_integer/fast_integers/positive.ind#1/1/1
-alias xO                 /Coq/ZArith/fast_integer/fast_integers/positive.ind#1/1/2
-alias zproduct           /Eindhoven/POCKLINGTON/list/zproduct.con
-
-!n:nat.(eq nat (mult (S (S O)) n) O);
-!n:nat.(eq nat (plus O n) (plus n O));
-!n:nat.!m:nat.(le (mult (S (S O)) n) (mult (S (S O)) m));
-!p:nat.(eq nat p p)->(eq nat p p);
-!p:nat.!q:nat.(le p q)->(or (le (S p) q) (eq nat p q));
-!n:nat.(eq nat (double (S n)) (S (S (double n))));
-!n:nat.(and (iff (even n) (eq nat (div2 n) (div2 (S n)))) (iff (odd n) (eq nat (S (div2 n)) (div2 (S n)))));
-!n:nat.!m:nat.!p:nat.(eq nat (minus n m) (minus (plus p n) (plus p m)));
-!a:Z.!n:nat.(eq Z (Exp a (pred (S n))) (Exp a n));
-!a:Z.!x:Z.(eq Z (ZExp a (Zminus (Zplus x (POS xH)) (POS xH))) (ZExp a x));
-!p:nat.!a:Z.(Prime p)->(not (Mod a ZERO p))->(allex p (until (pred p)) (mapmult a (until (pred p))));
-!a:Z.!n:nat.(eq Z (zproduct (mapmult a (until n))) (Zmult (Exp a n) (zproduct (until n))));
-!p:nat.!a:Z.(Prime p)->(not (Mod a ZERO p))->(permmod p (until (pred p)) (mapmult a (until (pred p))));
-!p:nat.(Prime p)->(not (Mod (zproduct (until (pred p))) ZERO p));
-!p:nat.!n:nat.(lt O n)->(lt n p)->(Prime p)->(not (Mod (zproduct (until n)) ZERO p));
-!p:positive.(eq nat (convert (xI p)) (S (mult (S (S O)) (convert p))));
-!a:ad.(eq nat (nat_of_ad (ad_double_plus_un a)) (S (mult (S (S O)) (nat_of_ad a))));
-!p:positive.!a:ad.(eq bool (ad_bit (ad_xor (ad_x (xI p)) a) O) (negb (ad_bit a O)));
-!r:R.(and (Rle (IZR (Int_part r)) r) (Rgt (Rminus (IZR (Int_part r)) r) (Ropp R1)));
-!eps:R.(Rgt eps R0)->(Rlt (Rmult eps (Rinv (Rplus (Rplus R1 R1) (Rplus R1 R1)))) eps);
-!x:Z.(Zge x ZERO)->(Zodd x)->(eq Z x (Zplus (Zmult (POS (xO xH)) (Zdiv2 x)) (POS xH)));
-!v:Z.!l1:Z.!l2:Z.!x:positive.(eq Z (Zplus (Zplus (Zmult v (POS x)) l1) (Zplus (Zmult v (NEG x)) l2)) (Zplus l1 l2));
-!v:Z.!l1:Z.!l2:Z.!x:positive.(eq Z (Zplus (Zplus (Zmult v (NEG x)) l1) (Zplus (Zmult v (POS x)) l2)) (Zplus l1 l2));
-!p:positive.(and (Zle (two_p (log_inf p)) (POS p)) (Zlt (POS p) (two_p (Zs (log_inf p)))));
-!x:positive.(and (Zlt (two_p (Zpred (log_sup x))) (POS x)) (Zle (POS x) (two_p (log_sup x))));
-!n:nat.!x:positive.(eq Z (POS (shift_nat n x)) (Zmult (Zpower_nat (POS (xO xH)) n) (POS x)));
-!p:positive.!x:positive.(eq Z (POS (shift_pos p x)) (Zmult (Zpower_pos (POS (xO xH)) p) (POS x)));
-!U:redexes.!V:redexes.!k:nat.!p:nat.!n:nat.(eq redexes (lift_rec_r (subst_rec_r V U p) (plus p n) k) (subst_rec_r (lift_rec_r V (S (plus p n)) k) (lift_rec_r U n k) p));
-!U:redexes.!V:redexes.!W:redexes.!n:nat.!p:nat.(eq redexes (subst_rec_r (subst_rec_r V U p) W (plus p n)) (subst_rec_r (subst_rec_r V W (S (plus p n))) (subst_rec_r U W n) p));
-!v:BV.(eq nat (BV_to_nat (appbv (BV_increment v) (consbv (BV_increment_carry v) nilbv))) (S (BV_to_nat v)));
-!l:BV.!n:BV.(eq nat (BV_to_nat (appbv l n)) (plus (BV_to_nat l) (mult (power2 (lengthbv l)) (BV_to_nat n))));
-!x:Z.(Zle ZERO x)->(eq Z (Zdiv2 (Zplus (Zmult (POS (xO xH)) x) (POS xH))) x);
-!n:Z.(Zle (POS xH) n)->(Zle ZERO (Zplus (Zdiv2 (Zminus n (POS (xO xH)))) (POS xH)));
diff --git a/helm/gTopLevel/xml2Gdome.ml b/helm/gTopLevel/xml2Gdome.ml
index 8c6298d09..c4e9445eb 100644
--- a/helm/gTopLevel/xml2Gdome.ml
+++ b/helm/gTopLevel/xml2Gdome.ml
@@ -27,6 +27,8 @@ let document_of_xml (domImplementation : Gdome.domImplementation) strm =
  let module G = Gdome in
  let module X = Xml in
   let root_name,root_attributes,root_content =
+   ignore (Stream.next strm) ; (* to skip the  declaration *)
+   ignore (Stream.next strm) ; (* to skip the DOCTYPE declaration *)
    match Stream.next strm with
       X.Empty(n,l) -> n,l,[<>]
     | X.NEmpty(n,l,c) -> n,l,c
diff --git a/helm/ocaml/.cvsignore b/helm/ocaml/.cvsignore
index 18745fc01..dc4fce342 100644
--- a/helm/ocaml/.cvsignore
+++ b/helm/ocaml/.cvsignore
@@ -1,19 +1,26 @@
 META.helm-cic
-META.helm-getter
 META.helm-cic_annotations
-META.helm-pxp
 META.helm-cic_annotations_cache
-META.helm-urimanager
 META.helm-cic_cache
-META.helm-xml
 META.helm-cic_proof_checking
+META.helm-tex_cic_textual_parser
 META.helm-cic_textual_parser
 META.helm-cic_unification
-META.helm-mathql_interpreter
+META.helm-getter
 META.helm-mathql
+META.helm-mathql_interpreter
+META.helm-mathql_test
+META.helm-mathql_generator
+META.helm-pxp
+META.helm-tactics
+META.helm-urimanager
+META.helm-xml
 Makefile
 Makefile.common
-configure
-config.log
+autom4te.cache
 config.cache
+config.log
 config.status
+configure
+libraries.ps
+.dep.dot
diff --git a/helm/ocaml/META.helm-tactics.src b/helm/ocaml/META.helm-tactics.src
new file mode 100644
index 000000000..cffd94f6b
--- /dev/null
+++ b/helm/ocaml/META.helm-tactics.src
@@ -0,0 +1,4 @@
+requires="helm-cic_textual_parser helm-cic_proof_checking helm-cic_unification helm-mathql_generator"
+version="0.0.1"
+archive(byte)="tactics.cma"
+archive(native)="tactics.cmxa"
diff --git a/helm/ocaml/META.helm-tex_cic_textual_parser.src b/helm/ocaml/META.helm-tex_cic_textual_parser.src
new file mode 100644
index 000000000..dec21eebd
--- /dev/null
+++ b/helm/ocaml/META.helm-tex_cic_textual_parser.src
@@ -0,0 +1,5 @@
+requires="helm-cic"
+version="0.0.1"
+archive(byte)="tex_cic_textual_parser.cma"
+archive(native)="tex_cic_textual_parser.cmxa"
+linkopts=""
diff --git a/helm/ocaml/Makefile.common.in b/helm/ocaml/Makefile.common.in
index db01ff2b5..47d02bb42 100644
--- a/helm/ocaml/Makefile.common.in
+++ b/helm/ocaml/Makefile.common.in
@@ -40,12 +40,18 @@ opt: $(IMPLEMENTATION_FILES:%.ml=%.cmx) $(ARCHIVE_OPT)
 depend: $(DEPEND_FILES)
 	$(OCAMLDEP) $(INTERFACE_FILES) $(IMPLEMENTATION_FILES) > .depend
 
+$(PACKAGE).ps: .dep.dot
+	dot -Tps -o $@ $<
+
+.dep.dot: .depend
+	ocamldot < .depend > $@
+
 .SUFFIXES: .ml .mli .cmo .cmi .cmx .mll .mly
-.ml.cmo: $(LIBRARIES)
+.ml.cmo:
 	$(OCAMLC) -c $<
-.mli.cmi: $(LIBRARIES)
+.mli.cmi:
 	$(OCAMLC) -c $<
-.ml.cmx: $(LIBRARIES_OPT)
+.ml.cmx:
 	$(OCAMLOPT) -c $<
 .mly.ml:
 	$(OCAMLYACC) $<
@@ -54,6 +60,9 @@ depend: $(DEPEND_FILES)
 .mll.ml:
 	$(OCAMLLEX) $<
 
+$(IMPLEMENTATION_FILES:%.ml=%.cmo): $(LIBRARIES)
+$(IMPLEMENTATION_FILES:%.ml=%.cmx): $(LIBRARIES_OPT)
+
 clean:
 	rm -f *.cm[ioax] *.cmxa *.o *.a $(EXTRA_OBJECTS_TO_CLEAN)
 
@@ -67,4 +76,6 @@ uninstall:
 
 .PHONY: all opt depend install uninstall clean
 
-include .depend
+ifneq ($(MAKECMDGOALS), depend)
+   include .depend   
+endif
diff --git a/helm/ocaml/Makefile.in b/helm/ocaml/Makefile.in
index 06a314961..96a7522d9 100644
--- a/helm/ocaml/Makefile.in
+++ b/helm/ocaml/Makefile.in
@@ -1,7 +1,8 @@
 # Warning: the modules must be in compilation order
 MODULES = xml urimanager getter pxp cic cic_annotations cic_annotations_cache \
-          cic_cache cic_proof_checking cic_textual_parser cic_unification \
-          mathql mathql_interpreter mathql_interpreter_galax
+          cic_cache cic_proof_checking cic_textual_parser \
+          tex_cic_textual_parser cic_unification mathql mathql_interpreter \
+          mathql_generator mathql_test tactics
 
 OCAMLFIND_DEST_DIR = @OCAMLFIND_DEST_DIR@
 OCAMLFIND_META_DIR = @OCAMLFIND_META_DIR@
@@ -38,3 +39,14 @@ $(MODULES:%=%.clean):
 	cd $(@:%.clean=%) && make clean
 META.helm-%: META.helm-%.src
 	cp $< $@ && echo "directory=\"$(CWD)/$(@:META.helm-%=%)\"" >> $@
+
+.PHONY: .dep.dot
+.dep.dot:
+	echo "digraph G {" > $@
+	echo "   rankdir = TB ;" >> $@
+	for i in $(MODULES); do ocamlfind query helm-$$i -recursive -p-format | grep helm | sed "s/^helm-/ \"$$i\" -> \"/g" | sed "s/$$/\";/g" >> $@ ; done
+	mv $@ $@.old ; ./simplify_deps/simplify_deps.opt < $@.old > $@ ; rm $@.old
+	echo "}" >> $@
+
+libraries.ps: .dep.dot
+	dot -Tps -o $@ $<
diff --git a/helm/ocaml/cic/cic.ml b/helm/ocaml/cic/cic.ml
index 2429dcfed..fd46c22b4 100644
--- a/helm/ocaml/cic/cic.ml
+++ b/helm/ocaml/cic/cic.ml
@@ -37,8 +37,11 @@
 
 (* STUFF TO MANAGE IDENTIFIERS *)
 type id = string  (* the abstract type of the (annotated) node identifiers *)
+type 'term explicit_named_substitution = (UriManager.uri * 'term) list
+
 type anntarget =
-   Object of annobj
+   Object of annobj         (* if annobj is a Constant, this is its type *)
+ | ConstantBody of annobj
  | Term of annterm
  | Conjecture of annconjecture
  | Hypothesis of annhypothesis
@@ -50,10 +53,11 @@ and sort =
  | Type
 and name =
    Name of string
- | Anonimous
+ | Anonymous
 and term =
    Rel of int                                       (* DeBrujin index *)
- | Var of UriManager.uri                            (* uri *)
+ | Var of UriManager.uri *                          (* uri,                   *)
+     term explicit_named_substitution               (*  explicit named subst. *)
  | Meta of int * (term option) list                 (* numeric id,    *)
                                                     (*  local context *)
  | Sort of sort                                     (* sort *)
@@ -63,50 +67,58 @@ and term =
  | Lambda of name * term * term                     (* binder, source, target *)
  | LetIn of name * term * term                      (* binder, term, target *)
  | Appl of term list                                (* arguments *)
- | Const of UriManager.uri * int                    (* uri, number of cookings*)
- | MutInd of UriManager.uri * int * int             (* uri, cookingsno, typeno*)
-                                                    (* typeno is 0 based *)
- | MutConstruct of UriManager.uri * int *           (* uri, cookingsno, *)
-    int * int                                       (*  typeno, consno  *)
-                                                    (* consno is 1 based *)
- (*CSC: serve cookingsno?*)
- | MutCase of UriManager.uri * int *                (* ind. uri, cookingsno, *)
+ | Const of UriManager.uri *                        (* uri,                   *)
+     term explicit_named_substitution               (*  explicit named subst. *)
+ | MutInd of UriManager.uri * int *                 (* uri, typeno, *)
+     term explicit_named_substitution               (*  explicit named subst. *)
+                                                    (* typeno is 0 based      *)
+ | MutConstruct of UriManager.uri *                 (* uri,                   *)
+    int * int *                                     (*  typeno, consno        *)
+     term explicit_named_substitution               (*  explicit named subst. *)
+                                                    (* typeno is 0 based      *)
+                                                    (* consno is 1 based      *)
+ | MutCase of UriManager.uri *                      (* ind. uri,             *)
     int *                                           (*  ind. typeno,         *)
     term * term *                                   (*  outtype, ind. term   *)
     term list                                       (*  patterns             *)
  | Fix of int * inductiveFun list                   (* funno, functions *)
  | CoFix of int * coInductiveFun list               (* funno, functions *)
 and obj =
-   Definition of string * term * term *           (* id, value, type,         *)
-    (int * UriManager.uri list) list              (*  parameters              *)
- | Axiom of string * term *
-    (int * UriManager.uri list) list              (* id, type, parameters     *)
- | Variable of string * term option * term        (* name, body, type         *)
+   Constant of string * term option * term *      (* id, body, type,          *)
+    UriManager.uri list                           (*  parameters              *)
+ | Variable of string * term option * term *      (* name, body, type         *)
+    UriManager.uri list                           (* parameters               *)
  | CurrentProof of string * metasenv *            (* name, conjectures,       *)
-    term * term                                   (*  value, type             *)
+    term * term * UriManager.uri list             (*  value, type, parameters *)
  | InductiveDefinition of inductiveType list *    (* inductive types,         *)
-    (int * UriManager.uri list) list * int        (*  parameters, n ind. pars *)
+    UriManager.uri list * int                     (*  parameters, n ind. pars *)
 and inductiveType = 
  string * bool * term *                       (* typename, inductive, arity *)
   constructor list                            (*  constructors              *)
 and constructor =
- string * term * bool list option ref         (* id, type, really recursive *)
+ string * term                                (* id, type *)
 and inductiveFun =
  string * int * term * term                   (* name, ind. index, type, body *)
 and coInductiveFun =
  string * term * term                         (* name, type, body *)
 
-(* a metasenv is a list of declarations of metas *)
+(* a metasenv is a list of declarations of metas in declarations *)
+(* order (i.e. [oldest ; ... ; newest]). Older variables can not *)
+(* depend on new ones.                                           *)
 and conjecture = int * context * term
 and metasenv = conjecture list
 
-(* a metasenv is a list of declarations of metas *)
+(* a metasenv is a list of declarations of metas in declarations *)
+(* order (i.e. [oldest ; ... ; newest]). Older variables can not *)
+(* depend on new ones.                                           *)
 and annconjecture = id * int * anncontext * annterm
 and annmetasenv = annconjecture list
 
 and annterm =
-   ARel of id * int * string                        (* DeBrujin index, binder *)
- | AVar of id * UriManager.uri                      (* uri *)
+   ARel of id * id * int *                          (* idref, DeBrujin index, *)
+    string                                          (*  binder                *)
+ | AVar of id * UriManager.uri *                    (* uri,                   *)
+    annterm explicit_named_substitution             (*  explicit named subst. *)
  | AMeta of id * int * (annterm option) list        (* numeric id,    *)
                                                     (*  local context *)
  | ASort of id * sort                               (* sort *)
@@ -116,47 +128,46 @@ and annterm =
  | ALambda of id * name * annterm * annterm         (* binder, source, target *)
  | ALetIn of id * name * annterm * annterm          (* binder, term, target *)
  | AAppl of id * annterm list                       (* arguments *)
- | AConst of id * UriManager.uri * int              (* uri, number of cookings*)
- | AMutInd of id * UriManager.uri * int * int       (* uri, cookingsno, typeno*)
+ | AConst of id * UriManager.uri *                  (* uri,                   *)
+    annterm explicit_named_substitution             (*  explicit named subst. *)
+ | AMutInd of id * UriManager.uri * int *           (* uri, typeno            *)
+    annterm explicit_named_substitution             (*  explicit named subst. *)
+                                                    (* typeno is 0 based *)
+ | AMutConstruct of id * UriManager.uri *           (* uri,                   *)
+    int * int *                                     (*  typeno, consno        *)
+    annterm explicit_named_substitution             (*  explicit named subst. *)
                                                     (* typeno is 0 based *)
- | AMutConstruct of id * UriManager.uri * int *     (* uri, cookingsno, *)
-    int * int                                       (*  typeno, consno  *)
                                                     (* consno is 1 based *)
- (*CSC: serve cookingsno?*)
- | AMutCase of id * UriManager.uri * int *          (* ind. uri, cookingsno  *)
+ | AMutCase of id * UriManager.uri *                (* ind. uri,             *)
     int *                                           (*  ind. typeno,         *)
     annterm * annterm *                             (*  outtype, ind. term   *)
     annterm list                                    (*  patterns             *)
  | AFix of id * int * anninductiveFun list          (* funno, functions *)
  | ACoFix of id * int * anncoInductiveFun list      (* funno, functions *)
 and annobj =
-   ADefinition of id * string *                     (* id,           *)
-    annterm * annterm *                             (*  value, type, *)
-    (int * UriManager.uri list) list exactness      (*  parameters   *)
- | AAxiom of id * string * annterm *                (* id, type    *)
-    (int * UriManager.uri list) list                (*  parameters *)
+   AConstant of id * id option * string *           (* name,         *)
+    annterm option * annterm *                      (*  body, type,  *)
+    UriManager.uri list                             (*  parameters   *)
  | AVariable of id *
-    string * annterm option * annterm               (* name, body, type *)
- | ACurrentProof of id *
-    string * annmetasenv *                          (*  name, conjectures, *)
-    annterm * annterm                               (*  value, type        *)
+    string * annterm option * annterm *             (* name, body, type *)
+    UriManager.uri list                             (*  parameters      *)
+ | ACurrentProof of id * id *
+    string * annmetasenv *                          (*  name, conjectures,    *)
+    annterm * annterm * UriManager.uri list         (*  value,type,parameters *)
  | AInductiveDefinition of id *
     anninductiveType list *                         (* inductive types ,      *)
-    (int * UriManager.uri list) list * int          (*  parameters,n ind. pars*)
+    UriManager.uri list * int                       (*  parameters,n ind. pars*)
 and anninductiveType = 
- string * bool * annterm *                    (* typename, inductive, arity *)
+ id * string * bool * annterm *               (* typename, inductive, arity *)
   annconstructor list                         (*  constructors              *)
 and annconstructor =
- string * annterm * bool list option ref      (* id, type, really recursive *)
+ string * annterm                             (* id, type *)
 and anninductiveFun =
- string * int * annterm * annterm             (* name, ind. index, type, body *)
+ id * string * int * annterm * annterm        (* name, ind. index, type, body *)
 and anncoInductiveFun =
- string * annterm * annterm                   (* name, type, body *)
+ id * string * annterm * annterm              (* name, type, body *)
 and annotation =
  string
-and 'a exactness =
-   Possible of 'a                            (* an approximation to something *)
- | Actual of 'a                              (* something *)
 
 and context_entry =                            (* A declaration or definition *)
    Decl of term
diff --git a/helm/ocaml/cic/cicParser.ml b/helm/ocaml/cic/cicParser.ml
index 7cabeb6ae..cb3a064fd 100644
--- a/helm/ocaml/cic/cicParser.ml
+++ b/helm/ocaml/cic/cicParser.ml
@@ -41,55 +41,48 @@ exception Warnings;;
 class warner =
   object 
     method warn w =
-      print_endline ("WARNING: " ^ w) ;
+      prerr_endline ("WARNING: " ^ w) ;
       (raise Warnings : unit)
   end
 ;;
 
 exception EmptyUri of string;;
 
-(* given an uri u it returns the list of tokens of the base uri of u *)
-(* e.g.: token_of_uri "cic:/a/b/c/d.xml" returns ["a" ; "b" ; "c"]   *)
-let tokens_of_uri uri =
- let uri' = UriManager.string_of_uri uri in
- let rec chop_list =
-  function
-     [] -> raise (EmptyUri uri')
-   | [fn] -> []
-   | he::[fn] -> [he]
-   | he::tl -> he::(chop_list tl)
- in
-  let trimmed_uri = Str.replace_first (Str.regexp "cic:") "" uri' in
-   let list_of_tokens = Str.split (Str.regexp "/") trimmed_uri in
-    chop_list list_of_tokens
-;;
-
 (* given the filename of an xml file of a cic object it returns its internal *)
 (* representation.                                                           *)
-let annobj_of_xml filename uri =
+let annobj_of_xml filename filenamebody =
  let module Y = Pxp_yacc in
   try 
-    let d =
-      (* sets the current base uri to resolve relative URIs *)
-      CicParser3.current_sp := tokens_of_uri uri ;
-      CicParser3.current_uri := uri ;
-      let config = {Y.default_config with Y.warner = new warner} in
-      Y.parse_document_entity config
-(*PXP       (Y.ExtID (Pxp_types.System filename,
-         new Pxp_reader.resolve_as_file ~url_of_id ()))
-*)
-(*       (PxpUriResolver.from_file filename) *)
-       (Y.from_file ~alt:[PxpUrlResolver.url_resolver] filename)
-       CicParser3.domspec
+    let root, rootbody =
+     let config = {Y.default_config with Y.warner = new warner} in
+      let doc =
+       Y.parse_document_entity config
+        (Y.from_file ~alt:[PxpUrlResolver.url_resolver] filename)
+        CicParser3.domspec in
+(* CSC: Until PXP bug is resolved *)
+PxpUrlResolver.url_resolver#close_all ;
+      let docroot = doc#root in
+       match filenamebody with
+          None -> docroot,None
+        | Some filename ->
+           let docbody =
+            Y.parse_document_entity config
+             (Y.from_file ~alt:[PxpUrlResolver.url_resolver] filename)
+             CicParser3.domspec
+           in
+(* CSC: Until PXP bug is resolved *)
+PxpUrlResolver.url_resolver#close_all ;
+            docroot,Some docbody#root
     in
-     CicParser2.get_term d#root
+     CicParser2.get_term root rootbody
   with
    e ->
-     print_endline ("Filename: " ^ filename ^ "\nException: ") ;
-     print_endline (Pxp_types.string_of_exn e) ;
+     prerr_endline ("Filenames: " ^ filename ^
+      (match filenamebody with None -> "" | Some s -> ", " ^ s)) ;
+     prerr_endline ("Exception: " ^ Pxp_types.string_of_exn e) ;
      raise e
 ;;
 
-let obj_of_xml filename uri =
- Deannotate.deannotate_obj (annobj_of_xml filename uri)
+let obj_of_xml filename filenamebody =
+ Deannotate.deannotate_obj (annobj_of_xml filename filenamebody)
 ;;
diff --git a/helm/ocaml/cic/cicParser.mli b/helm/ocaml/cic/cicParser.mli
index 1eb5a043b..a965cf262 100644
--- a/helm/ocaml/cic/cicParser.mli
+++ b/helm/ocaml/cic/cicParser.mli
@@ -36,10 +36,14 @@
 (*                                                                            *)
 (******************************************************************************)
 
-(* given the filename of an xml file of a cic object and it's uri, it returns *)
-(* its internal annotated representation.                                     *)
-val annobj_of_xml : string -> UriManager.uri -> Cic.annobj
+(* given the filename of an xml file of a cic object, it returns              *)
+(* its internal annotated representation. In the case of constants (whose     *)
+(* type is splitted from the body), a second xml file (for the body) must be  *)
+(* provided.                                                                  *)
+val annobj_of_xml : string -> string option -> Cic.annobj
 
-(* given the filename of an xml file of a cic object and it's uri, it returns *)
-(* its internal logical representation.                                       *)
-val obj_of_xml : string -> UriManager.uri -> Cic.obj
+(* given the filename of an xml file of a cic object, it returns              *)
+(* its internal logical representation. In the case of constants (whose       *)
+(* type is splitted from the body), a second xml file (for the body) must be  *)
+(* provided.                                                                  *)
+val obj_of_xml : string -> string option -> Cic.obj
diff --git a/helm/ocaml/cic/cicParser2.ml b/helm/ocaml/cic/cicParser2.ml
index 154b294ce..15bc2b935 100644
--- a/helm/ocaml/cic/cicParser2.ml
+++ b/helm/ocaml/cic/cicParser2.ml
@@ -42,64 +42,11 @@ exception NotImplemented;;
 
 (* Utility functions that transform a Pxp attribute into something useful *)
 
-(* mk_absolute_uris "n1: v1 ... vn n2 : u1 ... un ...."      *)
-(* returns [(n1,[absolute_uri_for_v1 ; ... ; absolute_uri_for_vn]) ; (n2,...) *)
-let mk_absolute_uris s =
- let l = (Str.split (Str.regexp ":") s) in
-  let absolute_of_relative n v =
-   let module P3 = CicParser3 in
-    let rec mkburi =
-     function
-        (0,_) -> "/"
-      | (n,he::tl) when n > 0 ->
-         "/" ^ he ^ mkburi (n - 1, tl)
-      | _ -> raise (IllFormedXml 12)
-    in
-     let m = List.length !P3.current_sp - (int_of_string n) in
-      let buri = mkburi (m, !P3.current_sp) in
-       UriManager.uri_of_string ("cic:" ^ buri ^ v ^ ".var")
-  in
-   let rec absolutize =
-    function
-       [] -> []
-     | [no ; vs] ->
-        let vars = (Str.split (Str.regexp " ") vs) in
-         [(int_of_string no, List.map (absolute_of_relative no) vars)]
-     | no::vs::tl -> 
-        let vars = (Str.split (Str.regexp " ") vs) in
-         let rec add_prefix =
-          function
-             [no2] -> ([], no2)
-           | he::tl ->
-              let (pvars, no2) = add_prefix tl in
-               ((absolute_of_relative no he)::pvars, no2)
-           | _ -> raise (IllFormedXml 11)
-         in
-          let (pvars, no2) = add_prefix vars in
-           (int_of_string no, pvars)::(absolutize (no2::tl))
-     | _ -> raise (IllFormedXml 10)
-   in
-    (* last parameter must be applied first *)
-    absolutize l
-;;
-
-let option_uri_list_of_attr a1 a2 =
- let module T = Pxp_types in
-  let parameters =
-   match a1 with
-      T.Value s -> mk_absolute_uris s
-    | _ -> raise (IllFormedXml 0)
-  in
-   match a2 with
-      T.Value "POSSIBLE" -> Cic.Possible parameters
-    | T.Implied_value -> Cic.Actual parameters
-    | _ -> raise (IllFormedXml 0)
-;;
-
 let uri_list_of_attr a =
  let module T = Pxp_types in
   match a with
-     T.Value s -> mk_absolute_uris s
+     T.Value s ->
+      List.map UriManager.uri_of_string (Str.split (Str.regexp " ") s)
    | _ -> raise (IllFormedXml 0)
 ;;
 
@@ -123,7 +70,7 @@ let name_of_attr a =
  let module C = Cic in
   match a with
      T.Value s -> C.Name s
-   | T.Implied_value -> C.Anonimous
+   | T.Implied_value -> C.Anonymous
    | _ -> raise (IllFormedXml 0)
 ;;
 
@@ -145,55 +92,46 @@ let get_content n =
 (* dtd                                                                        *)
 
 (* called when a CurrentProof is found *)
-let get_conjs_value_type l =
- let rec rget (c, v, t) l =
+let get_conjs_value l =
+ let rec rget (c, v) l =
   let module D = Pxp_document in
    match l with
-      [] -> (c, v, t)
+      [] -> (c, v)
     | conj::tl when conj#node_type = D.T_element "Conjecture" ->
        let no = int_of_attr (conj#attribute "no") in
-       let xid = string_of_attr (conj#attribute "id") in
+       let id = string_of_attr (conj#attribute "id") in
        let typ,canonical_context =
         match List.rev (conj#sub_nodes) with
            [] -> raise (IllFormedXml 13)
          | typ::canonical_context ->
-            (get_content typ)#extension#to_cic_term,
+            (get_content typ)#extension#to_cic_term [],
             List.map
              (function n ->
-               match n#node_type with
-                  D.T_element "Decl" ->
-                   let name = name_of_attr (n#attribute "name") in
-                   let hid = string_of_attr (n#attribute "id") in
-                   let term = (get_content n)#extension#to_cic_term in
-                    hid,Some (name,Cic.ADecl term)
-                | D.T_element "Def" ->
-                   let name = name_of_attr (n#attribute "name") in
-                   let hid = string_of_attr (n#attribute "id") in
-                   let term = (get_content n)#extension#to_cic_term in
-                    hid,Some (name,Cic.ADef term)
-                | D.T_element "Hidden" ->
-                   let hid = string_of_attr (n#attribute "id") in
-                    hid,None
-                | _ -> raise (IllFormedXml 14)
+               let id = string_of_attr (n#attribute "id") in
+                match n#node_type with
+                   D.T_element "Decl" ->
+                    let name = name_of_attr (n#attribute "name") in
+                    let term = (get_content n)#extension#to_cic_term [] in
+                     id, Some (name,Cic.ADecl term)
+                 | D.T_element "Def" ->
+                    let name = name_of_attr (n#attribute "name") in
+                    let term = (get_content n)#extension#to_cic_term [] in
+                     id, Some (name,Cic.ADef term)
+                 | D.T_element "Hidden" -> id, None
+                 | _ -> raise (IllFormedXml 14)
              ) canonical_context
        in
-        rget ((xid, no, canonical_context, typ)::c, v, t) tl
+        rget ((id, no, canonical_context, typ)::c, v) tl
     | value::tl when value#node_type = D.T_element "body" ->
-       let v' = (get_content value)#extension#to_cic_term in
+       let v' = (get_content value)#extension#to_cic_term [] in
         (match v with
-            None -> rget (c, Some v', t) tl
+            None -> rget (c, Some v') tl
           | _    -> raise (IllFormedXml 2)
         )
-    | typ::tl when typ#node_type = D.T_element "type" ->
-       let t' = (get_content typ)#extension#to_cic_term in
-        (match t with
-            None -> rget (c, v, Some t') tl
-          | _    -> raise (IllFormedXml 3)
-        )
     | _ -> raise (IllFormedXml 4)
  in
-  match rget ([], None, None) l with
-     (revc, Some v, Some t) -> (List.rev revc, v, t)
+  match rget ([], None) l with
+     (revc, Some v) -> (List.rev revc, v)
    | _ -> raise (IllFormedXml 5)
 ;;
 
@@ -205,12 +143,12 @@ let get_names_arity_constructors l =
    match l with
       [] -> (a, c)
     | arity::tl when arity#node_type = D.T_element "arity" ->
-       let a' = (get_content arity)#extension#to_cic_term in
+       let a' = (get_content arity)#extension#to_cic_term [] in
         rget (Some a',c) tl
     | con::tl when con#node_type = D.T_element "Constructor" ->
        let id = string_of_attr (con#attribute "name")
-       and ty = (get_content con)#extension#to_cic_term in
-         rget (a,(id,ty,ref None)::c) tl
+       and ty = (get_content con)#extension#to_cic_term [] in
+         rget (a,(id,ty)::c) tl
     | _ -> raise (IllFormedXml 9)
  in
   match rget (None,[]) l with
@@ -225,10 +163,11 @@ let rec get_inductive_types =
   | he::tl ->
      let tyname    = string_of_attr (he#attribute "name")
      and inductive = bool_of_attr   (he#attribute "inductive")
+     and xid = string_of_attr (he#attribute "id")
      and (arity,cons) =
       get_names_arity_constructors (he#sub_nodes)
      in
-      (tyname,inductive,arity,cons)::(get_inductive_types tl) (*CSC 0 a caso *)
+      (xid,tyname,inductive,arity,cons)::(get_inductive_types tl)
 ;;
 
 (* This is the main function and also the only one used directly from *)
@@ -236,40 +175,48 @@ let rec get_inductive_types =
 (* representation of the cic object described in the tree             *)
 (* It uses the previous functions and the to_cic_term method defined  *)
 (* in cicParser3 (used for subtrees that encode cic terms)            *)
-let rec get_term n =
+let rec get_term (n : CicParser3.cic_term Pxp_document.node) nbody
+=
+ let module U = UriManager in
  let module D = Pxp_document in
  let module C = Cic in
-  let ntype = n # node_type in
+  let ntype = n#node_type in
   match ntype with
-    D.T_element "Definition" ->
-      let id = string_of_attr (n # attribute "name")
-      and params =
-       option_uri_list_of_attr (n#attribute "params") (n#attribute "paramMode")
-      and (value, typ) = 
-       let sons = n#sub_nodes in
-        match sons with
-          [v ; t] when
-            v#node_type = D.T_element "body" &&
-            t#node_type = D.T_element "type" ->
-             let v' = get_content v
-             and t' = get_content t in
-              (v'#extension#to_cic_term, t'#extension#to_cic_term)
-        | _ -> raise (IllFormedXml 6)
-      and xid = string_of_attr (n#attribute "id") in
-       C.ADefinition (xid, id, value, typ, params)
-  | D.T_element "Axiom" ->
-      let id = string_of_attr (n # attribute "name")
-      and params = uri_list_of_attr (n # attribute "params")
-      and typ = 
-       (get_content (get_content n))#extension#to_cic_term
-      and xid = string_of_attr (n#attribute "id") in
-       C.AAxiom (xid, id, typ, params)
-  | D.T_element "CurrentProof" ->
-     let name = string_of_attr (n#attribute "name")
-     and xid = string_of_attr (n#attribute "id") in
-     let sons = n#sub_nodes in
-      let (conjs, value, typ) = get_conjs_value_type sons in
-       C.ACurrentProof (xid, name, conjs, value, typ)
+    D.T_element "ConstantType" ->
+      let name = string_of_attr (n # attribute "name") in
+      let params = uri_list_of_attr (n#attribute "params") in
+      let xid = string_of_attr (n#attribute "id") in
+      let typ = (get_content n)#extension#to_cic_term [] in
+       (match nbody with
+           None ->
+            (* Axiom *)
+            C.AConstant (xid, None, name, None, typ, params)
+         | Some nbody' ->
+            let nbodytype = nbody'#node_type in
+            match nbodytype with
+             D.T_element "ConstantBody" ->
+(*CSC: the attribute "for" is ignored and not checked
+              let for_ = string_of_attr (nbody'#attribute "for") in
+*)
+              let paramsbody = uri_list_of_attr (nbody'#attribute "params") in
+              let xidbody = string_of_attr (nbody'#attribute "id") in
+              let value = (get_content nbody')#extension#to_cic_term [] in
+               if paramsbody = params then
+                C.AConstant (xid, Some xidbody, name, Some value, typ, params)
+               else
+                raise (IllFormedXml 6)
+           | D.T_element "CurrentProof" ->
+(*CSC: the attribute "of" is ignored and not checked
+              let for_ = string_of_attr (nbody'#attribute "of") in
+*)
+              let xidbody = string_of_attr (nbody'#attribute "id") in
+              let sons = nbody'#sub_nodes in
+               let (conjs, value) = get_conjs_value sons in
+                C.ACurrentProof (xid, xidbody, name, conjs, value, typ, params)
+           | D.T_element _
+           | D.T_data
+           | _ -> raise (IllFormedXml 6)
+       )
   | D.T_element "InductiveDefinition" ->
      let sons = n#sub_nodes
      and xid = string_of_attr (n#attribute "id") in
@@ -279,6 +226,7 @@ let rec get_term n =
        C.AInductiveDefinition (xid, inductiveTypes, params, nparams)
   | D.T_element "Variable" ->
      let name = string_of_attr (n#attribute "name")
+     and params = uri_list_of_attr (n#attribute "params")
      and xid = string_of_attr (n#attribute "id")
      and (body, typ) = 
       let sons = n#sub_nodes in
@@ -288,15 +236,14 @@ let rec get_term n =
             t#node_type = D.T_element "type" ->
              let b' = get_content b
              and t' = get_content t in
-              (Some (b'#extension#to_cic_term), t'#extension#to_cic_term)
+              (Some (b'#extension#to_cic_term []), t'#extension#to_cic_term [])
         | [t] when t#node_type = D.T_element "type" ->
              let t' = get_content t in
-              (None, t'#extension#to_cic_term)
+              (None, t'#extension#to_cic_term [])
         | _ -> raise (IllFormedXml 6)
      in
-      C.AVariable (xid,name,body,typ)
+      C.AVariable (xid,name,body,typ,params)
   | D.T_element _
   | D.T_data
-  | _ ->
-     raise (IllFormedXml 7)
+  | _ -> raise (IllFormedXml 7)
 ;;
diff --git a/helm/ocaml/cic/cicParser2.mli b/helm/ocaml/cic/cicParser2.mli
index be0a00054..1d95f35ee 100644
--- a/helm/ocaml/cic/cicParser2.mli
+++ b/helm/ocaml/cic/cicParser2.mli
@@ -41,17 +41,12 @@ exception IllFormedXml of int
 exception NotImplemented
 
 (* This is the main function and also the only one used directly from *)
-(* cicParser. Given the root of the dom tree, it returns the internal *)
-(* representation of the cic object described in the tree             *)
+(* cicParser. Given the root of the dom tree and, possibly, also the  *)
+(* root of the dom tree of the constant body, it returns the internal *)
+(* representation of the cic object described in the tree(s).         *)
 (* It uses the previous functions and the to_cic_term method defined  *)
 (* in cicParser3 (used for subtrees that encode cic terms)            *)
 val get_term :
- < attribute : string -> Pxp_types.att_value;
-   node_type : Pxp_document.node_type;
-   sub_nodes : < attribute : string -> Pxp_types.att_value;
-                 node_type : Pxp_document.node_type;
-                 sub_nodes : CicParser3.cic_term Pxp_document.node list;
-                 .. >
-               list;
-   .. > ->
- Cic.annobj
+  CicParser3.cic_term Pxp_document.node ->
+  CicParser3.cic_term Pxp_document.node option ->
+  Cic.annobj
diff --git a/helm/ocaml/cic/cicParser3.ml b/helm/ocaml/cic/cicParser3.ml
index 8f87504ac..02d22b321 100644
--- a/helm/ocaml/cic/cicParser3.ml
+++ b/helm/ocaml/cic/cicParser3.ml
@@ -41,19 +41,12 @@
 
 exception IllFormedXml of int;;
 
-(* The list of tokens of the current section path. *)
-(* Used to resolve relative URIs                   *)
-let current_sp = ref [];;
-
-(* The uri of the object been parsed *)
-let current_uri = ref (UriManager.uri_of_string "cic:/.xml");;
-
 (* Utility functions to map a markup attribute to something useful *)
 
 let cic_attr_of_xml_attr =
  function
     Pxp_types.Value s       -> Cic.Name s
-  | Pxp_types.Implied_value -> Cic.Anonimous
+  | Pxp_types.Implied_value -> Cic.Anonymous
   | _             -> raise (IllFormedXml 1)
 
 let cic_sort_of_xml_attr =
@@ -89,7 +82,7 @@ let binder_of_xml_attr =
 class virtual cic_term =
   object (self)
 
-    (* fields and methods ever required by markup *)
+    (* fields and methods always required by markup *)
     val mutable node = (None : cic_term Pxp_document.node option)
 
     method clone = {< >} 
@@ -103,7 +96,8 @@ class virtual cic_term =
 
     (* a method that returns the internal representation of the tree (term) *)
     (* rooted in this node                                                  *)
-    method virtual to_cic_term : Cic.annterm
+    method virtual to_cic_term :
+     (UriManager.uri * Cic.annterm) list -> Cic.annterm
   end
 ;;
 
@@ -113,7 +107,7 @@ class eltype_not_of_cic =
 
      inherit cic_term
 
-     method to_cic_term = raise (IllFormedXml 6)
+     method to_cic_term _ = raise (IllFormedXml 6)
   end
 ;;
 
@@ -124,10 +118,11 @@ class eltype_transparent =
 
     inherit cic_term
 
-    method to_cic_term =
+    method to_cic_term exp_named_subst =
+     assert (exp_named_subst = []) ;
      let n = self#node in
       match n#sub_nodes with
-         [ t ]  -> t#extension#to_cic_term
+         [ t ]  -> t#extension#to_cic_term []
        | _  -> raise (IllFormedXml 7)
   end
 ;;
@@ -139,7 +134,8 @@ class eltype_fix =
 
     inherit cic_term
 
-    method to_cic_term =
+    method to_cic_term exp_named_subst =
+     assert (exp_named_subst = []) ;
      let n = self#node in
       let nofun = int_of_xml_attr (n#attribute "noFun")
       and id = string_of_xml_attr (n#attribute "id")
@@ -149,16 +145,17 @@ class eltype_fix =
          (function
              f when f#node_type = Pxp_document.T_element "FixFunction" ->
               let name = string_of_xml_attr (f#attribute "name")
+              and id = string_of_xml_attr (f#attribute "id")
               and recindex = int_of_xml_attr (f#attribute "recIndex")
               and (ty, body) =
                match f#sub_nodes with
                   [t ; b] when
                     t#node_type = Pxp_document.T_element "type" &&
                     b#node_type = Pxp_document.T_element "body" ->
-                     (t#extension#to_cic_term, b#extension#to_cic_term)
+                     (t#extension#to_cic_term [], b#extension#to_cic_term [])
                 | _ -> raise (IllFormedXml 14)
               in
-               (name, recindex, ty, body)
+               (id, name, recindex, ty, body)
            | _ -> raise (IllFormedXml 13)
          ) sons
       in
@@ -171,7 +168,8 @@ class eltype_cofix =
 
     inherit cic_term
 
-    method to_cic_term =
+    method to_cic_term exp_named_subst =
+     assert (exp_named_subst = []) ;
      let n = self#node in
       let nofun = int_of_xml_attr (n#attribute "noFun")
       and id = string_of_xml_attr (n#attribute "id")
@@ -181,15 +179,16 @@ class eltype_cofix =
          (function
              f when f#node_type = Pxp_document.T_element "CofixFunction" ->
               let name = string_of_xml_attr (f#attribute "name")
+              and id = string_of_xml_attr (f#attribute "id")
               and (ty, body) =
                match f#sub_nodes with
                   [t ; b] when
                     t#node_type = Pxp_document.T_element "type" &&
                     b#node_type = Pxp_document.T_element "body" ->
-                     (t#extension#to_cic_term, b#extension#to_cic_term)
+                     (t#extension#to_cic_term [], b#extension#to_cic_term [])
                 | _ -> raise (IllFormedXml 16)
               in
-               (name, ty, body)
+               (id, name, ty, body)
            | _ -> raise (IllFormedXml 15)
          ) sons
       in
@@ -202,7 +201,8 @@ class eltype_implicit =
 
     inherit cic_term
 
-    method to_cic_term =
+    method to_cic_term exp_named_subst =
+     assert (exp_named_subst = []) ;
      let n = self#node in
       let id = string_of_xml_attr (n#attribute "id") in
        Cic.AImplicit id
@@ -214,12 +214,14 @@ class eltype_rel =
 
     inherit cic_term
 
-    method to_cic_term =
+    method to_cic_term exp_named_subst =
+     assert (exp_named_subst = []) ;
      let n = self#node in
       let value  = int_of_xml_attr (n#attribute "value")
       and binder = binder_of_xml_attr (n#attribute "binder")
-      and id = string_of_xml_attr (n#attribute "id") in
-       Cic.ARel (id,value,binder)
+      and id = string_of_xml_attr (n#attribute "id")
+      and idref = string_of_xml_attr (n#attribute "idref") in
+       Cic.ARel (id,idref,value,binder)
   end
 ;;
 
@@ -228,7 +230,8 @@ class eltype_meta =
 
     inherit cic_term
 
-    method to_cic_term =
+    method to_cic_term exp_named_subst =
+     assert (exp_named_subst = []) ;
      let n = self#node in
       let value = int_of_xml_attr (n#attribute "no")
       and id = string_of_xml_attr (n#attribute "id")
@@ -239,7 +242,7 @@ class eltype_meta =
           (function substitution ->
             match substitution#sub_nodes with
                [] -> None
-             | [he] -> Some he#extension#to_cic_term
+             | [he] -> Some (he#extension#to_cic_term [])
              | _ -> raise (IllFormedXml 20)
           ) sons
        in
@@ -252,27 +255,13 @@ class eltype_var =
 
     inherit cic_term
 
-    method to_cic_term =
+    method to_cic_term exp_named_subst =
+     assert (exp_named_subst = []) ;
      let n = self#node in
-      let name = string_of_xml_attr (n#attribute "relUri")
+      let uri = uri_of_xml_attr (n#attribute "uri")
       and xid = string_of_xml_attr (n#attribute "id") in
-       match Str.split (Str.regexp ",") name with
-          [index; id] ->
-           let get_prefix n =
-            let rec aux =
-             function
-                (0,_) -> "/"
-              | (n,he::tl) when n > 0 -> "/" ^ he ^ aux (n - 1, tl)
-              | _ -> raise (IllFormedXml 19)
-            in   
-             aux (List.length !current_sp - n,!current_sp)
-           in
-            Cic.AVar
-             (xid, 
-              (UriManager.uri_of_string
-               ("cic:" ^ get_prefix (int_of_string index) ^ id ^ ".var"))
-             )
-        | _ -> raise (IllFormedXml 18)
+(*CSC: BIG BUG: [] MUST BE REPLACED WITH THE PARSED EXPLICIT NAMED SUBSTITUTION *)
+       Cic.AVar (xid,uri,[])
   end
 ;;
 
@@ -281,14 +270,15 @@ class eltype_apply =
 
     inherit cic_term
 
-    method to_cic_term =
+    method to_cic_term exp_named_subst =
+     assert (exp_named_subst = []) ;
      let n = self#node in
       let children = n#sub_nodes
       and id = string_of_xml_attr (n#attribute "id") in
        if List.length children < 2 then raise (IllFormedXml 8)
        else
         Cic.AAppl
-         (id,List.map (fun x -> x#extension#to_cic_term) children)
+         (id,List.map (fun x -> x#extension#to_cic_term []) children)
   end
 ;;
 
@@ -297,7 +287,8 @@ class eltype_cast =
 
     inherit cic_term
 
-    method to_cic_term =
+    method to_cic_term exp_named_subst =
+     assert (exp_named_subst = []) ;
      let n = self#node in
       let sons = n#sub_nodes
       and id = string_of_xml_attr (n#attribute "id") in
@@ -305,8 +296,8 @@ class eltype_cast =
           [te ; ty] when
             te#node_type = Pxp_document.T_element "term" &&
             ty#node_type = Pxp_document.T_element "type" ->
-             let term = te#extension#to_cic_term
-             and typ  = ty#extension#to_cic_term in
+             let term = te#extension#to_cic_term []
+             and typ  = ty#extension#to_cic_term [] in
               Cic.ACast (id,term,typ)
         | _  -> raise (IllFormedXml 9)
   end
@@ -317,7 +308,8 @@ class eltype_sort =
 
     inherit cic_term
 
-    method to_cic_term =
+    method to_cic_term exp_named_subst =
+     assert (exp_named_subst = []) ;
      let n = self#node in
       let sort = cic_sort_of_xml_attr (n#attribute "value")
       and id = string_of_xml_attr (n#attribute "id") in
@@ -330,12 +322,12 @@ class eltype_const =
 
     inherit cic_term
 
-    method to_cic_term =
+    method to_cic_term exp_named_subst =
      let module U = UriManager in
       let n = self#node in
        let value = uri_of_xml_attr (n#attribute "uri")
        and id = string_of_xml_attr (n#attribute "id") in
-        Cic.AConst (id,value, U.relative_depth !current_uri value 0)
+        Cic.AConst (id,value, exp_named_subst)
   end
 ;;
 
@@ -344,14 +336,14 @@ class eltype_mutind =
 
     inherit cic_term
 
-    method to_cic_term =
+    method to_cic_term exp_named_subst =
      let module U = UriManager in
       let n = self#node in
        let name = uri_of_xml_attr (n#attribute "uri")
        and noType = int_of_xml_attr (n#attribute "noType")
        and id = string_of_xml_attr (n#attribute "id") in
         Cic.AMutInd
-         (id,name, U.relative_depth !current_uri name 0, noType)
+         (id,name, noType, exp_named_subst)
   end
 ;;
 
@@ -360,7 +352,7 @@ class eltype_mutconstruct =
 
     inherit cic_term
 
-    method to_cic_term =
+    method to_cic_term exp_named_subst =
      let module U = UriManager in
       let n = self#node in
        let name = uri_of_xml_attr (n#attribute "uri")
@@ -368,8 +360,7 @@ class eltype_mutconstruct =
        and noConstr = int_of_xml_attr (n#attribute "noConstr")
        and id = string_of_xml_attr (n#attribute "id") in
         Cic.AMutConstruct
-         (id, name, U.relative_depth !current_uri name 0,
-         noType, noConstr)
+         (id, name, noType, noConstr, exp_named_subst)
   end
 ;;
 
@@ -378,19 +369,25 @@ class eltype_prod =
 
     inherit cic_term
 
-    method to_cic_term =
+    method to_cic_term exp_named_subst =
+     assert (exp_named_subst = []) ;
      let n = self#node in
-      let sons = n#sub_nodes
-      and id = string_of_xml_attr (n#attribute "id") in
-       match sons with
-          [s ; t] when
-            s#node_type = Pxp_document.T_element "source" &&
-            t#node_type = Pxp_document.T_element "target" ->
-             let name = cic_attr_of_xml_attr (t#attribute "binder")
-             and source = s#extension#to_cic_term
-             and target = t#extension#to_cic_term in
-              Cic.AProd (id,name,source,target)
-        | _  -> raise (IllFormedXml 10)
+      let sons = n#sub_nodes in
+       let rec get_decls_and_target =
+        function
+           [t] when t#node_type = Pxp_document.T_element "target" ->
+            [],t#extension#to_cic_term []
+         | s::tl when s#node_type = Pxp_document.T_element "decl" ->
+            let decls,target = get_decls_and_target tl in
+             let id = string_of_xml_attr (s#attribute "id") in
+             let binder = cic_attr_of_xml_attr (s#attribute "binder") in
+              (id,binder,s#extension#to_cic_term [])::decls, target
+         | _  -> raise (IllFormedXml 10)
+       in
+        let decls,target = get_decls_and_target sons in
+         List.fold_right
+          (fun (id,b,s) t -> Cic.AProd (id,b,s,t))
+          decls target
   end
 ;;
 
@@ -399,7 +396,8 @@ class eltype_mutcase =
 
     inherit cic_term
 
-    method to_cic_term =
+    method to_cic_term exp_named_subst =
+     assert (exp_named_subst = []) ;
      let module U = UriManager in
       let n = self#node in
        let sons = n#sub_nodes
@@ -410,12 +408,12 @@ class eltype_mutcase =
              te#node_type = Pxp_document.T_element "inductiveTerm" ->
               let ci = uri_of_xml_attr (n#attribute "uriType")
               and typeno = int_of_xml_attr (n#attribute "noType")
-              and inductiveType = ty#extension#to_cic_term
-              and inductiveTerm = te#extension#to_cic_term
-              and lpattern= List.map (fun x -> x#extension#to_cic_term) patterns
+              and inductiveType = ty#extension#to_cic_term []
+              and inductiveTerm = te#extension#to_cic_term []
+              and lpattern =
+               List.map (fun x -> x#extension#to_cic_term []) patterns
               in
-               Cic.AMutCase (id,ci,U.relative_depth !current_uri ci 0,
-                typeno,inductiveType,inductiveTerm,lpattern)
+               Cic.AMutCase (id,ci, typeno,inductiveType,inductiveTerm,lpattern)
          | _  -> raise (IllFormedXml 11)
   end
 ;;
@@ -425,19 +423,25 @@ class eltype_lambda =
 
     inherit cic_term
 
-    method to_cic_term =
+    method to_cic_term exp_named_subst =
+     assert (exp_named_subst = []) ;
      let n = self#node in
-      let sons = n#sub_nodes
-      and id = string_of_xml_attr (n#attribute "id") in
-       match sons with
-          [s ; t] when
-            s#node_type = Pxp_document.T_element "source" &&
-            t#node_type = Pxp_document.T_element "target" ->
-             let name = cic_attr_of_xml_attr (t#attribute "binder")
-             and source = s#extension#to_cic_term
-             and target = t#extension#to_cic_term in
-              Cic.ALambda (id,name,source,target)
-        | _  -> raise (IllFormedXml 12)
+      let sons = n#sub_nodes in
+       let rec get_decls_and_target =
+        function
+           [t] when t#node_type = Pxp_document.T_element "target" ->
+            [],t#extension#to_cic_term []
+         | s::tl when s#node_type = Pxp_document.T_element "decl" ->
+            let decls,target = get_decls_and_target tl in
+             let id = string_of_xml_attr (s#attribute "id") in
+             let binder = cic_attr_of_xml_attr (s#attribute "binder") in
+              (id,binder,s#extension#to_cic_term [])::decls, target
+         | _  -> raise (IllFormedXml 12)
+       in
+        let decls,target = get_decls_and_target sons in
+         List.fold_right
+          (fun (id,b,s) t -> Cic.ALambda (id,b,s,t))
+          decls target
   end
 ;;
 
@@ -446,22 +450,64 @@ class eltype_letin =
 
     inherit cic_term
 
-    method to_cic_term =
+    method to_cic_term exp_named_subst =
+     assert (exp_named_subst = []) ;
      let n = self#node in
-      let sons = n#sub_nodes
-      and id = string_of_xml_attr (n#attribute "id") in
-       match sons with
-          [s ; t] when
-            s#node_type = Pxp_document.T_element "term" &&
-            t#node_type = Pxp_document.T_element "letintarget" ->
-             let name = cic_attr_of_xml_attr (t#attribute "binder")
-             and source = s#extension#to_cic_term
-             and target = t#extension#to_cic_term in
-              Cic.ALetIn (id,name,source,target)
-        | _  -> raise (IllFormedXml 12)
+      let sons = n#sub_nodes in
+       let rec get_defs_and_target =
+        function
+           [t] when t#node_type = Pxp_document.T_element "target" ->
+            [],t#extension#to_cic_term []
+         | s::tl when s#node_type = Pxp_document.T_element "def" ->
+            let defs,target = get_defs_and_target tl in
+             let id = string_of_xml_attr (s#attribute "id") in
+             let binder = cic_attr_of_xml_attr (s#attribute "binder") in
+              (id,binder,s#extension#to_cic_term [])::defs, target
+         | _  -> raise (IllFormedXml 12)
+       in
+        let defs,target = get_defs_and_target sons in
+         List.fold_right
+          (fun (id,b,s) t -> Cic.ALetIn (id,b,s,t))
+          defs target
+  end
+;;
+
+class eltype_instantiate =
+  object (self)
+
+    inherit cic_term
+
+    method to_cic_term exp_named_subst =
+     assert (exp_named_subst = []) ;
+     let n = self#node in
+(* CSC: this optional attribute should be parsed and reflected in Cic.annterm
+      and id = string_of_xml_attr (n#attribute "id")
+*)
+       match n#sub_nodes with
+          t::l  ->
+           let baseUri =
+            UriManager.buri_of_uri (uri_of_xml_attr (t#attribute "uri")) in
+           let exp_named_subst =
+            List.map
+             (function
+                 n when n#node_type = Pxp_document.T_element "arg" ->
+                  let relUri = string_of_xml_attr (n#attribute "relUri") in
+                  let uri = UriManager.uri_of_string (baseUri ^ "/" ^ relUri) in
+                  let arg =
+                   match n#sub_nodes with
+                      [ t ]  -> t#extension#to_cic_term []
+                    | _  -> raise (IllFormedXml 7)
+                  in
+                   (uri, arg)
+               | _ -> raise (IllFormedXml 7)
+             ) l
+           in
+            t#extension#to_cic_term exp_named_subst
+        | _  -> raise (IllFormedXml 7)
   end
 ;;
 
+
 (* The definition of domspec, an hashtable that maps each node type to the *)
 (* object that must be linked to it. Used by markup.                       *)
 
@@ -487,11 +533,13 @@ let domspec =
       "MUTCASE",       (new D.element_impl (new eltype_mutcase)) ;
       "FIX",           (new D.element_impl (new eltype_fix)) ;
       "COFIX",         (new D.element_impl (new eltype_cofix)) ;
+      "instantiate",   (new D.element_impl (new eltype_instantiate)) ;
       "arity",         (new D.element_impl (new eltype_transparent)) ;
       "term",          (new D.element_impl (new eltype_transparent)) ;
       "type",          (new D.element_impl (new eltype_transparent)) ;
       "body",          (new D.element_impl (new eltype_transparent)) ;
-      "source",        (new D.element_impl (new eltype_transparent)) ;
+      "decl",          (new D.element_impl (new eltype_transparent)) ;
+      "def",           (new D.element_impl (new eltype_transparent)) ;
       "target",        (new D.element_impl (new eltype_transparent)) ;
       "letintarget",   (new D.element_impl (new eltype_transparent)) ;
       "patternsType",  (new D.element_impl (new eltype_transparent)) ;
diff --git a/helm/ocaml/cic/cicParser3.mli b/helm/ocaml/cic/cicParser3.mli
index 990346e82..3c2f5d94c 100644
--- a/helm/ocaml/cic/cicParser3.mli
+++ b/helm/ocaml/cic/cicParser3.mli
@@ -41,9 +41,6 @@
 
 exception IllFormedXml of int
 
-val current_sp : string list ref
-val current_uri : UriManager.uri ref
-
 (* the "interface" of the class linked to each node of the dom tree *)
 class virtual cic_term :
   object ('a)
@@ -56,7 +53,8 @@ class virtual cic_term :
 
     (* a method that returns the internal representation of the tree (term) *)
     (* rooted in this node                                                  *)
-    method virtual to_cic_term : Cic.annterm
+    method virtual to_cic_term :
+     (UriManager.uri * Cic.annterm) list -> Cic.annterm
 
   end
 
diff --git a/helm/ocaml/cic/deannotate.ml b/helm/ocaml/cic/deannotate.ml
index ec98b9774..df59305fe 100644
--- a/helm/ocaml/cic/deannotate.ml
+++ b/helm/ocaml/cic/deannotate.ml
@@ -23,16 +23,16 @@
  * http://cs.unibo.it/helm/.
  *)
 
-let expect_possible_parameters = ref false;;
-
-exception NotExpectingPossibleParameters;;
-
 (* converts annotated terms into cic terms (forgetting ids and names) *)
 let rec deannotate_term =
  let module C = Cic in
   function
-     C.ARel (_,n,_) -> C.Rel n
-   | C.AVar (_,uri) -> C.Var uri
+     C.ARel (_,_,n,_) -> C.Rel n
+   | C.AVar (_,uri,exp_named_subst) ->
+      let deann_exp_named_subst =
+       List.map (function (uri,t) -> uri,deannotate_term t) exp_named_subst
+      in
+       C.Var (uri, deann_exp_named_subst)
    | C.AMeta (_,n, l) ->
       let l' =
        List.map
@@ -52,50 +52,53 @@ let rec deannotate_term =
    | C.ALetIn (_,name,so,ta) ->
       C.LetIn (name, deannotate_term so, deannotate_term ta)
    | C.AAppl (_,l) -> C.Appl (List.map deannotate_term l)
-   | C.AConst (_,uri, cookingsno) -> C.Const (uri, cookingsno)
-   | C.AMutInd (_,uri,cookingsno,i) -> C.MutInd (uri,cookingsno,i)
-   | C.AMutConstruct (_,uri,cookingsno,i,j) ->
-      C.MutConstruct (uri,cookingsno,i,j)
-   | C.AMutCase (_,uri,cookingsno,i,outtype,te,pl) ->
-      C.MutCase (uri,cookingsno,i,deannotate_term outtype,
+   | C.AConst (_,uri,exp_named_subst) ->
+      let deann_exp_named_subst =
+       List.map (function (uri,t) -> uri,deannotate_term t) exp_named_subst
+      in
+       C.Const (uri, deann_exp_named_subst)
+   | C.AMutInd (_,uri,i,exp_named_subst) ->
+      let deann_exp_named_subst =
+       List.map (function (uri,t) -> uri,deannotate_term t) exp_named_subst
+      in
+       C.MutInd (uri,i,deann_exp_named_subst)
+   | C.AMutConstruct (_,uri,i,j,exp_named_subst) ->
+      let deann_exp_named_subst =
+       List.map (function (uri,t) -> uri,deannotate_term t) exp_named_subst
+      in
+       C.MutConstruct (uri,i,j,deann_exp_named_subst)
+   | C.AMutCase (_,uri,i,outtype,te,pl) ->
+      C.MutCase (uri,i,deannotate_term outtype,
        deannotate_term te, List.map deannotate_term pl)
    | C.AFix (_,funno,ifl) ->
       C.Fix (funno, List.map deannotate_inductiveFun ifl)
    | C.ACoFix (_,funno,ifl) ->
       C.CoFix (funno, List.map deannotate_coinductiveFun ifl)
 
-and deannotate_inductiveFun (name,index,ty,bo) =
+and deannotate_inductiveFun (_,name,index,ty,bo) =
  (name, index, deannotate_term ty, deannotate_term bo)
 
-and deannotate_coinductiveFun (name,ty,bo) =
+and deannotate_coinductiveFun (_,name,ty,bo) =
  (name, deannotate_term ty, deannotate_term bo)
 ;;
 
-let deannotate_inductiveType (name, isinductive, arity, cons) =
+let deannotate_inductiveType (_, name, isinductive, arity, cons) =
  (name, isinductive, deannotate_term arity,
-  List.map (fun (id,ty,recs) -> (id,deannotate_term ty, recs)) cons)
+  List.map (fun (id,ty) -> (id,deannotate_term ty)) cons)
 ;;
 
 let deannotate_obj =
  let module C = Cic in
   function
-     C.ADefinition (_, id, bo, ty, params) ->
-      (match params with
-          C.Possible params ->
-           if !expect_possible_parameters then
-            C.Definition (id, deannotate_term bo, deannotate_term ty, params)
-           else
-            raise NotExpectingPossibleParameters
-        | C.Actual params ->
-           C.Definition (id, deannotate_term bo, deannotate_term ty, params)
-      )
-   | C.AAxiom (_, id, ty, params) ->
-      C.Axiom (id, deannotate_term ty, params)
-   | C.AVariable (_, name, bo, ty) ->
+     C.AConstant (_, _, id, bo, ty, params) ->
+      C.Constant (id,
+       (match bo with None -> None | Some bo -> Some (deannotate_term bo)),
+       deannotate_term ty, params)
+   | C.AVariable (_, name, bo, ty, params) ->
       C.Variable (name,
        (match bo with None -> None | Some bo -> Some (deannotate_term bo)),
-       deannotate_term ty)
-   | C.ACurrentProof (_, name, conjs, bo, ty) ->
+       deannotate_term ty, params)
+   | C.ACurrentProof (_, _, name, conjs, bo, ty, params) ->
       C.CurrentProof (
        name,
         List.map
@@ -113,9 +116,9 @@ let deannotate_obj =
             in
 	     (id,context,deannotate_term con) 
          ) conjs,
-       deannotate_term bo,deannotate_term ty
+       deannotate_term bo,deannotate_term ty,params
       )
    | C.AInductiveDefinition (_, tys, params, parno) ->
-      C.InductiveDefinition ( List.map deannotate_inductiveType tys,
+      C.InductiveDefinition (List.map deannotate_inductiveType tys,
        params, parno)
 ;;
diff --git a/helm/ocaml/cic/deannotate.mli b/helm/ocaml/cic/deannotate.mli
index d1bd72c07..89b18d2d6 100644
--- a/helm/ocaml/cic/deannotate.mli
+++ b/helm/ocaml/cic/deannotate.mli
@@ -32,8 +32,5 @@
 (*                                                                            *)
 (******************************************************************************)
 
-(* Useful only for fix_params *)
-val expect_possible_parameters : bool ref
-
 val deannotate_term : Cic.annterm -> Cic.term
 val deannotate_obj : Cic.annobj -> Cic.obj
diff --git a/helm/ocaml/cic_annotations/cicAnnotation2Xml.ml b/helm/ocaml/cic_annotations/cicAnnotation2Xml.ml
index 1961a2bc2..353ef1f74 100644
--- a/helm/ocaml/cic_annotations/cicAnnotation2Xml.ml
+++ b/helm/ocaml/cic_annotations/cicAnnotation2Xml.ml
@@ -50,8 +50,7 @@ let print_term i2a =
   let module X = Xml in
   let module U = UriManager in
     function
-       C.ARel (id,_,_) -> print_ann i2a id
-     | C.AVar (id,_) -> print_ann i2a id
+       C.ARel (id,_,_,_) -> print_ann i2a id
      | C.AMeta (id,_,_) -> print_ann i2a id
      | C.ASort (id,_) -> print_ann i2a id
      | C.AImplicit _ -> raise NotImplemented
@@ -63,10 +62,16 @@ let print_term i2a =
         [< print_ann i2a id ;
            List.fold_right (fun x i -> [< (aux x) ; i >]) li [<>]
         >]
-     | C.AConst (id,_,_) -> print_ann i2a id
-     | C.AMutInd (id,_,_,_) -> print_ann i2a id
-     | C.AMutConstruct (id,_,_,_,_) -> print_ann i2a id
-     | C.AMutCase (id,_,_,_,ty,te,patterns) ->
+     | C.AVar (id,_,exp_named_subst)
+     | C.AConst (id,_,exp_named_subst)
+     | C.AMutInd (id,_,_,exp_named_subst)
+     | C.AMutConstruct (id,_,_,_,exp_named_subst) ->
+        [< print_ann i2a id ;
+           List.fold_right
+            (fun (_,x) i -> [< aux x ; i >])
+            exp_named_subst [<>]
+        >] 
+     | C.AMutCase (id,_,_,ty,te,patterns) ->
         [< print_ann i2a id ;
            aux ty ;
            aux te ;
@@ -77,21 +82,21 @@ let print_term i2a =
      | C.AFix (id,_,funs) ->
         [< print_ann i2a id ;
            List.fold_right
-            (fun (_,_,ti,bi) i -> [< aux ti ; aux bi ; i >]) funs [<>]
+            (fun (_,_,_,ti,bi) i -> [< aux ti ; aux bi ; i >]) funs [<>]
         >]
      | C.ACoFix (id,no,funs) ->
         [< print_ann i2a id ;
            List.fold_right
-            (fun (_,ti,bi) i -> [< aux ti ; aux bi ; i >]) funs [<>]
+            (fun (_,_,ti,bi) i -> [< aux ti ; aux bi ; i >]) funs [<>]
         >]
  in
   aux
 ;;
 
-let print_mutual_inductive_type i2a (_,_,arity,constructors) =
+let print_mutual_inductive_type i2a (_,_,_,arity,constructors) =
  [< print_term i2a arity ;
     List.fold_right
-     (fun (name,ty,_) i -> [< print_term i2a ty ; i >]) constructors [<>]
+     (fun (name,ty) i -> [< print_term i2a ty ; i >]) constructors [<>]
  >]
 ;;
 
@@ -104,10 +109,19 @@ let pp_annotation obj i2a curi =
       ["of", UriManager.string_of_uri (UriManager.cicuri_of_uri curi)]
       begin
        match obj with
-         C.ADefinition (xid, _, te, ty, _) ->
-          [< print_ann i2a xid ; print_term i2a te ; print_term i2a ty >]
-       | C.AAxiom (xid, _, ty, _) -> [< print_ann i2a xid ; print_term i2a ty >]
-       | C.AVariable (xid, _, bo, ty) ->
+         C.AConstant (xid, xidobj, _, te, ty, _) ->
+          [< print_ann i2a xid ;
+             (match xidobj,te with
+                 Some xidobj, Some te ->
+                  [< print_ann i2a xidobj ;
+                     print_term i2a te
+                  >]
+               | None, None -> [<>]
+               | _,_ -> assert false
+             ) ;
+             print_term i2a ty
+          >]
+       | C.AVariable (xid, _, bo, ty,_) ->
           [< print_ann i2a xid ;
              (match bo with
                  None -> [<>]
@@ -115,8 +129,9 @@ let pp_annotation obj i2a curi =
              ) ;
              print_term i2a ty
           >]
-       | C.ACurrentProof (xid, _, conjs, bo, ty) ->
+       | C.ACurrentProof (xid, xidobj, _, conjs, bo, ty,_) ->
           [< print_ann i2a xid ;
+             print_ann i2a xidobj ;
              List.fold_right
               (fun (cid, _, context, t) i ->
                 [< print_ann i2a cid ;
diff --git a/helm/ocaml/cic_annotations/cicAnnotationParser.ml b/helm/ocaml/cic_annotations/cicAnnotationParser.ml
index 33782d4f2..d8c67ea63 100644
--- a/helm/ocaml/cic_annotations/cicAnnotationParser.ml
+++ b/helm/ocaml/cic_annotations/cicAnnotationParser.ml
@@ -41,10 +41,6 @@ let get_annotations filename =
     let d =
      let config = {Y.default_config with Y.warner = new warner} in
       Y.parse_document_entity config
-(*PXP       (Y.ExtID (Pxp_types.System filename,
-         new Pxp_reader.resolve_as_file ~url_of_id ()))
-*)
-(*       (PxpUriResolver.from_file filename)	*)
        (Y.from_file ~alt:[PxpUrlResolver.url_resolver] filename)
        Y.default_spec
 
diff --git a/helm/ocaml/cic_annotations/cicXPath.ml b/helm/ocaml/cic_annotations/cicXPath.ml
index f2cb0ed40..b20fbd5c0 100644
--- a/helm/ocaml/cic_annotations/cicXPath.ml
+++ b/helm/ocaml/cic_annotations/cicXPath.ml
@@ -56,8 +56,7 @@ let get_ids_to_targets annobj =
    in
     let rec add_target_term t =
      match t with
-        C.ARel (id,_,_)
-      | C.AVar (id,_)
+        C.ARel (id,_,_,_)
       | C.AMeta (id,_,_)
       | C.ASort (id,_)
       | C.AImplicit id ->
@@ -75,46 +74,52 @@ let get_ids_to_targets annobj =
       | C.AAppl (id,l) ->
          set_target id (C.Term t) ;
          List.iter add_target_term l
-      | C.AConst (id,_,_)
-      | C.AMutInd (id,_,_,_)
-      | C.AMutConstruct (id,_,_,_,_) ->
-         set_target id (C.Term t)
-      | C.AMutCase (id,_,_,_,ot,it,pl) ->
+      | C.AVar (id,_,exp_named_subst)
+      | C.AConst (id,_,exp_named_subst)
+      | C.AMutInd (id,_,_,exp_named_subst)
+      | C.AMutConstruct (id,_,_,_,exp_named_subst) ->
+         set_target id (C.Term t) ;
+         List.iter (function (_,t) -> add_target_term t) exp_named_subst
+      | C.AMutCase (id,_,_,ot,it,pl) ->
          set_target id (C.Term t) ;
          List.iter add_target_term (ot::it::pl)
       | C.AFix (id,_,ifl) ->
          set_target id (C.Term t) ;
          List.iter
-          (function (_,_,ty,bo) ->
+          (function (_,_,_,ty,bo) ->
             add_target_term ty ;
             add_target_term bo
           ) ifl
       | C.ACoFix (id,_,cfl) ->
          set_target id (C.Term t) ;
          List.iter
-          (function (_,ty,bo) ->
+          (function (_,_,ty,bo) ->
             add_target_term ty ;
             add_target_term bo
           ) cfl
     in
      let add_target_obj annobj =
       match annobj with
-        C.ADefinition (id,_,bo,ty,_) ->
-         set_target id (C.Object annobj) ;
-         add_target_term bo ;
-         add_target_term ty
-      | C.AAxiom (id,_,ty,_) ->
+        C.AConstant (id,idbody,_,bo,ty,_) ->
          set_target id (C.Object annobj) ;
+         (match idbody,bo with
+             Some idbody,Some bo ->
+              set_target idbody (C.ConstantBody annobj) ;
+              add_target_term bo
+           | None, None -> ()
+           | _,_ -> assert false
+         ) ;
          add_target_term ty
-      | C.AVariable (id,_,None,ty) ->
+      | C.AVariable (id,_,None,ty,_) ->
          set_target id (C.Object annobj) ;
          add_target_term ty
-      | C.AVariable (id,_,Some bo,ty) ->
+      | C.AVariable (id,_,Some bo,ty,_) ->
          set_target id (C.Object annobj) ;
          add_target_term bo ;
          add_target_term ty
-      | C.ACurrentProof (id,_,cl,bo,ty) ->
+      | C.ACurrentProof (id,idbody,_,cl,bo,ty,_) ->
          set_target id (C.Object annobj) ;
+         set_target idbody (C.ConstantBody annobj) ;
          List.iter (function (cid,_,context, t) as annconj ->
            set_target cid (C.Conjecture annconj) ;
 	   List.iter 
@@ -131,9 +136,9 @@ let get_ids_to_targets annobj =
       | C.AInductiveDefinition (id,itl,_,_) ->
          set_target id (C.Object annobj) ;
          List.iter
-          (function (_,_,arity,cl) ->
+          (function (_,_,_,arity,cl) ->
             add_target_term arity ;
-            List.iter (function (_,ty,_) -> add_target_term ty) cl
+            List.iter (function (_,ty) -> add_target_term ty) cl
           ) itl
      in
       add_target_obj annobj ;
diff --git a/helm/ocaml/cic_annotations_cache/cicCache.ml b/helm/ocaml/cic_annotations_cache/cicCache.ml
index 8bc4be6c4..de5c1926e 100644
--- a/helm/ocaml/cic_annotations_cache/cicCache.ml
+++ b/helm/ocaml/cic_annotations_cache/cicCache.ml
@@ -39,7 +39,13 @@ let get_annobj uri =
  let module G = Getter in
  let module U = UriManager in
   let cicfilename = G.getxml (U.cicuri_of_uri uri) in
-   let annobj = CicParser.annobj_of_xml cicfilename uri in
+  let cicbodyfilename =
+   match U.bodyuri_of_uri uri with
+      None -> None
+    | Some bodyuri ->
+       Some (G.getxml (U.cicuri_of_uri bodyuri))
+  in
+   let annobj = CicParser.annobj_of_xml cicfilename cicbodyfilename in
     annobj,
      if U.uri_is_annuri uri then
       begin
diff --git a/helm/ocaml/cic_cache/cicCache.ml b/helm/ocaml/cic_cache/cicCache.ml
index adfeb0575..1080c39e7 100644
--- a/helm/ocaml/cic_cache/cicCache.ml
+++ b/helm/ocaml/cic_cache/cicCache.ml
@@ -39,12 +39,22 @@ let get_annobj uri =
  let module G = Getter in
  let module U = UriManager in
   let cicfilename = G.getxml (U.cicuri_of_uri uri) in
-   CicParser.annobj_of_xml cicfilename uri
+   match (U.bodyuri_of_uri uri) with
+      None ->
+        CicParser.annobj_of_xml cicfilename None
+    | Some bodyuri ->
+       let cicbodyfilename = G.getxml (U.cicuri_of_uri bodyuri) in
+        CicParser.annobj_of_xml cicfilename (Some cicbodyfilename)
 ;;
 
 let get_obj uri =
  let module G = Getter in
  let module U = UriManager in
   let cicfilename = G.getxml (U.cicuri_of_uri uri) in
-   CicParser.obj_of_xml cicfilename uri
+   match (U.bodyuri_of_uri uri) with
+      None ->
+        CicParser.obj_of_xml cicfilename None
+    | Some bodyuri ->
+       let cicbodyfilename = G.getxml (U.cicuri_of_uri bodyuri) in
+        CicParser.obj_of_xml cicfilename (Some cicbodyfilename)
 ;;
diff --git a/helm/ocaml/cic_proof_checking/.cvsignore b/helm/ocaml/cic_proof_checking/.cvsignore
index 1e0e8c7f0..333bd154e 100644
--- a/helm/ocaml/cic_proof_checking/.cvsignore
+++ b/helm/ocaml/cic_proof_checking/.cvsignore
@@ -1,2 +1,4 @@
 *.cm[iaox] *.cmxa
 cicReduction.ml
+.dep.dot
+cic_proof_checking.ps
diff --git a/helm/ocaml/cic_proof_checking/.depend b/helm/ocaml/cic_proof_checking/.depend
index 04373b39e..c1319a692 100644
--- a/helm/ocaml/cic_proof_checking/.depend
+++ b/helm/ocaml/cic_proof_checking/.depend
@@ -1,13 +1,17 @@
-cicSubstitution.cmo: cicSubstitution.cmi 
-cicSubstitution.cmx: cicSubstitution.cmi 
 logger.cmo: logger.cmi 
 logger.cmx: logger.cmi 
-cicEnvironment.cmo: cicSubstitution.cmi cicEnvironment.cmi 
-cicEnvironment.cmx: cicSubstitution.cmx cicEnvironment.cmi 
+cicEnvironment.cmo: logger.cmi cicEnvironment.cmi 
+cicEnvironment.cmx: logger.cmx cicEnvironment.cmi 
 cicPp.cmo: cicEnvironment.cmi cicPp.cmi 
 cicPp.cmx: cicEnvironment.cmx cicPp.cmi 
+cicSubstitution.cmo: cicEnvironment.cmi cicSubstitution.cmi 
+cicSubstitution.cmx: cicEnvironment.cmx cicSubstitution.cmi 
 cicMiniReduction.cmo: cicSubstitution.cmi cicMiniReduction.cmi 
 cicMiniReduction.cmx: cicSubstitution.cmx cicMiniReduction.cmi 
+cicReductionNaif.cmo: cicEnvironment.cmi cicPp.cmi cicSubstitution.cmi \
+    cicReductionNaif.cmi 
+cicReductionNaif.cmx: cicEnvironment.cmx cicPp.cmx cicSubstitution.cmx \
+    cicReductionNaif.cmi 
 cicReduction.cmo: cicEnvironment.cmi cicPp.cmi cicSubstitution.cmi \
     cicReduction.cmi 
 cicReduction.cmx: cicEnvironment.cmx cicPp.cmx cicSubstitution.cmx \
@@ -16,5 +20,3 @@ cicTypeChecker.cmo: cicEnvironment.cmi cicPp.cmi cicReduction.cmi \
     cicSubstitution.cmi logger.cmi cicTypeChecker.cmi 
 cicTypeChecker.cmx: cicEnvironment.cmx cicPp.cmx cicReduction.cmx \
     cicSubstitution.cmx logger.cmx cicTypeChecker.cmi 
-cicCooking.cmo: cicEnvironment.cmi cicCooking.cmi 
-cicCooking.cmx: cicEnvironment.cmx cicCooking.cmi 
diff --git a/helm/ocaml/cic_proof_checking/Makefile b/helm/ocaml/cic_proof_checking/Makefile
index b4e5b8ae6..0259effd1 100644
--- a/helm/ocaml/cic_proof_checking/Makefile
+++ b/helm/ocaml/cic_proof_checking/Makefile
@@ -2,9 +2,11 @@ PACKAGE = cic_proof_checking
 REQUIRES = helm-cic
 PREDICATES =
 
-INTERFACE_FILES = cicSubstitution.mli logger.mli cicEnvironment.mli cicPp.mli \
-                  cicMiniReduction.mli cicReduction.mli cicTypeChecker.mli \
-                  cicCooking.mli
+REDUCTION_IMPLEMENTATION = cicReductionMachine.ml
+
+INTERFACE_FILES = logger.mli cicEnvironment.mli cicPp.mli cicSubstitution.mli \
+                  cicMiniReduction.mli cicReductionNaif.mli cicReduction.mli \
+                  cicTypeChecker.mli
 IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml)
 
 # Metadata tools only need zeta-reduction
@@ -13,5 +15,13 @@ EXTRA_OBJECTS_TO_INSTALL = \
             cicMiniReduction.cmo cicMiniReduction.cmx cicMiniReduction.o
 EXTRA_OBJECTS_TO_CLEAN =
 
-
 include ../Makefile.common
+
+cicReduction.ml: $(REDUCTION_IMPLEMENTATION)
+	if ! [ -f $@ ]; then \
+		echo "Using $< for $@";	\
+		ln -s $< $@;	\
+	else	\
+		true;	\
+	fi
+
diff --git a/helm/ocaml/cic_proof_checking/cicCooking.ml b/helm/ocaml/cic_proof_checking/cicCooking.ml
deleted file mode 100644
index 2c5d0b439..000000000
--- a/helm/ocaml/cic_proof_checking/cicCooking.ml
+++ /dev/null
@@ -1,235 +0,0 @@
-(* Copyright (C) 2000, HELM Team.
- * 
- * This file is part of HELM, an Hypertextual, Electronic
- * Library of Mathematics, developed at the Computer Science
- * Department, University of Bologna, Italy.
- * 
- * HELM is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- * 
- * HELM is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with HELM; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- * MA  02111-1307, USA.
- * 
- * For details, see the HELM World-Wide-Web page,
- * http://cs.unibo.it/helm/.
- *)
-
-exception Impossible;;
-exception NotImplemented of int * string;;
-exception WrongUriToConstant;;
-exception WrongUriToVariable of string;;
-exception WrongUriToInductiveDefinition;;
-
-(* mem x lol is true if x is a member of one    *)
-(* of the lists of the list of (int * list) lol *)
-let mem x lol =
- List.fold_right (fun (_,l) i -> i || List.mem x l) lol false
-;;
-
-(* cook var term *)
-let cook curi cookingsno var is_letin =
- let rec aux k =
-  let module C = Cic in
-   function
-      C.Rel n as t ->
-       (match n with
-           n when n >= k -> C.Rel (n + 1)
-         | _ -> C.Rel n
-       )
-    | C.Var uri as t ->
-       if UriManager.eq uri var then
-        C.Rel k
-       else
-        t
-    | C.Meta _ as t -> t
-    | C.Sort _ as t -> t
-    | C.Implicit as t -> t
-    | C.Cast (te, ty) -> C.Cast (aux k te, aux k ty)
-    | C.Prod (n,s,t) -> C.Prod (n, aux k s, aux (k + 1) t)
-    | C.Lambda (n,s,t) -> C.Lambda (n, aux k s, aux (k + 1) t)
-    | C.LetIn (n,s,t) -> C.LetIn (n, aux k s, aux (k + 1) t)
-    | C.Appl (he::tl) ->
-       (* Get rid of C.Appl (C.Appl l1) l2 *)
-       let newtl = List.map (aux k) tl in
-        (match aux k he with
-            C.Appl (he'::tl') -> C.Appl (he'::(tl'@newtl))
-          | t -> C.Appl (t::newtl)
-        )
-    | C.Appl [] -> raise Impossible
-    | C.Const (uri,_) ->
-       if not is_letin && match CicEnvironment.get_obj uri with
-           C.Definition (_,_,_,params) when mem var params -> true
-         | C.Definition _ -> false
-         | C.Axiom (_,_,params) when mem var params -> true
-         | C.Axiom _ -> false
-         | C.CurrentProof _ ->
-            raise (NotImplemented (2,(UriManager.string_of_uri uri)))
-         | _ -> raise WrongUriToConstant
-       then
-        C.Appl
-         ((C.Const (uri,UriManager.relative_depth curi uri cookingsno))::
-          [C.Rel k])
-       else
-        C.Const (uri,UriManager.relative_depth curi uri cookingsno)
-    | C.MutInd (uri,_,i) ->
-       if not is_letin && match CicEnvironment.get_obj uri with
-           C.InductiveDefinition (_,params,_) when mem var params -> true
-         | C.InductiveDefinition _ -> false
-         | _ -> raise WrongUriToInductiveDefinition
-       then
-        C.Appl ((C.MutInd (uri,UriManager.relative_depth curi uri cookingsno,i))::[C.Rel k])
-       else
-        C.MutInd (uri,UriManager.relative_depth curi uri cookingsno,i)
-    | C.MutConstruct (uri,_,i,j) ->
-       if not is_letin && match CicEnvironment.get_obj uri with
-           C.InductiveDefinition (_,params,_) when mem var params -> true
-         | C.InductiveDefinition _ -> false
-         | _ -> raise WrongUriToInductiveDefinition
-       then
-        C.Appl ((C.MutConstruct (uri,UriManager.relative_depth curi uri cookingsno,i,j))::[C.Rel k])
-       else
-        C.MutConstruct (uri,UriManager.relative_depth curi uri cookingsno,i,j)
-    | C.MutCase (uri,_,i,outt,term,pl) ->
-       let substitutedfl =
-        List.map (aux k) pl
-       in
-        C.MutCase (uri,UriManager.relative_depth curi uri cookingsno,i,
-         aux k outt,aux k term, substitutedfl)
-    | C.Fix (i,fl) ->
-       let len = List.length fl in
-       let substitutedfl =
-         List.map
-          (fun (name,i,ty,bo) -> (name,i,aux k ty, aux (k+len) bo))
-          fl
-       in
-        C.Fix (i, substitutedfl)
-    | C.CoFix (i,fl) ->
-       let len = List.length fl in
-       let substitutedfl =
-         List.map
-          (fun (name,ty,bo) -> (name,aux k ty, aux (k+len) bo))
-          fl
-       in
-        C.CoFix (i, substitutedfl)
- in
-  aux 1 
-;;
-
-let cook_gen add_binder curi cookingsno ty vars =
- let module C = Cic in
- let module U = UriManager in
-  let rec cookrec ty =
-   function
-     var::tl ->
-      let (varname, varbody, vartype) =
-       match CicEnvironment.get_obj var with
-          C.Variable (varname, varbody, vartype) -> (varname, varbody, vartype)
-        | _ -> raise (WrongUriToVariable (U.string_of_uri var))
-      in
-       let cooked_once =
-        add_binder (C.Name varname) varbody vartype
-         (match varbody with
-             Some _ -> cook curi cookingsno var true ty
-           | None -> cook curi cookingsno var false ty
-         )
-       in
-        cookrec cooked_once tl
-   | _ -> ty
-  in
-   cookrec ty vars
-;;
-
-let cook_prod =
- cook_gen (fun n b s t ->
-  match b with
-     None   -> Cic.Prod (n,s,t)
-   | Some b -> Cic.LetIn (n,b,t)
- )
-and cook_lambda =
- cook_gen (fun n b s t ->
-  match b with
-     None   -> Cic.Lambda (n,s,t)
-   | Some b -> Cic.LetIn (n,b,t)
- )
-;;
-
-(*CSC: sbagliato da rifare e completare *)
-let cook_one_level obj curi cookingsno vars =
- let module C = Cic in
-  match obj with
-     C.Definition (id,te,ty,params) ->
-      let ty' = cook_prod curi cookingsno ty vars in
-      let te' = cook_lambda curi cookingsno te vars in
-       C.Definition (id,te',ty',params)
-   | C.Axiom (id,ty,parameters) ->
-      let ty' = cook_prod curi cookingsno ty vars in
-       C.Axiom (id,ty',parameters)
-   | C.Variable _ as obj -> obj
-   | C.CurrentProof (id,conjs,te,ty) ->
-      let ty' = cook_prod curi cookingsno ty vars in
-      let te' = cook_lambda curi cookingsno te vars in
-       C.CurrentProof (id,conjs,te',ty')
-   | C.InductiveDefinition (dl, params, n_ind_params) ->
-      let dl' =
-       List.map
-        (fun (name,inductive,arity,constructors) ->
-          let constructors' =
-          List.map
-           (fun (name,ty,r) ->
-             let r' = 
-              match !r with
-                 None -> raise Impossible
-               | Some r -> List.map (fun _ -> false) vars @ r
-             in
-             (name,cook_prod curi cookingsno ty vars,ref (Some r')) 
-           ) constructors
-          in
-           (name,inductive,cook_prod curi cookingsno arity vars,constructors')
-        ) dl
-      in
-       let number_of_variables_without_a_body =
-        let is_not_letin uri =
-         match CicEnvironment.get_obj uri with
-            C.Variable (_,None,_) -> true
-          | C.Variable (_,Some _,_) -> false
-          | _ -> raise (WrongUriToVariable (UriManager.string_of_uri uri))
-        in
-         List.fold_left
-          (fun i uri -> if is_not_letin uri then i + 1 else i) 0 vars
-       in
-        C.InductiveDefinition
-         (dl', params, n_ind_params + number_of_variables_without_a_body)
-;; 
-
-let cook_obj obj uri =
- let module C = Cic in
-  let params =
-   match obj with
-      C.Definition (_,_,_,params) -> params
-    | C.Axiom (_,_,params) -> params
-    | C.Variable _ -> []
-    | C.CurrentProof _ -> []
-    | C.InductiveDefinition (_,params,_) -> params
-  in
-   let rec cook_all_levels obj =
-    function
-       [] -> []
-     | (n,vars)::tl ->
-        let cooked_obj = cook_one_level obj uri (n + 1) (List.rev vars) in
-         (n,cooked_obj)::(cook_all_levels cooked_obj tl)
-   in
-    cook_all_levels obj (List.rev params)
-;;
-
-let init () =
-   CicEnvironment.set_cooking_function cook_obj
-;;
diff --git a/helm/ocaml/cic_proof_checking/cicEnvironment.ml b/helm/ocaml/cic_proof_checking/cicEnvironment.ml
index 9d93c443e..823aa3a40 100644
--- a/helm/ocaml/cic_proof_checking/cicEnvironment.ml
+++ b/helm/ocaml/cic_proof_checking/cicEnvironment.ml
@@ -35,18 +35,15 @@
 (*                                                                            *)
 (******************************************************************************)
 
+let cleanup_tmp = true;;
+
+let trust_obj = function uri -> true;;
+
 type type_checked_obj =
    CheckedObj of Cic.obj     (* cooked obj *)
  | UncheckedObj of Cic.obj   (* uncooked obj to proof-check *)
 ;;
 
-exception NoFunctionProvided;;
-
-let cook_obj = ref (fun obj uri -> raise NoFunctionProvided);;
-
-let set_cooking_function foo =
- cook_obj := foo
-;;
 
 exception AlreadyCooked of string;;
 exception CircularDependency of string;;
@@ -62,22 +59,17 @@ module Cache :
     UriManager.uri -> get_object_to_add:(unit -> Cic.obj) -> Cic.obj
    val unchecked_to_frozen : UriManager.uri -> unit
    val frozen_to_cooked :
-    uri:UriManager.uri ->
-    cooking_procedure:
-     (object_to_cook:Cic.obj ->
-      add_cooked:(UriManager.uri * int-> Cic.obj -> unit)
-      -> unit
-     )
-    -> unit
-   val find_cooked : key:(UriManager.uri * int) -> Cic.obj
+    uri:UriManager.uri -> unit
+   val find_cooked : key:UriManager.uri -> Cic.obj
+   val add_cooked : key:UriManager.uri -> Cic.obj -> unit
   end 
 =
   struct
    module CacheOfCookedObjects :
     sig
-     val mem  : UriManager.uri -> int -> bool
-     val find : UriManager.uri -> int -> Cic.obj
-     val add  : UriManager.uri -> int -> Cic.obj -> unit
+     val mem  : UriManager.uri -> bool
+     val find : UriManager.uri -> Cic.obj
+     val add  : UriManager.uri -> Cic.obj -> unit
     end
    =
     struct
@@ -90,29 +82,16 @@ module Cache :
      ;;
      module HT = Hashtbl.Make(HashedType);;
      let hashtable = HT.create 1009;;
-     let mem uri cookingsno =
+     let mem uri =
       try
-       let cooked_list =
-        HT.find hashtable uri
-       in
-        List.mem_assq cookingsno !cooked_list
+       HT.mem hashtable uri
       with
        Not_found -> false
      ;;
-     let find uri cookingsno =
-      List.assq cookingsno !(HT.find hashtable uri)
+     let find uri = HT.find hashtable uri
      ;;
-     let add uri cookingsno obj =
-      let cooked_list =
-       try
-        HT.find hashtable uri
-       with
-        Not_found ->
-         let newl = ref [] in
-          HT.add hashtable uri newl ;
-          newl
-      in
-       cooked_list := (cookingsno,obj)::!cooked_list
+     let add uri obj =
+      HT.add hashtable uri obj
      ;;
     end
    ;;
@@ -127,7 +106,7 @@ module Cache :
       if List.mem_assq uri !frozen_list then
        raise (CircularDependency (UriManager.string_of_uri uri))
       else
-       if CacheOfCookedObjects.mem uri 0 then
+       if CacheOfCookedObjects.mem uri then
         raise (AlreadyCooked (UriManager.string_of_uri uri))
        else
         (* OK, it is not already frozen nor cooked *)
@@ -143,48 +122,55 @@ module Cache :
     with
      Not_found -> raise (CouldNotFreeze (UriManager.string_of_uri uri))
    ;;
-   let frozen_to_cooked ~uri ~cooking_procedure =
+   let frozen_to_cooked ~uri =
     try
      let obj = List.assq uri !frozen_list in
       frozen_list := List.remove_assq uri !frozen_list ;
-      cooking_procedure
-       ~object_to_cook:obj
-       ~add_cooked:(fun (uri,cookno) -> CacheOfCookedObjects.add uri cookno)
+       CacheOfCookedObjects.add uri obj
     with
      Not_found -> raise (CouldNotUnfreeze (UriManager.string_of_uri uri))
    ;;
-   let find_cooked ~key:(uri,cookingsno)= CacheOfCookedObjects.find uri cookingsno;;
+   let find_cooked ~key:uri = CacheOfCookedObjects.find uri;;
+   let add_cooked ~key:uri obj = CacheOfCookedObjects.add uri obj;;
   end
 ;;
 
-(* get_cooked_obj uri                                                               *)
-(* returns the cooked cic object whose uri is uri. The term must be present  *)
-(* and cooked in cache                                                       *)
-let get_cooked_obj uri cookingsno =
- Cache.find_cooked (uri,cookingsno)
-;;
-
 let find_or_add_unchecked_to_cache uri =
  Cache.find_or_add_unchecked uri
   ~get_object_to_add:
    (function () ->
      let filename = Getter.getxml uri in
-      let obj = CicParser.obj_of_xml filename uri in
+     let bodyfilename =
+      match UriManager.bodyuri_of_uri uri with
+         None -> None
+       | Some bodyuri ->
+          try
+           ignore (Getter.resolve bodyuri) ;
+           (* The body exists ==> it is not an axiom *)
+           Some (Getter.getxml bodyuri)
+          with
+           Getter.Unresolved ->
+            (* The body does not exist ==> we consider it an axiom *)
+            None
+     in
+      let obj = CicParser.obj_of_xml filename bodyfilename in
+       if cleanup_tmp then
+        begin
+         Unix.unlink filename ;
+         match bodyfilename with
+            Some f -> Unix.unlink f
+          | None -> ()
+        end ;
        obj
    )
 ;;
 
-(* get_obj uri                                                                *)
-(* returns the cic object whose uri is uri. If the term is not just in cache, *)
-(* then it is parsed via CicParser.term_of_xml from the file whose name is    *)
-(* the result of Getter.getxml uri                                            *)
-let get_obj uri =
- try
-  get_cooked_obj uri 0
- with
-  Not_found ->
-   find_or_add_unchecked_to_cache uri
-;; 
+(* set_type_checking_info uri                               *)
+(* must be called once the type-checking of uri is finished *)
+(* The object whose uri is uri is unfreezed                 *)
+let set_type_checking_info uri =
+ Cache.frozen_to_cooked uri
+;;
 
 (* is_type_checked uri                                                *)
 (* CSC: commento falso ed obsoleto *)
@@ -192,39 +178,60 @@ let get_obj uri =
 (* otherwise it freezes the term for type-checking and returns
  it *)
 (* set_type_checking_info must be called to unfreeze the term         *)
-let is_type_checked uri cookingsno =
+let is_type_checked ?(trust=true) uri =
  try
-  CheckedObj (Cache.find_cooked (uri,cookingsno))
+  CheckedObj (Cache.find_cooked uri)
  with
   Not_found ->
    let obj = find_or_add_unchecked_to_cache uri in
     Cache.unchecked_to_frozen uri ;
-    UncheckedObj obj
+    if trust && trust_obj uri then
+     begin
+      Logger.log (`Trusting uri) ;
+      set_type_checking_info uri ;
+      CheckedObj (Cache.find_cooked uri)
+     end
+    else
+     UncheckedObj obj
 ;;
 
-(* set_type_checking_info uri                               *)
-(* must be called once the type-checking of uri is finished *)
-(* The object whose uri is uri is unfreezed                 *)
-let set_type_checking_info uri =
- Cache.frozen_to_cooked uri
-  (fun ~object_to_cook:obj ~add_cooked ->
-    (* let's cook the object at every level *)
-    let obj' = CicSubstitution.undebrujin_inductive_def uri obj in
-     add_cooked (uri,0) obj' ;
-     let cooked_objs = !cook_obj obj' uri in
-      let last_cooked_level = ref 0 in
-      let last_cooked_obj = ref obj' in
-       List.iter
-        (fun (n,cobj) ->
-          for i = !last_cooked_level + 1 to n do
-           add_cooked (uri,i) !last_cooked_obj
-          done ;
-          add_cooked (uri,n + 1) cobj ;
-          last_cooked_level := n + 1 ;
-          last_cooked_obj := cobj
-        ) cooked_objs ;
-       for i = !last_cooked_level + 1 to UriManager.depth_of_uri uri + 1 do
-        add_cooked (uri,i) !last_cooked_obj
-       done
-  )
+(* get_cooked_obj ~trust uri *)
+(* returns the object if it is already type-checked or if it can be *)
+(* trusted (if [trust] = true and the trusting function accepts it) *)
+(* Otherwise it raises Not_found                                    *)
+let get_cooked_obj ?(trust=true) uri =
+ try
+  Cache.find_cooked uri
+ with Not_found ->
+  if trust && trust_obj uri then
+   begin
+    match is_type_checked uri with
+       CheckedObj obj -> obj
+     | _ -> assert false
+   end
+  else
+   begin
+    prerr_endline ("@@@ OOOOOOOPS: get_cooked_obj(" ^ UriManager.string_of_uri uri ^ ") raises Not_found since the object is not type-checked nor trusted.") ;
+    raise Not_found
+   end
+;;
+
+(* get_obj uri                                                                *)
+(* returns the cic object whose uri is uri. If the term is not just in cache, *)
+(* then it is parsed via CicParser.term_of_xml from the file whose name is    *)
+(* the result of Getter.getxml uri                                            *)
+let get_obj uri =
+ try
+  get_cooked_obj uri
+ with
+  Not_found ->
+   find_or_add_unchecked_to_cache uri
+;; 
+
+exception OnlyPutOfInductiveDefinitionsIsAllowed
+
+let put_inductive_definition uri obj =
+ match obj with
+    Cic.InductiveDefinition _ -> Cache.add_cooked uri obj
+  | _ -> raise OnlyPutOfInductiveDefinitionsIsAllowed
 ;;
diff --git a/helm/ocaml/cic_proof_checking/cicEnvironment.mli b/helm/ocaml/cic_proof_checking/cicEnvironment.mli
index 22fd5d657..e93db9582 100644
--- a/helm/ocaml/cic_proof_checking/cicEnvironment.mli
+++ b/helm/ocaml/cic_proof_checking/cicEnvironment.mli
@@ -53,7 +53,7 @@ type type_checked_obj =
 (* otherwise it returns (false,object) and freeze the object for    *)
 (* type-checking                                                    *)
 (* set_type_checking_info must be called to unfreeze the object     *)
-val is_type_checked : UriManager.uri -> int -> type_checked_obj
+val is_type_checked : ?trust:bool -> UriManager.uri -> type_checked_obj
 
 (* set_type_checking_info uri                                         *)
 (* must be called once the type-checking of uri is finished           *)
@@ -61,9 +61,19 @@ val is_type_checked : UriManager.uri -> int -> type_checked_obj
 (* again in the future (is_type_checked will return true)             *)
 val set_type_checking_info : UriManager.uri -> unit
 
-(* get_cooked_obj uri cookingsno *)
-val get_cooked_obj : UriManager.uri -> int -> Cic.obj
+(* get_cooked_obj ~trust uri                                        *)
+(* returns the object if it is already type-checked or if it can be *)
+(* trusted (if [trust] = true and the trusting function accepts it) *)
+(* Otherwise it raises Not_found                                    *)
+val get_cooked_obj : ?trust:bool -> UriManager.uri -> Cic.obj
 
-(* set_cooking_function cooking_function *)
-val set_cooking_function :
- (Cic.obj -> UriManager.uri -> (int * Cic.obj) list) -> unit
+(* FUNCTIONS USED ONLY IN THE TOPLEVEL/PROOF-ENGINE *)
+
+exception OnlyPutOfInductiveDefinitionsIsAllowed
+
+(* put_inductive_definition uri obj                                      *)
+(* put [obj] (that must be an InductiveDefinition and show URI is [uri]) *)
+(* in the environment.                                                   *)
+(* WARNING: VERY UNSAFE.                                                 *)
+(* This function should be called only on a well-typed definition.       *)
+val put_inductive_definition : UriManager.uri -> Cic.obj -> unit
diff --git a/helm/ocaml/cic_proof_checking/cicMiniReduction.ml b/helm/ocaml/cic_proof_checking/cicMiniReduction.ml
index bdc6e3a09..1f6b72636 100644
--- a/helm/ocaml/cic_proof_checking/cicMiniReduction.ml
+++ b/helm/ocaml/cic_proof_checking/cicMiniReduction.ml
@@ -27,7 +27,11 @@ let rec letin_nf =
  let module C = Cic in
   function
      C.Rel _ as t -> t
-   | C.Var _ as t  -> t
+   | C.Var (uri,exp_named_subst) ->
+      let exp_named_subst' =
+       List.map (function (uri,t) -> (uri,letin_nf t)) exp_named_subst
+      in
+       C.Var (uri,exp_named_subst')
    | C.Meta _ as t -> t
    | C.Sort _ as t -> t
    | C.Implicit as t -> t
@@ -36,12 +40,23 @@ let rec letin_nf =
    | C.Lambda (n,s,t) -> C.Lambda (n, letin_nf s, letin_nf t)
    | C.LetIn (n,s,t) -> CicSubstitution.subst (letin_nf s) t
    | C.Appl l -> C.Appl (List.map letin_nf l)
-   | C.Const _ as t -> t
-   | C.MutInd _ as t -> t
-   | C.MutConstruct _ as t -> t
-   | C.MutCase (sp,cookingsno,i,outt,t,pl) ->
-      C.MutCase (sp,cookingsno,i,letin_nf outt, letin_nf t,
-       List.map letin_nf pl)
+   | C.Const (uri,exp_named_subst) ->
+      let exp_named_subst' =
+       List.map (function (uri,t) -> (uri,letin_nf t)) exp_named_subst
+      in
+       C.Const (uri,exp_named_subst')
+   | C.MutInd (uri,typeno,exp_named_subst) ->
+      let exp_named_subst' =
+       List.map (function (uri,t) -> (uri,letin_nf t)) exp_named_subst
+      in
+       C.MutInd (uri,typeno,exp_named_subst')
+   | C.MutConstruct (uri,typeno,consno,exp_named_subst) ->
+      let exp_named_subst' =
+       List.map (function (uri,t) -> (uri,letin_nf t)) exp_named_subst
+      in
+       C.MutConstruct (uri,typeno,consno,exp_named_subst')
+   | C.MutCase (sp,i,outt,t,pl) ->
+      C.MutCase (sp,i,letin_nf outt, letin_nf t, List.map letin_nf pl)
    | C.Fix (i,fl) ->
       let substitutedfl =
        List.map
diff --git a/helm/ocaml/cic_proof_checking/cicPp.ml b/helm/ocaml/cic_proof_checking/cicPp.ml
index fce4e7f48..d3f7f0f60 100644
--- a/helm/ocaml/cic_proof_checking/cicPp.ml
+++ b/helm/ocaml/cic_proof_checking/cicPp.ml
@@ -44,7 +44,7 @@ exception NotEnoughElements;;
 let string_of_name =
  function
     Cic.Name s     -> s
-  | Cic.Anonimous  -> "_"
+  | Cic.Anonymous  -> "_"
 ;;
 
 (* get_nth l n   returns the nth element of the list l if it exists or *)
@@ -68,12 +68,14 @@ let rec pp t l =
         try
          (match get_nth l n with
              Some (C.Name s) -> s
-           | _        -> raise CicPpInternalError
+           | Some C.Anonymous -> "__" ^ string_of_int n
+           | _ -> raise CicPpInternalError
          )
         with
          NotEnoughElements -> string_of_int (List.length l - n)
        end
-    | C.Var uri -> UriManager.name_of_uri uri
+    | C.Var (uri,exp_named_subst) ->
+       UriManager.string_of_uri (*UriManager.name_of_uri*) uri ^ pp_exp_named_subst exp_named_subst l
     | C.Meta (n,l1) ->
        "?" ^ (string_of_int n) ^ "[" ^ 
         String.concat " ; "
@@ -89,7 +91,7 @@ let rec pp t l =
     | C.Prod (b,s,t) ->
        (match b with
           C.Name n -> "(" ^ n ^ ":" ^ pp s l ^ ")" ^ pp t ((Some b)::l)
-        | C.Anonimous -> "(" ^ pp s l ^ "->" ^ pp t ((Some b)::l) ^ ")"
+        | C.Anonymous -> "(" ^ pp s l ^ "->" ^ pp t ((Some b)::l) ^ ")"
        )
     | C.Cast (v,t) -> pp v l
     | C.Lambda (b,s,t) ->
@@ -102,41 +104,37 @@ let rec pp t l =
         (fun x i -> pp x l ^ (match i with "" -> "" | _ -> " ") ^ i)
         li ""
        ) ^ ")"
-    | C.Const (uri,_) -> UriManager.name_of_uri uri
-    | C.MutInd (uri,_,n) ->
-       begin
-        try
-         (match CicEnvironment.get_obj uri with
-             C.InductiveDefinition (dl,_,_) ->
-              let (name,_,_,_) = get_nth dl (n+1) in
-               name
-           | _ -> raise CicPpInternalError
-         )
+    | C.Const (uri,exp_named_subst) ->
+       UriManager.name_of_uri uri ^ pp_exp_named_subst exp_named_subst l
+    | C.MutInd (uri,n,exp_named_subst) ->
+       (try
+         match CicEnvironment.get_obj uri with
+            C.InductiveDefinition (dl,_,_) ->
+             let (name,_,_,_) = get_nth dl (n+1) in
+              name ^ pp_exp_named_subst exp_named_subst l
+          | _ -> raise CicPpInternalError
         with
-         NotEnoughElements ->
-          UriManager.string_of_uri uri ^ "#1/" ^ string_of_int (n + 1)
-       end
-    | C.MutConstruct (uri,_,n1,n2) ->
-       begin
-        try
-         (match CicEnvironment.get_obj uri with
-             C.InductiveDefinition (dl,_,_) ->
-              let (_,_,_,cons) = get_nth dl (n1+1) in
-               let (id,_,_) = get_nth cons n2 in
-                id
-           | _ -> raise CicPpInternalError
-         )
+         _ -> UriManager.string_of_uri uri ^ "#1/" ^ string_of_int (n + 1)
+       )
+    | C.MutConstruct (uri,n1,n2,exp_named_subst) ->
+       (try
+         match CicEnvironment.get_obj uri with
+            C.InductiveDefinition (dl,_,_) ->
+             let (_,_,_,cons) = get_nth dl (n1+1) in
+              let (id,_) = get_nth cons n2 in
+               id ^ pp_exp_named_subst exp_named_subst l
+          | _ -> raise CicPpInternalError
         with
-         NotEnoughElements ->
+         _ ->
           UriManager.string_of_uri uri ^ "#1/" ^ string_of_int (n1 + 1) ^ "/" ^
            string_of_int n2
-       end
-    | C.MutCase (uri,_,n1,ty,te,patterns) ->
+       )
+    | C.MutCase (uri,n1,ty,te,patterns) ->
        let connames =
         (match CicEnvironment.get_obj uri with
             C.InductiveDefinition (dl,_,_) ->
              let (_,_,_,cons) = get_nth dl (n1+1) in
-              List.map (fun (id,_,_) -> id) cons
+              List.map (fun (id,_) -> id) cons
           | _ -> raise CicPpInternalError
         )
        in
@@ -168,24 +166,28 @@ let rec pp t l =
             pp bo (names@l) ^ i)
           funs "" ^
          "}\n"
+and pp_exp_named_subst exp_named_subst l =
+ if exp_named_subst = [] then "" else
+  "{" ^
+   String.concat " ; " (
+    List.map
+     (function (uri,t) -> UriManager.name_of_uri uri ^ ":=" ^ pp t l)
+     exp_named_subst
+   ) ^ "}"
 ;;
 
 let ppterm t =
  pp t []
 ;;
 
-(* ppinductiveType (typename, inductive, arity, cons) names                 *)
-(* pretty-prints a single inductive definition (typename, inductive, arity, *)
-(*  cons) where the cic terms in the inductive definition need to be        *)
-(*  evaluated in the environment names that is the list of typenames of the *)
-(*  mutual inductive definitions defined in the block of mutual inductive   *)
-(*  definitions to which this one belongs to                                *)
-let ppinductiveType (typename, inductive, arity, cons) names =
+(* ppinductiveType (typename, inductive, arity, cons)                       *)
+(* pretty-prints a single inductive definition                              *)
+(* (typename, inductive, arity, cons)                                       *)
+let ppinductiveType (typename, inductive, arity, cons) =
   (if inductive then "\nInductive " else "\nCoInductive ") ^ typename ^ ": " ^
-  (*CSC: bug found: was pp arity names ^ " =\n   " ^*)
   pp arity [] ^ " =\n   " ^
   List.fold_right
-   (fun (id,ty,_) i -> id ^ " : " ^ pp ty names ^ 
+   (fun (id,ty) i -> id ^ " : " ^ pp ty [] ^ 
     (if i = "" then "\n" else "\n | ") ^ i)
    cons ""
 ;;
@@ -196,32 +198,24 @@ let ppobj obj =
  let module C = Cic in
  let module U = UriManager in
   match obj with
-    C.Definition (id, t1, t2, params) ->
-      "Definition of " ^ id ^
-      "(" ^
-      List.fold_right
-       (fun (_,x) i ->
-         List.fold_right
-          (fun x i ->
-            U.string_of_uri x ^ match i with "" -> "" | i' -> " " ^ i'
-          ) x "" ^ match i with "" -> "" | i' -> " " ^ i'
-       ) params "" ^ ")" ^
-      ":\n" ^ pp t1 [] ^ " : " ^ pp t2 []
-   | C.Axiom (id, ty, params) ->
-      "Axiom " ^ id ^ "(" ^
-      List.fold_right
-       (fun (_,x) i ->
-         List.fold_right
-          (fun x i ->
-            U.string_of_uri x ^ match i with "" -> "" | i' -> " " ^ i'
-          ) x "" ^ match i with "" -> "" | i' -> " " ^ i'
-       ) params "" ^
-      "):\n" ^ pp ty []
-   | C.Variable (name, bo, ty) ->
-      "Variable " ^ name ^ ":\n" ^ pp ty [] ^ "\n" ^
-      (match bo with None -> "" | Some bo -> ":= " ^ pp bo [])
-   | C.CurrentProof (name, conjectures, value, ty) ->
-      "Current Proof:\n" ^
+    C.Constant (name, Some t1, t2, params) ->
+      "Definition of " ^ name ^
+       "(" ^ String.concat ";" (List.map UriManager.string_of_uri params) ^
+       ")" ^ ":\n" ^ pp t1 [] ^ " : " ^ pp t2 []
+   | C.Constant (name, None, ty, params) ->
+      "Axiom " ^ name ^
+       "(" ^ String.concat ";" (List.map UriManager.string_of_uri params) ^
+       "):\n" ^ pp ty []
+   | C.Variable (name, bo, ty, params) ->
+      "Variable " ^ name ^
+       "(" ^ String.concat ";" (List.map UriManager.string_of_uri params) ^
+       ")" ^ ":\n" ^
+       pp ty [] ^ "\n" ^
+       (match bo with None -> "" | Some bo -> ":= " ^ pp bo [])
+   | C.CurrentProof (name, conjectures, value, ty, params) ->
+      "Current Proof of " ^ name ^
+       "(" ^ String.concat ";" (List.map UriManager.string_of_uri params) ^
+       ")" ^ ":\n" ^
       let separate s = if s = "" then "" else s ^ " ; " in
        List.fold_right
         (fun (n, context, t) i -> 
@@ -247,14 +241,7 @@ let ppobj obj =
         "\n" ^ pp value [] ^ " : " ^ pp ty [] 
    | C.InductiveDefinition (l, params, nparams) ->
       "Parameters = " ^
-      List.fold_right
-       (fun (_,x) i ->
-         List.fold_right
-          (fun x i ->
-            U.string_of_uri x ^ match i with "" -> "" | i' -> " " ^ i'
-          ) x "" ^ match i with "" -> "" | i' -> " " ^ i'
-       ) params "" ^ "\n" ^
-      "NParams = " ^ string_of_int nparams ^ "\n" ^
-      let names = List.rev (List.map (fun (n,_,_,_) -> Some (C.Name n)) l) in
-       List.fold_right (fun x i -> ppinductiveType x names ^ i) l ""
+       String.concat ";" (List.map UriManager.string_of_uri params) ^ "\n" ^
+       "NParams = " ^ string_of_int nparams ^ "\n" ^
+        List.fold_right (fun x i -> ppinductiveType x ^ i) l ""
 ;;
diff --git a/helm/ocaml/cic_proof_checking/cicReduction.mli b/helm/ocaml/cic_proof_checking/cicReduction.mli
index c4332a2ed..7a6255003 100644
--- a/helm/ocaml/cic_proof_checking/cicReduction.mli
+++ b/helm/ocaml/cic_proof_checking/cicReduction.mli
@@ -24,8 +24,7 @@
  *)
 
 exception WrongUriToInductiveDefinition
-exception ReferenceToDefinition
-exception ReferenceToAxiom
+exception ReferenceToConstant
 exception ReferenceToVariable
 exception ReferenceToCurrentProof
 exception ReferenceToInductiveDefinition
diff --git a/helm/ocaml/cic_proof_checking/cicReductionMachine.ml b/helm/ocaml/cic_proof_checking/cicReductionMachine.ml
index 93335625a..30b688264 100644
--- a/helm/ocaml/cic_proof_checking/cicReductionMachine.ml
+++ b/helm/ocaml/cic_proof_checking/cicReductionMachine.ml
@@ -25,13 +25,18 @@
 
 exception CicReductionInternalError;;
 exception WrongUriToInductiveDefinition;;
+exception Impossible of int;;
+exception ReferenceToConstant;;
+exception ReferenceToVariable;;
+exception ReferenceToCurrentProof;;
+exception ReferenceToInductiveDefinition;;
 
 let fdebug = ref 1;;
 let debug t env s =
  let rec debug_aux t i =
   let module C = Cic in
   let module U = UriManager in
-   CicPp.ppobj (C.Variable ("DEBUG", None, t)) ^ "\n" ^ i
+   CicPp.ppobj (C.Variable ("DEBUG", None, t, [])) ^ "\n" ^ i
  in
   if !fdebug = 0 then
    begin
@@ -40,269 +45,694 @@ let debug t env s =
    end
 ;;
 
-exception Impossible of int;;
-exception ReferenceToDefinition;;
-exception ReferenceToAxiom;;
-exception ReferenceToVariable;;
-exception ReferenceToCurrentProof;;
-exception ReferenceToInductiveDefinition;;
+module type Strategy =
+ sig
+  type stack_term
+  type env_term
+  type ens_term
+  val to_stack : Cic.term -> stack_term
+  val to_stack_list : Cic.term list -> stack_term list
+  val to_env : Cic.term -> env_term
+  val to_ens : Cic.term -> ens_term
+  val from_stack :
+   unwind:
+    (int -> env_term list -> ens_term Cic.explicit_named_substitution ->
+      Cic.term -> Cic.term) ->
+   stack_term -> Cic.term
+  val from_stack_list :
+   unwind:
+    (int -> env_term list -> ens_term Cic.explicit_named_substitution ->
+      Cic.term -> Cic.term) ->
+   stack_term list -> Cic.term list
+  val from_env : env_term -> Cic.term
+  val from_ens : ens_term -> Cic.term
+  val stack_to_env :
+   reduce:
+    (int * env_term list * ens_term Cic.explicit_named_substitution *
+      Cic.term * stack_term list -> Cic.term) ->
+   unwind:
+    (int -> env_term list -> ens_term Cic.explicit_named_substitution ->
+      Cic.term -> Cic.term) ->
+   stack_term -> env_term
+  val compute_to_env :
+   reduce:
+    (int * env_term list * ens_term Cic.explicit_named_substitution * Cic.term *
+      stack_term list -> Cic.term) ->
+   unwind:
+    (int -> env_term list -> ens_term Cic.explicit_named_substitution ->
+      Cic.term -> Cic.term) ->
+   int -> env_term list -> ens_term Cic.explicit_named_substitution ->
+    Cic.term -> env_term
+  val compute_to_stack :
+   reduce:
+    (int * env_term list * ens_term Cic.explicit_named_substitution * Cic.term *
+      stack_term list -> Cic.term) ->
+   unwind:
+    (int -> env_term list -> ens_term Cic.explicit_named_substitution ->
+      Cic.term -> Cic.term) ->
+   int -> env_term list -> ens_term Cic.explicit_named_substitution ->
+    Cic.term -> stack_term
+ end
+;;
 
-type env = Cic.term list;;
-type stack = Cic.term list;;
-type config = int * env * Cic.term * stack;;
+module CallByNameStrategy =
+ struct
+  type stack_term = Cic.term
+  type env_term = Cic.term
+  type ens_term = Cic.term
+  let to_stack v = v
+  let to_stack_list l = l
+  let to_env v = v
+  let to_ens v = v
+  let from_stack ~unwind v = v
+  let from_stack_list ~unwind l = l
+  let from_env v = v
+  let from_ens v = v
+  let stack_to_env ~reduce ~unwind v = v
+  let compute_to_stack ~reduce ~unwind k e ens t = unwind k e ens t
+  let compute_to_env ~reduce ~unwind k e ens t = unwind k e ens t
+ end
+;;
 
-(* k is the length of the environment e *)
-(* m is the current depth inside the term *)
-let unwind' m k e t = 
-    let module C = Cic in
-    let module S = CicSubstitution in
-    if e = [] & k = 0 then t else 
-    let rec unwind_aux m = function
-      C.Rel n as t -> if n <= m then t else
-                   let d = try Some (List.nth e (n-m-1))
-                              with _ -> None
-                   in (match d with 
-                   Some t' -> if m = 0 then t'
-                              else S.lift m t'
-                  | None -> C.Rel (n-k))
-    | C.Var _ as t  -> t
-    | C.Meta (i,l) as t -> t
-    | C.Sort _ as t -> t
-    | C.Implicit as t -> t
-    | C.Cast (te,ty) -> C.Cast (unwind_aux m te, unwind_aux m ty) (*CSC ??? *)
-    | C.Prod (n,s,t) -> C.Prod (n, unwind_aux m s, unwind_aux (m + 1) t)
-    | C.Lambda (n,s,t) -> C.Lambda (n, unwind_aux m s, unwind_aux (m + 1) t)
-    | C.LetIn (n,s,t) -> C.LetIn (n, unwind_aux m s, unwind_aux (m + 1) t)
-    | C.Appl l -> C.Appl (List.map (unwind_aux m) l)
-    | C.Const _ as t -> t
-    | C.MutInd _ as t -> t
-    | C.MutConstruct _ as t -> t
-    | C.MutCase (sp,cookingsno,i,outt,t,pl) ->
-       C.MutCase (sp,cookingsno,i,unwind_aux m outt, unwind_aux m t,
-        List.map (unwind_aux m) pl)
-    | C.Fix (i,fl) ->
-       let len = List.length fl in
-       let substitutedfl =
-        List.map
-         (fun (name,i,ty,bo) -> (name, i, unwind_aux m ty, unwind_aux (m+len) bo))
-          fl
-       in
-        C.Fix (i, substitutedfl)
-    | C.CoFix (i,fl) ->
-       let len = List.length fl in
-       let substitutedfl =
-        List.map
-         (fun (name,ty,bo) -> (name, unwind_aux m ty, unwind_aux (m+len) bo))
-          fl
-       in
-        C.CoFix (i, substitutedfl)
- in
-  unwind_aux m t          
-    ;;
+module CallByValueStrategy =
+ struct
+  type stack_term = Cic.term
+  type env_term = Cic.term
+  type ens_term = Cic.term
+  let to_stack v = v
+  let to_stack_list l = l
+  let to_env v = v
+  let to_ens v = v
+  let from_stack ~unwind v = v
+  let from_stack_list ~unwind l = l
+  let from_env v = v
+  let from_ens v = v
+  let stack_to_env ~reduce ~unwind v = v
+  let compute_to_stack ~reduce ~unwind k e ens t = reduce (k,e,ens,t,[])
+  let compute_to_env ~reduce ~unwind k e ens t = reduce (k,e,ens,t,[])
+ end
+;;
+
+module CallByValueStrategyByNameOnConstants =
+ struct
+  type stack_term = Cic.term
+  type env_term = Cic.term
+  type ens_term = Cic.term
+  let to_stack v = v
+  let to_stack_list l = l
+  let to_env v = v
+  let to_ens v = v
+  let from_stack ~unwind v = v
+  let from_stack_list ~unwind l = l
+  let from_env v = v
+  let from_ens v = v
+  let stack_to_env ~reduce ~unwind v = v
+  let compute_to_stack ~reduce ~unwind k e ens =
+   function
+      Cic.Const _ as t -> unwind k e ens t    
+    | t -> reduce (k,e,ens,t,[])
+  let compute_to_env ~reduce ~unwind k e ens =
+   function
+      Cic.Const _ as t -> unwind k e ens t    
+    | t -> reduce (k,e,ens,t,[])
+ end
+;;
+
+module LazyCallByValueStrategy =
+ struct
+  type stack_term = Cic.term lazy_t
+  type env_term = Cic.term lazy_t
+  type ens_term = Cic.term lazy_t
+  let to_stack v = lazy v
+  let to_stack_list l = List.map to_stack l
+  let to_env v = lazy v
+  let to_ens v = lazy v
+  let from_stack ~unwind v = Lazy.force v
+  let from_stack_list ~unwind l = List.map (from_stack ~unwind) l
+  let from_env v = Lazy.force v
+  let from_ens v = Lazy.force v
+  let stack_to_env ~reduce ~unwind v = v
+  let compute_to_stack ~reduce ~unwind k e ens t = lazy (reduce (k,e,ens,t,[]))
+  let compute_to_env ~reduce ~unwind k e ens t = lazy (reduce (k,e,ens,t,[]))
+ end
+;;
 
-let unwind =
- unwind' 0 
+module LazyCallByValueStrategyByNameOnConstants =
+ struct
+  type stack_term = Cic.term lazy_t
+  type env_term = Cic.term lazy_t
+  type ens_term = Cic.term lazy_t
+  let to_stack v = lazy v
+  let to_stack_list l = List.map to_stack l
+  let to_env v = lazy v
+  let to_ens v = lazy v
+  let from_stack ~unwind v = Lazy.force v
+  let from_stack_list ~unwind l = List.map (from_stack ~unwind) l
+  let from_env v = Lazy.force v
+  let from_ens v = Lazy.force v
+  let stack_to_env ~reduce ~unwind v = v
+  let compute_to_stack ~reduce ~unwind k e ens t =
+   lazy (
+    match t with
+       Cic.Const _ as t -> unwind k e ens t    
+     | t -> reduce (k,e,ens,t,[]))
+  let compute_to_env ~reduce ~unwind k e ens t =
+   lazy (
+    match t with
+       Cic.Const _ as t -> unwind k e ens t    
+     | t -> reduce (k,e,ens,t,[]))
+ end
 ;;
 
-let rec reduce : config -> Cic.term = 
-    let module C = Cic in
-    let module S = CicSubstitution in 
+module LazyCallByNameStrategy =
+ struct
+  type stack_term = Cic.term lazy_t
+  type env_term = Cic.term lazy_t
+  type ens_term = Cic.term lazy_t
+  let to_stack v = lazy v
+  let to_stack_list l = List.map to_stack l
+  let to_env v = lazy v
+  let to_ens v = lazy v
+  let from_stack ~unwind v = Lazy.force v
+  let from_stack_list ~unwind l = List.map (from_stack ~unwind) l
+  let from_env v = Lazy.force v
+  let from_ens v = Lazy.force v
+  let stack_to_env ~reduce ~unwind v = v
+  let compute_to_stack ~reduce ~unwind k e ens t = lazy (unwind k e ens t)
+  let compute_to_env ~reduce ~unwind k e ens t = lazy (unwind k e ens t)
+ end
+;;
+
+module
+ LazyCallByValueByNameOnConstantsWhenFromStack_ByNameStrategyWhenFromEnvOrEns
+=
+ struct
+  type stack_term = reduce:bool -> Cic.term
+  type env_term = reduce:bool -> Cic.term
+  type ens_term = reduce:bool -> Cic.term
+  let to_stack v =
+   let value = lazy v in
+    fun ~reduce -> Lazy.force value
+  let to_stack_list l = List.map to_stack l
+  let to_env v =
+   let value = lazy v in
+    fun ~reduce -> Lazy.force value
+  let to_ens v =
+   let value = lazy v in
+    fun ~reduce -> Lazy.force value
+  let from_stack ~unwind v = (v ~reduce:false)
+  let from_stack_list ~unwind l = List.map (from_stack ~unwind) l
+  let from_env v = (v ~reduce:true)
+  let from_ens v = (v ~reduce:true)
+  let stack_to_env ~reduce ~unwind v = v
+  let compute_to_stack ~reduce ~unwind k e ens t =
+   let svalue =
+     lazy (
+      match t with
+         Cic.Const _ as t -> unwind k e ens t    
+       | t -> reduce (k,e,ens,t,[])
+     ) in
+   let lvalue =
+    lazy (unwind k e ens t)
+   in
+    fun ~reduce ->
+     if reduce then Lazy.force svalue else Lazy.force lvalue
+  let compute_to_env ~reduce ~unwind k e ens t =
+   let svalue =
+     lazy (
+      match t with
+         Cic.Const _ as t -> unwind k e ens t    
+       | t -> reduce (k,e,ens,t,[])
+     ) in
+   let lvalue =
+    lazy (unwind k e ens t)
+   in
+    fun ~reduce ->
+     if reduce then Lazy.force svalue else Lazy.force lvalue
+ end
+;;
+
+module ClosuresOnStackByValueFromEnvOrEnsStrategy =
+ struct
+  type stack_term =
+   int * Cic.term list * Cic.term Cic.explicit_named_substitution * Cic.term
+  type env_term = Cic.term
+  type ens_term = Cic.term
+  let to_stack v = (0,[],[],v)
+  let to_stack_list l = List.map to_stack l
+  let to_env v = v
+  let to_ens v = v
+  let from_stack ~unwind (k,e,ens,t) = unwind k e ens t
+  let from_stack_list ~unwind l = List.map (from_stack ~unwind) l
+  let from_env v = v
+  let from_ens v = v
+  let stack_to_env ~reduce ~unwind (k,e,ens,t) = reduce (k,e,ens,t,[])
+  let compute_to_env ~reduce ~unwind k e ens t =
+   unwind k e ens t
+  let compute_to_stack ~reduce ~unwind k e ens t = (k,e,ens,t)
+ end
+;;
+
+module ClosuresOnStackByValueFromEnvOrEnsByNameOnConstantsStrategy =
+ struct
+  type stack_term =
+   int * Cic.term list * Cic.term Cic.explicit_named_substitution * Cic.term
+  type env_term = Cic.term
+  type ens_term = Cic.term
+  let to_stack v = (0,[],[],v)
+  let to_stack_list l = List.map to_stack l
+  let to_env v = v
+  let to_ens v = v
+  let from_stack ~unwind (k,e,ens,t) = unwind k e ens t
+  let from_stack_list ~unwind l = List.map (from_stack ~unwind) l
+  let from_env v = v
+  let from_ens v = v
+  let stack_to_env ~reduce ~unwind (k,e,ens,t) =
+   match t with
+      Cic.Const _ as t -> unwind k e ens t    
+    | t -> reduce (k,e,ens,t,[])
+  let compute_to_env ~reduce ~unwind k e ens t =
+   unwind k e ens t
+  let compute_to_stack ~reduce ~unwind k e ens t = (k,e,ens,t)
+ end
+;;
+
+module Reduction(RS : Strategy) =
+ struct
+  type env = RS.env_term list
+  type ens = RS.ens_term Cic.explicit_named_substitution
+  type stack = RS.stack_term list
+  type config = int * env * ens * Cic.term * stack
+
+  (* k is the length of the environment e *)
+  (* m is the current depth inside the term *)
+  let unwind' m k e ens t = 
+   let module C = Cic in
+   let module S = CicSubstitution in
+    if k = 0 && ens = [] then
+     t
+    else 
+     let rec unwind_aux m =
+      function
+         C.Rel n as t ->
+          if n <= m then t else
+           let d =
+            try
+             Some (RS.from_env (List.nth e (n-m-1)))
+            with _ -> None
+           in
+            (match d with 
+                Some t' ->
+                 if m = 0 then t' else S.lift m t'
+              | None -> C.Rel (n-k)
+            )
+       | C.Var (uri,exp_named_subst) ->
+(*
+prerr_endline ("%%%%%UWVAR " ^ String.concat " ; " (List.map (function (uri,t) -> UriManager.string_of_uri uri ^ " := " ^ CicPp.ppterm t) ens)) ;
+*)
+         if List.exists (function (uri',_) -> UriManager.eq uri' uri) ens then
+          CicSubstitution.lift m (RS.from_ens (List.assq uri ens))
+         else
+          let params =
+           (match CicEnvironment.get_obj uri with
+               C.Constant _ -> raise ReferenceToConstant
+             | C.Variable (_,_,_,params) -> params
+             | C.CurrentProof _ -> raise ReferenceToCurrentProof
+             | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+           )
+          in
+           let exp_named_subst' =
+            substaux_in_exp_named_subst params exp_named_subst m 
+           in
+            C.Var (uri,exp_named_subst')
+       | C.Meta (i,l) ->
+          let l' =
+           List.map
+            (function
+                None -> None
+              | Some t -> Some (unwind_aux m t)
+            ) l
+          in
+           C.Meta (i, l')
+       | C.Sort _ as t -> t
+       | C.Implicit as t -> t
+       | C.Cast (te,ty) -> C.Cast (unwind_aux m te, unwind_aux m ty) (*CSC ???*)
+       | C.Prod (n,s,t) -> C.Prod (n, unwind_aux m s, unwind_aux (m + 1) t)
+       | C.Lambda (n,s,t) -> C.Lambda (n, unwind_aux m s, unwind_aux (m + 1) t)
+       | C.LetIn (n,s,t) -> C.LetIn (n, unwind_aux m s, unwind_aux (m + 1) t)
+       | C.Appl l -> C.Appl (List.map (unwind_aux m) l)
+       | C.Const (uri,exp_named_subst) ->
+          let params =
+           (match CicEnvironment.get_obj uri with
+               C.Constant (_,_,_,params) -> params
+             | C.Variable _ -> raise ReferenceToVariable
+             | C.CurrentProof (_,_,_,_,params) -> params
+             | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+           )
+          in
+           let exp_named_subst' =
+            substaux_in_exp_named_subst params exp_named_subst m 
+           in
+            C.Const (uri,exp_named_subst')
+       | C.MutInd (uri,i,exp_named_subst) ->
+          let params =
+           (match CicEnvironment.get_obj uri with
+               C.Constant _ -> raise ReferenceToConstant
+             | C.Variable _ -> raise ReferenceToVariable
+             | C.CurrentProof _ -> raise ReferenceToCurrentProof
+             | C.InductiveDefinition (_,params,_) -> params
+           )
+          in
+           let exp_named_subst' =
+            substaux_in_exp_named_subst params exp_named_subst m 
+           in
+            C.MutInd (uri,i,exp_named_subst')
+       | C.MutConstruct (uri,i,j,exp_named_subst) ->
+          let params =
+           (match CicEnvironment.get_obj uri with
+               C.Constant _ -> raise ReferenceToConstant
+             | C.Variable _ -> raise ReferenceToVariable
+             | C.CurrentProof _ -> raise ReferenceToCurrentProof
+             | C.InductiveDefinition (_,params,_) -> params
+           )
+          in
+           let exp_named_subst' =
+            substaux_in_exp_named_subst params exp_named_subst m 
+           in
+            C.MutConstruct (uri,i,j,exp_named_subst')
+       | C.MutCase (sp,i,outt,t,pl) ->
+          C.MutCase (sp,i,unwind_aux m outt, unwind_aux m t,
+           List.map (unwind_aux m) pl)
+       | C.Fix (i,fl) ->
+          let len = List.length fl in
+          let substitutedfl =
+           List.map
+            (fun (name,i,ty,bo) ->
+              (name, i, unwind_aux m ty, unwind_aux (m+len) bo))
+             fl
+          in
+           C.Fix (i, substitutedfl)
+       | C.CoFix (i,fl) ->
+          let len = List.length fl in
+          let substitutedfl =
+           List.map
+            (fun (name,ty,bo) -> (name, unwind_aux m ty, unwind_aux (m+len) bo))
+             fl
+          in
+           C.CoFix (i, substitutedfl)
+     and substaux_in_exp_named_subst params exp_named_subst' m  =
+  (*CSC: Idea di Andrea di ordinare compatibilmente con l'ordine dei params
+      let ens' =
+       List.map (function (uri,t) -> uri, unwind_aux m t) exp_named_subst' @
+  (*CSC: qui liftiamo tutti gli ens anche se magari me ne servono la meta'!!! *)
+        List.map (function (uri,t) -> uri, CicSubstitution.lift m t) ens
+      in
+      let rec filter_and_lift =
+       function
+          [] -> []
+        | uri::tl ->
+           let r = filter_and_lift tl in
+            (try
+              (uri,(List.assq uri ens'))::r
+             with
+              Not_found -> r
+            )
+      in
+       filter_and_lift params
+  *)
+  
+  (*CSC: invece di concatenare sarebbe meglio rispettare l'ordine dei params *)
+  (*CSC: e' vero???? una veloce prova non sembra confermare la teoria        *)
+  
+  (*CSC: codice copiato e modificato dalla cicSubstitution.subst_vars *)
+  (*CSC: codice altamente inefficiente *)
+      let rec filter_and_lift already_instantiated =
+       function
+          [] -> []
+        | (uri,t)::tl when
+            List.for_all
+             (function (uri',_)-> not (UriManager.eq uri uri')) exp_named_subst'
+            &&
+             not (List.mem uri already_instantiated)
+            &&
+             List.mem uri params
+           ->
+            (uri,CicSubstitution.lift m (RS.from_ens t)) ::
+             (filter_and_lift (uri::already_instantiated) tl)
+        | _::tl -> filter_and_lift already_instantiated tl
+(*
+        | (uri,_)::tl ->
+prerr_endline ("---- SKIPPO " ^ UriManager.string_of_uri uri) ;
+if List.for_all (function (uri',_) -> not (UriManager.eq uri uri')) exp_named_subst' then prerr_endline "---- OK1" ;
+prerr_endline ("++++ uri " ^ UriManager.string_of_uri uri ^ " not in " ^ String.concat " ; " (List.map UriManager.string_of_uri params)) ;
+if List.mem uri params then prerr_endline "---- OK2" ;
+        filter_and_lift tl
+*)
+      in
+       List.map (function (uri,t) -> uri, unwind_aux m t) exp_named_subst' @
+        (filter_and_lift [] (List.rev ens))
+     in
+      unwind_aux m t          
+  ;;
+  
+  let unwind =
+   unwind' 0 
+  ;;
+  
+  let reduce context : config -> Cic.term = 
+   let module C = Cic in
+   let module S = CicSubstitution in 
+   let rec reduce =
     function
-      (k, e, (C.Rel n as t), s) -> let d =
-(* prerr_string ("Rel " ^ string_of_int n) ; flush stderr ; *)
-                                   try Some (List.nth e (n-1))
-                                   with _ -> None
-                                 in (match d with 
-                                   Some t' -> reduce (0, [],t',s)
-                                 | None -> if s = [] then C.Rel (n-k)
-                                           else C.Appl (C.Rel (n-k)::s))
-    | (k, e, (C.Var uri as t), s) -> 
-        (match CicEnvironment.get_cooked_obj uri 0 with
-            C.Definition _ -> raise ReferenceToDefinition
-          | C.Axiom _ -> raise ReferenceToAxiom
-          | C.CurrentProof _ -> raise ReferenceToCurrentProof
-          | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
-          | C.Variable (_,None,_) -> if s = [] then t else C.Appl (t::s)
-          | C.Variable (_,Some body,_) -> reduce (0, [], body, s)
+       (k, e, _, (C.Rel n as t), s) ->
+        let d =
+         try
+          Some (RS.from_env (List.nth e (n-1)))
+         with
+          _ ->
+           try
+            begin
+             match List.nth context (n - 1 - k) with
+                None -> assert false
+              | Some (_,C.Decl _) -> None
+              | Some (_,C.Def x) -> Some (S.lift (n - k) x)
+            end
+           with
+            _ -> None
+        in
+         (match d with 
+             Some t' -> reduce (0,[],[],t',s)
+           | None ->
+              if s = [] then
+               C.Rel (n-k)
+              else C.Appl (C.Rel (n-k)::(RS.from_stack_list ~unwind s))
          )
-    | (k, e, (C.Meta _ as t), s) -> if s = [] then t 
-                                 else C.Appl (t::s)
-    | (k, e, (C.Sort _ as t), s) -> t (* s should be empty *)
-    | (k, e, (C.Implicit as t), s) -> t (* s should be empty *)
-    | (k, e, (C.Cast (te,ty) as t), s) -> reduce (k, e,te,s) (* s should be empty *)
-    | (k, e, (C.Prod _ as t), s) -> unwind k e t (* s should be empty *)
-    | (k, e, (C.Lambda (_,_,t) as t'), []) -> unwind k e t' 
-    | (k, e, C.Lambda (_,_,t), p::s) ->
-(* prerr_string ("Lambda body: " ^ CicPp.ppterm t) ; flush stderr ; *)
-        reduce (k+1, p::e,t,s) 
-    | (k, e, (C.LetIn (_,m,t) as t'), s) -> let m' = reduce (k,e,m,[]) in
-                                         reduce (k+1, m'::e,t,s)
-    | (k, e, C.Appl [], s) -> raise (Impossible 1)
-    (* this is lazy 
-    | (k, e, C.Appl (he::tl), s) ->  let tl' = List.map (unwind k e) tl
-                                 in reduce (k, e, he, (List.append tl' s)) *)
-    (* this is strict *)
-    | (k, e, C.Appl (he::tl), s) ->
-                                  (* constants are NOT unfolded *)
-                                  let red = function
-                                      C.Const _ as t -> t    
-                                    | t -> reduce (k, e,t,[]) in
-                                  let tl' = List.map red tl in
-                                   reduce (k, e, he , List.append tl' s) 
-(* 
-    | (k, e, C.Appl ((C.Lambda _ as he)::tl), s) 
-    | (k, e, C.Appl ((C.Const _ as he)::tl), s)  
-    | (k, e, C.Appl ((C.MutCase _ as he)::tl), s) 
-    | (k, e, C.Appl ((C.Fix _ as he)::tl), s) ->
-(* strict evaluation, but constants are NOT
-                                    unfolded *)
-                                  let red = function
-                                      C.Const _ as t -> t    
-                                    | t -> reduce (k, e,t,[]) in
-                                  let tl' = List.map red tl in
-                                   reduce (k, e, he , List.append tl' s)
-    | (k, e, C.Appl l, s) -> C.Appl (List.append (List.map (unwind k e) l) s) *)
-    | (k, e, (C.Const (uri,cookingsno) as t), s) ->
-       (match CicEnvironment.get_cooked_obj uri cookingsno with
-           C.Definition (_,body,_,_) -> reduce (0, [], body, s) 
-                                        (* constants are closed *)
-         | C.Axiom _ -> if s = [] then t else C.Appl (t::s)
-         | C.Variable _ -> raise ReferenceToVariable
-         | C.CurrentProof (_,_,body,_) -> reduce (0, [], body, s)
-         | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
-       )
-    | (k, e, (C.MutInd (uri,_,_) as t),s) -> let t' = unwind k e t in 
-                                         if s = [] then t' else C.Appl (t'::s)
-    | (k, e, (C.MutConstruct (uri,_,_,_) as t),s) -> 
-                                          let t' = unwind k e t in
-                                          if s = [] then t' else C.Appl (t'::s)
-    | (k, e, (C.MutCase (mutind,cookingsno,i,_,term,pl) as t),s) ->
+     | (k, e, ens, (C.Var (uri,exp_named_subst) as t), s) -> 
+         if List.exists (function (uri',_) -> UriManager.eq uri' uri) ens then
+          reduce (0, [], [], RS.from_ens (List.assq uri ens), s)
+         else
+          (match CicEnvironment.get_obj uri with
+              C.Constant _ -> raise ReferenceToConstant
+            | C.CurrentProof _ -> raise ReferenceToCurrentProof
+            | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+            | C.Variable (_,None,_,_) ->
+               let t' = unwind k e ens t in
+                if s = [] then t' else
+                 C.Appl (t'::(RS.from_stack_list ~unwind s))
+            | C.Variable (_,Some body,_,_) ->
+               let ens' = push_exp_named_subst k e ens exp_named_subst in
+                reduce (0, [], ens', body, s)
+          )
+     | (k, e, ens, (C.Meta _ as t), s) ->
+        let t' = unwind k e ens t in
+         if s = [] then t' else C.Appl (t'::(RS.from_stack_list ~unwind s))
+     | (k, e, _, (C.Sort _ as t), s) -> t (* s should be empty *)
+     | (k, e, _, (C.Implicit as t), s) -> t (* s should be empty *)
+     | (k, e, ens, (C.Cast (te,ty) as t), s) ->
+        reduce (k, e, ens, te, s) (* s should be empty *)
+     | (k, e, ens, (C.Prod _ as t), s) ->
+         unwind k e ens t (* s should be empty *)
+     | (k, e, ens, (C.Lambda (_,_,t) as t'), []) -> unwind k e ens t' 
+     | (k, e, ens, C.Lambda (_,_,t), p::s) ->
+         reduce (k+1, (RS.stack_to_env ~reduce ~unwind p)::e, ens, t,s)
+     | (k, e, ens, (C.LetIn (_,m,t) as t'), s) ->
+        let m' = RS.compute_to_env ~reduce ~unwind k e ens m in
+         reduce (k+1, m'::e, ens, t, s)
+     | (_, _, _, C.Appl [], _) -> raise (Impossible 1)
+     | (k, e, ens, C.Appl (he::tl), s) ->
+        let tl' =
+         List.map
+          (function t -> RS.compute_to_stack ~reduce ~unwind k e ens t) tl
+        in
+         reduce (k, e, ens, he, (List.append tl') s)
+  (* CSC: Old Dead Code 
+     | (k, e, ens, C.Appl ((C.Lambda _ as he)::tl), s) 
+     | (k, e, ens, C.Appl ((C.Const _ as he)::tl), s)  
+     | (k, e, ens, C.Appl ((C.MutCase _ as he)::tl), s) 
+     | (k, e, ens, C.Appl ((C.Fix _ as he)::tl), s) ->
+  (* strict evaluation, but constants are NOT unfolded *)
+        let red =
+         function
+            C.Const _ as t -> unwind k e ens t
+          | t -> reduce (k,e,ens,t,[])
+        in
+         let tl' = List.map red tl in
+          reduce (k, e, ens, he , List.append tl' s)
+     | (k, e, ens, C.Appl l, s) ->
+         C.Appl (List.append (List.map (unwind k e ens) l) s)
+  *)
+     | (k, e, ens, (C.Const (uri,exp_named_subst) as t), s) ->
+        (match CicEnvironment.get_obj uri with
+            C.Constant (_,Some body,_,_) ->
+             let ens' = push_exp_named_subst k e ens exp_named_subst in
+              (* constants are closed *)
+              reduce (0, [], ens', body, s) 
+          | C.Constant (_,None,_,_) ->
+             let t' = unwind k e ens t in
+              if s = [] then t' else C.Appl (t'::(RS.from_stack_list ~unwind s))
+          | C.Variable _ -> raise ReferenceToVariable
+          | C.CurrentProof (_,_,body,_,_) ->
+             let ens' = push_exp_named_subst k e ens exp_named_subst in
+              (* constants are closed *)
+              reduce (0, [], ens', body, s)
+          | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+        )
+     | (k, e, ens, (C.MutInd _ as t),s) ->
+        let t' = unwind k e ens t in 
+         if s = [] then t' else C.Appl (t'::(RS.from_stack_list ~unwind s))
+     | (k, e, ens, (C.MutConstruct _ as t),s) -> 
+         let t' = unwind k e ens t in
+          if s = [] then t' else C.Appl (t'::(RS.from_stack_list ~unwind s))
+     | (k, e, ens, (C.MutCase (mutind,i,_,term,pl) as t),s) ->
         let decofix =
-        function
-           C.CoFix (i,fl) as t ->
-            let (_,_,body) = List.nth fl i in
-             let body' =
-              let counter = ref (List.length fl) in
-               List.fold_right
-                (fun _ -> decr counter ; S.subst (C.CoFix (!counter,fl)))
-                fl
-                body
-             in
-              reduce (0,[],body',[])
-         | C.Appl (C.CoFix (i,fl) :: tl) ->
-            let (_,_,body) = List.nth fl i in
-             let body' =
-              let counter = ref (List.length fl) in
-               List.fold_right
-                (fun _ -> decr counter ; S.subst (C.CoFix (!counter,fl)))
-                fl
-                body
-             in
-              reduce (0,[], body', tl)
-         | t -> t
-       in
-        (match decofix (reduce (k, e,term,[])) with
-            C.MutConstruct (_,_,_,j) -> reduce (k, e, (List.nth pl (j-1)), s)
-          | C.Appl (C.MutConstruct (_,_,_,j) :: tl) ->
-             let (arity, r, num_ingredients) =
-              match CicEnvironment.get_obj mutind with
-                 C.InductiveDefinition (tl,ingredients,r) ->
-                   let (_,_,arity,_) = List.nth tl i
-                   and num_ingredients =
-                    List.fold_right
-                     (fun (k,l) i ->
-                       if k < cookingsno then i + List.length l else i
-                     ) ingredients 0
-                   in
-                    (arity,r,num_ingredients)
-               | _ -> raise WrongUriToInductiveDefinition
-             in
-              let ts =
-               let num_to_eat = r + num_ingredients in
-                let rec eat_first =
-                 function
-                    (0,l) -> l
-                  | (n,he::tl) when n > 0 -> eat_first (n - 1, tl)
-                  | _ -> raise (Impossible 5)
-                in
-                 eat_first (num_to_eat,tl)
+         function
+            C.CoFix (i,fl) as t ->
+             let (_,_,body) = List.nth fl i in
+              let body' =
+               let counter = ref (List.length fl) in
+                List.fold_right
+                 (fun _ -> decr counter ; S.subst (C.CoFix (!counter,fl)))
+                 fl
+                 body
               in
-               reduce (k, e, (List.nth pl (j-1)),(ts@s)) 
-	  | C.Cast _ | C.Implicit ->
-            raise (Impossible 2) (* we don't trust our whd ;-) *)
-         | _ -> let t' = unwind k e t in
-                if s = [] then t' else C.Appl (t'::s)
-       )
-    | (k, e, (C.Fix (i,fl) as t), s) ->
-       let (_,recindex,_,body) = List.nth fl i in
-        let recparam =
-         try
-          Some (List.nth s recindex)
-         with
-          _ -> None
+               (* the term is the result of a reduction; *)
+               (* so it is already unwinded.             *)
+               reduce (0,[],[],body',[])
+          | C.Appl (C.CoFix (i,fl) :: tl) ->
+             let (_,_,body) = List.nth fl i in
+              let body' =
+               let counter = ref (List.length fl) in
+                List.fold_right
+                 (fun _ -> decr counter ; S.subst (C.CoFix (!counter,fl)))
+                 fl
+                 body
+              in
+               (* the term is the result of a reduction; *)
+               (* so it is already unwinded.             *)
+               reduce (0,[],[],body',RS.to_stack_list tl)
+          | t -> t
         in
-         (match recparam with
-             Some recparam ->
-              (match reduce (0,[],recparam,[]) with
-                  (* match recparam with *) 
-                  C.MutConstruct _
-                | C.Appl ((C.MutConstruct _)::_) ->
-                   (* OLD 
-                   let body' =
-                    let counter = ref (List.length fl) in
-                     List.fold_right
-                      (fun _ -> decr counter ; S.subst (C.Fix (!counter,fl)))
-                      fl
-                      body
-                   in 
-                    reduce (k, e, body', s) *)
-                   (* NEW *)
-                   let leng = List.length fl in
-                   let fl' = 
-                       let unwind_fl (name,recindex,typ,body) = 
-                           (name,recindex,unwind' leng k e typ, unwind' leng k e body)  in
-		       List.map unwind_fl fl in 
-                   let new_env =
-                     let counter = ref leng in
-                     let rec build_env e =
-                         if !counter = 0 then e else (decr counter; 
-                                    build_env ((C.Fix (!counter,fl'))::e)) in
-                     build_env e in
-                   reduce (k+leng, new_env, body,s)  
-               | _ -> let t' = unwind k e t in 
-                      if s = [] then t' else C.Appl (t'::s)
-             )
-          | None -> let t' = unwind k e t in 
-                    if s = [] then t' else C.Appl (t'::s)
+         (match decofix (reduce (k,e,ens,term,[])) with
+             C.MutConstruct (_,_,j,_) ->
+              reduce (k, e, ens, (List.nth pl (j-1)), s)
+           | C.Appl (C.MutConstruct (_,_,j,_) :: tl) ->
+              let (arity, r) =
+               match CicEnvironment.get_obj mutind with
+                  C.InductiveDefinition (tl,ingredients,r) ->
+                    let (_,_,arity,_) = List.nth tl i in
+                     (arity,r)
+                | _ -> raise WrongUriToInductiveDefinition
+              in
+               let ts =
+                let num_to_eat = r in
+                 let rec eat_first =
+                  function
+                     (0,l) -> l
+                   | (n,he::tl) when n > 0 -> eat_first (n - 1, tl)
+                   | _ -> raise (Impossible 5)
+                 in
+                  eat_first (num_to_eat,tl)
+               in
+                (* ts are already unwinded because they are a sublist of tl *)
+                reduce (k, e, ens, (List.nth pl (j-1)), (RS.to_stack_list ts)@s)
+	   | C.Cast _ | C.Implicit ->
+              raise (Impossible 2) (* we don't trust our whd ;-) *)
+           | _ ->
+             let t' = unwind k e ens t in
+              if s = [] then t' else C.Appl (t'::(RS.from_stack_list ~unwind s))
          )
-    | (k, e,(C.CoFix (i,fl) as t),s) -> let t' = unwind k e t in 
-       if s = [] then t' else C.Appl (t'::s);;
-
-let rec whd = let module C = Cic in
+     | (k, e, ens, (C.Fix (i,fl) as t), s) ->
+        let (_,recindex,_,body) = List.nth fl i in
+         let recparam =
+          try
+           Some (RS.from_stack ~unwind (List.nth s recindex))
+          with
+           _ -> None
+         in
+          (match recparam with
+              Some recparam ->
+               (match reduce (0,[],[],recparam,[]) with
+                   (* match recparam with *) 
+                   C.MutConstruct _
+                 | C.Appl ((C.MutConstruct _)::_) ->
+                    (* OLD 
+                    let body' =
+                     let counter = ref (List.length fl) in
+                      List.fold_right
+                       (fun _ -> decr counter ; S.subst (C.Fix (!counter,fl)))
+                       fl
+                       body
+                    in 
+                     reduce (k, e, ens, body', s) *)
+                    (* NEW *)
+                    let leng = List.length fl in
+                    let fl' = 
+                     let unwind_fl (name,recindex,typ,body) = 
+                      (name,recindex,unwind k e ens typ,
+                        unwind' leng k e ens body)
+                     in
+	              List.map unwind_fl fl
+                    in
+                     let new_env =
+                      let counter = ref 0 in
+                      let rec build_env e =
+                       if !counter = leng then e
+                       else
+                        (incr counter ;
+                         build_env ((RS.to_env (C.Fix (!counter -1, fl')))::e))
+                      in
+                       build_env e
+                     in
+                      reduce (k+leng, new_env, ens, body, s)  
+                 | _ ->
+                   let t' = unwind k e ens t in 
+                    if s = [] then t' else
+                     C.Appl (t'::(RS.from_stack_list ~unwind s))
+               )
+            | None ->
+               let t' = unwind k e ens t in 
+                if s = [] then t' else
+                 C.Appl (t'::(RS.from_stack_list ~unwind s))
+          )
+     | (k, e, ens, (C.CoFix (i,fl) as t),s) ->
+        let t' = unwind k e ens t in 
+         if s = [] then t' else C.Appl (t'::(RS.from_stack_list ~unwind s))
+   and push_exp_named_subst k e ens =
     function
-      C.Rel _ as t -> t
-    | C.Var _ as t -> reduce (0, [], t, [])
-    | C.Meta _ as t -> t
-    | C.Sort _ as t -> t
-    | C.Implicit as t -> t
-    | C.Cast (te,ty) -> whd te
-    | C.Prod _ as t -> t
-    | C.Lambda _ as t -> t
-    | C.LetIn (n,s,t) -> reduce (1, [s], t, [])
-    | C.Appl [] -> raise (Impossible 1)
-    | C.Appl (he::tl) -> reduce (0, [], he, tl)
-    | C.Const _ as t -> reduce (0, [], t, [])
-    | C.MutInd _ as t -> t
-    | C.MutConstruct _ as t -> t
-    | C.MutCase _ as t -> reduce (0, [], t, [])
-    | C.Fix _ as t -> reduce (0, [], t, [])
-    | C.CoFix _ as t -> reduce (0, [], t, [])
-    ;;
-
-(* let whd t = reduce (0, [],t,[]);; 
- let res = reduce (0, [],t,[]) in
- let rescsc = CicReductionNaif.whd t in
-  if not (CicReductionNaif.are_convertible res rescsc) then
+       [] -> ens
+     | (uri,t)::tl ->
+         push_exp_named_subst k e ((uri,RS.to_ens (unwind k e ens t))::ens) tl
+   in
+    reduce
+  ;;
+  
+  let rec whd context t = reduce context (0, [], [], t, []);;
+  
+(* DEBUGGING ONLY
+let whd context t =
+ let res = whd context t in
+ let rescsc = CicReductionNaif.whd context t in
+  if not (CicReductionNaif.are_convertible context res rescsc) then
    begin
     prerr_endline ("PRIMA: " ^ CicPp.ppterm t) ;
     flush stderr ;
@@ -310,74 +740,155 @@ let rec whd = let module C = Cic in
     flush stderr ;
     prerr_endline ("CSC: " ^ CicPp.ppterm rescsc) ;
     flush stderr ;
+CicReductionNaif.fdebug := 0 ;
+let _ =  CicReductionNaif.are_convertible context res rescsc in
     assert false ;
    end
   else 
-   res ;; *)
+   res
+;;
+*)
+ end
+;;
+
 
+(*
+module R = Reduction CallByNameStrategy;;
+module R = Reduction CallByValueStrategy;;
+module R = Reduction CallByValueStrategyByNameOnConstants;;
+module R = Reduction LazyCallByValueStrategy;;
+module R = Reduction LazyCallByValueStrategyByNameOnConstants;;
+module R = Reduction LazyCallByNameStrategy;;
+module R = Reduction
+ LazyCallByValueByNameOnConstantsWhenFromStack_ByNameStrategyWhenFromEnvOrEns;;
+module R = Reduction ClosuresOnStackByValueFromEnvOrEnsStrategy;;
+module R = Reduction
+ ClosuresOnStackByValueFromEnvOrEnsByNameOnConstantsStrategy;;
+*)
+module R = Reduction ClosuresOnStackByValueFromEnvOrEnsStrategy;;
+
+let whd = R.whd;;
 
 (* t1, t2 must be well-typed *)
-let are_convertible = 
- let rec aux t1 t2 = 
- if t1 = t2 then true
- else
+let are_convertible =
+ let module U = UriManager in
+ let rec aux context t1 t2 =
   let aux2 t1 t2 =
-   let module U = UriManager in
-   let module C = Cic in 
-      match (t1,t2) with
-         (C.Rel n1, C.Rel n2) -> n1 = n2
-       | (C.Var uri1, C.Var uri2) -> U.eq uri1 uri2
-       | (C.Meta n1, C.Meta n2) -> n1 = n2
-       | (C.Sort s1, C.Sort s2) -> true (*CSC da finire con gli universi *)
-       | (C.Prod (_,s1,t1), C.Prod(_,s2,t2)) ->
-          aux s1 s2 && aux t1 t2
-       | (C.Lambda (_,s1,t1), C.Lambda(_,s2,t2)) ->
-          aux s1 s2 && aux t1 t2
-       | (C.Appl l1, C.Appl l2) ->
-          (try
-            List.fold_right2 (fun  x y b -> aux x y && b) l1 l2 true 
-           with
-            Invalid_argument _ -> false
-          )
-       | (C.Const (uri1,_), C.Const (uri2,_)) ->
-           U.eq uri1 uri2 
-       | (C.MutInd (uri1,k1,i1), C.MutInd (uri2,k2,i2)) ->
-           U.eq uri1 uri2 && i1 = i2
-       | (C.MutConstruct (uri1,_,i1,j1), C.MutConstruct (uri2,_,i2,j2)) ->
-           U.eq uri1 uri2 && i1 = i2 && j1 = j2
-       | (C.MutCase (uri1,_,i1,outtype1,term1,pl1),
-          C.MutCase (uri2,_,i2,outtype2,term2,pl2)) -> 
-           (* aux outtype1 outtype2 should be true if aux pl1 pl2 *)
-           U.eq uri1 uri2 && i1 = i2 && aux outtype1 outtype2 &&
-            aux term1 term2 &&
-            List.fold_right2 (fun x y b -> b && aux x y) pl1 pl2 true
-       | (C.Fix (i1,fl1), C.Fix (i2,fl2)) ->
-          i1 = i2 &&
-           List.fold_right2
-            (fun (_,recindex1,ty1,bo1) (_,recindex2,ty2,bo2) b ->
-              b && recindex1 = recindex2 && aux ty1 ty2 && aux bo1 bo2)
-            fl1 fl2 true
-       | (C.CoFix (i1,fl1), C.CoFix (i2,fl2)) ->
-          i1 = i2 &&
-           List.fold_right2
-            (fun (_,ty1,bo1) (_,ty2,bo2) b ->
-              b && aux ty1 ty2 && aux bo1 bo2)
-            fl1 fl2 true
-       | (_,_) -> false
+   (* this trivial euristic cuts down the total time of about five times ;-) *)
+   (* this because most of the time t1 and t2 are "sintactically" the same   *)
+   if t1 = t2 then
+    true
+   else
+    begin
+     let module C = Cic in
+       match (t1,t2) with
+          (C.Rel n1, C.Rel n2) -> n1 = n2
+        | (C.Var (uri1,exp_named_subst1), C.Var (uri2,exp_named_subst2)) ->
+            U.eq uri1 uri2 &&
+             (try
+               List.fold_right2
+                (fun (uri1,x) (uri2,y) b ->
+                  U.eq uri1 uri2 && aux context x y && b
+                ) exp_named_subst1 exp_named_subst2 true 
+              with
+               Invalid_argument _ -> false
+             )
+        | (C.Meta (n1,l1), C.Meta (n2,l2)) -> 
+            n1 = n2 &&
+             List.fold_left2
+              (fun b t1 t2 ->
+                b &&
+                 match t1,t2 with
+                    None,_
+                  | _,None  -> true
+                  | Some t1',Some t2' -> aux context t1' t2'
+              ) true l1 l2
+        | (C.Sort s1, C.Sort s2) -> true (*CSC da finire con gli universi *)
+        | (C.Prod (name1,s1,t1), C.Prod(_,s2,t2)) ->
+           aux context s1 s2 && aux ((Some (name1, (C.Decl s1)))::context) t1 t2
+        | (C.Lambda (name1,s1,t1), C.Lambda(_,s2,t2)) ->
+           aux context s1 s2 && aux ((Some (name1, (C.Decl s1)))::context) t1 t2
+        | (C.LetIn (name1,s1,t1), C.LetIn(_,s2,t2)) ->
+           aux context s1 s2 && aux ((Some (name1, (C.Def s1)))::context) t1 t2
+        | (C.Appl l1, C.Appl l2) ->
+           (try
+             List.fold_right2 (fun  x y b -> aux context x y && b) l1 l2 true 
+            with
+             Invalid_argument _ -> false
+           )
+        | (C.Const (uri1,exp_named_subst1), C.Const (uri2,exp_named_subst2)) ->
+            U.eq uri1 uri2 &&
+             (try
+               List.fold_right2
+                (fun (uri1,x) (uri2,y) b ->
+                  U.eq uri1 uri2 && aux context x y && b
+                ) exp_named_subst1 exp_named_subst2 true 
+              with
+               Invalid_argument _ -> false
+             )
+        | (C.MutInd (uri1,i1,exp_named_subst1),
+           C.MutInd (uri2,i2,exp_named_subst2)
+          ) ->
+            U.eq uri1 uri2 && i1 = i2 &&
+             (try
+               List.fold_right2
+                (fun (uri1,x) (uri2,y) b ->
+                  U.eq uri1 uri2 && aux context x y && b
+                ) exp_named_subst1 exp_named_subst2 true 
+              with
+               Invalid_argument _ -> false
+             )
+        | (C.MutConstruct (uri1,i1,j1,exp_named_subst1),
+           C.MutConstruct (uri2,i2,j2,exp_named_subst2)
+          ) ->
+            U.eq uri1 uri2 && i1 = i2 && j1 = j2 &&
+             (try
+               List.fold_right2
+                (fun (uri1,x) (uri2,y) b ->
+                  U.eq uri1 uri2 && aux context x y && b
+                ) exp_named_subst1 exp_named_subst2 true 
+              with
+               Invalid_argument _ -> false
+             )
+        | (C.MutCase (uri1,i1,outtype1,term1,pl1),
+           C.MutCase (uri2,i2,outtype2,term2,pl2)) -> 
+            U.eq uri1 uri2 && i1 = i2 && aux context outtype1 outtype2 &&
+             aux context term1 term2 &&
+             List.fold_right2 (fun x y b -> b && aux context x y) pl1 pl2 true
+        | (C.Fix (i1,fl1), C.Fix (i2,fl2)) ->
+           let tys =
+            List.map (function (n,_,ty,_) -> Some (C.Name n,(C.Decl ty))) fl1
+           in
+            i1 = i2 &&
+             List.fold_right2
+              (fun (_,recindex1,ty1,bo1) (_,recindex2,ty2,bo2) b ->
+                b && recindex1 = recindex2 && aux context ty1 ty2 &&
+                 aux (tys@context) bo1 bo2)
+              fl1 fl2 true
+        | (C.CoFix (i1,fl1), C.CoFix (i2,fl2)) ->
+           let tys =
+            List.map (function (n,ty,_) -> Some (C.Name n,(C.Decl ty))) fl1
+           in
+            i1 = i2 &&
+             List.fold_right2
+              (fun (_,ty1,bo1) (_,ty2,bo2) b ->
+                b && aux context ty1 ty2 && aux (tys@context) bo1 bo2)
+              fl1 fl2 true
+        | (C.Cast _, _) | (_, C.Cast _)
+        | (C.Implicit, _) | (_, C.Implicit) ->
+           raise (Impossible 3) (* we don't trust our whd ;-) *)
+        | (_,_) -> false
+    end
   in
    if aux2 t1 t2 then true
-   else aux2 (whd t1) (whd t2)
-in
- aux 
-;; 
-
-
-
-
-
-
-
-
-
-
-
+   else
+    begin
+     debug t1 [t2] "PREWHD";
+     let t1' = whd context t1 in
+     let t2' = whd context t2 in
+      debug t1' [t2'] "POSTWHD";
+      aux2 t1' t2'
+    end
+ in
+  aux
+;;
diff --git a/helm/ocaml/cic_proof_checking/cicReductionMachine.mli b/helm/ocaml/cic_proof_checking/cicReductionMachine.mli
index d61bc7251..7a6255003 100644
--- a/helm/ocaml/cic_proof_checking/cicReductionMachine.mli
+++ b/helm/ocaml/cic_proof_checking/cicReductionMachine.mli
@@ -24,11 +24,10 @@
  *)
 
 exception WrongUriToInductiveDefinition
-exception ReferenceToDefinition
-exception ReferenceToAxiom
+exception ReferenceToConstant
 exception ReferenceToVariable
 exception ReferenceToCurrentProof
 exception ReferenceToInductiveDefinition
 val fdebug : int ref
-val whd : Cic.term -> Cic.term
-val are_convertible : Cic.term -> Cic.term -> bool
+val whd : Cic.context -> Cic.term -> Cic.term
+val are_convertible : Cic.context -> Cic.term -> Cic.term -> bool
diff --git a/helm/ocaml/cic_proof_checking/cicReductionNaif.ml b/helm/ocaml/cic_proof_checking/cicReductionNaif.ml
index f569e75cd..581c5918f 100644
--- a/helm/ocaml/cic_proof_checking/cicReductionNaif.ml
+++ b/helm/ocaml/cic_proof_checking/cicReductionNaif.ml
@@ -31,18 +31,14 @@ let debug t env s =
  let rec debug_aux t i =
   let module C = Cic in
   let module U = UriManager in
-   CicPp.ppobj (C.Variable ("DEBUG", None, t)) ^ "\n" ^ i
+   CicPp.ppobj (C.Variable ("DEBUG", None, t, [])) ^ "\n" ^ i
  in
   if !fdebug = 0 then
-   begin
-    print_endline (s ^ "\n" ^ List.fold_right debug_aux (t::env) "") ;
-    flush stdout
-   end
+   prerr_endline (s ^ "\n" ^ List.fold_right debug_aux (t::env) "")
 ;;
 
 exception Impossible of int;;
-exception ReferenceToDefinition;;
-exception ReferenceToAxiom;;
+exception ReferenceToConstant;;
 exception ReferenceToVariable;;
 exception ReferenceToCurrentProof;;
 exception ReferenceToInductiveDefinition;;
@@ -60,14 +56,14 @@ let whd context =
          | Some (_, C.Def bo) -> whdaux l (S.lift n bo)
 	 | None -> raise RelToHiddenHypothesis
        )
-    | C.Var uri as t ->
-       (match CicEnvironment.get_cooked_obj uri 0 with
-           C.Definition _ -> raise ReferenceToDefinition
-         | C.Axiom _ -> raise ReferenceToAxiom
+    | C.Var (uri,exp_named_subst) as t ->
+       (match CicEnvironment.get_cooked_obj ~trust:false uri with
+           C.Constant _ -> raise ReferenceToConstant
          | C.CurrentProof _ -> raise ReferenceToCurrentProof
          | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
-         | C.Variable (_,None,_) -> if l = [] then t else C.Appl (t::l)
-         | C.Variable (_,Some body,_) -> whdaux l body
+         | C.Variable (_,None,_,_) -> if l = [] then t else C.Appl (t::l)
+         | C.Variable (_,Some body,_,_) ->
+            whdaux l (CicSubstitution.subst_vars exp_named_subst body)
        )
     | C.Meta _ as t -> if l = [] then t else C.Appl (t::l)
     | C.Sort _ as t -> t (* l should be empty *)
@@ -83,17 +79,19 @@ let whd context =
     | C.LetIn (n,s,t) -> whdaux l (S.subst (whdaux [] s) t)
     | C.Appl (he::tl) -> whdaux (tl@l) he
     | C.Appl [] -> raise (Impossible 1)
-    | C.Const (uri,cookingsno) as t ->
-       (match CicEnvironment.get_cooked_obj uri cookingsno with
-           C.Definition (_,body,_,_) -> whdaux l body
-         | C.Axiom _ -> if l = [] then t else C.Appl (t::l)
+    | C.Const (uri,exp_named_subst) as t ->
+       (match CicEnvironment.get_cooked_obj ~trust:false uri with
+           C.Constant (_,Some body,_,_) ->
+            whdaux l (CicSubstitution.subst_vars exp_named_subst body)
+         | C.Constant _ -> if l = [] then t else C.Appl (t::l)
          | C.Variable _ -> raise ReferenceToVariable
-         | C.CurrentProof (_,_,body,_) -> whdaux l body
+         | C.CurrentProof (_,_,body,_,_) ->
+            whdaux l (CicSubstitution.subst_vars exp_named_subst body)
          | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
        )
-    | C.MutInd (uri,_,_) as t -> if l = [] then t else C.Appl (t::l)
-    | C.MutConstruct (uri,_,_,_) as t -> if l = [] then t else C.Appl (t::l)
-    | C.MutCase (mutind,cookingsno,i,_,term,pl) as t->
+    | C.MutInd _ as t -> if l = [] then t else C.Appl (t::l)
+    | C.MutConstruct _ as t -> if l = [] then t else C.Appl (t::l)
+    | C.MutCase (mutind,i,_,term,pl) as t->
        let decofix =
         function
            C.CoFix (i,fl) as t ->
@@ -119,35 +117,28 @@ let whd context =
          | t -> t
        in
         (match decofix (whdaux [] term) with
-            C.MutConstruct (_,_,_,j) -> whdaux l (List.nth pl (j-1))
-          | C.Appl (C.MutConstruct (_,_,_,j) :: tl) ->
-             let (arity, r, num_ingredients) =
+            C.MutConstruct (_,_,j,_) -> whdaux l (List.nth pl (j-1))
+          | C.Appl (C.MutConstruct (_,_,j,_) :: tl) ->
+             let (arity, r) =
               match CicEnvironment.get_obj mutind with
                  C.InductiveDefinition (tl,ingredients,r) ->
-                   let (_,_,arity,_) = List.nth tl i
-                   and num_ingredients =
-                    List.fold_right
-                     (fun (k,l) i ->
-                       if k < cookingsno then i + List.length l else i
-                     ) ingredients 0
-                   in
-                    (arity,r,num_ingredients)
+                   let (_,_,arity,_) = List.nth tl i in
+                    (arity,r)
                | _ -> raise WrongUriToInductiveDefinition
              in
               let ts =
-               let num_to_eat = r + num_ingredients in
-                let rec eat_first =
-                 function
-                    (0,l) -> l
-                  | (n,he::tl) when n > 0 -> eat_first (n - 1, tl)
-                  | _ -> raise (Impossible 5)
-                in
-                 eat_first (num_to_eat,tl)
+               let rec eat_first =
+                function
+                   (0,l) -> l
+                 | (n,he::tl) when n > 0 -> eat_first (n - 1, tl)
+                 | _ -> raise (Impossible 5)
+               in
+                eat_first (r,tl)
               in
                whdaux (ts@l) (List.nth pl (j-1))
-         | C.Cast _ | C.Implicit ->
-            raise (Impossible 2) (* we don't trust our whd ;-) *)
-         | _ -> if l = [] then t else C.Appl (t::l)
+          | C.Cast _ | C.Implicit ->
+             raise (Impossible 2) (* we don't trust our whd ;-) *)
+          | _ -> if l = [] then t else C.Appl (t::l)
        )
     | C.Fix (i,fl) as t ->
        let (_,recindex,_,body) = List.nth fl i in
@@ -204,7 +195,16 @@ let are_convertible =
      let module C = Cic in
        match (t1,t2) with
           (C.Rel n1, C.Rel n2) -> n1 = n2
-        | (C.Var uri1, C.Var uri2) -> U.eq uri1 uri2
+        | (C.Var (uri1,exp_named_subst1), C.Var (uri2,exp_named_subst2)) ->
+            U.eq uri1 uri2 &&
+             (try
+               List.fold_right2
+                (fun (uri1,x) (uri2,y) b ->
+                  U.eq uri1 uri2 && aux context x y && b
+                ) exp_named_subst1 exp_named_subst2 true 
+              with
+               Invalid_argument _ -> false
+             )
         | (C.Meta (n1,l1), C.Meta (n2,l2)) -> 
             n1 = n2 &&
              List.fold_left2
@@ -228,31 +228,42 @@ let are_convertible =
             with
              Invalid_argument _ -> false
            )
-        | (C.Const (uri1,_), C.Const (uri2,_)) ->
-            (*CSC: questo commento e' chiaro o delirante? Io lo sto scrivendo *)
-            (*CSC: mentre sono delirante, quindi ...                          *)
-            (* WARNING: it is really important that the two cookingsno are not*)
-            (* checked for equality. This allows not to cook an object with no*)
-            (* ingredients only to update the cookingsno. E.g: if a term t has*)
-            (* a reference to a term t1 which does not depend on any variable *)
-            (* and t1 depends on a term t2 (that can't depend on any variable *)
-            (* because of t1), then t1 cooked at every level could be the same*)
-            (* as t1 cooked at level 0. Doing so, t2 will be extended in t    *)
-            (* with cookingsno 0 and not 2. But this will not cause any       *)
-            (* trouble if here we don't check that the two cookingsno are     *)
-            (* equal.                                                         *)
-            U.eq uri1 uri2
-        | (C.MutInd (uri1,k1,i1), C.MutInd (uri2,k2,i2)) ->
-            (* WARNIG: see the previous warning *)
-            U.eq uri1 uri2 && i1 = i2
-        | (C.MutConstruct (uri1,_,i1,j1), C.MutConstruct (uri2,_,i2,j2)) ->
-            (* WARNIG: see the previous warning *)
-            U.eq uri1 uri2 && i1 = i2 && j1 = j2
-        | (C.MutCase (uri1,_,i1,outtype1,term1,pl1),
-           C.MutCase (uri2,_,i2,outtype2,term2,pl2)) -> 
-            (* WARNIG: see the previous warning *)
-            (* aux context outtype1 outtype2 should be true if *)
-            (* aux context pl1 pl2 *)
+        | (C.Const (uri1,exp_named_subst1), C.Const (uri2,exp_named_subst2)) ->
+            U.eq uri1 uri2 &&
+             (try
+               List.fold_right2
+                (fun (uri1,x) (uri2,y) b ->
+                  U.eq uri1 uri2 && aux context x y && b
+                ) exp_named_subst1 exp_named_subst2 true 
+              with
+               Invalid_argument _ -> false
+             )
+        | (C.MutInd (uri1,i1,exp_named_subst1),
+           C.MutInd (uri2,i2,exp_named_subst2)
+          ) ->
+            U.eq uri1 uri2 && i1 = i2 &&
+             (try
+               List.fold_right2
+                (fun (uri1,x) (uri2,y) b ->
+                  U.eq uri1 uri2 && aux context x y && b
+                ) exp_named_subst1 exp_named_subst2 true 
+              with
+               Invalid_argument _ -> false
+             )
+        | (C.MutConstruct (uri1,i1,j1,exp_named_subst1),
+           C.MutConstruct (uri2,i2,j2,exp_named_subst2)
+          ) ->
+            U.eq uri1 uri2 && i1 = i2 && j1 = j2 &&
+             (try
+               List.fold_right2
+                (fun (uri1,x) (uri2,y) b ->
+                  U.eq uri1 uri2 && aux context x y && b
+                ) exp_named_subst1 exp_named_subst2 true 
+              with
+               Invalid_argument _ -> false
+             )
+        | (C.MutCase (uri1,i1,outtype1,term1,pl1),
+           C.MutCase (uri2,i2,outtype2,term2,pl2)) -> 
             U.eq uri1 uri2 && i1 = i2 && aux context outtype1 outtype2 &&
              aux context term1 term2 &&
              List.fold_right2 (fun x y b -> b && aux context x y) pl1 pl2 true
diff --git a/helm/ocaml/cic_proof_checking/cicReductionNaif.mli b/helm/ocaml/cic_proof_checking/cicReductionNaif.mli
index d61bc7251..7a6255003 100644
--- a/helm/ocaml/cic_proof_checking/cicReductionNaif.mli
+++ b/helm/ocaml/cic_proof_checking/cicReductionNaif.mli
@@ -24,11 +24,10 @@
  *)
 
 exception WrongUriToInductiveDefinition
-exception ReferenceToDefinition
-exception ReferenceToAxiom
+exception ReferenceToConstant
 exception ReferenceToVariable
 exception ReferenceToCurrentProof
 exception ReferenceToInductiveDefinition
 val fdebug : int ref
-val whd : Cic.term -> Cic.term
-val are_convertible : Cic.term -> Cic.term -> bool
+val whd : Cic.context -> Cic.term -> Cic.term
+val are_convertible : Cic.context -> Cic.term -> Cic.term -> bool
diff --git a/helm/ocaml/cic_proof_checking/cicSubstitution.ml b/helm/ocaml/cic_proof_checking/cicSubstitution.ml
index f312f556c..4a938acb9 100644
--- a/helm/ocaml/cic_proof_checking/cicSubstitution.ml
+++ b/helm/ocaml/cic_proof_checking/cicSubstitution.ml
@@ -25,6 +25,10 @@
 
 exception CannotSubstInMeta;;
 exception RelToHiddenHypothesis;;
+exception ReferenceToVariable;;
+exception ReferenceToConstant;;
+exception ReferenceToCurrentProof;;
+exception ReferenceToInductiveDefinition;;
 
 let lift n =
  let rec liftaux k =
@@ -35,7 +39,11 @@ let lift n =
         C.Rel m
        else
         C.Rel (m + n)
-    | C.Var _  as t -> t
+    | C.Var (uri,exp_named_subst) ->
+       let exp_named_subst' = 
+        List.map (function (uri,t) -> (uri,liftaux k t)) exp_named_subst
+       in
+        C.Var (uri,exp_named_subst')
     | C.Meta (i,l) ->
        let l' =
         List.map
@@ -52,11 +60,23 @@ let lift n =
     | C.Lambda (n,s,t) -> C.Lambda (n, liftaux k s, liftaux (k+1) t)
     | C.LetIn (n,s,t) -> C.LetIn (n, liftaux k s, liftaux (k+1) t)
     | C.Appl l -> C.Appl (List.map (liftaux k) l)
-    | C.Const _ as t -> t
-    | C.MutInd _ as t -> t
-    | C.MutConstruct _ as t -> t
-    | C.MutCase (sp,cookingsno,i,outty,t,pl) ->
-       C.MutCase (sp, cookingsno, i, liftaux k outty, liftaux k t,
+    | C.Const (uri,exp_named_subst) ->
+       let exp_named_subst' = 
+        List.map (function (uri,t) -> (uri,liftaux k t)) exp_named_subst
+       in
+        C.Const (uri,exp_named_subst')
+    | C.MutInd (uri,tyno,exp_named_subst) ->
+       let exp_named_subst' = 
+        List.map (function (uri,t) -> (uri,liftaux k t)) exp_named_subst
+       in
+        C.MutInd (uri,tyno,exp_named_subst')
+    | C.MutConstruct (uri,tyno,consno,exp_named_subst) ->
+       let exp_named_subst' = 
+        List.map (function (uri,t) -> (uri,liftaux k t)) exp_named_subst
+       in
+        C.MutConstruct (uri,tyno,consno,exp_named_subst')
+    | C.MutCase (sp,i,outty,t,pl) ->
+       C.MutCase (sp, i, liftaux k outty, liftaux k t,
         List.map (liftaux k) pl)
     | C.Fix (i, fl) ->
        let len = List.length fl in
@@ -91,7 +111,11 @@ let subst arg =
          | n when n < k -> t
          | _            -> C.Rel (n - 1)
        )
-    | C.Var _ as t  -> t
+    | C.Var (uri,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map (function (uri,t) -> (uri,substaux k t)) exp_named_subst
+       in
+        C.Var (uri,exp_named_subst')
     | C.Meta (i, l) as t -> 
        let l' =
         List.map
@@ -116,11 +140,23 @@ let subst arg =
           | _ as he' -> C.Appl (he'::tl')
         end
     | C.Appl _ -> assert false
-    | C.Const _ as t -> t
-    | C.MutInd _ as t -> t
-    | C.MutConstruct _ as t -> t
-    | C.MutCase (sp,cookingsno,i,outt,t,pl) ->
-       C.MutCase (sp,cookingsno,i,substaux k outt, substaux k t,
+    | C.Const (uri,exp_named_subst)  ->
+       let exp_named_subst' =
+        List.map (function (uri,t) -> (uri,substaux k t)) exp_named_subst
+       in
+        C.Const (uri,exp_named_subst')
+    | C.MutInd (uri,typeno,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map (function (uri,t) -> (uri,substaux k t)) exp_named_subst
+       in
+        C.MutInd (uri,typeno,exp_named_subst')
+    | C.MutConstruct (uri,typeno,consno,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map (function (uri,t) -> (uri,substaux k t)) exp_named_subst
+       in
+        C.MutConstruct (uri,typeno,consno,exp_named_subst')
+    | C.MutCase (sp,i,outt,t,pl) ->
+       C.MutCase (sp,i,substaux k outt, substaux k t,
         List.map (substaux k) pl)
     | C.Fix (i,fl) ->
        let len = List.length fl in
@@ -142,35 +178,164 @@ let subst arg =
   substaux 1
 ;;
 
-let undebrujin_inductive_def uri =
- function
-    Cic.InductiveDefinition (dl,params,n_ind_params) ->
-     let dl' =
-      List.map
-       (fun (name,inductive,arity,constructors) ->
-         let constructors' =
-          List.map
-           (fun (name,ty,r) ->
-             let ty' =
-              let counter = ref (List.length dl) in
-               List.fold_right
-                (fun _ ->
-                  decr counter ;
-                  subst (Cic.MutInd (uri,0,!counter))
-                ) dl ty
-             in
-              (name,ty',r)
-           ) constructors
+(*CSC: i controlli di tipo debbono essere svolti da destra a             *)
+(*CSC: sinistra: i{B/A;b/a} ==> a{B/A;b/a} ==> a{b/a{B/A}} ==> b         *)
+(*CSC: la sostituzione ora e' implementata in maniera simultanea, ma     *)
+(*CSC: dovrebbe diventare da sinistra verso destra:                      *)
+(*CSC: t{a=a/A;b/a} ==> \H:a=a.H{b/a} ==> \H:b=b.H                       *)
+(*CSC: per la roba che proviene da Coq questo non serve!                 *)
+let subst_vars exp_named_subst =
+(*
+prerr_endline ("@@@POSSIBLE BUG: SUBSTITUTION IS NOT SIMULTANEOUS") ;
+*)
+ let rec substaux k =
+  let module C = Cic in
+   function
+      C.Rel _ as t -> t
+    | C.Var (uri,exp_named_subst') ->
+       (try
+         let (_,arg) =
+          List.find
+           (function (varuri,_) -> UriManager.eq uri varuri) exp_named_subst
          in
-          (name,inductive,arity,constructors')
-       ) dl
-      in
-       Cic.InductiveDefinition (dl', params, n_ind_params)
-  | obj -> obj
+          lift (k -1) arg
+        with
+         Not_found ->
+          let params =
+           (match CicEnvironment.get_cooked_obj ~trust:true uri with
+               C.Constant _ -> raise ReferenceToConstant
+             | C.Variable (_,_,_,params) -> params
+             | C.CurrentProof _ -> raise ReferenceToCurrentProof
+             | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+           )
+          in
+(*
+prerr_endline "\n\n---- BEGIN " ;
+prerr_endline ("----params: " ^ String.concat " ; " (List.map UriManager.string_of_uri params)) ;
+prerr_endline ("----S(" ^ UriManager.string_of_uri uri ^ "): " ^ String.concat " ; " (List.map (function (uri,_) -> UriManager.string_of_uri uri) exp_named_subst)) ;
+prerr_endline ("----P: " ^ String.concat " ; " (List.map (function (uri,_) -> UriManager.string_of_uri uri) exp_named_subst')) ;
+*)
+           let exp_named_subst'' =
+            substaux_in_exp_named_subst uri k exp_named_subst' params
+           in
+(*
+prerr_endline ("----D: " ^ String.concat " ; " (List.map (function (uri,_) -> UriManager.string_of_uri uri) exp_named_subst'')) ;
+prerr_endline "---- END\n\n " ;
+*)
+            C.Var (uri,exp_named_subst'')
+       )
+    | C.Meta (i, l) as t -> 
+       let l' =
+        List.map
+         (function
+             None -> None
+           | Some t -> Some (substaux k t)
+         ) l
+       in
+        C.Meta(i,l')
+    | C.Sort _ as t -> t
+    | C.Implicit as t -> t
+    | C.Cast (te,ty) -> C.Cast (substaux k te, substaux k ty)
+    | C.Prod (n,s,t) -> C.Prod (n, substaux k s, substaux (k + 1) t)
+    | C.Lambda (n,s,t) -> C.Lambda (n, substaux k s, substaux (k + 1) t)
+    | C.LetIn (n,s,t) -> C.LetIn (n, substaux k s, substaux (k + 1) t)
+    | C.Appl (he::tl) ->
+       (* Invariant: no Appl applied to another Appl *)
+       let tl' = List.map (substaux k) tl in
+        begin
+         match substaux k he with
+            C.Appl l -> C.Appl (l@tl')
+          | _ as he' -> C.Appl (he'::tl')
+        end
+    | C.Appl _ -> assert false
+    | C.Const (uri,exp_named_subst')  ->
+       let params =
+        (match CicEnvironment.get_cooked_obj ~trust:true uri with
+            C.Constant (_,_,_,params) -> params
+          | C.Variable _ -> raise ReferenceToVariable
+          | C.CurrentProof (_,_,_,_,params) -> params
+          | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+        )
+       in
+        let exp_named_subst'' =
+         substaux_in_exp_named_subst uri k exp_named_subst' params
+        in
+         C.Const (uri,exp_named_subst'')
+    | C.MutInd (uri,typeno,exp_named_subst') ->
+       let params =
+        (match CicEnvironment.get_cooked_obj ~trust:true uri with
+            C.Constant _ -> raise ReferenceToConstant
+          | C.Variable _ -> raise ReferenceToVariable
+          | C.CurrentProof _ -> raise ReferenceToCurrentProof
+          | C.InductiveDefinition (_,params,_) -> params
+        )
+       in
+        let exp_named_subst'' =
+         substaux_in_exp_named_subst uri k exp_named_subst' params
+        in
+         C.MutInd (uri,typeno,exp_named_subst'')
+    | C.MutConstruct (uri,typeno,consno,exp_named_subst') ->
+       let params =
+        (match CicEnvironment.get_cooked_obj ~trust:true uri with
+            C.Constant _ -> raise ReferenceToConstant
+          | C.Variable _ -> raise ReferenceToVariable
+          | C.CurrentProof _ -> raise ReferenceToCurrentProof
+          | C.InductiveDefinition (_,params,_) -> params
+        )
+       in
+        let exp_named_subst'' =
+         substaux_in_exp_named_subst uri k exp_named_subst' params
+        in
+         C.MutConstruct (uri,typeno,consno,exp_named_subst'')
+    | C.MutCase (sp,i,outt,t,pl) ->
+       C.MutCase (sp,i,substaux k outt, substaux k t,
+        List.map (substaux k) pl)
+    | C.Fix (i,fl) ->
+       let len = List.length fl in
+       let substitutedfl =
+        List.map
+         (fun (name,i,ty,bo) -> (name, i, substaux k ty, substaux (k+len) bo))
+          fl
+       in
+        C.Fix (i, substitutedfl)
+    | C.CoFix (i,fl) ->
+       let len = List.length fl in
+       let substitutedfl =
+        List.map
+         (fun (name,ty,bo) -> (name, substaux k ty, substaux (k+len) bo))
+          fl
+       in
+        C.CoFix (i, substitutedfl)
+ and substaux_in_exp_named_subst uri k exp_named_subst' params =
+(*CSC: invece di concatenare sarebbe meglio rispettare l'ordine dei params *)
+(*CSC: e' vero???? una veloce prova non sembra confermare la teoria        *)
+  let rec filter_and_lift =
+   function
+      [] -> []
+    | (uri,t)::tl when
+        List.for_all
+         (function (uri',_) -> not (UriManager.eq uri uri')) exp_named_subst'
+        &&
+         List.mem uri params
+       ->
+        (uri,lift (k-1) t)::(filter_and_lift tl)
+    | _::tl -> filter_and_lift tl
+(*
+    | (uri,_)::tl ->
+prerr_endline ("---- SKIPPO " ^ UriManager.string_of_uri uri) ;
+if List.for_all (function (uri',_) -> not (UriManager.eq uri uri')) exp_named_subst' then prerr_endline "---- OK1" ;
+prerr_endline ("++++ uri " ^ UriManager.string_of_uri uri ^ " not in " ^ String.concat " ; " (List.map UriManager.string_of_uri params)) ;
+if List.mem uri params then prerr_endline "---- OK2" ;
+        filter_and_lift tl
+*)
+  in
+   List.map (function (uri,t) -> (uri,substaux k t)) exp_named_subst' @
+    (filter_and_lift exp_named_subst)
+ in
+  substaux 1
 ;;
 
 (* l is the relocation list *)
-
 let lift_meta l t = 
     let module C = Cic in
     if l = [] then t else 
@@ -184,7 +349,11 @@ let lift_meta l t =
           with
            (Failure _) -> assert false
          )
-    | C.Var _ as t  -> t
+    | C.Var (uri,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map (function (uri,t) -> (uri,aux k t)) exp_named_subst
+       in
+        C.Var (uri,exp_named_subst')
     | C.Meta (i,l) ->
        let l' =
         List.map
@@ -205,12 +374,23 @@ let lift_meta l t =
     | C.Lambda (n,s,t) -> C.Lambda (n, aux k s, aux (k + 1) t)
     | C.LetIn (n,s,t) -> C.LetIn (n, aux k s, aux (k + 1) t)
     | C.Appl l -> C.Appl (List.map (aux k) l)
-    | C.Const _ as t -> t
-    | C.MutInd _ as t -> t
-    | C.MutConstruct _ as t -> t
-    | C.MutCase (sp,cookingsno,i,outt,t,pl) ->
-       C.MutCase (sp,cookingsno,i,aux k outt, aux k t,
-        List.map (aux k) pl)
+    | C.Const (uri,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map (function (uri,t) -> (uri,aux k t)) exp_named_subst
+       in
+        C.Const (uri,exp_named_subst')
+    | C.MutInd (uri,typeno,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map (function (uri,t) -> (uri,aux k t)) exp_named_subst
+       in
+        C.MutInd (uri,typeno,exp_named_subst')
+    | C.MutConstruct (uri,typeno,consno,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map (function (uri,t) -> (uri,aux k t)) exp_named_subst
+       in
+        C.MutConstruct (uri,typeno,consno,exp_named_subst')
+    | C.MutCase (sp,i,outt,t,pl) ->
+       C.MutCase (sp,i,aux k outt, aux k t, List.map (aux k) pl)
     | C.Fix (i,fl) ->
        let len = List.length fl in
        let substitutedfl =
diff --git a/helm/ocaml/cic_proof_checking/cicSubstitution.mli b/helm/ocaml/cic_proof_checking/cicSubstitution.mli
index 8915b814a..038b5de3f 100644
--- a/helm/ocaml/cic_proof_checking/cicSubstitution.mli
+++ b/helm/ocaml/cic_proof_checking/cicSubstitution.mli
@@ -23,7 +23,24 @@
  * http://cs.unibo.it/helm/.
  *)
 
+exception CannotSubstInMeta;;
+exception RelToHiddenHypothesis;;
+exception ReferenceToVariable;;
+exception ReferenceToConstant;;
+exception ReferenceToInductiveDefinition;;
+
+(* lift n t         *)
+(* lifts [t] of [n] *)
 val lift : int -> Cic.term -> Cic.term
+
+(* subst t1 t2                          *)
+(* substitutes [t1] for [Rel 1] in [t2] *)
 val subst : Cic.term -> Cic.term -> Cic.term
+
+(* subst_vars exp_named_subst t2     *)
+(* applies [exp_named_subst] to [t2] *)
+val subst_vars :
+ Cic.term Cic.explicit_named_substitution -> Cic.term -> Cic.term
+
+(* ?????????? *)
 val lift_meta : (Cic.term option) list -> Cic.term -> Cic.term
-val undebrujin_inductive_def : UriManager.uri -> Cic.obj -> Cic.obj
diff --git a/helm/ocaml/cic_proof_checking/cicTypeChecker.ml b/helm/ocaml/cic_proof_checking/cicTypeChecker.ml
index 11d68b78c..48d8b2ea9 100644
--- a/helm/ocaml/cic_proof_checking/cicTypeChecker.ml
+++ b/helm/ocaml/cic_proof_checking/cicTypeChecker.ml
@@ -23,27 +23,33 @@
  * http://cs.unibo.it/helm/.
  *)
 
-exception Impossible of int;;
-exception NotWellTyped of string;;
-exception WrongUriToConstant of string;;
-exception WrongUriToVariable of string;;
-exception WrongUriToMutualInductiveDefinitions of string;;
-exception ListTooShort;;
-exception NotPositiveOccurrences of string;;
-exception NotWellFormedTypeOfInductiveConstructor of string;;
-exception WrongRequiredArgument of string;;
-exception RelToHiddenHypothesis;;
-exception MetasenvInconsistency;;
+type type_checker_exn =
+   Impossible of int
+ | NotWellTyped of string
+ | WrongUriToConstant of string
+ | WrongUriToVariable of string
+ | WrongUriToMutualInductiveDefinitions of string
+ | ListTooShort
+ | NotPositiveOccurrences of string
+ | NotWellFormedTypeOfInductiveConstructor of string
+ | WrongRequiredArgument of string
+ | RelToHiddenHypothesis
+ | MetasenvInconsistency;;
+
+(* This is the only exception that will be raised *)
+exception TypeCheckerFailure of type_checker_exn;;
 
 let fdebug = ref 0;;
 let debug t context =
  let rec debug_aux t i =
   let module C = Cic in
   let module U = UriManager in
-   CicPp.ppobj (C.Variable ("DEBUG", None, t)) ^ "\n" ^ i
+   CicPp.ppobj (C.Variable ("DEBUG", None, t, [])) ^ "\n" ^ i
  in
   if !fdebug = 0 then
-   raise (NotWellTyped ("\n" ^ List.fold_right debug_aux (t::context) ""))
+   raise
+    (TypeCheckerFailure
+      (NotWellTyped ("\n" ^ List.fold_right debug_aux (t::context) "")))
    (*print_endline ("\n" ^ List.fold_right debug_aux (t::context) "") ; flush stdout*)
 ;;
 
@@ -51,57 +57,133 @@ let rec split l n =
  match (l,n) with
     (l,0) -> ([], l)
   | (he::tl, n) -> let (l1,l2) = split tl (n-1) in (he::l1,l2)
-  | (_,_) -> raise ListTooShort
+  | (_,_) -> raise (TypeCheckerFailure ListTooShort)
+;;
+
+let debrujin_constructor uri number_of_types =
+ let rec aux k =
+  let module C = Cic in
+   function
+      C.Rel n as t when n <= k -> t
+    | C.Rel _ ->
+        raise (TypeCheckerFailure (NotWellTyped ("Debrujin: open term found")))
+    | C.Var (uri,exp_named_subst) ->
+       let exp_named_subst' = 
+        List.map (function (uri,t) -> (uri,aux k t)) exp_named_subst
+       in
+        C.Var (uri,exp_named_subst')
+    | C.Meta _ -> assert false
+    | C.Sort _
+    | C.Implicit as t -> t
+    | C.Cast (te,ty) -> C.Cast (aux k te, aux k ty)
+    | C.Prod (n,s,t) -> C.Prod (n, aux k s, aux (k+1) t)
+    | C.Lambda (n,s,t) -> C.Lambda (n, aux k s, aux (k+1) t)
+    | C.LetIn (n,s,t) -> C.LetIn (n, aux k s, aux (k+1) t)
+    | C.Appl l -> C.Appl (List.map (aux k) l)
+    | C.Const (uri,exp_named_subst) ->
+       let exp_named_subst' = 
+        List.map (function (uri,t) -> (uri,aux k t)) exp_named_subst
+       in
+        C.Const (uri,exp_named_subst')
+    | C.MutInd (uri',tyno,exp_named_subst) when UriManager.eq uri uri' ->
+       if exp_named_subst != [] then
+        raise
+         (TypeCheckerFailure
+           (NotWellTyped
+            ("Debrujin: a non-empty explicit named substitution is applied to "^
+             "a mutual inductive type which is being defined"))) ;
+       C.Rel (k + number_of_types - tyno) ;
+    | C.MutInd (uri',tyno,exp_named_subst) ->
+       let exp_named_subst' = 
+        List.map (function (uri,t) -> (uri,aux k t)) exp_named_subst
+       in
+        C.MutInd (uri',tyno,exp_named_subst')
+    | C.MutConstruct (uri,tyno,consno,exp_named_subst) ->
+       let exp_named_subst' = 
+        List.map (function (uri,t) -> (uri,aux k t)) exp_named_subst
+       in
+        C.MutConstruct (uri,tyno,consno,exp_named_subst')
+    | C.MutCase (sp,i,outty,t,pl) ->
+       C.MutCase (sp, i, aux k outty, aux k t,
+        List.map (aux k) pl)
+    | C.Fix (i, fl) ->
+       let len = List.length fl in
+       let liftedfl =
+        List.map
+         (fun (name, i, ty, bo) -> (name, i, aux k ty, aux (k+len) bo))
+          fl
+       in
+        C.Fix (i, liftedfl)
+    | C.CoFix (i, fl) ->
+       let len = List.length fl in
+       let liftedfl =
+        List.map
+         (fun (name, ty, bo) -> (name, aux k ty, aux (k+len) bo))
+          fl
+       in
+        C.CoFix (i, liftedfl)
+ in
+  aux 0
 ;;
 
 exception CicEnvironmentError;;
 
-let rec cooked_type_of_constant uri cookingsno =
+let rec type_of_constant uri =
  let module C = Cic in
  let module R = CicReduction in
  let module U = UriManager in
   let cobj =
-   match CicEnvironment.is_type_checked uri cookingsno with
+   match CicEnvironment.is_type_checked ~trust:true uri with
       CicEnvironment.CheckedObj cobj -> cobj
     | CicEnvironment.UncheckedObj uobj ->
        Logger.log (`Start_type_checking uri) ;
        (* let's typecheck the uncooked obj *)
        (match uobj with
-           C.Definition (_,te,ty,_) ->
+           C.Constant (_,Some te,ty,_) ->
              let _ = type_of ty in
               if not (R.are_convertible [] (type_of te) ty) then
-               raise (NotWellTyped ("Constant " ^ (U.string_of_uri uri)))
-         | C.Axiom (_,ty,_) ->
+               raise
+                (TypeCheckerFailure
+                  (NotWellTyped ("Constant " ^ (U.string_of_uri uri))))
+         | C.Constant (_,None,ty,_) ->
            (* only to check that ty is well-typed *)
            let _ = type_of ty in ()
-         | C.CurrentProof (_,conjs,te,ty) ->
-             (*CSC: bisogna controllare anche il metasenv!!! *)
-             let _ = type_of_aux' conjs [] ty in
-              if not (R.are_convertible [] (type_of_aux' conjs [] te) ty)
-              then
-               raise (NotWellTyped ("CurrentProof" ^ (U.string_of_uri uri)))
-         | _ -> raise (WrongUriToConstant (U.string_of_uri uri))
+         | C.CurrentProof (_,conjs,te,ty,_) ->
+             let _ =
+              List.fold_left
+               (fun metasenv ((_,context,ty) as conj) ->
+                 ignore (type_of_aux' metasenv context ty) ;
+                 metasenv @ [conj]
+               ) [] conjs
+             in
+              let _ = type_of_aux' conjs [] ty in
+               if not (R.are_convertible [] (type_of_aux' conjs [] te) ty)
+               then
+                raise
+                 (TypeCheckerFailure
+                   (NotWellTyped ("CurrentProof" ^ (U.string_of_uri uri))))
+         | _ ->
+           raise (TypeCheckerFailure (WrongUriToConstant (U.string_of_uri uri)))
        ) ;
        CicEnvironment.set_type_checking_info uri ;
        Logger.log (`Type_checking_completed uri) ;
-       match CicEnvironment.is_type_checked uri cookingsno with
+       match CicEnvironment.is_type_checked ~trust:false uri with
           CicEnvironment.CheckedObj cobj -> cobj
         | CicEnvironment.UncheckedObj _ -> raise CicEnvironmentError
   in
    match cobj with
-      C.Definition (_,_,ty,_) -> ty
-    | C.Axiom (_,ty,_) -> ty
-    | C.CurrentProof (_,_,_,ty) -> ty
-    | _ -> raise (WrongUriToConstant (U.string_of_uri uri))
+      C.Constant (_,_,ty,_) -> ty
+    | C.CurrentProof (_,_,_,ty,_) -> ty
+    | _ -> raise (TypeCheckerFailure (WrongUriToConstant (U.string_of_uri uri)))
 
 and type_of_variable uri =
  let module C = Cic in
  let module R = CicReduction in
  let module U = UriManager in
   (* 0 because a variable is never cooked => no partial cooking at one level *)
-  match CicEnvironment.is_type_checked uri 0 with
-     CicEnvironment.CheckedObj (C.Variable (_,_,ty)) -> ty
-   | CicEnvironment.UncheckedObj (C.Variable (_,bo,ty)) ->
+  match CicEnvironment.is_type_checked ~trust:true uri with
+     CicEnvironment.CheckedObj (C.Variable (_,_,ty,_)) -> ty
+   | CicEnvironment.UncheckedObj (C.Variable (_,bo,ty,_)) ->
       Logger.log (`Start_type_checking uri) ;
       (* only to check that ty is well-typed *)
       let _ = type_of ty in
@@ -109,12 +191,16 @@ and type_of_variable uri =
            None -> ()
          | Some bo ->
             if not (R.are_convertible [] (type_of bo) ty) then
-             raise (NotWellTyped ("Variable " ^ (U.string_of_uri uri)))
+             raise
+              (TypeCheckerFailure
+                (NotWellTyped ("Variable " ^ (U.string_of_uri uri))))
        ) ;
        CicEnvironment.set_type_checking_info uri ;
        Logger.log (`Type_checking_completed uri) ;
        ty
-   |  _ -> raise (WrongUriToVariable (UriManager.string_of_uri uri))
+   |  _ ->
+       raise
+        (TypeCheckerFailure (WrongUriToVariable (UriManager.string_of_uri uri)))
 
 and does_not_occur context n nn te =
  let module C = Cic in
@@ -124,7 +210,6 @@ and does_not_occur context n nn te =
    match CicReduction.whd context te with
       C.Rel m when m > n && m <= nn -> false
     | C.Rel _
-    | C.Var _
     | C.Meta _
     | C.Sort _
     | C.Implicit -> true
@@ -141,10 +226,13 @@ and does_not_occur context n nn te =
         does_not_occur ((Some (name,(C.Def so)))::context) (n + 1) (nn + 1) dest
     | C.Appl l ->
        List.fold_right (fun x i -> i && does_not_occur context n nn x) l true
-    | C.Const _
-    | C.MutInd _
-    | C.MutConstruct _ -> true
-    | C.MutCase (_,_,_,out,te,pl) ->
+    | C.Var (_,exp_named_subst)
+    | C.Const (_,exp_named_subst)
+    | C.MutInd (_,_,exp_named_subst)
+    | C.MutConstruct (_,_,_,exp_named_subst) ->
+       List.fold_right (fun (_,x) i -> i && does_not_occur context n nn x)
+        exp_named_subst true
+    | C.MutCase (_,_,out,te,pl) ->
        does_not_occur context n nn out && does_not_occur context n nn te &&
         List.fold_right (fun x i -> i && does_not_occur context n nn x) pl true
     | C.Fix (_,fl) ->
@@ -181,14 +269,14 @@ and weakly_positive context n nn uri te =
  let module C = Cic in
 (*CSC: Che schifo! Bisogna capire meglio e trovare una soluzione ragionevole!*)
   let dummy_mutind =
-   C.MutInd (UriManager.uri_of_string "cic:/Coq/Init/Datatypes/nat.ind",0,0)
+   C.MutInd (UriManager.uri_of_string "cic:/Coq/Init/Datatypes/nat.ind",0,[])
   in
   (*CSC mettere in cicSubstitution *)
   let rec subst_inductive_type_with_dummy_mutind =
    function
-      C.MutInd (uri',_,0) when UriManager.eq uri' uri ->
+      C.MutInd (uri',0,_) when UriManager.eq uri' uri ->
        dummy_mutind
-    | C.Appl ((C.MutInd (uri',_,0))::tl) when UriManager.eq uri' uri ->
+    | C.Appl ((C.MutInd (uri',0,_))::tl) when UriManager.eq uri' uri ->
        dummy_mutind
     | C.Cast (te,ty) -> subst_inductive_type_with_dummy_mutind te
     | C.Prod (name,so,ta) ->
@@ -199,8 +287,8 @@ and weakly_positive context n nn uri te =
         subst_inductive_type_with_dummy_mutind ta)
     | C.Appl tl ->
        C.Appl (List.map subst_inductive_type_with_dummy_mutind tl)
-    | C.MutCase (uri,cookingsno,i,outtype,term,pl) ->
-       C.MutCase (uri,cookingsno,i,
+    | C.MutCase (uri,i,outtype,term,pl) ->
+       C.MutCase (uri,i,
         subst_inductive_type_with_dummy_mutind outtype,
         subst_inductive_type_with_dummy_mutind term,
         List.map subst_inductive_type_with_dummy_mutind pl)
@@ -212,15 +300,36 @@ and weakly_positive context n nn uri te =
        C.CoFix (i,List.map (fun (name,ty,bo) -> (name,
         subst_inductive_type_with_dummy_mutind ty,
         subst_inductive_type_with_dummy_mutind bo)) fl)
+    | C.Const (uri,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map
+         (function (uri,t) -> (uri,subst_inductive_type_with_dummy_mutind t))
+         exp_named_subst
+       in
+        C.Const (uri,exp_named_subst')
+    | C.MutInd (uri,typeno,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map
+         (function (uri,t) -> (uri,subst_inductive_type_with_dummy_mutind t))
+         exp_named_subst
+       in
+        C.MutInd (uri,typeno,exp_named_subst')
+    | C.MutConstruct (uri,typeno,consno,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map
+         (function (uri,t) -> (uri,subst_inductive_type_with_dummy_mutind t))
+         exp_named_subst
+       in
+        C.MutConstruct (uri,typeno,consno,exp_named_subst')
     | t -> t
   in
   match CicReduction.whd context te with
-     C.Appl ((C.MutInd (uri',_,0))::tl) when UriManager.eq uri' uri -> true
-   | C.MutInd (uri',_,0) when UriManager.eq uri' uri -> true
-   | C.Prod (C.Anonimous,source,dest) ->
+     C.Appl ((C.MutInd (uri',0,_))::tl) when UriManager.eq uri' uri -> true
+   | C.MutInd (uri',0,_) when UriManager.eq uri' uri -> true
+   | C.Prod (C.Anonymous,source,dest) ->
       strictly_positive context n nn
        (subst_inductive_type_with_dummy_mutind source) &&
-       weakly_positive ((Some (C.Anonimous,(C.Decl source)))::context)
+       weakly_positive ((Some (C.Anonymous,(C.Decl source)))::context)
         (n + 1) (nn + 1) uri dest
    | C.Prod (name,source,dest) when
       does_not_occur ((Some (name,(C.Decl source)))::context) 0 n dest ->
@@ -234,7 +343,11 @@ and weakly_positive context n nn uri te =
        (subst_inductive_type_with_dummy_mutind source)&&
        weakly_positive ((Some (name,(C.Decl source)))::context)
         (n + 1) (nn + 1) uri dest
-   | _ -> raise (NotWellFormedTypeOfInductiveConstructor ("Guess where the error is ;-)"))
+   | _ ->
+     raise
+      (TypeCheckerFailure
+        (NotWellFormedTypeOfInductiveConstructor
+          ("Guess where the error is ;-)")))
 
 (* instantiate_parameters ps (x1:T1)...(xn:Tn)C                             *)
 (* returns ((x_|ps|:T_|ps|)...(xn:Tn)C){ps_1 / x1 ; ... ; ps_|ps| / x_|ps|} *)
@@ -246,7 +359,7 @@ and instantiate_parameters params c =
        instantiate_parameters tl
         (CicSubstitution.subst he ta)
    | (C.Cast (te,_), _) -> instantiate_parameters params te
-   | (t,l) -> raise (Impossible 1)
+   | (t,l) -> raise (TypeCheckerFailure (Impossible 1))
 
 and strictly_positive context n nn te =
  let module C = Cic in
@@ -261,18 +374,25 @@ and strictly_positive context n nn te =
        strictly_positive ((Some (name,(C.Decl so)))::context) (n+1) (nn+1) ta
    | C.Appl ((C.Rel m)::tl) when m > n && m <= nn ->
       List.fold_right (fun x i -> i && does_not_occur context n nn x) tl true
-   | C.Appl ((C.MutInd (uri,_,i))::tl) -> 
+   | C.Appl ((C.MutInd (uri,i,exp_named_subst))::tl) -> 
       let (ok,paramsno,ity,cl,name) =
        match CicEnvironment.get_obj uri with
            C.InductiveDefinition (tl,_,paramsno) ->
             let (name,_,ity,cl) = List.nth tl i in
              (List.length tl = 1, paramsno, ity, cl, name)
-         | _ -> raise(WrongUriToMutualInductiveDefinitions(U.string_of_uri uri))
+         | _ ->
+           raise
+            (TypeCheckerFailure
+              (WrongUriToMutualInductiveDefinitions(U.string_of_uri uri)))
       in
        let (params,arguments) = split tl paramsno in
        let lifted_params = List.map (CicSubstitution.lift 1) params in
        let cl' =
-        List.map (fun (_,te,_) -> instantiate_parameters lifted_params te) cl
+        List.map
+         (fun (_,te) ->
+           instantiate_parameters lifted_params
+            (CicSubstitution.subst_vars exp_named_subst te)
+         ) cl
        in
         ok &&
          List.fold_right
@@ -302,22 +422,29 @@ and are_all_occurrences_positive context uri indparamsno i n nn te =
           else
            match CicReduction.whd context x with
               C.Rel m when m = n - (indparamsno - k) -> k - 1
-            | _ -> raise (WrongRequiredArgument (UriManager.string_of_uri uri))
+            | _ ->
+              raise
+               (TypeCheckerFailure
+                 (WrongRequiredArgument (UriManager.string_of_uri uri)))
         ) indparamsno tl
       in
        if last = 0 then
         List.fold_right (fun x i -> i && does_not_occur context n nn x) tl true
        else
-        raise (WrongRequiredArgument (UriManager.string_of_uri uri))
+        raise
+         (TypeCheckerFailure
+          (WrongRequiredArgument (UriManager.string_of_uri uri)))
    | C.Rel m when m = i ->
       if indparamsno = 0 then
        true
       else
-       raise (WrongRequiredArgument (UriManager.string_of_uri uri))
-   | C.Prod (C.Anonimous,source,dest) ->
+       raise
+        (TypeCheckerFailure
+          (WrongRequiredArgument (UriManager.string_of_uri uri)))
+   | C.Prod (C.Anonymous,source,dest) ->
       strictly_positive context n nn source &&
        are_all_occurrences_positive
-        ((Some (C.Anonimous,(C.Decl source)))::context) uri indparamsno
+        ((Some (C.Anonymous,(C.Decl source)))::context) uri indparamsno
         (i+1) (n + 1) (nn + 1) dest
    | C.Prod (name,source,dest) when
       does_not_occur ((Some (name,(C.Decl source)))::context) 0 n dest ->
@@ -330,71 +457,79 @@ and are_all_occurrences_positive context uri indparamsno i n nn te =
       does_not_occur context n nn source &&
        are_all_occurrences_positive ((Some (name,(C.Decl source)))::context)
         uri indparamsno (i+1) (n + 1) (nn + 1) dest
-   | _ -> raise (NotWellFormedTypeOfInductiveConstructor (UriManager.string_of_uri uri))
+   | _ ->
+     raise
+      (TypeCheckerFailure
+       (NotWellFormedTypeOfInductiveConstructor (UriManager.string_of_uri uri)))
 
-(*CSC: cambiare il nome, torna unit! *)
-and cooked_mutual_inductive_defs uri =
+(* Main function to checks the correctness of a mutual *)
+(* inductive block definition. This is the function    *)
+(* exported to the proof-engine.                       *)
+and typecheck_mutual_inductive_defs uri (itl,_,indparamsno) =
  let module U = UriManager in
-  function
-     Cic.InductiveDefinition (itl, _, indparamsno) ->
-      (* let's check if the arity of the inductive types are well *)
-      (* formed                                                   *)
-      List.iter (fun (_,_,x,_) -> let _ = type_of x in ()) itl ;
+  (* let's check if the arity of the inductive types are well *)
+  (* formed                                                   *)
+  List.iter (fun (_,_,x,_) -> let _ = type_of x in ()) itl ;
 
-      (* let's check if the types of the inductive constructors  *)
-      (* are well formed.                                        *)
-      (* In order not to use type_of_aux we put the types of the *)
-      (* mutual inductive types at the head of the types of the  *)
-      (* constructors using Prods                                *)
-      (*CSC: piccola??? inefficienza                             *)
-      let len = List.length itl in
-(*CSC: siamo sicuri che non debba fare anche un List.rev? Il bug *)
-(*CSC: si manifesterebbe solamene con tipi veramente mutualmente *)
-(*CSC: induttivi...                                              *)
-       let tys =
-        List.map (fun (n,_,ty,_) -> Some (Cic.Name n,(Cic.Decl ty))) itl in
-       let _ =
-        List.fold_right
-         (fun (_,_,_,cl) i ->
-           List.iter
-            (fun (name,te,r) -> 
-              let augmented_term =
-               List.fold_right
-                (fun (name,_,ty,_) i -> Cic.Prod (Cic.Name name, ty, i))
-                itl te
-              in
-               let _ = type_of augmented_term in
-                (* let's check also the positivity conditions *)
-                if
-                 not
-                  (are_all_occurrences_positive tys uri indparamsno i 0 len te)
-                then
-                 raise (NotPositiveOccurrences (U.string_of_uri uri))
-                else
-                 match !r with
-                    Some _ -> raise (Impossible 2)
-                  | None -> r := Some (recursive_args tys 0 len te)
-            ) cl ;
-           (i + 1)
-        ) itl 1
-       in
-        ()
-   | _ ->
-     raise (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri))
+  (* let's check if the types of the inductive constructors  *)
+  (* are well formed.                                        *)
+  (* In order not to use type_of_aux we put the types of the *)
+  (* mutual inductive types at the head of the types of the  *)
+  (* constructors using Prods                                *)
+  let len = List.length itl in
+   let tys =
+    List.map (fun (n,_,ty,_) -> Some (Cic.Name n,(Cic.Decl ty))) itl in
+   let _ =
+    List.fold_right
+     (fun (_,_,_,cl) i ->
+       List.iter
+        (fun (name,te) -> 
+          let debrujinedte = debrujin_constructor uri len te in
+          let augmented_term =
+           List.fold_right
+            (fun (name,_,ty,_) i -> Cic.Prod (Cic.Name name, ty, i))
+            itl debrujinedte
+          in
+           let _ = type_of augmented_term in
+            (* let's check also the positivity conditions *)
+            if
+             not
+              (are_all_occurrences_positive tys uri indparamsno i 0 len
+                debrujinedte)
+            then
+             raise
+              (TypeCheckerFailure
+                (NotPositiveOccurrences (U.string_of_uri uri)))
+        ) cl ;
+       (i + 1)
+    ) itl 1
+   in
+    ()
 
-and cooked_type_of_mutual_inductive_defs uri cookingsno i =
+(* Main function to checks the correctness of a mutual *)
+(* inductive block definition.                         *)
+and check_mutual_inductive_defs uri =
+ function
+    Cic.InductiveDefinition (itl, params, indparamsno) ->
+     typecheck_mutual_inductive_defs uri (itl,params,indparamsno)
+  | _ ->
+    raise
+     (TypeCheckerFailure
+       (WrongUriToMutualInductiveDefinitions (UriManager.string_of_uri uri)))
+
+and type_of_mutual_inductive_defs uri i =
  let module C = Cic in
  let module R = CicReduction in
  let module U = UriManager in
   let cobj =
-   match CicEnvironment.is_type_checked uri cookingsno with
+   match CicEnvironment.is_type_checked ~trust:true uri with
       CicEnvironment.CheckedObj cobj -> cobj
     | CicEnvironment.UncheckedObj uobj ->
        Logger.log (`Start_type_checking uri) ;
-       cooked_mutual_inductive_defs uri uobj ;
+       check_mutual_inductive_defs uri uobj ;
        CicEnvironment.set_type_checking_info uri ;
        Logger.log (`Type_checking_completed uri) ;
-       (match CicEnvironment.is_type_checked uri cookingsno with
+       (match CicEnvironment.is_type_checked ~trust:false uri with
           CicEnvironment.CheckedObj cobj -> cobj
         | CicEnvironment.UncheckedObj _ -> raise CicEnvironmentError
        )
@@ -403,21 +538,24 @@ and cooked_type_of_mutual_inductive_defs uri cookingsno i =
       C.InductiveDefinition (dl,_,_) ->
        let (_,_,arity,_) = List.nth dl i in
         arity
-    | _ -> raise (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri))
+    | _ ->
+      raise
+       (TypeCheckerFailure
+         (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri)))
 
-and cooked_type_of_mutual_inductive_constr uri cookingsno i j =
+and type_of_mutual_inductive_constr uri i j =
  let module C = Cic in
  let module R = CicReduction in
  let module U = UriManager in
   let cobj =
-   match CicEnvironment.is_type_checked uri cookingsno with
+   match CicEnvironment.is_type_checked ~trust:true uri with
       CicEnvironment.CheckedObj cobj -> cobj
     | CicEnvironment.UncheckedObj uobj ->
        Logger.log (`Start_type_checking uri) ;
-       cooked_mutual_inductive_defs uri uobj ;
+       check_mutual_inductive_defs uri uobj ;
        CicEnvironment.set_type_checking_info uri ;
        Logger.log (`Type_checking_completed uri) ;
-       (match CicEnvironment.is_type_checked uri cookingsno with
+       (match CicEnvironment.is_type_checked ~trust:false uri with
           CicEnvironment.CheckedObj cobj -> cobj
         | CicEnvironment.UncheckedObj _ -> raise CicEnvironmentError
        )
@@ -425,9 +563,12 @@ and cooked_type_of_mutual_inductive_constr uri cookingsno i j =
    match cobj with
       C.InductiveDefinition (dl,_,_) ->
        let (_,_,_,cl) = List.nth dl i in
-        let (_,ty,_) = List.nth cl (j-1) in
+        let (_,ty) = List.nth cl (j-1) in
          ty
-    | _ -> raise (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri))
+    | _ ->
+      raise
+       (TypeCheckerFailure
+         (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri)))
 
 and recursive_args context n nn te =
  let module C = Cic in
@@ -437,19 +578,22 @@ and recursive_args context n nn te =
    | C.Meta _
    | C.Sort _
    | C.Implicit
-   | C.Cast _ (*CSC ??? *) -> raise (Impossible 3) (* due to type-checking *)
+   | C.Cast _ (*CSC ??? *) ->
+      raise (TypeCheckerFailure (Impossible 3)) (* due to type-checking *)
    | C.Prod (name,so,de) ->
       (not (does_not_occur context n nn so)) ::
        (recursive_args ((Some (name,(C.Decl so)))::context) (n+1) (nn + 1) de)
    | C.Lambda _
-   | C.LetIn _ -> raise (Impossible 4) (* due to type-checking *)
+   | C.LetIn _ ->
+      raise (TypeCheckerFailure (Impossible 4)) (* due to type-checking *)
    | C.Appl _ -> []
-   | C.Const _ -> raise (Impossible 5)
+   | C.Const _ -> raise (TypeCheckerFailure (Impossible 5))
    | C.MutInd _
    | C.MutConstruct _
    | C.MutCase _
    | C.Fix _
-   | C.CoFix _ -> raise (Impossible 6) (* due to type-checking *)
+   | C.CoFix _ ->
+      raise (TypeCheckerFailure (Impossible 6)) (* due to type-checking *)
 
 and get_new_safes context p c rl safes n nn x =
  let module C = Cic in
@@ -477,7 +621,7 @@ and get_new_safes context p c rl safes n nn x =
       (* CSC: as a branch of a case whose type is a Prod. In        *)
       (* CSC: particular, this means that a new (C.Prod, x,_) case  *)
       (* CSC: must be considered in this match. (e.g. x = MutCase)  *)
-      raise (Impossible 7)
+      raise (TypeCheckerFailure (Impossible 7))
 
 and split_prods context n te =
  let module C = Cic in
@@ -486,7 +630,7 @@ and split_prods context n te =
      (0, _) -> context,te
    | (n, C.Prod (name,so,ta)) when n > 0 ->
        split_prods ((Some (name,(C.Decl so)))::context) (n - 1) ta
-   | (_, _) -> raise (Impossible 8)
+   | (_, _) -> raise (TypeCheckerFailure (Impossible 8))
 
 and eat_lambdas context n te =
  let module C = Cic in
@@ -498,7 +642,7 @@ and eat_lambdas context n te =
        eat_lambdas ((Some (name,(C.Decl so)))::context) (n - 1) ta
       in
        (te, k + 1, context')
-   | (_, _) -> raise (Impossible 9)
+   | (_, _) -> raise (TypeCheckerFailure (Impossible 9))
 
 (*CSC: Tutto quello che segue e' l'intuzione di luca ;-) *)
 and check_is_really_smaller_arg context n nn kl x safes te =
@@ -521,7 +665,7 @@ and check_is_really_smaller_arg context n nn kl x safes te =
       check_is_really_smaller_arg n nn kl x safes so &&
        check_is_really_smaller_arg (n+1) (nn+1) kl (x+1)
         (List.map (fun x -> x + 1) safes) ta*)
-   | C.Prod _ -> raise (Impossible 10)
+   | C.Prod _ -> raise (TypeCheckerFailure (Impossible 10))
    | C.Lambda (name,so,ta) ->
       check_is_really_smaller_arg context n nn kl x safes so &&
        check_is_really_smaller_arg ((Some (name,(C.Decl so)))::context)
@@ -534,14 +678,14 @@ and check_is_really_smaller_arg context n nn kl x safes te =
       (*CSC: sulla coda ci vogliono dei controlli? secondo noi no, ma *)
       (*CSC: solo perche' non abbiamo trovato controesempi            *)
       check_is_really_smaller_arg context n nn kl x safes he
-   | C.Appl [] -> raise (Impossible 11)
+   | C.Appl [] -> raise (TypeCheckerFailure (Impossible 11))
    | C.Const _
-   | C.MutInd _ -> raise (Impossible 12)
+   | C.MutInd _ -> raise (TypeCheckerFailure (Impossible 12))
    | C.MutConstruct _ -> false
-   | C.MutCase (uri,_,i,outtype,term,pl) ->
+   | C.MutCase (uri,i,outtype,term,pl) ->
       (match term with
           C.Rel m when List.mem m safes || m = x ->
-           let (isinductive,paramsno,cl) =
+           let (tys,len,isinductive,paramsno,cl) =
             match CicEnvironment.get_obj uri with
                C.InductiveDefinition (tl,_,paramsno) ->
                 let tys =
@@ -550,12 +694,14 @@ and check_is_really_smaller_arg context n nn kl x safes te =
                  let (_,isinductive,_,cl) = List.nth tl i in
                   let cl' =
                    List.map
-                    (fun (id,ty,r) ->
-                      (id, snd (split_prods tys paramsno ty), r)) cl
+                    (fun (id,ty) ->
+                      (id, snd (split_prods tys paramsno ty))) cl
                   in
-                   (isinductive,paramsno,cl')
+                   (tys,List.length tl,isinductive,paramsno,cl')
              | _ ->
-               raise (WrongUriToMutualInductiveDefinitions(U.string_of_uri uri))
+               raise
+                (TypeCheckerFailure
+                 (WrongUriToMutualInductiveDefinitions(U.string_of_uri uri)))
            in
             if not isinductive then
               List.fold_right
@@ -564,13 +710,10 @@ and check_is_really_smaller_arg context n nn kl x safes te =
                pl true
             else
               List.fold_right
-               (fun (p,(_,c,rl)) i ->
+               (fun (p,(_,c)) i ->
                  let rl' =
-                  match !rl with
-                     Some rl' ->
-                      let (_,rl'') = split rl' paramsno in
-                       rl''
-                   | None -> raise (Impossible 13)
+                  let debrujinedte = debrujin_constructor uri len c in
+                   recursive_args tys 0 len debrujinedte
                  in
                   let (e,safes',n',nn',x',context') =
                    get_new_safes context p c rl' safes n nn x
@@ -579,7 +722,7 @@ and check_is_really_smaller_arg context n nn kl x safes te =
                    check_is_really_smaller_arg context' n' nn' kl x' safes' e
                ) (List.combine pl cl) true
         | C.Appl ((C.Rel m)::tl) when List.mem m safes || m = x ->
-           let (isinductive,paramsno,cl) =
+           let (tys,len,isinductive,paramsno,cl) =
             match CicEnvironment.get_obj uri with
                C.InductiveDefinition (tl,_,paramsno) ->
                 let (_,isinductive,_,cl) = List.nth tl i in
@@ -588,12 +731,14 @@ and check_is_really_smaller_arg context n nn kl x safes te =
                  in
                   let cl' =
                    List.map
-                    (fun (id,ty,r) ->
-                      (id, snd (split_prods tys paramsno ty), r)) cl
+                    (fun (id,ty) ->
+                      (id, snd (split_prods tys paramsno ty))) cl
                   in
-                  (isinductive,paramsno,cl')
+                   (tys,List.length tl,isinductive,paramsno,cl')
              | _ ->
-               raise (WrongUriToMutualInductiveDefinitions(U.string_of_uri uri))
+               raise
+                (TypeCheckerFailure
+                  (WrongUriToMutualInductiveDefinitions(U.string_of_uri uri)))
            in
             if not isinductive then
               List.fold_right
@@ -604,13 +749,10 @@ and check_is_really_smaller_arg context n nn kl x safes te =
               (*CSC: supponiamo come prima che nessun controllo sia necessario*)
               (*CSC: sugli argomenti di una applicazione                      *)
               List.fold_right
-               (fun (p,(_,c,rl)) i ->
+               (fun (p,(_,c)) i ->
                  let rl' =
-                  match !rl with
-                     Some rl' ->
-                      let (_,rl'') = split rl' paramsno in
-                       rl''
-                   | None -> raise (Impossible 14)
+                  let debrujinedte = debrujin_constructor uri len c in
+                   recursive_args tys 0 len debrujinedte
                  in
                   let (e, safes',n',nn',x',context') =
                    get_new_safes context p c rl' safes n nn x
@@ -660,9 +802,8 @@ and guarded_by_destructors context n nn kl x safes =
       (match List.nth context (n-1) with
           Some (_,C.Decl _) -> true
         | Some (_,C.Def bo) -> guarded_by_destructors context n nn kl x safes bo
-	| None -> raise RelToHiddenHypothesis
+	| None -> raise (TypeCheckerFailure RelToHiddenHypothesis)
       )
-   | C.Var _
    | C.Meta _
    | C.Sort _
    | C.Implicit -> true
@@ -694,13 +835,17 @@ and guarded_by_destructors context n nn kl x safes =
       List.fold_right
        (fun t i -> i && guarded_by_destructors context n nn kl x safes t)
        tl true
-   | C.Const _
-   | C.MutInd _
-   | C.MutConstruct _ -> true
-   | C.MutCase (uri,_,i,outtype,term,pl) ->
+   | C.Var (_,exp_named_subst)
+   | C.Const (_,exp_named_subst)
+   | C.MutInd (_,_,exp_named_subst)
+   | C.MutConstruct (_,_,_,exp_named_subst) ->
+      List.fold_right
+       (fun (_,t) i -> i && guarded_by_destructors context n nn kl x safes t)
+       exp_named_subst true
+   | C.MutCase (uri,i,outtype,term,pl) ->
       (match term with
           C.Rel m when List.mem m safes || m = x ->
-           let (isinductive,paramsno,cl) =
+           let (tys,len,isinductive,paramsno,cl) =
             match CicEnvironment.get_obj uri with
                C.InductiveDefinition (tl,_,paramsno) ->
                 let (_,isinductive,_,cl) = List.nth tl i in
@@ -709,12 +854,14 @@ and guarded_by_destructors context n nn kl x safes =
                  in
                   let cl' =
                    List.map
-                    (fun (id,ty,r) ->
-                      (id, snd (split_prods tys paramsno ty), r)) cl
+                    (fun (id,ty) ->
+                      (id, snd (split_prods tys paramsno ty))) cl
                   in
-                   (isinductive,paramsno,cl')
+                   (tys,List.length tl,isinductive,paramsno,cl')
              | _ ->
-               raise (WrongUriToMutualInductiveDefinitions(U.string_of_uri uri))
+               raise
+                (TypeCheckerFailure
+                  (WrongUriToMutualInductiveDefinitions(U.string_of_uri uri)))
            in
             if not isinductive then
              guarded_by_destructors context n nn kl x safes outtype &&
@@ -728,13 +875,10 @@ and guarded_by_destructors context n nn kl x safes =
              guarded_by_destructors context n nn kl x safes outtype &&
               (*CSC: manca ??? il controllo sul tipo di term? *)
               List.fold_right
-               (fun (p,(_,c,rl)) i ->
+               (fun (p,(_,c)) i ->
                  let rl' =
-                  match !rl with
-                     Some rl' ->
-                      let (_,rl'') = split rl' paramsno in
-                       rl''
-                   | None -> raise (Impossible 15)
+                  let debrujinedte = debrujin_constructor uri len c in
+                   recursive_args tys 0 len debrujinedte
                  in
                   let (e,safes',n',nn',x',context') =
                    get_new_safes context p c rl' safes n nn x
@@ -743,7 +887,7 @@ and guarded_by_destructors context n nn kl x safes =
                    guarded_by_destructors context' n' nn' kl x' safes' e
                ) (List.combine pl cl) true
         | C.Appl ((C.Rel m)::tl) when List.mem m safes || m = x ->
-           let (isinductive,paramsno,cl) =
+           let (tys,len,isinductive,paramsno,cl) =
             match CicEnvironment.get_obj uri with
                C.InductiveDefinition (tl,_,paramsno) ->
                 let (_,isinductive,_,cl) = List.nth tl i in
@@ -752,12 +896,14 @@ and guarded_by_destructors context n nn kl x safes =
                  in
                   let cl' =
                    List.map
-                    (fun (id,ty,r) ->
-                      (id, snd (split_prods tys paramsno ty), r)) cl
+                    (fun (id,ty) ->
+                      (id, snd (split_prods tys paramsno ty))) cl
                   in
-                   (isinductive,paramsno,cl')
+                   (tys,List.length tl,isinductive,paramsno,cl')
              | _ ->
-               raise (WrongUriToMutualInductiveDefinitions(U.string_of_uri uri))
+               raise
+                (TypeCheckerFailure
+                  (WrongUriToMutualInductiveDefinitions(U.string_of_uri uri)))
            in
             if not isinductive then
              guarded_by_destructors context n nn kl x safes outtype &&
@@ -775,13 +921,10 @@ and guarded_by_destructors context n nn kl x safes =
                  i && guarded_by_destructors context n nn kl x safes t)
                tl true &&
               List.fold_right
-               (fun (p,(_,c,rl)) i ->
+               (fun (p,(_,c)) i ->
                  let rl' =
-                  match !rl with
-                     Some rl' ->
-                      let (_,rl'') = split rl' paramsno in
-                       rl''
-                   | None -> raise (Impossible 16)
+                  let debrujinedte = debrujin_constructor uri len c in
+                   recursive_args tys 0 len debrujinedte
                  in
                   let (e, safes',n',nn',x',context') =
                    get_new_safes context p c rl' safes n nn x
@@ -836,15 +979,15 @@ and guarded_by_constructors context n nn h te args coInductiveTypeURI =
   (*CSC: that maps X into (C.Appl X []) when X is not already a C.Appl *)
   match CicReduction.whd context te with
      C.Rel m when m > n && m <= nn -> h
-   | C.Rel _
-   | C.Var _  -> true
+   | C.Rel _ -> true
    | C.Meta _
    | C.Sort _
    | C.Implicit
    | C.Cast _
    | C.Prod _
    | C.LetIn _ ->
-      raise (Impossible 17) (* the term has just been type-checked *)
+      (* the term has just been type-checked *)
+      raise (TypeCheckerFailure (Impossible 17))
    | C.Lambda (name,so,de) ->
       does_not_occur context n nn so &&
        guarded_by_constructors ((Some (name,(C.Decl so)))::context)
@@ -852,47 +995,53 @@ and guarded_by_constructors context n nn h te args coInductiveTypeURI =
    | C.Appl ((C.Rel m)::tl) when m > n && m <= nn ->
       h &&
        List.fold_right (fun x i -> i && does_not_occur context n nn x) tl true
-   | C.Appl ((C.MutConstruct (uri,cookingsno,i,j))::tl) ->
+   | C.Appl ((C.MutConstruct (uri,i,j,exp_named_subst))::tl) ->
       let consty =
-       match CicEnvironment.get_cooked_obj uri cookingsno with
+       match CicEnvironment.get_cooked_obj ~trust:false uri with
           C.InductiveDefinition (itl,_,_) ->
            let (_,_,_,cl) = List.nth itl i in
-            let (_,cons,_) = List.nth cl (j - 1) in cons
+            let (_,cons) = List.nth cl (j - 1) in
+             CicSubstitution.subst_vars exp_named_subst cons
         | _ ->
-         raise (WrongUriToMutualInductiveDefinitions
-          (UriManager.string_of_uri uri))
+         raise
+          (TypeCheckerFailure
+            (WrongUriToMutualInductiveDefinitions
+              (UriManager.string_of_uri uri)))
       in
        let rec analyse_branch context ty te =
         match CicReduction.whd context ty with
-           C.Meta _ -> raise (Impossible 34)
+           C.Meta _ -> raise (TypeCheckerFailure (Impossible 34))
          | C.Rel _
          | C.Var _
          | C.Sort _ ->
             does_not_occur context n nn te
          | C.Implicit
-         | C.Cast _ -> raise (Impossible 24) (* due to type-checking *)
+         | C.Cast _ ->
+            raise (TypeCheckerFailure (Impossible 24))(* due to type-checking *)
          | C.Prod (name,so,de) ->
             analyse_branch ((Some (name,(C.Decl so)))::context) de te
          | C.Lambda _
-         | C.LetIn _ -> raise (Impossible 25) (* due to type-checking *)
-         | C.Appl ((C.MutInd (uri,_,_))::tl) as ty
+         | C.LetIn _ ->
+            raise (TypeCheckerFailure (Impossible 25))(* due to type-checking *)
+         | C.Appl ((C.MutInd (uri,_,_))::_) as ty
             when uri == coInductiveTypeURI -> 
              guarded_by_constructors context n nn true te [] coInductiveTypeURI
-         | C.Appl ((C.MutInd (uri,_,_))::tl) as ty -> 
+         | C.Appl ((C.MutInd (uri,_,_))::_) as ty -> 
             guarded_by_constructors context n nn true te tl coInductiveTypeURI
          | C.Appl _ ->
             does_not_occur context n nn te
-         | C.Const _ -> raise (Impossible 26)
+         | C.Const _ -> raise (TypeCheckerFailure (Impossible 26))
          | C.MutInd (uri,_,_) when uri == coInductiveTypeURI ->
             guarded_by_constructors context n nn true te [] coInductiveTypeURI
          | C.MutInd _ ->
             does_not_occur context n nn te
-         | C.MutConstruct _ -> raise (Impossible 27)
+         | C.MutConstruct _ -> raise (TypeCheckerFailure (Impossible 27))
          (*CSC: we do not consider backbones with a MutCase, Fix, Cofix *)
          (*CSC: in head position.                                       *)
          | C.MutCase _
          | C.Fix _
-         | C.CoFix _ -> raise (Impossible 28) (* due to type-checking *)
+         | C.CoFix _ ->
+            raise (TypeCheckerFailure (Impossible 28))(* due to type-checking *)
        in
        let rec analyse_instantiated_type context ty l =
         match CicReduction.whd context ty with
@@ -901,7 +1050,8 @@ and guarded_by_constructors context n nn h te args coInductiveTypeURI =
          | C.Meta _
          | C.Sort _
          | C.Implicit
-         | C.Cast _ -> raise (Impossible 29) (* due to type-checking *)
+         | C.Cast _ ->
+            raise (TypeCheckerFailure (Impossible 29))(* due to type-checking *)
          | C.Prod (name,so,de) ->
             begin
              match l with
@@ -912,20 +1062,22 @@ and guarded_by_constructors context n nn h te args coInductiveTypeURI =
                    de tl
             end
          | C.Lambda _
-         | C.LetIn _ -> raise (Impossible 30) (* due to type-checking *)
+         | C.LetIn _ ->
+            raise (TypeCheckerFailure (Impossible 30))(* due to type-checking *)
          | C.Appl _ -> 
             List.fold_left
              (fun i x -> i && does_not_occur context n nn x) true l
-         | C.Const _ -> raise (Impossible 31)
+         | C.Const _ -> raise (TypeCheckerFailure (Impossible 31))
          | C.MutInd _ ->
             List.fold_left
              (fun i x -> i && does_not_occur context n nn x) true l
-         | C.MutConstruct _ -> raise (Impossible 32)
+         | C.MutConstruct _ -> raise (TypeCheckerFailure (Impossible 32))
          (*CSC: we do not consider backbones with a MutCase, Fix, Cofix *)
          (*CSC: in head position.                                       *)
          | C.MutCase _
          | C.Fix _
-         | C.CoFix _ -> raise (Impossible 33) (* due to type-checking *)
+         | C.CoFix _ ->
+            raise (TypeCheckerFailure (Impossible 33))(* due to type-checking *)
        in
         let rec instantiate_type args consty =
          function
@@ -944,7 +1096,7 @@ and guarded_by_constructors context n nn h te args coInductiveTypeURI =
                     | _ ->
                       (*CSC:We do not consider backbones with a MutCase, a    *)
                       (*CSC:FixPoint, a CoFixPoint and so on in head position.*)
-                      raise (Impossible 23)
+                      raise (TypeCheckerFailure (Impossible 23))
                   end
                | [] -> analyse_instantiated_type context consty' l
                   (* These are all the other cases *)
@@ -963,7 +1115,7 @@ and guarded_by_constructors context n nn h te args coInductiveTypeURI =
              guarded_by_constructors (tys@context) n_plus_len nn_plus_len h bo
               args coInductiveTypeURI
           ) fl true
-   | C.Appl ((C.MutCase (_,_,_,out,te,pl))::tl) ->
+   | C.Appl ((C.MutCase (_,_,out,te,pl))::tl) ->
        List.fold_left (fun i x -> i && does_not_occur context n nn x) true tl &&
         does_not_occur context n nn out &&
          does_not_occur context n nn te &&
@@ -974,10 +1126,15 @@ and guarded_by_constructors context n nn h te args coInductiveTypeURI =
            ) pl true
    | C.Appl l ->
       List.fold_right (fun x i -> i && does_not_occur context n nn x) l true
-   | C.Const _ -> true
+   | C.Var (_,exp_named_subst)
+   | C.Const (_,exp_named_subst) ->
+      List.fold_right
+       (fun (_,x) i -> i && does_not_occur context n nn x) exp_named_subst true
    | C.MutInd _ -> assert false
-   | C.MutConstruct _ -> true
-   | C.MutCase (_,_,_,out,te,pl) ->
+   | C.MutConstruct (_,_,_,exp_named_subst) ->
+      List.fold_right
+       (fun (_,x) i -> i && does_not_occur context n nn x) exp_named_subst true
+   | C.MutCase (_,_,out,te,pl) ->
        does_not_occur context n nn out &&
         does_not_occur context n nn te &&
          List.fold_right
@@ -1018,14 +1175,18 @@ and check_allowed_sort_elimination context uri i need_dummy ind arity1 arity2 =
        check_allowed_sort_elimination context uri i need_dummy
         (C.Appl [CicSubstitution.lift 1 ind ; C.Rel 1]) de1 de2
    | (C.Sort C.Prop, C.Sort C.Prop) when need_dummy -> true
-   | (C.Sort C.Prop, C.Sort C.Set) when need_dummy ->
+   | (C.Sort C.Prop, C.Sort C.Set)
+   | (C.Sort C.Prop, C.Sort C.Type) when need_dummy ->
+(*CSC: WRONG. MISSING CONDITIONS ON THE ARGUMENTS OF THE CONSTRUTOR *)
        (match CicEnvironment.get_obj uri with
            C.InductiveDefinition (itl,_,_) ->
             let (_,_,_,cl) = List.nth itl i in
-             (* is a singleton definition? *)
-             List.length cl = 1
+             (* is a singleton definition or the empty proposition? *)
+             List.length cl = 1 || List.length cl = 0
          | _ ->
-           raise (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri))
+           raise
+            (TypeCheckerFailure
+              (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri)))
        )
    | (C.Sort C.Set, C.Sort C.Prop) when need_dummy -> true
    | (C.Sort C.Set, C.Sort C.Set) when need_dummy -> true
@@ -1037,9 +1198,11 @@ and check_allowed_sort_elimination context uri i need_dummy ind arity1 arity2 =
             in
              let (_,_,_,cl) = List.nth itl i in
               List.fold_right
-               (fun (_,x,_) i -> i && is_small tys paramsno x) cl true
+               (fun (_,x) i -> i && is_small tys paramsno x) cl true
          | _ ->
-           raise (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri))
+           raise
+            (TypeCheckerFailure
+              (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri)))
        )
    | (C.Sort C.Type, C.Sort _) when need_dummy -> true
    | (C.Sort C.Prop, C.Prod (name,so,ta)) when not need_dummy ->
@@ -1055,8 +1218,9 @@ and check_allowed_sort_elimination context uri i need_dummy ind arity1 arity2 =
                    (* is a singleton definition? *)
                    List.length cl = 1
                | _ ->
-                 raise (WrongUriToMutualInductiveDefinitions
-                  (U.string_of_uri uri))
+                 raise
+                  (TypeCheckerFailure
+                    (WrongUriToMutualInductiveDefinitions(U.string_of_uri uri)))
              )
           | _ -> false
         )
@@ -1076,12 +1240,13 @@ and check_allowed_sort_elimination context uri i need_dummy ind arity1 arity2 =
                      (fun (n,_,ty,_) -> Some (Cic.Name n,(Cic.Decl ty))) itl
                    in
                     List.fold_right
-                     (fun (_,x,_) i -> i && is_small tys paramsno x) cl true
+                     (fun (_,x) i -> i && is_small tys paramsno x) cl true
                | _ ->
-                 raise (WrongUriToMutualInductiveDefinitions
-                  (U.string_of_uri uri))
+                 raise
+                  (TypeCheckerFailure
+                    (WrongUriToMutualInductiveDefinitions(U.string_of_uri uri)))
              )
-          | _ -> raise (Impossible 19)
+          | _ -> raise (TypeCheckerFailure (Impossible 19))
         )
    | (C.Sort C.Type, C.Prod (_,so,_)) when not need_dummy ->
        CicReduction.are_convertible context so ind
@@ -1109,10 +1274,10 @@ and type_of_branch context argsno need_dummy outtype term constype =
           C.Appl l -> C.Appl (l@[C.Rel 1])
         | t -> C.Appl [t ; C.Rel 1]
       in
-       C.Prod (C.Anonimous,so,type_of_branch
+       C.Prod (C.Anonymous,so,type_of_branch
         ((Some (name,(C.Decl so)))::context) argsno need_dummy
         (CicSubstitution.lift 1 outtype) term' de)
-  | _ -> raise (Impossible 20)
+  | _ -> raise (TypeCheckerFailure (Impossible 20))
 
 (* check_metasenv_consistency checks that the "canonical" context of a
 metavariable is consitent - up to relocation via the relocation list l -
@@ -1145,7 +1310,7 @@ and check_metasenv_consistency metasenv context canonical_context l =
             R.are_convertible context (type_of_aux' metasenv context t) ct
          | _, _  -> false
        in
-        if not res then raise MetasenvInconsistency
+        if not res then raise (TypeCheckerFailure MetasenvInconsistency)
      ) l lifted_canonical_context 
 
 (* type_of_aux' is just another name (with a different scope) for type_of_aux *)
@@ -1161,13 +1326,16 @@ and type_of_aux' metasenv context t =
          match List.nth context (n - 1) with
             Some (_,C.Decl t) -> S.lift n t
           | Some (_,C.Def bo) -> type_of_aux context (S.lift n bo)
-	  | None -> raise RelToHiddenHypothesis
+	  | None -> raise (TypeCheckerFailure RelToHiddenHypothesis)
         with
-         _ -> raise (NotWellTyped "Not a close term")
+         _ -> raise (TypeCheckerFailure (NotWellTyped "Not a close term"))
        )
-    | C.Var uri ->
+    | C.Var (uri,exp_named_subst) ->
       incr fdebug ;
-      let ty = type_of_variable uri in
+      check_exp_named_subst context exp_named_subst ;
+      let ty =
+       CicSubstitution.subst_vars exp_named_subst (type_of_variable uri)
+      in
        decr fdebug ;
        ty
     | C.Meta (n,l) -> 
@@ -1177,11 +1345,11 @@ and type_of_aux' metasenv context t =
         check_metasenv_consistency metasenv context canonical_context l;
         CicSubstitution.lift_meta l ty
     | C.Sort s -> C.Sort C.Type (*CSC manca la gestione degli universi!!! *)
-    | C.Implicit -> raise (Impossible 21)
+    | C.Implicit -> raise (TypeCheckerFailure (Impossible 21))
     | C.Cast (te,ty) ->
        let _ = type_of_aux context ty in
         if R.are_convertible context (type_of_aux context te) ty then ty
-        else raise (NotWellTyped "Cast")
+        else raise (TypeCheckerFailure (NotWellTyped "Cast"))
     | C.Prod (name,s,t) ->
        let sort1 = type_of_aux context s
        and sort2 = type_of_aux ((Some (name,(C.Decl s)))::context) t in
@@ -1196,27 +1364,50 @@ and type_of_aux' metasenv context t =
    | C.LetIn (n,s,t) ->
       (* only to check if s is well-typed *)
       let _ = type_of_aux context s in
-       C.LetIn (n,s, type_of_aux ((Some (n,(C.Def s)))::context) t)
+       (* The type of a LetIn is a LetIn. Extremely slow since the computed
+          LetIn is later reduced and maybe also re-checked.
+       (C.LetIn (n,s, type_of_aux ((Some (n,(C.Def s)))::context) t))
+       *)
+       (* The type of the LetIn is reduced. Much faster than the previous
+          solution. Moreover the inferred type is probably very different
+          from the expected one.
+       (CicReduction.whd context
+        (C.LetIn (n,s, type_of_aux ((Some (n,(C.Def s)))::context) t)))
+       *)
+       (* One-step LetIn reduction. Even faster than the previous solution.
+          Moreover the inferred type is closer to the expected one. *)
+       (CicSubstitution.subst s
+        (type_of_aux ((Some (n,(C.Def s)))::context) t))
    | C.Appl (he::tl) when List.length tl > 0 ->
       let hetype = type_of_aux context he
       and tlbody_and_type = List.map (fun x -> (x, type_of_aux context x)) tl in
        eat_prods context hetype tlbody_and_type
-   | C.Appl _ -> raise (NotWellTyped "Appl: no arguments")
-   | C.Const (uri,cookingsno) ->
+   | C.Appl _ -> raise (TypeCheckerFailure (NotWellTyped "Appl: no arguments"))
+   | C.Const (uri,exp_named_subst) ->
       incr fdebug ;
-      let cty = cooked_type_of_constant uri cookingsno in
+      check_exp_named_subst context exp_named_subst ;
+      let cty =
+       CicSubstitution.subst_vars exp_named_subst (type_of_constant uri)
+      in
        decr fdebug ;
        cty
-   | C.MutInd (uri,cookingsno,i) ->
+   | C.MutInd (uri,i,exp_named_subst) ->
       incr fdebug ;
-      let cty = cooked_type_of_mutual_inductive_defs uri cookingsno i in
+      check_exp_named_subst context exp_named_subst ;
+      let cty =
+       CicSubstitution.subst_vars exp_named_subst
+        (type_of_mutual_inductive_defs uri i)
+      in
        decr fdebug ;
        cty
-   | C.MutConstruct (uri,cookingsno,i,j) ->
-      let cty = cooked_type_of_mutual_inductive_constr uri cookingsno i j
+   | C.MutConstruct (uri,i,j,exp_named_subst) ->
+      check_exp_named_subst context exp_named_subst ;
+      let cty =
+       CicSubstitution.subst_vars exp_named_subst
+        (type_of_mutual_inductive_constr uri i j)
       in
        cty
-   | C.MutCase (uri,cookingsno,i,outtype,term,pl) ->
+   | C.MutCase (uri,i,outtype,term,pl) ->
       let outsort = type_of_aux context outtype in
       let (need_dummy, k) =
        let rec guess_args context t =
@@ -1227,75 +1418,97 @@ and type_of_aux' metasenv context t =
              if n = 0 then
               (* last prod before sort *)
               match CicReduction.whd context s with
-                 (*CSC vedi nota delirante su cookingsno in cicReduction.ml *)
-                 C.MutInd (uri',_,i') when U.eq uri' uri && i' = i -> (false, 1)
-               | C.Appl ((C.MutInd (uri',_,i')) :: _)
+(*CSC: for _ see comment below about the missing named_exp_subst ?????????? *)
+                 C.MutInd (uri',i',_) when U.eq uri' uri && i' = i ->
+                  (false, 1)
+(*CSC: for _ see comment below about the missing named_exp_subst ?????????? *)
+               | C.Appl ((C.MutInd (uri',i',_)) :: _)
                   when U.eq uri' uri && i' = i -> (false, 1)
                | _ -> (true, 1)
              else
               (b, n + 1)
-         | _ -> raise (NotWellTyped "MutCase: outtype ill-formed")
+         | _ ->
+           raise
+            (TypeCheckerFailure (NotWellTyped "MutCase: outtype ill-formed"))
        in
         (*CSC whd non serve dopo type_of_aux ? *)
         let (b, k) = guess_args context outsort in
          if not b then (b, k - 1) else (b, k)
       in
-      let (parameters, arguments) =
+      let (parameters, arguments, exp_named_subst) =
         match R.whd context (type_of_aux context term) with
            (*CSC manca il caso dei CAST *)
-           C.MutInd (uri',_,i') ->
-            (*CSC vedi nota delirante sui cookingsno in cicReduction.ml*)
-            if U.eq uri uri' && i = i' then ([],[])
-            else raise (NotWellTyped ("MutCase: the term is of type " ^
-             (U.string_of_uri uri') ^ "," ^ string_of_int i' ^
-             " instead of type " ^ (U.string_of_uri uri') ^ "," ^
-             string_of_int i))
-         | C.Appl (C.MutInd (uri',_,i') :: tl) ->
-            if U.eq uri uri' && i = i' then split tl (List.length tl - k)
-            else raise (NotWellTyped ("MutCase: the term is of type " ^
-             (U.string_of_uri uri') ^ "," ^ string_of_int i' ^
-             " instead of type " ^ (U.string_of_uri uri) ^ "," ^
-             string_of_int i))
-         | _ -> raise (NotWellTyped "MutCase: the term is not an inductive one")
+(*CSC: ma servono i parametri (uri,i)? Se si', perche' non serve anche il *)
+(*CSC: parametro exp_named_subst? Se no, perche' non li togliamo?         *)
+(*CSC: Hint: nella DTD servono per gli stylesheet.                        *)
+           C.MutInd (uri',i',exp_named_subst) as typ ->
+            if U.eq uri uri' && i = i' then ([],[],exp_named_subst)
+            else raise (TypeCheckerFailure
+             (NotWellTyped ("MutCase: the term is of type " ^
+             CicPp.ppterm typ ^
+             " instead of type " ^ (U.string_of_uri uri) ^ "#1/" ^
+             string_of_int i ^ "{_}")))
+         | C.Appl ((C.MutInd (uri',i',exp_named_subst) as typ):: tl) ->
+            if U.eq uri uri' && i = i' then
+             let params,args =
+              split tl (List.length tl - k)
+             in params,args,exp_named_subst
+            else raise (TypeCheckerFailure (NotWellTyped
+             ("MutCase: the term is of type " ^
+             CicPp.ppterm typ ^
+             " instead of type " ^ (U.string_of_uri uri) ^ "#1/" ^
+             string_of_int i ^ "{_}")))
+         | _ -> raise (TypeCheckerFailure
+                 (NotWellTyped "MutCase: the term is not an inductive one"))
       in
        (* let's control if the sort elimination is allowed: [(I q1 ... qr)|B] *)
        let sort_of_ind_type =
         if parameters = [] then
-         C.MutInd (uri,cookingsno,i)
+         C.MutInd (uri,i,exp_named_subst)
         else
-         C.Appl ((C.MutInd (uri,cookingsno,i))::parameters)
+         C.Appl ((C.MutInd (uri,i,exp_named_subst))::parameters)
        in
         if not (check_allowed_sort_elimination context uri i need_dummy
          sort_of_ind_type (type_of_aux context sort_of_ind_type) outsort)
         then
-         raise (NotWellTyped "MutCase: not allowed sort elimination") ;
+         raise
+          (TypeCheckerFailure
+            (NotWellTyped "MutCase: not allowed sort elimination")) ;
 
         (* let's check if the type of branches are right *)
-        let (cl,parsno) =
-         match CicEnvironment.get_cooked_obj uri cookingsno with
-            C.InductiveDefinition (tl,_,parsno) ->
-             let (_,_,_,cl) = List.nth tl i in (cl,parsno)
+        let parsno =
+         match CicEnvironment.get_cooked_obj ~trust:false uri with
+            C.InductiveDefinition (_,_,parsno) -> parsno
           | _ ->
-            raise (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri))
+            raise
+             (TypeCheckerFailure
+               (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri)))
         in
          let (_,branches_ok) =
           List.fold_left
-           (fun (j,b) (p,(_,c,_)) ->
+           (fun (j,b) p ->
              let cons =
               if parameters = [] then
-               (C.MutConstruct (uri,cookingsno,i,j))
+               (C.MutConstruct (uri,i,j,exp_named_subst))
               else
-               (C.Appl (C.MutConstruct (uri,cookingsno,i,j)::parameters))
+               (C.Appl (C.MutConstruct (uri,i,j,exp_named_subst)::parameters))
              in
+(*
               (j + 1, b &&
+*)
+              (j + 1,
+let res = b &&
                R.are_convertible context (type_of_aux context p)
                 (type_of_branch context parsno need_dummy outtype cons
                   (type_of_aux context cons))
+in if not res then prerr_endline ("#### " ^ CicPp.ppterm (type_of_aux context p) ^ " <==> " ^ CicPp.ppterm (type_of_branch context parsno need_dummy outtype cons (type_of_aux context cons))) ; res
               )
-           ) (1,true) (List.combine pl cl)
+           ) (1,true) pl
          in
           if not branches_ok then
-           raise (NotWellTyped "MutCase: wrong type of a branch") ;
+           raise
+            (TypeCheckerFailure
+              (NotWellTyped "MutCase: wrong type of a branch")) ;
 
           if not need_dummy then
            C.Appl ((outtype::arguments)@[term])
@@ -1328,10 +1541,12 @@ and type_of_aux' metasenv context t =
                not
                 (guarded_by_destructors context' eaten (len + eaten) kl 1 [] m)
               then
-               raise (NotWellTyped "Fix: not guarded by destructors")
+               raise
+                (TypeCheckerFailure
+                  (NotWellTyped "Fix: not guarded by destructors"))
             end
            else
-            raise (NotWellTyped "Fix: ill-typed bodies")
+            raise (TypeCheckerFailure (NotWellTyped "Fix: ill-typed bodies"))
          ) fl ;
       
         (*CSC: controlli mancanti solo su D{f,k,x,M} *)
@@ -1355,7 +1570,9 @@ and type_of_aux' metasenv context t =
              (* let's control that the returned type is coinductive *)
              match returns_a_coinductive context ty with
                 None ->
-                 raise(NotWellTyped "CoFix: does not return a coinductive type")
+                 raise
+                  (TypeCheckerFailure
+                    (NotWellTyped "CoFix: does not return a coinductive type"))
               | Some uri ->
                  (*let's control the guarded by constructors conditions C{f,M}*)
                  if
@@ -1363,15 +1580,54 @@ and type_of_aux' metasenv context t =
                    (guarded_by_constructors (types @ context) 0 len false bo
                      [] uri)
                  then
-                  raise (NotWellTyped "CoFix: not guarded by constructors")
+                  raise
+                   (TypeCheckerFailure
+                     (NotWellTyped "CoFix: not guarded by constructors"))
             end
            else
-            raise (NotWellTyped "CoFix: ill-typed bodies")
+            raise
+             (TypeCheckerFailure
+               (NotWellTyped "CoFix: ill-typed bodies"))
          ) fl ;
       
         let (_,ty,_) = List.nth fl i in
          ty
 
+ and check_exp_named_subst context =
+  let rec check_exp_named_subst_aux substs =
+   function
+      [] -> ()
+    | ((uri,t) as subst)::tl ->
+       let typeofvar =
+        CicSubstitution.subst_vars substs (type_of_variable uri) in
+       (match CicEnvironment.get_cooked_obj ~trust:false uri with
+           Cic.Variable (_,Some bo,_,_) ->
+            raise
+             (TypeCheckerFailure
+               (NotWellTyped
+                 "A variable with a body can not be explicit substituted"))
+         | Cic.Variable (_,None,_,_) -> ()
+         | _ ->
+            raise
+             (TypeCheckerFailure
+               (WrongUriToVariable (UriManager.string_of_uri uri)))
+       ) ;
+       let typeoft = type_of_aux context t in
+        if CicReduction.are_convertible context typeoft typeofvar then
+         check_exp_named_subst_aux (substs@[subst]) tl
+        else
+         begin
+          CicReduction.fdebug := 0 ;
+          ignore (CicReduction.are_convertible context typeoft typeofvar) ;
+          fdebug := 0 ;
+          debug typeoft [typeofvar] ;
+          raise
+           (TypeCheckerFailure
+             (NotWellTyped "Wrong Explicit Named Substitution"))
+         end
+  in
+   check_exp_named_subst_aux []
+
  and sort_of_prod context (name,s) (t1, t2) =
   let module C = Cic in
    let t1' = CicReduction.whd context t1 in
@@ -1383,8 +1639,9 @@ and type_of_aux' metasenv context t =
     | (C.Sort s1, C.Sort s2) -> C.Sort C.Type (*CSC manca la gestione degli universi!!! *)
     | (_,_) ->
       raise
-       (NotWellTyped
-        ("Prod: sort1= " ^ CicPp.ppterm t1' ^ " ; sort2= " ^ CicPp.ppterm t2'))
+       (TypeCheckerFailure
+        (NotWellTyped
+         ("Prod: sort1= " ^ CicPp.ppterm t1' ^ " ; sort2= "^ CicPp.ppterm t2')))
 
  and eat_prods context hetype =
   (*CSC: siamo sicuri che le are_convertible non lavorino con termini non *)
@@ -1404,32 +1661,36 @@ and type_of_aux' metasenv context t =
            ignore (CicReduction.are_convertible context s hety) ;
            fdebug := 0 ;
            debug s [hety] ;
-           raise (NotWellTyped "Appl: wrong parameter-type")
+           raise
+            (TypeCheckerFailure (NotWellTyped "Appl: wrong parameter-type"))
           end
-      | _ -> raise (NotWellTyped "Appl: wrong Prod-type")
+      | _ -> raise (TypeCheckerFailure (NotWellTyped "Appl: wrong Prod-type"))
     )
 
  and returns_a_coinductive context ty =
   let module C = Cic in
    match CicReduction.whd context ty with
-      C.MutInd (uri,cookingsno,i) ->
+      C.MutInd (uri,i,_) ->
        (*CSC: definire una funzioncina per questo codice sempre replicato *)
-       (match CicEnvironment.get_cooked_obj uri cookingsno with
+       (match CicEnvironment.get_cooked_obj ~trust:false uri with
            C.InductiveDefinition (itl,_,_) ->
-            let (_,is_inductive,_,cl) = List.nth itl i in
+            let (_,is_inductive,_,_) = List.nth itl i in
              if is_inductive then None else (Some uri)
          | _ ->
-           raise (WrongUriToMutualInductiveDefinitions
-            (UriManager.string_of_uri uri))
+           raise
+            (TypeCheckerFailure (WrongUriToMutualInductiveDefinitions
+             (UriManager.string_of_uri uri)))
         )
-    | C.Appl ((C.MutInd (uri,_,i))::_) ->
+    | C.Appl ((C.MutInd (uri,i,_))::_) ->
        (match CicEnvironment.get_obj uri with
            C.InductiveDefinition (itl,_,_) ->
             let (_,is_inductive,_,_) = List.nth itl i in
              if is_inductive then None else (Some uri)
          | _ ->
-           raise (WrongUriToMutualInductiveDefinitions
-            (UriManager.string_of_uri uri))
+           raise
+            (TypeCheckerFailure
+             (WrongUriToMutualInductiveDefinitions
+              (UriManager.string_of_uri uri)))
         )
     | C.Prod (n,so,de) ->
        returns_a_coinductive ((Some (n,C.Decl so))::context) de
@@ -1476,36 +1737,48 @@ let typecheck uri =
  let module C = Cic in
  let module R = CicReduction in
  let module U = UriManager in
-  match CicEnvironment.is_type_checked uri 0 with
+  match CicEnvironment.is_type_checked ~trust:false uri with
      CicEnvironment.CheckedObj _ -> ()
    | CicEnvironment.UncheckedObj uobj ->
       (* let's typecheck the uncooked object *)
       Logger.log (`Start_type_checking uri) ;
       (match uobj with
-          C.Definition (_,te,ty,_) ->
+          C.Constant (_,Some te,ty,_) ->
            let _ = type_of ty in
             if not (R.are_convertible [] (type_of te ) ty) then
-             raise (NotWellTyped ("Constant " ^ (U.string_of_uri uri)))
-        | C.Axiom (_,ty,_) ->
+             raise
+              (TypeCheckerFailure
+                (NotWellTyped ("Constant " ^ (U.string_of_uri uri))))
+        | C.Constant (_,None,ty,_) ->
           (* only to check that ty is well-typed *)
           let _ = type_of ty in ()
-        | C.CurrentProof (_,conjs,te,ty) ->
-            (*CSC: bisogna controllare anche il metasenv!!! *)
+        | C.CurrentProof (_,conjs,te,ty,_) ->
+           let _ =
+            List.fold_left
+             (fun metasenv ((_,context,ty) as conj) ->
+               ignore (type_of_aux' metasenv context ty) ;
+               metasenv @ [conj]
+             ) [] conjs
+           in
             let _ = type_of_aux' conjs [] ty in
-             debug (type_of_aux' conjs [] te) [] ;
-             if not (R.are_convertible [] (type_of_aux' conjs [] te) ty) then
-              raise (NotWellTyped ("CurrentProof" ^ (U.string_of_uri uri)))
-        | C.Variable (_,bo,ty) ->
+             if not (R.are_convertible [] (type_of_aux' conjs [] te) ty)
+             then
+              raise
+               (TypeCheckerFailure
+                 (NotWellTyped ("CurrentProof" ^ (U.string_of_uri uri))))
+        | C.Variable (_,bo,ty,_) ->
            (* only to check that ty is well-typed *)
            let _ = type_of ty in
             (match bo with
                 None -> ()
               | Some bo ->
                  if not (R.are_convertible [] (type_of bo) ty) then
-                  raise (NotWellTyped ("Variable" ^ (U.string_of_uri uri)))
+                  raise
+                   (TypeCheckerFailure
+                     (NotWellTyped ("Variable" ^ (U.string_of_uri uri))))
             )
         | C.InductiveDefinition _ ->
-           cooked_mutual_inductive_defs uri uobj
+           check_mutual_inductive_defs uri uobj
       ) ;
       CicEnvironment.set_type_checking_info uri ;
       Logger.log (`Type_checking_completed uri)
diff --git a/helm/ocaml/cic_proof_checking/cicTypeChecker.mli b/helm/ocaml/cic_proof_checking/cicTypeChecker.mli
index a18d651f6..1dbcc11c8 100644
--- a/helm/ocaml/cic_proof_checking/cicTypeChecker.mli
+++ b/helm/ocaml/cic_proof_checking/cicTypeChecker.mli
@@ -23,17 +23,30 @@
  * http://cs.unibo.it/helm/.
  *)
 
-exception NotWellTyped of string
-exception WrongUriToConstant of string
-exception WrongUriToVariable of string
-exception WrongUriToMutualInductiveDefinitions of string
-exception ListTooShort
-exception NotPositiveOccurrences of string
-exception NotWellFormedTypeOfInductiveConstructor of string
-exception WrongRequiredArgument of string
+type type_checker_exn =
+   Impossible of int
+ | NotWellTyped of string
+ | WrongUriToConstant of string
+ | WrongUriToVariable of string
+ | WrongUriToMutualInductiveDefinitions of string
+ | ListTooShort
+ | NotPositiveOccurrences of string
+ | NotWellFormedTypeOfInductiveConstructor of string
+ | WrongRequiredArgument of string
+ | RelToHiddenHypothesis
+ | MetasenvInconsistency;;
+
+(* This is the only exception that will be raised *)
+exception TypeCheckerFailure of type_checker_exn;;
+
 val typecheck : UriManager.uri -> unit
 
-(* used only in the toplevel *)
+(* FUNCTIONS USED ONLY IN THE TOPLEVEL *)
+
 (* type_of_aux' metasenv context term *)
 val type_of_aux':
  Cic.metasenv -> Cic.context -> Cic.term -> Cic.term
+
+(* typecheck_mutual_inductive_defs uri (itl,params,indparamsno) *)
+val typecheck_mutual_inductive_defs :
+ UriManager.uri -> Cic.inductiveType list * UriManager.uri list * int -> unit
diff --git a/helm/ocaml/cic_proof_checking/logger.ml b/helm/ocaml/cic_proof_checking/logger.ml
index efae1b195..2fe8ac0a1 100644
--- a/helm/ocaml/cic_proof_checking/logger.ml
+++ b/helm/ocaml/cic_proof_checking/logger.ml
@@ -26,6 +26,7 @@
 type msg =
  [ `Start_type_checking of UriManager.uri
  | `Type_checking_completed of UriManager.uri
+ | `Trusting of UriManager.uri
  ]
 ;;
 
@@ -52,6 +53,13 @@ let log_to_html ~print_and_flush =
           string_of_float (float_of_int !indent *. 0.5) ^ "cm\">" ^
           "Type-Checking of " ^ (U.string_of_uri uri) ^ " completed.\n"
          )
+     | `Trusting uri ->
+         print_and_flush (
+           mkindent () ^
+          "
" ^
+          (U.string_of_uri uri) ^ " is trusted.
\n"
+         )
 ;;
 
 let log_callback = ref (function (_:msg) -> ())
diff --git a/helm/ocaml/cic_proof_checking/logger.mli b/helm/ocaml/cic_proof_checking/logger.mli
index c5e74ec90..781abdef6 100644
--- a/helm/ocaml/cic_proof_checking/logger.mli
+++ b/helm/ocaml/cic_proof_checking/logger.mli
@@ -26,6 +26,7 @@
 type msg =
  [ `Start_type_checking of UriManager.uri
  | `Type_checking_completed of UriManager.uri
+ | `Trusting of UriManager.uri
  ]
 ;;
 
diff --git a/helm/ocaml/cic_textual_parser/.depend b/helm/ocaml/cic_textual_parser/.depend
index 2708be9f0..f5ce25fb9 100644
--- a/helm/ocaml/cic_textual_parser/.depend
+++ b/helm/ocaml/cic_textual_parser/.depend
@@ -1,9 +1,10 @@
-cicTextualParserContext.cmi: cicTextualParser.cmi 
+cicTextualParser.cmi: cicTextualParser0.cmo 
+cicTextualParserContext.cmi: cicTextualParser.cmi cicTextualParser0.cmo 
 cicTextualParser.cmo: cicTextualParser0.cmo cicTextualParser.cmi 
 cicTextualParser.cmx: cicTextualParser0.cmx cicTextualParser.cmi 
 cicTextualParserContext.cmo: cicTextualParser.cmi cicTextualParser0.cmo \
     cicTextualParserContext.cmi 
 cicTextualParserContext.cmx: cicTextualParser.cmx cicTextualParser0.cmx \
     cicTextualParserContext.cmi 
-cicTextualLexer.cmo: cicTextualParser.cmi 
-cicTextualLexer.cmx: cicTextualParser.cmx 
+cicTextualLexer.cmo: cicTextualParser.cmi cicTextualParser0.cmo 
+cicTextualLexer.cmx: cicTextualParser.cmx cicTextualParser0.cmx 
diff --git a/helm/ocaml/cic_textual_parser/cicTextualLexer.mll b/helm/ocaml/cic_textual_parser/cicTextualLexer.mll
index 1be084795..6db492ee1 100644
--- a/helm/ocaml/cic_textual_parser/cicTextualLexer.mll
+++ b/helm/ocaml/cic_textual_parser/cicTextualLexer.mll
@@ -31,35 +31,43 @@
  let indtyuri_of_uri uri =
   let index_sharp =  String.index uri '#' in
   let index_num = index_sharp + 3 in
-   (UriManager.uri_of_string (String.sub uri 0 index_sharp),
-    int_of_string (String.sub uri index_num (String.length uri - index_num)) - 1
-   )
+   try
+    (UriManager.uri_of_string (String.sub uri 0 index_sharp),
+     int_of_string(String.sub uri index_num (String.length uri - index_num)) - 1
+    )
+   with
+    Failure msg ->
+     raise (CicTextualParser0.LexerFailure "Not an inductive URI")
  ;;
 
  let indconuri_of_uri uri =
   let index_sharp =  String.index uri '#' in
   let index_div = String.rindex uri '/' in
   let index_con = index_div + 1 in
-   (UriManager.uri_of_string (String.sub uri 0 index_sharp),
-    int_of_string
-     (String.sub uri (index_sharp + 3) (index_div - index_sharp - 3)) - 1,
-    int_of_string
-     (String.sub uri index_con (String.length uri - index_con))
-   )
+   try
+    (UriManager.uri_of_string (String.sub uri 0 index_sharp),
+     int_of_string
+      (String.sub uri (index_sharp + 3) (index_div - index_sharp - 3)) - 1,
+     int_of_string
+      (String.sub uri index_con (String.length uri - index_con))
+    )
+   with
+    Failure msg ->
+     raise (CicTextualParser0.LexerFailure "Not a constructor URI")
  ;;
 }
 let num = ['1'-'9']['0'-'9']* | '0'
 let alfa = ['A'-'Z' 'a'-'z' '_' ''' '-']
 let ident = alfa (alfa | num)*
 let baseuri = '/'(ident '/')* ident '.'
-let conuri = baseuri ("con" | "var")
+let conuri = baseuri "con"
+let varuri = baseuri "var"
 let indtyuri = baseuri "ind#1/" num
 let indconuri = baseuri "ind#1/" num "/" num
 let blanks = [' ' '\t' '\n']
 rule token =
  parse
     blanks      { token lexbuf } (* skip blanks *)
-  | "alias"     { ALIAS }
   | "Case"      { CASE }
   | "Fix"       { FIX }
   | "CoFix"     { COFIX }
@@ -68,6 +76,7 @@ rule token =
   | "Type"      { TYPE }
   | ident       { ID (L.lexeme lexbuf) }
   | conuri      { CONURI (U.uri_of_string ("cic:" ^ L.lexeme lexbuf)) }
+  | varuri      { VARURI (U.uri_of_string ("cic:" ^ L.lexeme lexbuf)) }
   | indtyuri    { INDTYURI (indtyuri_of_uri ("cic:" ^ L.lexeme lexbuf)) }
   | indconuri   { INDCONURI (indconuri_of_uri("cic:" ^ L.lexeme lexbuf)) }
   | num         { NUM (int_of_string (L.lexeme lexbuf)) }
diff --git a/helm/ocaml/cic_textual_parser/cicTextualParser.mly b/helm/ocaml/cic_textual_parser/cicTextualParser.mly
index af67f1c14..08d85a595 100644
--- a/helm/ocaml/cic_textual_parser/cicTextualParser.mly
+++ b/helm/ocaml/cic_textual_parser/cicTextualParser.mly
@@ -30,8 +30,19 @@
  exception InvalidSuffix of string;;
  exception InductiveTypeURIExpected;;
  exception UnknownIdentifier of string;;
+ exception ExplicitNamedSubstitutionAppliedToRel;;
+ exception TheLeftHandSideOfAnExplicitNamedSubstitutionMustBeAVariable;;
  
- let uri_of_id_map = Hashtbl.create 53;;
+ (* merge removing duplicates of two lists free of duplicates *)
+ let union dom1 dom2 =
+  let rec filter =
+   function
+      [] -> []
+    | he::tl ->
+       if List.mem he dom1 then filter tl else he::(filter tl)
+  in
+   dom1 @ (filter dom2)
+ ;;
 
  let get_index_in_list e =
   let rec aux i =
@@ -41,10 +52,6 @@
     | _::tl -> aux (i+1) tl
   in
    aux 1
-;;
-
- let get_cookingno uri =
-  UriManager.relative_depth !CicTextualParser0.current_uri uri 0
  ;;
 
  (* Returns the first meta whose number is above the *)
@@ -77,223 +84,429 @@
     aux (1,canonical_context)
  ;;
 
+ let deoptionize_exp_named_subst =
+  function
+     None -> [], (function _ -> [])
+   | Some (dom,mk_exp_named_subst) -> dom,mk_exp_named_subst
+ ;;
+
+ let term_of_con_uri uri exp_named_subst =
+  Const (uri,exp_named_subst)
+ ;;
+
+ let term_of_var_uri uri exp_named_subst =
+  Var (uri,exp_named_subst)
+ ;;
+
+ let term_of_indty_uri (uri,tyno) exp_named_subst =
+  MutInd (uri, tyno, exp_named_subst)
+ ;;
+
+ let term_of_indcon_uri (uri,tyno,consno) exp_named_subst =
+  MutConstruct (uri, tyno, consno, exp_named_subst)
+ ;;
+
+ let term_of_uri uri =
+  match uri with
+     CicTextualParser0.ConUri uri ->
+      term_of_con_uri uri
+   | CicTextualParser0.VarUri uri ->
+      term_of_var_uri uri
+   | CicTextualParser0.IndTyUri (uri,tyno) ->
+      term_of_indty_uri (uri,tyno) 
+   | CicTextualParser0.IndConUri (uri,tyno,consno) ->
+      term_of_indcon_uri (uri,tyno,consno)
+ ;;
+
+ let var_uri_of_id id interp =
+  let module CTP0 = CicTextualParser0 in
+   match interp (CicTextualParser0.Id id) with
+      None -> raise (UnknownIdentifier id)
+    | Some (CTP0.Uri (CTP0.VarUri uri)) -> uri
+    | Some _ -> raise TheLeftHandSideOfAnExplicitNamedSubstitutionMustBeAVariable
+ ;;
+
+ let indty_uri_of_id id interp =
+  let module CTP0 = CicTextualParser0 in
+   match interp (CicTextualParser0.Id id) with
+      None -> raise (UnknownIdentifier id)
+    | Some (CTP0.Uri (CTP0.IndTyUri (uri,tyno))) -> (uri,tyno)
+    | Some _ -> raise InductiveTypeURIExpected
+ ;;
+
+ let mk_implicit () =
+  let newmeta = new_meta () in
+   let new_canonical_context = [] in
+    let irl =
+     identity_relocation_list_for_metavariable new_canonical_context
+    in
+     CicTextualParser0.metasenv :=
+      [newmeta, new_canonical_context, Sort Type ;
+       newmeta+1, new_canonical_context, Meta (newmeta,irl);
+       newmeta+2, new_canonical_context, Meta (newmeta+1,irl)
+      ] @ !CicTextualParser0.metasenv ;
+     [], function _ -> Meta (newmeta+2,irl)
+ ;;
 %}
 %token  ID
 %token  META
 %token  NUM
 %token  CONURI
+%token  VARURI
 %token  INDTYURI
 %token  INDCONURI
-%token ALIAS
 %token LPAREN RPAREN PROD LAMBDA COLON DOT SET PROP TYPE CAST IMPLICIT NONE
 %token LETIN FIX COFIX SEMICOLON LCURLY RCURLY CASE ARROW LBRACKET RBRACKET EOF
 %right ARROW
 %start main
-%type  main
+%type  Cic.term)> main
 %%
 main:
-   expr  { Some $1 }
- | alias { None }
- | EOF   { raise CicTextualParser0.Eof }
+ | EOF { raise CicTextualParser0.Eof } /* FG: was never raised */
+ | expr EOF { $1 }
+ | expr SEMICOLON { $1 } /*  FG: to read several terms in a row
+                          *  Do we need to clear some static variables? 
+			  */
 ;
 expr2:
-   CONURI
-   { let uri = UriManager.string_of_uri $1 in
-     let suff = (String.sub uri (String.length uri - 3) 3) in
-      match suff with
-         "con" ->
-           let cookingno = get_cookingno $1 in
-            Const ($1,cookingno)
-       | "var" -> Var $1
-       | _ -> raise (InvalidSuffix suff)
+   CONURI exp_named_subst
+   { let dom,mk_exp_named_subst = deoptionize_exp_named_subst $2 in
+      dom, function interp -> term_of_con_uri $1 (mk_exp_named_subst interp)
+   }
+ | VARURI exp_named_subst
+   { let dom,mk_exp_named_subst = deoptionize_exp_named_subst $2 in
+      dom, function interp -> term_of_var_uri $1 (mk_exp_named_subst interp)
    }
- | INDTYURI
-    { let cookingno = get_cookingno (fst $1) in
-       MutInd (fst $1, cookingno, snd $1) }
- | INDCONURI
-   { let (uri,tyno,consno) = $1 in
-      let cookingno = get_cookingno uri in
-       MutConstruct (uri, cookingno, tyno, consno) }
- | ID
+ | INDTYURI exp_named_subst
+   { let dom,mk_exp_named_subst = deoptionize_exp_named_subst $2 in
+      dom, function interp -> term_of_indty_uri $1 (mk_exp_named_subst interp)
+   }
+ | INDCONURI exp_named_subst
+   { let dom,mk_exp_named_subst = deoptionize_exp_named_subst $2 in
+      dom, function interp -> term_of_indcon_uri $1 (mk_exp_named_subst interp)
+   }
+ | ID exp_named_subst
    { try
+      let res =
        Rel (get_index_in_list (Name $1) !CicTextualParser0.binders)
+      in
+       (match $2 with
+           None -> ([], function _ -> res)
+         | Some _ -> raise (ExplicitNamedSubstitutionAppliedToRel)
+       )
      with
       Not_found ->
-       try
-        Hashtbl.find uri_of_id_map $1
-       with
-        Not_found ->
-	 match ! CicTextualParser0.locate_object $1 with
-	  | None      -> raise (UnknownIdentifier $1)
-	  | Some term -> Hashtbl.add uri_of_id_map $1 term; term  
+       let dom1,mk_exp_named_subst = deoptionize_exp_named_subst $2 in
+        let dom = union dom1 [CicTextualParser0.Id $1] in
+         dom,
+          function interp ->
+           match interp (CicTextualParser0.Id $1) with
+	      None  -> raise (UnknownIdentifier $1)
+	    | Some (CicTextualParser0.Uri uri) ->
+               term_of_uri uri (mk_exp_named_subst interp)
+            | Some CicTextualParser0.Implicit ->
+               (*CSC: not very clean; to maximize code reusage *)
+               snd (mk_implicit ()) ""
+            | Some (CicTextualParser0.Term mk_term) ->
+               (mk_term interp)
    }
  | CASE LPAREN expr COLON INDTYURI SEMICOLON expr RPAREN LCURLY branches RCURLY
-    { let cookingno = get_cookingno (fst $5) in
-       MutCase (fst $5, cookingno, snd $5, $7, $3, $10) }
+    { let dom1,mk_expr1 = $3 in
+      let dom2,mk_expr2 = $7 in
+      let dom3,mk_expr3 = $10 in
+       let dom = (union  dom1 (union dom2 dom3)) in
+        dom,
+        function interp ->
+         MutCase
+          (fst $5,snd $5,(mk_expr2 interp),(mk_expr1 interp),(mk_expr3 interp))
+    }
  | CASE LPAREN expr COLON ID SEMICOLON expr RPAREN LCURLY branches RCURLY
-    { try
-       let _ = get_index_in_list (Name $5) !CicTextualParser0.binders in
-        raise InductiveTypeURIExpected
-      with
-       Not_found ->
-        match Hashtbl.find uri_of_id_map $5 with
-           MutInd (uri,cookingno,typeno) ->
-            MutCase (uri, cookingno, typeno, $7, $3, $10)
-         | _ -> raise InductiveTypeURIExpected
+    { let dom1,mk_expr1 = $3 in
+      let dom2,mk_expr2 = $7 in
+      let dom3,mk_expr3 = $10 in
+       let dom = union [CicTextualParser0.Id $5] (union dom1 (union dom2 dom3)) in
+        dom,
+        function interp ->
+         let uri,typeno = indty_uri_of_id $5 interp in
+          MutCase
+           (uri,typeno,(mk_expr2 interp),(mk_expr1 interp),
+             (mk_expr3 interp))
     }
  | fixheader LCURLY exprseplist RCURLY
-    { let fixfunsdecls = snd $1 in
-      let fixfunsbodies = $3 in
-       let idx =
-        let rec find idx =
-         function
-            [] -> raise Not_found
-          | (name,_,_)::_  when name = (fst $1) -> idx
-          | _::tl -> find (idx+1) tl
-        in
-         find 0 fixfunsdecls
-       in
-        let fixfuns =
-         List.map2 (fun (name,recindex,ty) bo -> (name,recindex,ty,bo))
-          fixfunsdecls fixfunsbodies
-        in
-         for i = 1 to List.length fixfuns do
-          CicTextualParser0.binders := List.tl !CicTextualParser0.binders
-         done ;
-         Fix (idx,fixfuns)
+    { let dom1,foo,ids_and_indexes,mk_types = $1 in
+      let dom2,mk_exprseplist = $3 in
+       let dom = union dom1 dom2 in
+        for i = 1 to List.length ids_and_indexes do
+         CicTextualParser0.binders := List.tl !CicTextualParser0.binders
+        done ;
+        dom,
+         function interp ->
+          let types = mk_types interp in
+          let fixfunsbodies = (mk_exprseplist interp) in
+           let idx =
+            let rec find idx =
+             function
+                [] -> raise Not_found
+              | (name,_)::_  when name = foo -> idx
+              | _::tl -> find (idx+1) tl
+            in
+             find 0 ids_and_indexes
+           in
+            let fixfuns =
+             List.map2 (fun ((name,recindex),ty) bo -> (name,recindex,ty,bo))
+              (List.combine ids_and_indexes types) fixfunsbodies
+            in
+             Fix (idx,fixfuns)
     }
  | cofixheader LCURLY exprseplist RCURLY
-    { let cofixfunsdecls = (snd $1) in
-      let cofixfunsbodies = $3 in
-       let idx =
-        let rec find idx =
-         function
-            [] -> raise Not_found
-          | (name,_)::_  when name = (fst $1) -> idx
-          | _::tl -> find (idx+1) tl
-        in
-         find 0 cofixfunsdecls
-       in
-        let cofixfuns =
-         List.map2 (fun (name,ty) bo -> (name,ty,bo))
-          cofixfunsdecls cofixfunsbodies
-        in
-         for i = 1 to List.length cofixfuns do
-          CicTextualParser0.binders := List.tl !CicTextualParser0.binders
-         done ;
-         CoFix (idx,cofixfuns)
+    { let dom1,foo,ids,mk_types = $1 in
+      let dom2,mk_exprseplist = $3 in
+       let dom = union dom1 dom2 in
+        dom,
+         function interp ->
+          let types = mk_types interp in
+          let fixfunsbodies = (mk_exprseplist interp) in
+           let idx =
+            let rec find idx =
+             function
+                [] -> raise Not_found
+              | name::_  when name = foo -> idx
+              | _::tl -> find (idx+1) tl
+            in
+             find 0 ids
+           in
+            let fixfuns =
+             List.map2 (fun (name,ty) bo -> (name,ty,bo))
+              (List.combine ids types) fixfunsbodies
+            in
+             for i = 1 to List.length fixfuns do
+              CicTextualParser0.binders := List.tl !CicTextualParser0.binders
+             done ;
+             CoFix (idx,fixfuns)
     }
  | IMPLICIT
-    { let newmeta = new_meta () in
-       let new_canonical_context = [] in
-        let irl =
-         identity_relocation_list_for_metavariable new_canonical_context
-        in
-         CicTextualParser0.metasenv :=
-          [newmeta, new_canonical_context, Sort Type ;
-           newmeta+1, new_canonical_context, Meta (newmeta,irl);
-           newmeta+2, new_canonical_context, Meta (newmeta+1,irl)
-          ] @ !CicTextualParser0.metasenv ;
-         Meta (newmeta+2,irl)
+    { mk_implicit () }
+ | SET  { [], function _ -> Sort Set }
+ | PROP { [], function _ -> Sort Prop }
+ | TYPE { [], function _ -> Sort Type }
+ | LPAREN expr CAST expr RPAREN
+    { let dom1,mk_expr1 = $2 in
+      let dom2,mk_expr2 = $4 in
+       let dom = union dom1 dom2 in
+        dom, function interp -> Cast ((mk_expr1 interp),(mk_expr2 interp))
+    }
+ | META LBRACKET substitutionlist RBRACKET
+    { let dom,mk_substitutionlist = $3 in
+       dom, function interp -> Meta ($1, mk_substitutionlist interp)
+    } 
+ | LPAREN expr exprlist RPAREN
+    { let length,dom2,mk_exprlist = $3 in
+       match length with
+          0 -> $2
+        | _ ->
+          let dom1,mk_expr1 = $2 in
+           let dom = union dom1 dom2 in
+            dom,
+             function interp ->
+              Appl ((mk_expr1 interp)::(mk_exprlist interp))
+    }
+;
+exp_named_subst :
+    { None }
+ | LCURLY named_substs RCURLY
+    { Some $2 }
+;
+named_substs :
+   VARURI LETIN expr2
+    { let dom,mk_expr = $3 in
+       dom, function interp -> [$1, mk_expr interp] }
+ | ID LETIN expr2
+    { let dom1,mk_expr = $3 in
+       let dom = union [CicTextualParser0.Id $1] dom1 in
+        dom, function interp -> [var_uri_of_id $1 interp, mk_expr interp] }
+ | VARURI LETIN expr2 SEMICOLON named_substs
+    { let dom1,mk_expr = $3 in
+      let dom2,mk_named_substs = $5 in
+       let dom = union dom1 dom2 in
+        dom, function interp -> ($1, mk_expr interp)::(mk_named_substs interp)
+    }
+ | ID LETIN expr2 SEMICOLON named_substs
+    { let dom1,mk_expr = $3 in
+      let dom2,mk_named_substs = $5 in
+       let dom = union [CicTextualParser0.Id $1] (union dom1 dom2) in
+        dom,
+         function interp ->
+          (var_uri_of_id $1 interp, mk_expr interp)::(mk_named_substs interp)
     }
- | SET { Sort Set }
- | PROP { Sort Prop }
- | TYPE { Sort Type }
- | LPAREN expr CAST expr RPAREN { Cast ($2,$4) }
- | META LBRACKET substitutionlist RBRACKET { Meta ($1, $3) } 
- | LPAREN expr expr exprlist RPAREN { Appl ([$2;$3]@$4) }
 ;
 expr :
    pihead expr
     { CicTextualParser0.binders := List.tl !CicTextualParser0.binders ;
-      Prod (fst $1, snd $1,$2) }
+      let dom1,mk_expr1 = snd $1 in
+      let dom2,mk_expr2 = $2 in
+       let dom = union dom1 dom2 in
+        dom, function interp -> Prod (fst $1, mk_expr1 interp, mk_expr2 interp)
+    }
  | lambdahead expr
     { CicTextualParser0.binders := List.tl !CicTextualParser0.binders ;
-      Lambda (fst $1, snd $1,$2) }
+      let dom1,mk_expr1 = snd $1 in
+      let dom2,mk_expr2 = $2 in
+       let dom = union dom1 dom2 in
+        dom,function interp -> Lambda (fst $1, mk_expr1 interp, mk_expr2 interp)
+    }
  | letinhead expr
     { CicTextualParser0.binders := List.tl !CicTextualParser0.binders ;
-      LetIn (fst $1, snd $1,$2) }
+      let dom1,mk_expr1 = snd $1 in
+      let dom2,mk_expr2 = $2 in
+       let dom = union dom1 dom2 in
+        dom, function interp -> LetIn (fst $1, mk_expr1 interp, mk_expr2 interp)
+    }
  | expr2
     { $1 }
 ;
 fixheader:
    FIX ID LCURLY fixfunsdecl RCURLY
-    { let bs = List.rev_map (function (name,_,_) -> Some (Name name)) $4 in
-       CicTextualParser0.binders := bs@(!CicTextualParser0.binders) ;
-       $2,$4
+    { let dom,ids_and_indexes,mk_types = $4 in
+       let bs =
+        List.rev_map (function (name,_) -> Some (Name name)) ids_and_indexes
+       in
+        CicTextualParser0.binders := bs@(!CicTextualParser0.binders) ;
+        dom, $2, ids_and_indexes, mk_types
     }
 ;
 fixfunsdecl:
    ID LPAREN NUM RPAREN COLON expr
-    { [$1,$3,$6] }
+    { let dom,mk_expr = $6 in
+       dom, [$1,$3], function interp -> [mk_expr interp]
+    }
  | ID LPAREN NUM RPAREN COLON expr SEMICOLON fixfunsdecl
-    { ($1,$3,$6)::$8 }
+    { let dom1,mk_expr = $6 in
+      let dom2,ids_and_indexes,mk_types = $8 in
+       let dom = union dom1 dom2 in
+        dom, ($1,$3)::ids_and_indexes,
+         function interp -> (mk_expr interp)::(mk_types interp)
+    }
 ;
 cofixheader:
    COFIX ID LCURLY cofixfunsdecl RCURLY
-    { let bs = List.rev_map (function (name,_) -> Some (Name name)) $4 in
-       CicTextualParser0.binders := bs@(!CicTextualParser0.binders) ;
-       $2,$4
+    { let dom,ids,mk_types = $4 in
+       let bs =
+        List.rev_map (function name -> Some (Name name)) ids
+       in
+        CicTextualParser0.binders := bs@(!CicTextualParser0.binders) ;
+        dom, $2, ids, mk_types
     }
 ;
 cofixfunsdecl:
    ID COLON expr
-    { [$1,$3] }
+    { let dom,mk_expr = $3 in
+       dom, [$1], function interp -> [mk_expr interp]
+    }
  | ID COLON expr SEMICOLON cofixfunsdecl
-    { ($1,$3)::$5 }
+    { let dom1,mk_expr = $3 in
+      let dom2,ids,mk_types = $5 in
+       let dom = union dom1 dom2 in
+        dom, $1::ids,
+         function interp -> (mk_expr interp)::(mk_types interp)
+    }
 ;
 pihead:
    PROD ID COLON expr DOT
     { CicTextualParser0.binders := (Some (Name $2))::!CicTextualParser0.binders;
-      (Cic.Name $2, $4) }
+      let dom,mk_expr = $4 in
+       Cic.Name $2, (dom, function interp -> mk_expr interp)
+    }
  | expr2 ARROW
-   { CicTextualParser0.binders := (Some Anonimous)::!CicTextualParser0.binders ;
-     (Anonimous, $1) }
- | LPAREN expr RPAREN ARROW
-   { CicTextualParser0.binders := (Some Anonimous)::!CicTextualParser0.binders ;
-     (Anonimous, $2) }
+   { CicTextualParser0.binders := (Some Anonymous)::!CicTextualParser0.binders ;
+     let dom,mk_expr = $1 in
+      Anonymous, (dom, function interp -> mk_expr interp)
+   }
+ | PROD ID DOT
+    { CicTextualParser0.binders := (Some (Name $2))::!CicTextualParser0.binders;
+      let newmeta = new_meta () in
+       let new_canonical_context = [] in
+        let irl =
+         identity_relocation_list_for_metavariable new_canonical_context
+        in
+         CicTextualParser0.metasenv :=
+          [newmeta, new_canonical_context, Sort Type ;
+           newmeta+1, new_canonical_context, Meta (newmeta,irl)
+          ] @ !CicTextualParser0.metasenv ;
+         Cic.Name $2, ([], function _ -> Meta (newmeta+1,irl))
+    }
 ;
 lambdahead:
-  LAMBDA ID COLON expr DOT
-   { CicTextualParser0.binders := (Some (Name $2))::!CicTextualParser0.binders ;
-     (Cic.Name $2, $4) }
+   LAMBDA ID COLON expr DOT
+    { CicTextualParser0.binders := (Some (Name $2))::!CicTextualParser0.binders;
+      let dom,mk_expr = $4 in
+       Cic.Name $2, (dom, function interp -> mk_expr interp)
+    }
+ | LAMBDA ID DOT
+    { CicTextualParser0.binders := (Some (Name $2))::!CicTextualParser0.binders;
+      let newmeta = new_meta () in
+       let new_canonical_context = [] in
+        let irl =
+         identity_relocation_list_for_metavariable new_canonical_context
+        in
+         CicTextualParser0.metasenv :=
+          [newmeta, new_canonical_context, Sort Type ;
+           newmeta+1, new_canonical_context, Meta (newmeta,irl)
+          ] @ !CicTextualParser0.metasenv ;
+         Cic.Name $2, ([], function _ -> Meta (newmeta+1,irl))
+    }
 ;
 letinhead:
   LAMBDA ID LETIN expr DOT
    { CicTextualParser0.binders := (Some (Name $2))::!CicTextualParser0.binders ;
-     (Cic.Name $2, $4) }
+     let dom,mk_expr = $4 in
+      Cic.Name $2, (dom, function interp -> mk_expr interp)
+   }
 ;
 branches:
-                            { [] }
- | expr SEMICOLON branches  { $1::$3 }
- | expr                     { [$1] }
+    { [], function _ -> [] }
+ | expr SEMICOLON branches
+    { let dom1,mk_expr = $1 in
+      let dom2,mk_branches = $3 in
+       let dom = union dom1 dom2 in
+        dom, function interp -> (mk_expr interp)::(mk_branches interp)
+    }
+ | expr
+    { let dom,mk_expr = $1 in
+       dom, function interp -> [mk_expr interp]
+    }
 ;
 exprlist:
-                  { [] }
- | expr exprlist  { $1::$2 }
+    
+    { 0, [], function _ -> [] }
+ | expr exprlist
+    { let dom1,mk_expr = $1 in
+      let length,dom2,mk_exprlist = $2 in
+       let dom = union dom1 dom2 in
+        length+1, dom, function interp -> (mk_expr interp)::(mk_exprlist interp)
+    }
 ;
 exprseplist:
-   expr                        { [$1] }
- | expr SEMICOLON exprseplist  { $1::$3 }
+   expr
+    { let dom,mk_expr = $1 in
+       dom, function interp -> [mk_expr interp]
+    }
+ | expr SEMICOLON exprseplist
+    { let dom1,mk_expr = $1 in
+      let dom2,mk_exprseplist = $3 in
+       let dom = union dom1 dom2 in
+        dom, function interp -> (mk_expr interp)::(mk_exprseplist interp)
+    }
 ;
 substitutionlist:
-                                     { [] }
- | expr SEMICOLON substitutionlist   { (Some $1)::$3 }
- | NONE SEMICOLON substitutionlist   { None::$3 }
-;
-alias:
-   ALIAS ID CONURI
-    { let cookingno = get_cookingno $3 in
-       Hashtbl.add uri_of_id_map $2 (Cic.Const ($3,cookingno)) }
- | ALIAS ID INDTYURI
-    { let cookingno = get_cookingno (fst $3) in
-       Hashtbl.add uri_of_id_map $2 (Cic.MutInd (fst $3, cookingno, snd $3)) }
- | ALIAS ID INDCONURI
-    { let uri,indno,consno = $3 in
-       let cookingno = get_cookingno uri in
-        Hashtbl.add uri_of_id_map $2
-         (Cic.MutConstruct (uri, cookingno, indno ,consno))
+    { [], function _ -> [] }
+ | expr SEMICOLON substitutionlist
+    { let dom1,mk_expr = $1 in
+      let dom2,mk_substitutionlist = $3 in
+       let dom = union dom1 dom2 in
+        dom,
+         function interp ->(Some (mk_expr interp))::(mk_substitutionlist interp)
+    }
+ | NONE SEMICOLON substitutionlist
+    { let dom,mk_exprsubstitutionlist = $3 in
+       dom, function interp -> None::(mk_exprsubstitutionlist interp)
     }
-
-
-
diff --git a/helm/ocaml/cic_textual_parser/cicTextualParser0.ml b/helm/ocaml/cic_textual_parser/cicTextualParser0.ml
index fe4bf0623..7a53057e2 100644
--- a/helm/ocaml/cic_textual_parser/cicTextualParser0.ml
+++ b/helm/ocaml/cic_textual_parser/cicTextualParser0.ml
@@ -24,11 +24,25 @@
  *)
 
 exception Eof;;
+exception LexerFailure of string;;
+
+type uri =
+   ConUri of UriManager.uri
+ | VarUri of UriManager.uri
+ | IndTyUri of UriManager.uri * int
+ | IndConUri of UriManager.uri * int * int
+;;
+
+type interpretation_domain_item =
+   Id of string
+ | Symbol of string * (string * (interpretation -> Cic.term)) list
+and interpretation_codomain_item =
+   Uri of uri
+ | Implicit
+ | Term of (interpretation -> Cic.term)
+and interpretation =
+ interpretation_domain_item -> interpretation_codomain_item option
+;;
 
-let current_uri = ref (UriManager.uri_of_string "cic:/dummy.con");;
 let binders = ref ([] : (Cic.name option) list);;
 let metasenv = ref ([] : Cic.metasenv);;
-let locate_object = ref ((fun _ -> None):string->Cic.term option);;
-
-let set_locate_object f =
-   locate_object := f
diff --git a/helm/ocaml/cic_textual_parser/cicTextualParserContext.ml b/helm/ocaml/cic_textual_parser/cicTextualParserContext.ml
index bdf701d80..6901bd48c 100644
--- a/helm/ocaml/cic_textual_parser/cicTextualParserContext.ml
+++ b/helm/ocaml/cic_textual_parser/cicTextualParserContext.ml
@@ -23,14 +23,14 @@
  * http://cs.unibo.it/helm/.
  *)
 
-let main ~current_uri ~context ~metasenv lexer lexbuf =
+let main ~context ~metasenv lexer lexbuf =
  (* Warning: higly non-reentrant code!!! *)
- CicTextualParser0.current_uri := current_uri ;
  CicTextualParser0.binders := context ;
  CicTextualParser0.metasenv := metasenv ;
- match CicTextualParser.main lexer lexbuf with
-    None -> None
-  | Some res ->
-     CicTextualParser0.binders := [] ;
-     Some (!CicTextualParser0.metasenv,res)
+ let dom,mk_term = CicTextualParser.main lexer lexbuf in
+  dom,
+   function interp ->
+    let term = mk_term interp in 
+    let metasenv = !CicTextualParser0.metasenv in
+     metasenv,term
 ;;
diff --git a/helm/ocaml/cic_textual_parser/cicTextualParserContext.mli b/helm/ocaml/cic_textual_parser/cicTextualParserContext.mli
index 837628b21..0b8871ee8 100644
--- a/helm/ocaml/cic_textual_parser/cicTextualParserContext.mli
+++ b/helm/ocaml/cic_textual_parser/cicTextualParserContext.mli
@@ -24,6 +24,8 @@
  *)
 
 val main :
-  current_uri:(UriManager.uri) -> context:((Cic.name option) list) ->
-   metasenv:Cic.metasenv -> (Lexing.lexbuf  -> CicTextualParser.token) ->
-   Lexing.lexbuf -> (Cic.metasenv * Cic.term) option
+  context:((Cic.name option) list) ->
+  metasenv:Cic.metasenv ->
+  (Lexing.lexbuf  -> CicTextualParser.token) -> Lexing.lexbuf ->
+   CicTextualParser0.interpretation_domain_item list *
+    (CicTextualParser0.interpretation -> (Cic.metasenv * Cic.term))
diff --git a/helm/ocaml/cic_unification/.depend b/helm/ocaml/cic_unification/.depend
index 31eaf6dd0..d22689dce 100644
--- a/helm/ocaml/cic_unification/.depend
+++ b/helm/ocaml/cic_unification/.depend
@@ -1,2 +1,5 @@
+cicRefine.cmi: cicUnification.cmi 
 cicUnification.cmo: cicUnification.cmi 
 cicUnification.cmx: cicUnification.cmi 
+cicRefine.cmo: cicUnification.cmi cicRefine.cmi 
+cicRefine.cmx: cicUnification.cmx cicRefine.cmi 
diff --git a/helm/ocaml/cic_unification/Makefile b/helm/ocaml/cic_unification/Makefile
index 5a88cbb4d..fbf0d22ed 100644
--- a/helm/ocaml/cic_unification/Makefile
+++ b/helm/ocaml/cic_unification/Makefile
@@ -2,7 +2,7 @@ PACKAGE = cic_unification
 REQUIRES = helm-cic_proof_checking
 PREDICATES =
 
-INTERFACE_FILES = cicUnification.mli
+INTERFACE_FILES = cicUnification.mli cicRefine.mli
 IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml)
 EXTRA_OBJECTS_TO_INSTALL =
 
diff --git a/helm/ocaml/cic_unification/cicRefine.ml b/helm/ocaml/cic_unification/cicRefine.ml
new file mode 100644
index 000000000..e5e846982
--- /dev/null
+++ b/helm/ocaml/cic_unification/cicRefine.ml
@@ -0,0 +1,365 @@
+(* Copyright (C) 2000, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+exception Impossible of int;;
+exception NotRefinable of string;;
+exception Uncertain of string;;
+exception WrongUriToConstant of string;;
+exception WrongUriToVariable of string;;
+exception WrongUriToMutualInductiveDefinitions of string;;
+exception RelToHiddenHypothesis;;
+exception MetasenvInconsistency;;
+exception MutCaseFixAndCofixRefineNotImplemented;;
+exception FreeMetaFound of int;;
+
+let fdebug = ref 0;;
+let debug t context =
+ let rec debug_aux t i =
+  let module C = Cic in
+  let module U = UriManager in
+   CicPp.ppobj (C.Variable ("DEBUG", None, t, [])) ^ "\n" ^ i
+ in
+  if !fdebug = 0 then
+   raise (NotRefinable ("\n" ^ List.fold_right debug_aux (t::context) ""))
+   (*print_endline ("\n" ^ List.fold_right debug_aux (t::context) "") ; flush stdout*)
+;;
+
+let rec type_of_constant uri =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+  match CicEnvironment.get_cooked_obj uri with
+     C.Constant (_,_,ty,_) -> ty
+   | C.CurrentProof (_,_,_,ty,_) -> ty
+   | _ -> raise (WrongUriToConstant (U.string_of_uri uri))
+
+and type_of_variable uri =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+  match CicEnvironment.get_cooked_obj uri with
+     C.Variable (_,_,ty,_) -> ty
+   |  _ -> raise (WrongUriToVariable (UriManager.string_of_uri uri))
+
+and type_of_mutual_inductive_defs uri i =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+  match CicEnvironment.get_cooked_obj uri with
+     C.InductiveDefinition (dl,_,_) ->
+      let (_,_,arity,_) = List.nth dl i in
+       arity
+   | _ -> raise (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri))
+
+and type_of_mutual_inductive_constr uri i j =
+ let module C = Cic in
+ let module R = CicReduction in
+ let module U = UriManager in
+  match CicEnvironment.get_cooked_obj uri with
+      C.InductiveDefinition (dl,_,_) ->
+       let (_,_,_,cl) = List.nth dl i in
+        let (_,ty) = List.nth cl (j-1) in
+         ty
+   | _ -> raise (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri))
+
+(* type_of_aux' is just another name (with a different scope) for type_of_aux *)
+and type_of_aux' metasenv context t =
+ let rec type_of_aux subst metasenv context =
+  let module C = Cic in
+  let module S = CicSubstitution in
+  let module U = UriManager in
+  let module Un = CicUnification in
+   function
+      C.Rel n ->
+       (try
+         match List.nth context (n - 1) with
+            Some (_,C.Decl t) -> S.lift n t,subst,metasenv
+          | Some (_,C.Def bo) ->
+             type_of_aux subst metasenv context (S.lift n bo)
+	  | None -> raise RelToHiddenHypothesis
+        with
+         _ -> raise (NotRefinable "Not a close term")
+       )
+    | C.Var (uri,exp_named_subst) ->
+      incr fdebug ;
+      let subst',metasenv' =
+       check_exp_named_subst subst metasenv context exp_named_subst in
+      let ty =
+       CicSubstitution.subst_vars exp_named_subst (type_of_variable uri)
+      in
+       decr fdebug ;
+       ty,subst',metasenv'
+    | C.Meta (n,l) -> 
+       let (_,canonical_context,ty) =
+        try
+         List.find (function (m,_,_) -> n = m) metasenv
+        with
+         Not_found -> raise (FreeMetaFound n)
+       in
+        let subst',metasenv' =
+         check_metasenv_consistency subst metasenv context canonical_context l
+        in
+         CicSubstitution.lift_meta l ty, subst', metasenv'
+    | C.Sort s ->
+       C.Sort C.Type, (*CSC manca la gestione degli universi!!! *)
+        subst,metasenv
+    | C.Implicit -> raise (Impossible 21)
+    | C.Cast (te,ty) ->
+       let _,subst',metasenv' =
+        type_of_aux subst metasenv context ty in
+       let inferredty,subst'',metasenv'' =
+        type_of_aux subst' metasenv' context ty
+       in
+        (try
+          let subst''',metasenv''' =
+           Un.fo_unif_subst subst'' context metasenv'' inferredty ty
+          in
+           ty,subst''',metasenv'''
+         with
+          _ -> raise (NotRefinable "Cast"))
+    | C.Prod (name,s,t) ->
+       let sort1,subst',metasenv' = type_of_aux subst metasenv context s in
+       let sort2,subst'',metasenv'' =
+        type_of_aux subst' metasenv' ((Some (name,(C.Decl s)))::context) t
+       in
+        sort_of_prod subst'' metasenv'' context (name,s) (sort1,sort2)
+   | C.Lambda (n,s,t) ->
+       let sort1,subst',metasenv' = type_of_aux subst metasenv context s in
+       let type2,subst'',metasenv'' =
+        type_of_aux subst' metasenv' ((Some (n,(C.Decl s)))::context) t
+       in
+        let sort2,subst''',metasenv''' =
+         type_of_aux subst'' metasenv''((Some (n,(C.Decl s)))::context) type2
+        in
+         (* only to check if the product is well-typed *)
+         let _,subst'''',metasenv'''' =
+          sort_of_prod subst''' metasenv''' context (n,s) (sort1,sort2)
+         in
+          C.Prod (n,s,type2),subst'''',metasenv''''
+   | C.LetIn (n,s,t) ->
+      (* only to check if s is well-typed *)
+      let _,subst',metasenv' = type_of_aux subst metasenv context s in
+      let inferredty,subst'',metasenv'' =
+       type_of_aux subst' metasenv' ((Some (n,(C.Def s)))::context) t
+      in
+       (* One-step LetIn reduction. Even faster than the previous solution.
+          Moreover the inferred type is closer to the expected one. *)
+       CicSubstitution.subst s inferredty,subst',metasenv'
+   | C.Appl (he::tl) when List.length tl > 0 ->
+      let hetype,subst',metasenv' = type_of_aux subst metasenv context he in
+      let tlbody_and_type,subst'',metasenv'' =
+       List.fold_right
+        (fun x (res,subst,metasenv) ->
+          let ty,subst',metasenv' =
+           type_of_aux subst metasenv context x
+          in
+           (x, ty)::res,subst',metasenv'
+        ) tl ([],subst',metasenv')
+      in
+       eat_prods subst'' metasenv'' context hetype tlbody_and_type
+   | C.Appl _ -> raise (NotRefinable "Appl: no arguments")
+   | C.Const (uri,exp_named_subst) ->
+      incr fdebug ;
+      let subst',metasenv' =
+       check_exp_named_subst subst metasenv context exp_named_subst in
+      let cty =
+       CicSubstitution.subst_vars exp_named_subst (type_of_constant uri)
+      in
+       decr fdebug ;
+       cty,subst',metasenv'
+   | C.MutInd (uri,i,exp_named_subst) ->
+      incr fdebug ;
+      let subst',metasenv' =
+       check_exp_named_subst subst metasenv context exp_named_subst in
+      let cty =
+       CicSubstitution.subst_vars exp_named_subst
+        (type_of_mutual_inductive_defs uri i)
+      in
+       decr fdebug ;
+       cty,subst',metasenv'
+   | C.MutConstruct (uri,i,j,exp_named_subst) ->
+      let subst',metasenv' =
+       check_exp_named_subst subst metasenv context exp_named_subst in
+      let cty =
+       CicSubstitution.subst_vars exp_named_subst
+        (type_of_mutual_inductive_constr uri i j)
+      in
+       cty,subst',metasenv'
+   | C.MutCase _
+   | C.Fix _
+   | C.CoFix _ -> raise MutCaseFixAndCofixRefineNotImplemented
+
+ (* check_metasenv_consistency checks that the "canonical" context of a
+ metavariable is consitent - up to relocation via the relocation list l -
+ with the actual context *)
+ and check_metasenv_consistency subst metasenv context canonical_context l =
+   let module C = Cic in
+   let module R = CicReduction in
+   let module S = CicSubstitution in
+    let lifted_canonical_context = 
+     let rec aux i =
+      function
+         [] -> []
+       | (Some (n,C.Decl t))::tl ->
+          (Some (n,C.Decl (S.lift_meta l (S.lift i t))))::(aux (i+1) tl)
+       | (Some (n,C.Def t))::tl ->
+          (Some (n,C.Def (S.lift_meta l (S.lift i t))))::(aux (i+1) tl)
+       | None::tl -> None::(aux (i+1) tl)
+     in
+      aux 1 canonical_context
+    in
+     List.fold_left2 
+      (fun (subst,metasenv) t ct -> 
+        match (t,ct) with
+           _,None -> subst,metasenv
+         | Some t,Some (_,C.Def ct) ->
+            (try
+              CicUnification.fo_unif_subst subst context metasenv t ct
+             with _ -> raise MetasenvInconsistency)
+         | Some t,Some (_,C.Decl ct) ->
+            let inferredty,subst',metasenv' =
+             type_of_aux subst metasenv context t
+            in
+             (try
+               CicUnification.fo_unif_subst subst context metasenv inferredty ct
+             with _ -> raise MetasenvInconsistency)
+         | _, _  -> raise MetasenvInconsistency
+      ) (subst,metasenv) l lifted_canonical_context 
+
+ and check_exp_named_subst metasubst metasenv context =
+  let rec check_exp_named_subst_aux metasubst metasenv substs =
+   function
+      [] -> metasubst,metasenv
+    | ((uri,t) as subst)::tl ->
+       let typeofvar =
+        CicSubstitution.subst_vars substs (type_of_variable uri) in
+       (match CicEnvironment.get_cooked_obj ~trust:false uri with
+           Cic.Variable (_,Some bo,_,_) ->
+            raise
+             (NotRefinable
+               "A variable with a body can not be explicit substituted")
+         | Cic.Variable (_,None,_,_) -> ()
+         | _ -> raise (WrongUriToVariable (UriManager.string_of_uri uri))
+       ) ;
+       let typeoft,metasubst',metasenv' =
+        type_of_aux metasubst metasenv context t
+       in
+        try
+         let metasubst'',metasenv'' =
+          CicUnification.fo_unif_subst
+           metasubst' context metasenv' typeoft typeofvar
+         in
+          check_exp_named_subst_aux metasubst'' metasenv'' (substs@[subst]) tl
+        with _ ->
+         raise (NotRefinable "Wrong Explicit Named Substitution")
+  in
+   check_exp_named_subst_aux metasubst metasenv []
+
+ and sort_of_prod subst metasenv context (name,s) (t1, t2) =
+  let module C = Cic in
+   (* ti could be a metavariable in the domain of the substitution *)
+   let subst',metasenv' = CicUnification.unwind_subst metasenv subst in
+   let t1' = CicUnification.apply_subst subst' t1 in
+   let t2' = CicUnification.apply_subst subst' t2 in
+    let t1'' = CicReduction.whd context t1' in
+    let t2'' = CicReduction.whd ((Some (name,C.Decl s))::context) t2' in
+    match (t1'', t2'') with
+       (C.Sort s1, C.Sort s2)
+         when (s2 = C.Prop or s2 = C.Set) -> (* different from Coq manual!!! *)
+          C.Sort s2,subst',metasenv'
+     | (C.Sort s1, C.Sort s2) ->
+         (*CSC manca la gestione degli universi!!! *)
+         C.Sort C.Type,subst',metasenv'
+     | (C.Meta _,_)
+     | (_,C.Meta _) ->
+       raise
+        (Uncertain
+          ("Two sorts were expected, found " ^ CicPp.ppterm t1'' ^ " and " ^
+           CicPp.ppterm t2''))
+     | (_,_) ->
+       raise
+        (NotRefinable
+         ("Prod: sort1= "^ CicPp.ppterm t1'' ^ " ; sort2= "^ CicPp.ppterm t2''))
+
+ and eat_prods subst metasenv context hetype =
+  function
+     [] -> hetype,subst,metasenv
+   | (hete, hety)::tl ->
+    (match (CicReduction.whd context hetype) with
+        Cic.Prod (n,s,t) ->
+         let subst',metasenv' =
+          try
+           CicUnification.fo_unif_subst subst context metasenv s hety
+          with _ ->
+           raise (NotRefinable "Appl: wrong parameter-type")
+         in
+          CicReduction.fdebug := -1 ;
+          eat_prods subst' metasenv' context (CicSubstitution.subst hete t) tl
+      | Cic.Meta _ as t ->
+         raise
+          (Uncertain
+            ("Prod expected, " ^ CicPp.ppterm t ^ " found"))
+      | _ -> raise (NotRefinable "Appl: wrong Prod-type")
+    )
+ in
+  let ty,subst',metasenv' =
+   type_of_aux [] metasenv context t
+  in
+   let subst'',metasenv'' = CicUnification.unwind_subst metasenv' subst' in
+   (* we get rid of the metavariables that have been instantiated *)
+   let metasenv''' =
+    List.filter
+     (function (i,_,_) -> not (List.exists (function (j,_) -> j=i) subst''))
+     metasenv''
+   in
+    CicUnification.apply_subst subst'' t,
+     CicUnification.apply_subst subst'' ty,
+     subst'', metasenv'''
+;;
+
+(* DEBUGGING ONLY *)
+let type_of_aux' metasenv context term =
+ try
+  let (t,ty,s,m) =
+   type_of_aux' metasenv context term
+  in
+   List.iter
+    (function (i,t) ->
+      prerr_endline ("+ ?" ^ string_of_int i ^ " := " ^ CicPp.ppterm t)) s ;
+   List.iter
+    (function (i,_,t) ->
+      prerr_endline ("+ ?" ^ string_of_int i ^ " : " ^ CicPp.ppterm t)) m ;
+   prerr_endline
+    ("@@@ REFINE SUCCESSFUL: " ^ CicPp.ppterm t ^ " : " ^ CicPp.ppterm ty) ;
+   (t,ty,s,m)
+ with
+  e ->
+   List.iter
+    (function (i,_,t) ->
+      prerr_endline ("+ ?" ^ string_of_int i ^ " : " ^ CicPp.ppterm t))
+    metasenv ;
+   prerr_endline ("@@@ REFINE FAILED: " ^ Printexc.to_string e) ;
+   raise e
+;;
diff --git a/helm/ocaml/cic_unification/cicRefine.mli b/helm/ocaml/cic_unification/cicRefine.mli
new file mode 100644
index 000000000..338f50663
--- /dev/null
+++ b/helm/ocaml/cic_unification/cicRefine.mli
@@ -0,0 +1,40 @@
+(* Copyright (C) 2000, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+exception NotRefinable of string
+exception Uncertain of string
+exception WrongUriToConstant of string
+exception WrongUriToVariable of string
+exception WrongUriToMutualInductiveDefinitions of string
+exception MutCaseFixAndCofixRefineNotImplemented;;
+exception FreeMetaFound of int;;
+
+(* type_of_aux' metasenv context term                        *)
+(* refines [term] and returns the refined form of [term],    *)
+(* its type, the computed substitution and the new metasenv. *)
+(* The substitution returned is already unwinded             *)
+val type_of_aux':
+ Cic.metasenv -> Cic.context -> Cic.term ->
+  Cic.term * Cic.term * CicUnification.substitution * Cic.metasenv
diff --git a/helm/ocaml/cic_unification/cicUnification.ml b/helm/ocaml/cic_unification/cicUnification.ml
index cd1e7aa0c..f7c19073b 100644
--- a/helm/ocaml/cic_unification/cicUnification.ml
+++ b/helm/ocaml/cic_unification/cicUnification.ml
@@ -79,7 +79,11 @@ let delift context metasenv l t =
              ignore (deliftaux k (S.lift m t)) ;
              C.Rel ((position (m-k) l) + k)
 	  | None -> raise RelToHiddenHypothesis)
-     | C.Var _  as t -> t
+     | C.Var (uri,exp_named_subst) ->
+        let exp_named_subst' =
+         List.map (function (uri,t) -> uri,deliftaux k t) exp_named_subst
+        in
+         C.Var (uri,exp_named_subst')
      | C.Meta (i, l1) as t -> 
         let rec deliftl j =
          function
@@ -103,11 +107,23 @@ let delift context metasenv l t =
      | C.Lambda (n,s,t) -> C.Lambda (n, deliftaux k s, deliftaux (k+1) t)
      | C.LetIn (n,s,t) -> C.LetIn (n, deliftaux k s, deliftaux (k+1) t)
      | C.Appl l -> C.Appl (List.map (deliftaux k) l)
-     | C.Const _ as t -> t
-     | C.MutInd _ as t -> t
-     | C.MutConstruct _ as t -> t
-     | C.MutCase (sp,cookingsno,i,outty,t,pl) ->
-        C.MutCase (sp, cookingsno, i, deliftaux k outty, deliftaux k t,
+     | C.Const (uri,exp_named_subst) ->
+        let exp_named_subst' =
+         List.map (function (uri,t) -> uri,deliftaux k t) exp_named_subst
+        in
+         C.Const (uri,exp_named_subst')
+     | C.MutInd (uri,typeno,exp_named_subst) ->
+        let exp_named_subst' =
+         List.map (function (uri,t) -> uri,deliftaux k t) exp_named_subst
+        in
+         C.MutInd (uri,typeno,exp_named_subst')
+     | C.MutConstruct (uri,typeno,consno,exp_named_subst) ->
+        let exp_named_subst' =
+         List.map (function (uri,t) -> uri,deliftaux k t) exp_named_subst
+        in
+         C.MutConstruct (uri,typeno,consno,exp_named_subst')
+     | C.MutCase (sp,i,outty,t,pl) ->
+        C.MutCase (sp, i, deliftaux k outty, deliftaux k t,
          List.map (deliftaux k) pl)
      | C.Fix (i, fl) ->
         let len = List.length fl in
@@ -144,113 +160,154 @@ type substitution = (int * Cic.term) list
    a new substitution which is _NOT_ unwinded. It must be unwinded before
    applying it. *)
  
-let fo_unif_new metasenv context t1 t2 =
-    let module C = Cic in
-    let module R = CicReduction in
-    let module S = CicSubstitution in
-    let rec fo_unif_aux subst context metasenv t1 t2 =  
-    match (t1, t2) with
-         (C.Meta (n,ln), C.Meta (m,lm)) when n=m ->
-           let ok =
-            List.fold_left2
-             (fun b t1 t2 ->
-               b &&
-                match t1,t2 with
-                  None,_
-                | _,None -> true
-                | Some t1', Some t2' ->
-                   (* First possibility:  restriction    *)
-                   (* Second possibility: unification    *)
-                   (* Third possibility:  convertibility *)
-	           R.are_convertible context t1' t2'
-             ) true ln lm
-           in
-            if ok then subst,metasenv else
-             raise UnificationFailed
-       | (C.Meta (n,l), C.Meta (m,_)) when n>m ->
-	   fo_unif_aux subst context metasenv t2 t1
-       | (C.Meta (n,l), t)   
-       | (t, C.Meta (n,l)) ->
-	   let subst',metasenv' =
-	     try
-	       let oldt = (List.assoc n subst) in
-	       let lifted_oldt = S.lift_meta l oldt in
-	       fo_unif_aux subst context metasenv lifted_oldt t
-	     with Not_found ->
-prerr_endline ("DELIFT2(" ^ CicPp.ppterm t ^ ")") ; flush stderr ;
-List.iter (function (Some t) -> prerr_endline ("l: " ^ CicPp.ppterm t) | None -> prerr_endline " _ ") l ; flush stderr ;
-prerr_endline " m=n) metasenv' in
-	    let tyt = CicTypeChecker.type_of_aux' metasenv' context t in
-	     fo_unif_aux subst' context metasenv' (S.lift_meta l meta_type) tyt
-       | (C.Rel _, _)
-       | (_,  C.Rel _) 
-       | (C.Var _, _)
-       | (_, C.Var _) 
-       | (C.Sort _ ,_)
-       | (_, C.Sort _)
-       | (C.Implicit, _)
-       | (_, C.Implicit) -> 
-	   if R.are_convertible context t1 t2 then subst, metasenv
-           else raise UnificationFailed
-       | (C.Cast (te,ty), t2) -> fo_unif_aux subst context metasenv te t2
-       | (t1, C.Cast (te,ty)) -> fo_unif_aux subst context metasenv t1 te
-       | (C.Prod (n1,s1,t1), C.Prod (_,s2,t2)) -> 
-	   let subst',metasenv' = fo_unif_aux subst context metasenv s1 s2 in
-           fo_unif_aux subst' ((Some (n1,(C.Decl s1)))::context) metasenv' t1 t2
-       | (C.Lambda (n1,s1,t1), C.Lambda (_,s2,t2)) -> 
-           let subst',metasenv' = fo_unif_aux subst context metasenv s1 s2 in
-           fo_unif_aux subst' ((Some (n1,(C.Decl s1)))::context) metasenv' t1 t2
-       | (C.LetIn (_,s1,t1), t2)  
-       | (t2, C.LetIn (_,s1,t1)) -> 
-	   fo_unif_aux subst context metasenv t2 (S.subst s1 t1)
-       | (C.Appl l1, C.Appl l2) -> 
-           let lr1 = List.rev l1 in
-           let lr2 = List.rev l2 in
-           let rec fo_unif_l subst metasenv = function
-               [],_
-             | _,[] -> assert false
-             | ([h1],[h2]) ->
-                 fo_unif_aux subst context metasenv h1 h2
-             | ([h],l) 
-             | (l,[h]) ->
-                 fo_unif_aux subst context metasenv h (C.Appl (List.rev l))
-             | ((h1::l1),(h2::l2)) -> 
-		 let subst', metasenv' = 
-		   fo_unif_aux subst context metasenv h1 h2
-                 in 
-                 fo_unif_l subst' metasenv' (l1,l2)
-           in
-	    fo_unif_l subst metasenv (lr1, lr2) 
-       | (C.Const _, _) 
-       | (_, C.Const _)
-       | (C.MutInd  _, _) 
-       | (_, C.MutInd _)
-       | (C.MutConstruct _, _)
-       | (_, C.MutConstruct _) -> 
-	   if R.are_convertible context t1 t2 then subst, metasenv
-           else raise UnificationFailed
-       | (C.MutCase (_,_,_,outt1,t1,pl1), C.MutCase (_,_,_,outt2,t2,pl2))->
-         let subst', metasenv' = 
-	   fo_unif_aux subst context metasenv outt1 outt2 in
-         let subst'',metasenv'' = 
-	   fo_unif_aux subst' context metasenv' t1 t2 in
-         List.fold_left2 
-	   (function (subst,metasenv) ->
-             fo_unif_aux subst context metasenv
-           ) (subst'',metasenv'') pl1 pl2 
-       | (C.Fix _, _)
-       | (_, C.Fix _) 
-       | (C.CoFix _, _)
-       | (_, C.CoFix _) -> 
-	   if R.are_convertible context t1 t2 then subst, metasenv
-           else raise UnificationFailed
-       | (_,_) -> raise UnificationFailed
-   in fo_unif_aux [] context metasenv t1 t2;;
+let rec fo_unif_subst subst context metasenv t1 t2 =  
+ let module C = Cic in
+ let module R = CicReduction in
+ let module S = CicSubstitution in
+  match (t1, t2) with
+     (C.Meta (n,ln), C.Meta (m,lm)) when n=m ->
+       let ok =
+        List.fold_left2
+         (fun b t1 t2 ->
+           b &&
+            match t1,t2 with
+               None,_
+             | _,None -> true
+             | Some t1', Some t2' ->
+                (* First possibility:  restriction    *)
+                (* Second possibility: unification    *)
+                (* Third possibility:  convertibility *)
+	        R.are_convertible context t1' t2'
+         ) true ln lm
+       in
+        if ok then subst,metasenv else raise UnificationFailed
+   | (C.Meta (n,l), C.Meta (m,_)) when n>m ->
+       fo_unif_subst subst context metasenv t2 t1
+   | (C.Meta (n,l), t)   
+   | (t, C.Meta (n,l)) ->
+       let subst',metasenv' =
+	try
+	 let oldt = (List.assoc n subst) in
+	 let lifted_oldt = S.lift_meta l oldt in
+	  fo_unif_subst subst context metasenv lifted_oldt t
+	with Not_found ->
+	 let t',metasenv' = delift context metasenv l t in
+	  (n, t')::subst, metasenv'
+       in
+	let (_,_,meta_type) = 
+	 List.find (function (m,_,_) -> m=n) metasenv' in
+	let tyt = CicTypeChecker.type_of_aux' metasenv' context t in
+	 fo_unif_subst subst' context metasenv' (S.lift_meta l meta_type) tyt
+   | (C.Var (uri1,exp_named_subst1),C.Var (uri2,exp_named_subst2))
+   | (C.Const (uri1,exp_named_subst1),C.Const (uri2,exp_named_subst2)) ->
+      if UriManager.eq uri1 uri2 then
+       fo_unif_subst_exp_named_subst subst context metasenv
+        exp_named_subst1 exp_named_subst2
+      else
+       raise UnificationFailed
+   | C.MutInd (uri1,i1,exp_named_subst1),C.MutInd (uri2,i2,exp_named_subst2) ->
+      if UriManager.eq uri1 uri2 && i1 = i2 then
+       fo_unif_subst_exp_named_subst subst context metasenv
+        exp_named_subst1 exp_named_subst2
+      else
+       raise UnificationFailed
+   | C.MutConstruct (uri1,i1,j1,exp_named_subst1),
+     C.MutConstruct (uri2,i2,j2,exp_named_subst2) ->
+      if UriManager.eq uri1 uri2 && i1 = i2 && j1 = j2 then
+       fo_unif_subst_exp_named_subst subst context metasenv
+        exp_named_subst1 exp_named_subst2
+      else
+       raise UnificationFailed
+   | (C.Rel _, _)
+   | (_,  C.Rel _) 
+   | (C.Var _, _)
+   | (_, C.Var _) 
+   | (C.Sort _ ,_)
+   | (_, C.Sort _)
+   | (C.Implicit, _)
+   | (_, C.Implicit) -> 
+       if R.are_convertible context t1 t2 then
+        subst, metasenv
+       else
+        raise UnificationFailed
+   | (C.Cast (te,ty), t2) -> fo_unif_subst subst context metasenv te t2
+   | (t1, C.Cast (te,ty)) -> fo_unif_subst subst context metasenv t1 te
+   | (C.Prod (n1,s1,t1), C.Prod (_,s2,t2)) -> 
+       let subst',metasenv' = fo_unif_subst subst context metasenv s1 s2 in
+        fo_unif_subst subst' ((Some (n1,(C.Decl s1)))::context) metasenv' t1 t2
+   | (C.Lambda (n1,s1,t1), C.Lambda (_,s2,t2)) -> 
+       let subst',metasenv' = fo_unif_subst subst context metasenv s1 s2 in
+        fo_unif_subst subst' ((Some (n1,(C.Decl s1)))::context) metasenv' t1 t2
+   | (C.LetIn (_,s1,t1), t2)  
+   | (t2, C.LetIn (_,s1,t1)) -> 
+       fo_unif_subst subst context metasenv t2 (S.subst s1 t1)
+   | (C.Appl l1, C.Appl l2) -> 
+       let lr1 = List.rev l1 in
+       let lr2 = List.rev l2 in
+       let rec fo_unif_l subst metasenv =
+        function
+           [],_
+         | _,[] -> assert false
+         | ([h1],[h2]) ->
+             fo_unif_subst subst context metasenv h1 h2
+         | ([h],l) 
+         | (l,[h]) ->
+             fo_unif_subst subst context metasenv h (C.Appl (List.rev l))
+         | ((h1::l1),(h2::l2)) -> 
+            let subst', metasenv' = 
+             fo_unif_subst subst context metasenv h1 h2
+            in 
+             fo_unif_l subst' metasenv' (l1,l2)
+       in
+	fo_unif_l subst metasenv (lr1, lr2) 
+   | (C.Const _, _) 
+   | (_, C.Const _)
+   | (C.MutInd  _, _) 
+   | (_, C.MutInd _)
+   | (C.MutConstruct _, _)
+   | (_, C.MutConstruct _) -> 
+      if R.are_convertible context t1 t2 then
+       subst, metasenv
+      else
+       raise UnificationFailed
+   | (C.MutCase (_,_,outt1,t1,pl1), C.MutCase (_,_,outt2,t2,pl2))->
+       let subst', metasenv' = 
+        fo_unif_subst subst context metasenv outt1 outt2 in
+       let subst'',metasenv'' = 
+	fo_unif_subst subst' context metasenv' t1 t2 in
+       List.fold_left2 
+	(function (subst,metasenv) ->
+          fo_unif_subst subst context metasenv
+        ) (subst'',metasenv'') pl1 pl2 
+   | (C.Fix _, _)
+   | (_, C.Fix _) 
+   | (C.CoFix _, _)
+   | (_, C.CoFix _) -> 
+       if R.are_convertible context t1 t2 then
+        subst, metasenv
+       else
+        raise UnificationFailed
+   | (_,_) ->
+       if R.are_convertible context t1 t2 then
+        subst, metasenv
+       else
+        raise UnificationFailed
+
+and fo_unif_subst_exp_named_subst subst context metasenv
+ exp_named_subst1 exp_named_subst2
+=
+try
+ List.fold_left2
+  (fun (subst,metasenv) (uri1,t1) (uri2,t2) ->
+    assert (uri1=uri2) ;
+    fo_unif_subst subst context metasenv t1 t2
+  ) (subst,metasenv) exp_named_subst1 exp_named_subst2
+with
+e ->
+let uri = UriManager.uri_of_string "cic:/dummy.var" in
+prerr_endline ("@@@: " ^ CicPp.ppterm (Cic.Var (uri,exp_named_subst1)) ^
+" <==> " ^ CicPp.ppterm (Cic.Var (uri,exp_named_subst2))) ; raise e
+;;
 
 (*CSC: ???????????????
 (* m is the index of a metavariable to restrict, k is nesting depth
@@ -385,9 +442,6 @@ let unwind metasenv subst unwinded t =
                let (_,canonical_context,_) = 
                 List.find (function (m,_,_) -> m=i) metasenv
                in
-prerr_endline ("DELIFT(" ^ CicPp.ppterm t' ^ ")") ; flush stderr ;
-List.iter (function (Some t) -> prerr_endline ("l: " ^ CicPp.ppterm t) | None -> prerr_endline " _ ") l ; flush stderr ;
-prerr_endline " C.Appl (he'::tl'),metasenv''
         end
     | C.Appl _ -> assert false
-    | C.Const _
-    | C.MutInd _
-    | C.MutConstruct _ as t -> t,metasenv
-    | C.MutCase (sp,cookingsno,i,outty,t,pl) ->
+    | C.Const (uri,exp_named_subst) ->
+       let exp_named_subst', metasenv' =
+        List.fold_right
+	 (fun (uri,t) (tl,metasenv) ->
+	   let t',metasenv' = um_aux metasenv t in
+	    (uri,t')::tl, metasenv'
+	 ) exp_named_subst ([],metasenv)
+       in
+        C.Const (uri,exp_named_subst'),metasenv'
+    | C.MutInd (uri,typeno,exp_named_subst) ->
+       let exp_named_subst', metasenv' =
+        List.fold_right
+	 (fun (uri,t) (tl,metasenv) ->
+	   let t',metasenv' = um_aux metasenv t in
+	    (uri,t')::tl, metasenv'
+	 ) exp_named_subst ([],metasenv)
+       in
+        C.MutInd (uri,typeno,exp_named_subst'),metasenv'
+    | C.MutConstruct (uri,typeno,consno,exp_named_subst) ->
+       let exp_named_subst', metasenv' =
+        List.fold_right
+	 (fun (uri,t) (tl,metasenv) ->
+	   let t',metasenv' = um_aux metasenv t in
+	    (uri,t')::tl, metasenv'
+	 ) exp_named_subst ([],metasenv)
+       in
+        C.MutConstruct (uri,typeno,consno,exp_named_subst'),metasenv'
+    | C.MutCase (sp,i,outty,t,pl) ->
        let outty',metasenv' = um_aux metasenv outty in
        let t',metasenv'' = um_aux metasenv' t in
        let pl',metasenv''' =
@@ -455,7 +533,7 @@ prerr_endline "
        let len = List.length fl in
        let liftedfl,metasenv' =
@@ -536,11 +614,23 @@ let apply_subst_reducing subst meta_to_reduce t =
            | _,_ -> t'
          end
     | C.Appl _ -> assert false
-    | C.Const _ as t -> t
-    | C.MutInd _ as t -> t
-    | C.MutConstruct _ as t -> t
-    | C.MutCase (sp,cookingsno,i,outty,t,pl) ->
-       C.MutCase (sp, cookingsno, i, um_aux outty, um_aux t,
+    | C.Const (uri,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map (function (uri,t) -> (uri,um_aux t)) exp_named_subst
+       in
+        C.Const (uri,exp_named_subst')
+    | C.MutInd (uri,typeno,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map (function (uri,t) -> (uri,um_aux t)) exp_named_subst
+       in
+        C.MutInd (uri,typeno,exp_named_subst')
+    | C.MutConstruct (uri,typeno,consno,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map (function (uri,t) -> (uri,um_aux t)) exp_named_subst
+       in
+        C.MutConstruct (uri,typeno,consno,exp_named_subst')
+    | C.MutCase (sp,i,outty,t,pl) ->
+       C.MutCase (sp, i, um_aux outty, um_aux t,
         List.map um_aux pl)
     | C.Fix (i, fl) ->
        let len = List.length fl in
@@ -604,7 +694,7 @@ let apply_subst subst t =
 (* metavariables may have been restricted.                                   *)
 let fo_unif metasenv context t1 t2 =
 prerr_endline "INIZIO FASE 1" ; flush stderr ;
- let subst_to_unwind,metasenv' = fo_unif_new metasenv context t1 t2 in
+ let subst_to_unwind,metasenv' = fo_unif_subst [] context metasenv t1 t2 in
 prerr_endline "FINE FASE 1" ; flush stderr ;
 let res =
   unwind_subst metasenv' subst_to_unwind
diff --git a/helm/ocaml/cic_unification/cicUnification.mli b/helm/ocaml/cic_unification/cicUnification.mli
index 464927a2d..30094f7f2 100644
--- a/helm/ocaml/cic_unification/cicUnification.mli
+++ b/helm/ocaml/cic_unification/cicUnification.mli
@@ -38,12 +38,37 @@ type substitution = (int * Cic.term) list
 (* unifies [t1] and [t2] in a context [context]. *)
 (* Only the metavariables declared in [metasenv] *)
 (* can be used in [t1] and [t2].                 *)
+(* The returned substitution can be directly     *)
+(* withouth first unwinding it.                  *)
 val fo_unif :
   Cic.metasenv -> Cic.context -> Cic.term -> Cic.term ->
    substitution * Cic.metasenv
 
-(* apply_subst subst t                    *)
-(* applies the substitution [sust] to [t] *)
+(* fo_unif_subst metasenv subst context t1 t2    *)
+(* unifies [t1] and [t2] in a context [context]  *)
+(* and with [subst] as the current substitution  *)
+(* (i.e. unifies ([subst] [t1]) and              *)
+(* ([subst] [t2]) in a context                   *)
+(* ([subst] [context]) using the metasenv        *)
+(* ([subst] [metasenv])                          *)
+(* Only the metavariables declared in [metasenv] *)
+(* can be used in [t1] and [t2].                 *)
+(* [subst] and the substitution returned are not *)
+(* unwinded.                                     *)
+(*CSC: fare un tipo unione Unwinded o ToUnwind e fare gestire la
+ cosa all'apply_subst!!!*)
+val fo_unif_subst :
+  substitution -> Cic.context -> Cic.metasenv -> Cic.term -> Cic.term ->
+   substitution * Cic.metasenv
+
+(* unwind_subst metasenv subst                         *)
+(* unwinds [subst] w.r.t. itself.                      *)
+(* It can restrict some metavariable in the [metasenv] *)
+val unwind_subst : Cic.metasenv -> substitution -> substitution * Cic.metasenv
+
+(* apply_subst subst t                     *)
+(* applies the substitution [subst] to [t] *)
+(* [subst] must be already unwinded        *)
 val apply_subst : substitution -> Cic.term -> Cic.term
 
 (* apply_subst_reducing subst (Some (mtr,reductions_no)) t              *)
@@ -55,5 +80,6 @@ val apply_subst : substitution -> Cic.term -> Cic.term
 (*  eta-expansions have been performed and the head of the new          *)
 (*  application has been unified with (META [meta_to_reduce]):          *)
 (*  during the unwinding the eta-expansions are undone.                 *)
+(* [subst] must be already unwinded                                     *)
 val apply_subst_reducing :
  substitution -> (int * int) option -> Cic.term -> Cic.term
diff --git a/helm/ocaml/getter/.depend b/helm/ocaml/getter/.depend
index 2013e9b3e..c51f1a8e4 100644
--- a/helm/ocaml/getter/.depend
+++ b/helm/ocaml/getter/.depend
@@ -1,6 +1,6 @@
 configuration.cmo: configuration.cmi 
 configuration.cmx: configuration.cmi 
-clientHTTP.cmo: configuration.cmi clientHTTP.cmi 
-clientHTTP.cmx: configuration.cmx clientHTTP.cmi 
+clientHTTP.cmo: clientHTTP.cmi 
+clientHTTP.cmx: clientHTTP.cmi 
 getter.cmo: clientHTTP.cmi configuration.cmi getter.cmi 
 getter.cmx: clientHTTP.cmx configuration.cmx getter.cmi 
diff --git a/helm/ocaml/getter/clientHTTP.ml b/helm/ocaml/getter/clientHTTP.ml
index 7d57c0b57..2444bded3 100644
--- a/helm/ocaml/getter/clientHTTP.ml
+++ b/helm/ocaml/getter/clientHTTP.ml
@@ -54,9 +54,11 @@ let get_and_save_to_tmp uri =
    done ;
    cs
  in
-  let user = try Sys.getenv "USER" ^ "_" with Not_found -> "" in 
-     (* FG: Unix.getlogin () should be used instead of the above *)
-  let tmp_file = Configuration.tmp_dir ^ "/" ^ user ^ (flat_string uri ".-=:;!?/&" '_') in
+  let user = try Unix.getlogin () with _ -> "" in
+  let tmp_file =
+    Filename.temp_file (user ^ flat_string uri ".-=:;!?/&" '_') ""
+  in
   get_and_save uri tmp_file ;
   tmp_file
 ;;
+
diff --git a/helm/ocaml/getter/configuration.ml b/helm/ocaml/getter/configuration.ml
index 2c7ead3dc..1eb4ab65e 100644
--- a/helm/ocaml/getter/configuration.ml
+++ b/helm/ocaml/getter/configuration.ml
@@ -34,14 +34,22 @@ class warner =
 ;;
 
 let xml_document () =
+ let error e =
+  prerr_endline ("Warning: configuration file not found, or incorrect: " ^
+   Pxp_types.string_of_exn e) ;
+  None
+ in
  let module Y = Pxp_yacc in
   try 
    let config = {Y.default_config with Y.warner = new warner} in
-    Y.parse_document_entity config (Y.from_file filename) Y.default_spec
+    Some (Y.parse_document_entity config (Y.from_file filename) Y.default_spec)
   with
-   e ->
-     print_endline (Pxp_types.string_of_exn e) ;
-     raise e
+   | (Pxp_types.Error _) as e -> error e
+   | (Pxp_types.At _) as e -> error e
+   | (Pxp_types.Validation_error _) as e -> error e
+   | (Pxp_types.WF_error _) as e -> error e
+   | (Pxp_types.Namespace_error _) as e -> error e
+   | (Pxp_types.Character_not_supported) as e -> error e
 ;;
 
 exception Impossible;;
@@ -65,15 +73,18 @@ let rec resolve =
 
 (* we trust the xml file to be valid because of the validating xml parser *)
 let _ =
- List.iter
-  (function
-      n ->
-       match n#node_type with
-          Pxp_document.T_element var ->
-           Hashtbl.add vars var (resolve (n#sub_nodes))
-        | _ -> raise Impossible
-  )
-  ((xml_document ())#root#sub_nodes)
+ match xml_document () with
+    None -> ()
+  | Some d ->
+     List.iter
+      (function
+          n ->
+           match n#node_type with
+              Pxp_document.T_element var ->
+               Hashtbl.add vars var (resolve (n#sub_nodes))
+            | _ -> raise Impossible
+      )
+      (d#root#sub_nodes)
 ;;
 
 (* try to read a configuration variable, given its name into the
@@ -101,15 +112,8 @@ let read_configuration_var xml_name =
    flush stdout ;
    raise Not_found
 
-let helm_dir      = read_configuration_var     "helm_dir";;
-let dtd_dir       = read_configuration_var     "dtd_dir";;
-let style_dir     = read_configuration_var_env "style_dir" "HELM_STYLE_DIR";;
-let servers_file  = read_configuration_var     "servers_file";;
-let uris_dbm      = read_configuration_var     "uris_dbm";;
-let dest          = read_configuration_var     "dest";;
-let indexname     = read_configuration_var     "indexname";;
-let tmp_dir       = read_configuration_var     "tmp_dir"
-let helm_dir      = read_configuration_var     "helm_dir";;
+(* Zack: no longer used *)
+(* let tmp_dir       = read_configuration_var_env "tmp_dir" "HELM_TMP_DIR";; *)
 let getter_url    = read_configuration_var_env "getter_url" "HELM_GETTER_URL";;
 let processor_url = read_configuration_var_env "processor_url" "HELM_PROCESSOR_URL";;
 let annotations_dir = read_configuration_var_env "annotations_dir" "HELM_ANNOTATIONS_DIR"
diff --git a/helm/ocaml/getter/configuration.mli b/helm/ocaml/getter/configuration.mli
index 4d0bfbc01..20daaa411 100644
--- a/helm/ocaml/getter/configuration.mli
+++ b/helm/ocaml/getter/configuration.mli
@@ -33,15 +33,8 @@
 (*                                                                            *)
 (******************************************************************************)
 
-val helm_dir : string
-val dtd_dir : string
-val style_dir : string
-val servers_file : string
-val uris_dbm : string
-val dest : string
-val indexname : string
-val tmp_dir : string
-val helm_dir : string
+(* Zack: no longer needed *)
+(* val tmp_dir : string *)
 val getter_url : string
 val processor_url : string
 val annotations_dir : string
diff --git a/helm/ocaml/getter/getter.ml b/helm/ocaml/getter/getter.ml
index 894bf3ea9..c1ba01016 100644
--- a/helm/ocaml/getter/getter.ml
+++ b/helm/ocaml/getter/getter.ml
@@ -61,3 +61,35 @@ let register uri url =
     "?uri=" ^ (UriManager.string_of_uri uri) ^
     "&url=" ^ url)
 ;;
+
+exception Unresolved;;
+exception UnexpectedGetterOutput;;
+
+(* resolve_result is needed because it is not possible to raise *)
+(* an exception in a pxp even-processing callback. Too bad.     *)
+type resolve_result =
+   Unknown
+ | Exception of exn
+ | Resolved of string
+
+let resolve uri =
+ (* deliver resolve request to http_getter *)
+ let doc =
+  ClientHTTP.get
+   (!getter_url ^ "resolve" ^ "?uri=" ^ (UriManager.string_of_uri uri))
+ in
+  let res = ref Unknown in
+   Pxp_yacc.process_entity Pxp_yacc.default_config (`Entry_content [])
+    (Pxp_yacc.create_entity_manager ~is_document:true Pxp_yacc.default_config
+     (Pxp_yacc.from_string doc))
+    (function
+        Pxp_yacc.E_start_tag ("url",["value",url],_) -> res := Resolved url
+      | Pxp_yacc.E_start_tag ("unresolved",[],_) -> res := Exception Unresolved
+      | Pxp_yacc.E_start_tag _ -> res := Exception UnexpectedGetterOutput
+      | _ -> ()
+    ) ;
+   match !res with
+      Unknown -> raise UnexpectedGetterOutput
+    | Exception e -> raise e
+    | Resolved url -> url
+;;
diff --git a/helm/ocaml/getter/getter.mli b/helm/ocaml/getter/getter.mli
index 6b1d2ca29..3fbec8070 100644
--- a/helm/ocaml/getter/getter.mli
+++ b/helm/ocaml/getter/getter.mli
@@ -51,3 +51,12 @@ val getxml : ?format:format -> ?patchdtd:bool -> UriManager.uri -> string
 
 (* adds an (URI -> URL) entry in the map from URIs to URLs *)
 val register : UriManager.uri -> string -> unit
+
+exception Unresolved
+exception UnexpectedGetterOutput
+
+(* resolves an URI to its corresponding URL.                  *)
+(* Unresolved is raised if there is no URL for the given URI. *)
+(* UnexceptedGetterOutput is raised if the output of the real *)
+(*  getter has not the expected format.                       *)
+val resolve: UriManager.uri -> string 
diff --git a/helm/ocaml/tactics/.cvsignore b/helm/ocaml/tactics/.cvsignore
new file mode 100644
index 000000000..8d98e3ef1
--- /dev/null
+++ b/helm/ocaml/tactics/.cvsignore
@@ -0,0 +1,9 @@
+*.cmi
+*.cma
+*.cmo
+*.cmx
+*.cmxa
+*.o
+*.a
+.dep.dot
+tactics.ps
diff --git a/helm/ocaml/tactics/.depend b/helm/ocaml/tactics/.depend
new file mode 100644
index 000000000..fd3a652e8
--- /dev/null
+++ b/helm/ocaml/tactics/.depend
@@ -0,0 +1,80 @@
+proofEngineHelpers.cmi: proofEngineTypes.cmo 
+tacticals.cmi: proofEngineTypes.cmo 
+reductionTactics.cmi: proofEngineTypes.cmo 
+proofEngineStructuralRules.cmi: proofEngineTypes.cmo 
+primitiveTactics.cmi: proofEngineTypes.cmo 
+variousTactics.cmi: proofEngineTypes.cmo 
+introductionTactics.cmi: proofEngineTypes.cmo 
+eliminationTactics.cmi: proofEngineTypes.cmo 
+negationTactics.cmi: proofEngineTypes.cmo 
+equalityTactics.cmi: proofEngineTypes.cmo 
+discriminationTactics.cmi: proofEngineTypes.cmo 
+ring.cmi: proofEngineTypes.cmo 
+fourierR.cmi: proofEngineTypes.cmo 
+tacticChaser.cmi: proofEngineTypes.cmo 
+proofEngineReduction.cmo: proofEngineReduction.cmi 
+proofEngineReduction.cmx: proofEngineReduction.cmi 
+proofEngineHelpers.cmo: proofEngineHelpers.cmi 
+proofEngineHelpers.cmx: proofEngineHelpers.cmi 
+fourier.cmo: fourier.cmi 
+fourier.cmx: fourier.cmi 
+tacticals.cmo: proofEngineTypes.cmo tacticals.cmi 
+tacticals.cmx: proofEngineTypes.cmx tacticals.cmi 
+reductionTactics.cmo: proofEngineReduction.cmi reductionTactics.cmi 
+reductionTactics.cmx: proofEngineReduction.cmx reductionTactics.cmi 
+proofEngineStructuralRules.cmo: proofEngineTypes.cmo \
+    proofEngineStructuralRules.cmi 
+proofEngineStructuralRules.cmx: proofEngineTypes.cmx \
+    proofEngineStructuralRules.cmi 
+primitiveTactics.cmo: proofEngineHelpers.cmi proofEngineReduction.cmi \
+    proofEngineTypes.cmo reductionTactics.cmi tacticals.cmi \
+    primitiveTactics.cmi 
+primitiveTactics.cmx: proofEngineHelpers.cmx proofEngineReduction.cmx \
+    proofEngineTypes.cmx reductionTactics.cmx tacticals.cmx \
+    primitiveTactics.cmi 
+variousTactics.cmo: primitiveTactics.cmi proofEngineHelpers.cmi \
+    proofEngineReduction.cmi proofEngineTypes.cmo tacticals.cmi \
+    variousTactics.cmi 
+variousTactics.cmx: primitiveTactics.cmx proofEngineHelpers.cmx \
+    proofEngineReduction.cmx proofEngineTypes.cmx tacticals.cmx \
+    variousTactics.cmi 
+introductionTactics.cmo: primitiveTactics.cmi proofEngineTypes.cmo \
+    introductionTactics.cmi 
+introductionTactics.cmx: primitiveTactics.cmx proofEngineTypes.cmx \
+    introductionTactics.cmi 
+eliminationTactics.cmo: primitiveTactics.cmi proofEngineStructuralRules.cmi \
+    tacticals.cmi eliminationTactics.cmi 
+eliminationTactics.cmx: primitiveTactics.cmx proofEngineStructuralRules.cmx \
+    tacticals.cmx eliminationTactics.cmi 
+negationTactics.cmo: eliminationTactics.cmi primitiveTactics.cmi \
+    proofEngineTypes.cmo tacticals.cmi variousTactics.cmi negationTactics.cmi 
+negationTactics.cmx: eliminationTactics.cmx primitiveTactics.cmx \
+    proofEngineTypes.cmx tacticals.cmx variousTactics.cmx negationTactics.cmi 
+equalityTactics.cmo: introductionTactics.cmi primitiveTactics.cmi \
+    proofEngineHelpers.cmi proofEngineReduction.cmi \
+    proofEngineStructuralRules.cmi proofEngineTypes.cmo reductionTactics.cmi \
+    tacticals.cmi equalityTactics.cmi 
+equalityTactics.cmx: introductionTactics.cmx primitiveTactics.cmx \
+    proofEngineHelpers.cmx proofEngineReduction.cmx \
+    proofEngineStructuralRules.cmx proofEngineTypes.cmx reductionTactics.cmx \
+    tacticals.cmx equalityTactics.cmi 
+discriminationTactics.cmo: eliminationTactics.cmi equalityTactics.cmi \
+    introductionTactics.cmi primitiveTactics.cmi proofEngineTypes.cmo \
+    tacticals.cmi discriminationTactics.cmi 
+discriminationTactics.cmx: eliminationTactics.cmx equalityTactics.cmx \
+    introductionTactics.cmx primitiveTactics.cmx proofEngineTypes.cmx \
+    tacticals.cmx discriminationTactics.cmi 
+ring.cmo: eliminationTactics.cmi equalityTactics.cmi primitiveTactics.cmi \
+    proofEngineStructuralRules.cmi proofEngineTypes.cmo tacticals.cmi \
+    ring.cmi 
+ring.cmx: eliminationTactics.cmx equalityTactics.cmx primitiveTactics.cmx \
+    proofEngineStructuralRules.cmx proofEngineTypes.cmx tacticals.cmx \
+    ring.cmi 
+fourierR.cmo: equalityTactics.cmi fourier.cmi primitiveTactics.cmi \
+    proofEngineHelpers.cmi proofEngineTypes.cmo reductionTactics.cmi ring.cmi \
+    tacticals.cmi fourierR.cmi 
+fourierR.cmx: equalityTactics.cmx fourier.cmx primitiveTactics.cmx \
+    proofEngineHelpers.cmx proofEngineTypes.cmx reductionTactics.cmx ring.cmx \
+    tacticals.cmx fourierR.cmi 
+tacticChaser.cmo: primitiveTactics.cmi proofEngineTypes.cmo tacticChaser.cmi 
+tacticChaser.cmx: primitiveTactics.cmx proofEngineTypes.cmx tacticChaser.cmi 
diff --git a/helm/ocaml/tactics/Makefile b/helm/ocaml/tactics/Makefile
new file mode 100644
index 000000000..0018ce230
--- /dev/null
+++ b/helm/ocaml/tactics/Makefile
@@ -0,0 +1,21 @@
+PACKAGE = tactics
+REQUIRES = \
+	helm-cic_textual_parser helm-cic_proof_checking helm-cic_unification \
+	helm-mathql_interpreter helm-mathql_generator
+
+INTERFACE_FILES =	\
+	proofEngineReduction.mli proofEngineHelpers.mli	\
+	tacticals.mli reductionTactics.mli proofEngineStructuralRules.mli	\
+	primitiveTactics.mli variousTactics.mli introductionTactics.mli	\
+	eliminationTactics.mli negationTactics.mli equalityTactics.mli	\
+	discriminationTactics.mli ring.mli fourierR.mli tacticChaser.mli
+IMPLEMENTATION_FILES =	\
+	proofEngineTypes.ml proofEngineReduction.ml proofEngineHelpers.ml	\
+	fourier.ml tacticals.ml reductionTactics.ml proofEngineStructuralRules.ml	\
+	primitiveTactics.ml variousTactics.ml introductionTactics.ml	\
+	eliminationTactics.ml negationTactics.ml equalityTactics.ml	\
+	discriminationTactics.ml ring.ml fourierR.ml tacticChaser.ml
+
+
+include ../Makefile.common
+
diff --git a/helm/ocaml/tactics/discriminationTactics.ml b/helm/ocaml/tactics/discriminationTactics.ml
new file mode 100644
index 000000000..4a349e54c
--- /dev/null
+++ b/helm/ocaml/tactics/discriminationTactics.ml
@@ -0,0 +1,583 @@
+(* Copyright (C) 2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+
+let rec injection_tac ~term ~status:((proof, goal) as status) = 
+  let module C = Cic in
+  let module U = UriManager in
+  let module P = PrimitiveTactics in
+  let module T = Tacticals in
+   let _,metasenv,_,_ = proof in
+    let _,context,_ = List.find (function (m,_,_) -> m=goal) metasenv in
+     let termty = (CicTypeChecker.type_of_aux' metasenv context term) in  
+      (match termty with
+          (C.Appl [(C.MutInd (equri, 0, [])) ; tty ; t1 ; t2])
+             when (U.eq equri (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind"))
+             or (U.eq equri (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind")) -> (
+           match tty with
+              (C.MutInd (turi,typeno,exp_named_subst))
+            | (C.Appl (C.MutInd (turi,typeno,exp_named_subst)::_)) -> (
+                   match t1,t2 with
+                      ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1)),
+                       (C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2)))
+                         when (uri1 = uri2) && (typeno1 = typeno2) && (consno1 = consno2) && (exp_named_subst1 = exp_named_subst2) ->
+                       (* raise (ProofEngineTypes.Fail "Injection: nothing to do") ; *) T.id_tac
+                    | ((C.Appl ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1))::applist1)),
+                       (C.Appl ((C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2))::applist2)))
+                         when (uri1 = uri2) && (typeno1 = typeno2) && (consno1 = consno2) && (exp_named_subst1 = exp_named_subst2) ->
+                       let rec traverse_list i l1 l2 =
+                         match l1,l2 with
+                            [],[] -> T.id_tac
+                          | hd1::tl1,hd2::tl2 -> 
+                             T.then_ 
+                              ~start:(injection1_tac ~i ~term)
+                              ~continuation:(traverse_list (i+1) tl1 tl2)
+                          | _ -> raise (ProofEngineTypes.Fail "Discriminate: i 2 termini hanno in testa lo stesso costruttore, ma applicato a un numero diverso di termini. possibile???") ; T.id_tac
+                       in traverse_list 1 applist1 applist2
+                    | ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1)),
+                       (C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2)))
+                    | ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1)),
+                       (C.Appl ((C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2))::_)))
+                    | ((C.Appl ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1))::_)),
+                       (C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2)))
+                    | ((C.Appl ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1))::_)),
+                       (C.Appl ((C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2))::_)))
+                         when (consno1 <> consno2) || (exp_named_subst1 <> exp_named_subst2) ->
+                       (* raise (ProofEngineTypes.Fail "Injection: not a projectable equality but a discriminable one") ; *) T.id_tac
+                    | _ -> (* raise (ProofEngineTypes.Fail "Injection: not a projectable equality") ; *) T.id_tac
+                   )
+            | _ -> raise (ProofEngineTypes.Fail "Injection: not a projectable equality")
+           )
+        | _ -> raise (ProofEngineTypes.Fail "Injection: not an equation")
+      ) ~status
+
+
+and injection1_tac ~term ~i ~status:((proof, goal) as status) = 
+(* precondizione: t1 e t2 hanno in testa lo stesso costruttore ma differiscono (o potrebbero differire?) nell'i-esimo parametro del costruttore *)
+  let module C = Cic in
+  let module S = CicSubstitution in
+  let module U = UriManager in
+  let module P = PrimitiveTactics in
+  let module T = Tacticals in
+   let _,metasenv,_,_ = proof in
+    let _,context,_ = List.find (function (m,_,_) -> m=goal) metasenv in
+     let termty = (CicTypeChecker.type_of_aux' metasenv context term) in
+      match termty with (* an equality *)
+         (C.Appl [(C.MutInd (equri, 0, [])) ; tty ; t1 ; t2])
+            when (U.eq equri (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind"))
+            or (U.eq equri (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind")) -> (
+          match tty with (* some inductive type *)
+             (C.MutInd (turi,typeno,exp_named_subst))
+           | (C.Appl (C.MutInd (turi,typeno,exp_named_subst)::_)) ->
+prerr_endline ("XXXX term " ^ CicPp.ppterm term) ;
+prerr_endline ("XXXX termty " ^ CicPp.ppterm termty) ;
+prerr_endline ("XXXX t1 " ^ CicPp.ppterm t1) ;
+prerr_endline ("XXXX t2 " ^ CicPp.ppterm t2) ;
+prerr_endline ("XXXX tty " ^ CicPp.ppterm tty) ;
+              let t1',t2',consno = (* sono i due sottotermini che differiscono *)
+               match t1,t2 with
+                  ((C.Appl ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1))::applist1)),
+                   (C.Appl ((C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2))::applist2)))
+                     when (uri1 = uri2) && (typeno1 = typeno2) && (consno1 = consno2) && (exp_named_subst1 = exp_named_subst2) -> (* controllo ridondante *)
+                   (List.nth applist1 (i-1)),(List.nth applist2 (i-1)),consno2
+                | _ -> raise (ProofEngineTypes.Fail "Injection: qui non dovrei capitarci mai")
+              in
+               let tty' = (CicTypeChecker.type_of_aux' metasenv context t1') in
+prerr_endline ("XXXX tty' " ^ CicPp.ppterm tty') ;
+prerr_endline ("XXXX t1' " ^ CicPp.ppterm t1') ;
+prerr_endline ("XXXX t2' " ^ CicPp.ppterm t2') ;
+prerr_endline ("XXXX consno " ^ string_of_int consno) ;
+               let pattern =
+                     match (CicEnvironment.get_obj turi) with
+                        C.InductiveDefinition (ind_type_list,_,nr_ind_params_dx)  ->
+                         let _,_,_,constructor_list = (List.nth ind_type_list typeno) in
+                          let i_constr_id,_ = List.nth constructor_list (consno - 1) in
+                           List.map
+                            (function (id,cty) ->
+                              let reduced_cty = CicReduction.whd context cty in
+                               let rec aux t k =
+                                match t with
+                                   C.Prod (_,_,target) when (k <= nr_ind_params_dx) ->
+                                    aux target (k+1)
+                                 | C.Prod (binder,source,target) when (k > nr_ind_params_dx) ->
+				    let binder' =
+                                     match binder with
+                                        C.Name b -> C.Name b
+                                      | C.Anonymous -> C.Name "y"
+                                    in
+                                     C.Lambda (binder',source,(aux target (k+1)))
+                                 | _ ->
+                                    let nr_param_constr = k - 1 - nr_ind_params_dx in
+                                     if (id = i_constr_id)
+                                      then C.Rel (nr_param_constr - i + 1)
+                                      else S.lift (nr_param_constr + 1) t1' (* + 1 per liftare anche il lambda agguinto esternamente al case *)
+                               in aux reduced_cty 1
+                            )
+                            constructor_list
+                      | _ -> raise (ProofEngineTypes.Fail "Discriminate: object is not an Inductive Definition: it's imposible")
+               in
+prerr_endline ("XXXX cominciamo!") ;
+                T.thens 
+                 ~start:(P.cut_tac (C.Appl [(C.MutInd (equri,0,[])) ; tty' ; t1' ; t2']))
+                 ~continuations:[
+                   T.then_ 
+                    ~start:(injection_tac ~term:(C.Rel 1))
+                    ~continuation:T.id_tac (* !!! qui devo anche fare clear di term tranne al primo passaggio *) 
+                   ;
+                   T.then_ 
+                    ~start:
+                      (fun ~status:((proof,goal) as status) ->    
+                        let _,metasenv,_,_ = proof in
+                         let _,context,gty = List.find (function (m,_,_) -> m=goal) metasenv in
+prerr_endline ("XXXX goal " ^ string_of_int goal) ;
+prerr_endline ("XXXX gty " ^ CicPp.ppterm gty) ;
+prerr_endline ("XXXX old t1' " ^ CicPp.ppterm t1') ;
+prerr_endline ("XXXX change " ^ CicPp.ppterm (C.Appl [ C.Lambda (C.Name "x", tty, C.MutCase (turi, typeno, (C.Lambda ((C.Name "x"),(S.lift 1 tty),(S.lift 2 tty'))), (C.Rel 1), pattern)); t1])) ;
+                          let new_t1' = 
+                           match gty with 
+                              (C.Appl (C.MutInd (_,_,_)::arglist)) -> 
+                               List.nth arglist 1
+                            | _ -> raise (ProofEngineTypes.Fail "Injection: goal after cut is not correct")
+                          in
+prerr_endline ("XXXX new t1' " ^ CicPp.ppterm new_t1') ;
+                           P.change_tac
+                              ~what:new_t1'
+                              ~with_what:
+                                (C.Appl [
+                                  C.Lambda (
+                                   C.Name "x", tty,
+                                   C.MutCase (
+                                    turi, typeno,
+                                    (C.Lambda (
+                                     (C.Name "x"),
+                                     (S.lift 1 tty),
+                                     (S.lift 2 tty'))),
+                                    (C.Rel 1), pattern
+                                   )
+                                  );
+                                  t1]
+                                )
+                       ~status
+                      )
+                    ~continuation:
+                      (T.then_
+                        ~start:(EqualityTactics.rewrite_simpl_tac ~term)
+                        ~continuation:EqualityTactics.reflexivity_tac
+                      )
+                  ]     
+                 ~status
+           | _ -> raise (ProofEngineTypes.Fail "Discriminate: not a discriminable equality")
+          )
+       | _ -> raise (ProofEngineTypes.Fail "Discriminate: not an equality")
+;;
+
+
+
+exception TwoDifferentSubtermsFound of int 
+
+(* term ha tipo t1=t2; funziona solo se t1 e t2 hanno in testa costruttori
+diversi *)
+
+let discriminate'_tac ~term ~status:((proof, goal) as status) = 
+  let module C = Cic in
+  let module U = UriManager in
+  let module P = PrimitiveTactics in
+  let module T = Tacticals in
+   let _,metasenv,_,_ = proof in
+    let _,context,_ = List.find (function (m,_,_) -> m=goal) metasenv in
+     let termty = (CicTypeChecker.type_of_aux' metasenv context term) in
+      match termty with
+         (C.Appl [(C.MutInd (equri, 0, [])) ; tty ; t1 ; t2]) 
+          when (U.eq equri (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind")) 
+            or (U.eq equri (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind")) -> (
+           match tty with
+              (C.MutInd (turi,typeno,exp_named_subst))
+            | (C.Appl (C.MutInd (turi,typeno,exp_named_subst)::_)) ->
+
+                let consno2 = (* bruuutto: uso un eccezione per terminare con successo! buuu!! :-/ *)
+                 try
+                  let rec traverse t1 t2 =
+prerr_endline ("XXXX t1 " ^ CicPp.ppterm t1) ;
+prerr_endline ("XXXX t2 " ^ CicPp.ppterm t2) ;
+                   match t1,t2 with
+                      ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1)),
+                       (C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2)))
+                         when (uri1 = uri2) && (typeno1 = typeno2) && (consno1 = consno2) && (exp_named_subst1 = exp_named_subst2) ->
+                       0
+                    | ((C.Appl ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1))::applist1)),
+                       (C.Appl ((C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2))::applist2))) 
+                         when (uri1 = uri2) && (typeno1 = typeno2) && (consno1 = consno2) && (exp_named_subst1 = exp_named_subst2) ->
+                       let rec traverse_list l1 l2 =
+                         match l1,l2 with
+                            [],[] -> 0
+                          | hd1::tl1,hd2::tl2 -> traverse hd1 hd2; traverse_list tl1 tl2
+                          | _ -> raise (ProofEngineTypes.Fail "Discriminate: i 2 termini hanno in testa lo stesso costruttore, ma applicato a un numero diverso di termini. possibile???")
+                       in traverse_list applist1 applist2
+
+                    | ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1)),
+                       (C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2)))
+                    | ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1)),
+                       (C.Appl ((C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2))::_)))
+                    | ((C.Appl ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1))::_)),
+                       (C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2)))
+                    | ((C.Appl ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1))::_)),
+                       (C.Appl ((C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2))::_)))
+                         when (consno1 <> consno2) || (exp_named_subst1 <> exp_named_subst2) ->
+                       raise (TwoDifferentSubtermsFound consno2)
+                    | _ -> raise (ProofEngineTypes.Fail "Discriminate: not a discriminable equality")
+                  in traverse t1 t2
+                 with (TwoDifferentSubtermsFound consno2) -> consno2
+                in
+prerr_endline ("XXXX consno2 " ^ (string_of_int consno2)) ;
+                 if consno2 = 0 
+                  then raise (ProofEngineTypes.Fail "Discriminate: Discriminating terms are structurally equal")
+                  else
+
+                   let pattern = 
+                     (* a list of "True" except for the element in position consno2 which is "False" *)
+                     match (CicEnvironment.get_obj turi) with
+                        C.InductiveDefinition (ind_type_list,_,nr_ind_params)  ->
+prerr_endline ("XXXX nth " ^ (string_of_int (List.length ind_type_list)) ^ " " ^ (string_of_int typeno)) ;
+                         let _,_,_,constructor_list = (List.nth ind_type_list typeno) in 
+prerr_endline ("XXXX nth " ^ (string_of_int (List.length constructor_list)) ^ " " ^ (string_of_int consno2)) ;
+                          let false_constr_id,_ = List.nth constructor_list (consno2 - 1) in
+prerr_endline ("XXXX nth funzionano ") ;
+                           List.map 
+                            (function (id,cty) ->
+                              let red_ty = CicReduction.whd context cty in (* dubbio: e' corretto ridurre in questo context ??? *)
+                               let rec aux t k =
+                                match t with
+                                   C.Prod (_,_,target) when (k <= nr_ind_params) ->
+                                    aux target (k+1)
+                                 | C.Prod (binder,source,target) when (k > nr_ind_params) -> 
+                                    C.Lambda (binder,source,(aux target (k+1)))
+                                 | _ -> 
+                                    if (id = false_constr_id)
+                                     then (C.MutInd (U.uri_of_string "cic:/Coq/Init/Logic/False.ind") 0 [])
+                                     else (C.MutInd (U.uri_of_string "cic:/Coq/Init/Logic/True.ind") 0 [])
+                               in aux red_ty 1
+                            ) 
+                            constructor_list
+                      | _ -> raise (ProofEngineTypes.Fail "Discriminate: object is not an Inductive Definition: it's imposible")
+                   in
+
+                    let (proof',goals') = 
+                     EliminationTactics.elim_type_tac 
+                      ~term:(C.MutInd (U.uri_of_string "cic:/Coq/Init/Logic/False.ind") 0 [] ) 
+                      ~status 
+                    in
+                     (match goals' with
+                         [goal'] -> 
+                          let _,metasenv',_,_ = proof' in
+                           let _,context',gty' = List.find (function (m,_,_) -> m=goal') metasenv' in
+prerr_endline ("XXXX gty " ^ CicPp.ppterm gty') ;
+prerr_endline ("XXXX tty " ^ CicPp.ppterm tty) ;
+prerr_endline ("XXXX t1 " ^ CicPp.ppterm t1) ;
+prerr_endline ("XXXX t2 " ^ CicPp.ppterm t2) ;
+ignore (List.map (fun t -> prerr_endline ("XXXX t " ^ CicPp.ppterm t)) pattern) ;
+prerr_endline ("XXXX case " ^ CicPp.ppterm (C.Appl [
+                                  C.Lambda (
+                                   C.Name "x", tty,
+                                   C.MutCase (
+                                    turi, typeno,
+                                    (C.Lambda ((C.Name "x"),tty,(C.Sort C.Prop))),
+                                    (C.Rel 1), pattern
+                                   )
+                                  ); t2])) ;
+                            T.then_
+                             ~start:
+                              (P.change_tac 
+                               ~what:gty' 
+                               ~with_what:
+                                (C.Appl [
+                                  C.Lambda (
+                                   C.Name "x", tty, 
+                                   C.MutCase (
+                                    turi, typeno,
+                                    (C.Lambda ((C.Name "x"),tty,(C.Sort C.Prop))),
+                                    (C.Rel 1), pattern
+                                   )
+                                  ); 
+                                  t2]
+                                )
+                              )
+                             ~continuation:
+                              (
+prerr_endline ("XXXX rewrite<-: " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' (C.Appl [(C.MutInd (equri,0,[])) ; tty ; t1 ; t2])));
+prerr_endline ("XXXX rewrite<-: " ^ CicPp.ppterm (C.Appl [(C.MutInd (equri,0,[])) ; tty ; t1 ; t2])) ;
+prerr_endline ("XXXX equri: " ^ U.string_of_uri equri) ;
+prerr_endline ("XXXX tty : " ^ CicPp.ppterm tty) ;
+prerr_endline ("XXXX tt1': " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' t1)) ;
+prerr_endline ("XXXX tt2': " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' t2)) ;
+if (CicTypeChecker.type_of_aux' metasenv' context' t1) <> tty then prerr_endline ("XXXX tt1': " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' t1)) ;
+if (CicTypeChecker.type_of_aux' metasenv' context' t2) <> tty then prerr_endline ("XXXX tt2': " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' t2)) ;
+if (CicTypeChecker.type_of_aux' metasenv' context' t1) <> (CicTypeChecker.type_of_aux' metasenv' context' t2) 
+ then prerr_endline ("XXXX tt1': " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' t1)) ; prerr_endline ("XXXX tt2': " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' t2)) ;
+prerr_endline ("XXXX rewrite<- " ^ CicPp.ppterm term ^ " : " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' term));
+                                 T.then_
+                                   ~start:(EqualityTactics.rewrite_back_simpl_tac ~term)
+                                   ~continuation:(IntroductionTactics.constructor_tac ~n:1) 
+                              )
+                             ~status:(proof',goal')
+                       | _ -> raise (ProofEngineTypes.Fail "Discriminate: ElimType False left more (or less) than one goal")
+                     )    
+            | _ -> raise (ProofEngineTypes.Fail "Discriminate: not a discriminable equality")
+           )
+       | _ -> raise (ProofEngineTypes.Fail "Discriminate: not an equality")
+;;
+
+
+let discriminate_tac ~term ~status =
+  Tacticals.then_
+   ~start:(* (injection_tac ~term) *) Tacticals.id_tac
+   ~continuation:(discriminate'_tac ~term) (* NOOO!!! non term ma una (qualunque) delle nuove hyp introdotte da inject *)
+   ~status
+;;
+
+
+
+let decide_equality_tac =
+(* il goal e' un termine della forma t1=t2\/~t1=t2; la tattica decide se l'uguaglianza
+e' vera o no e lo risolve *)
+  Tacticals.id_tac
+;;
+
+
+
+let compare_tac ~term ~status:((proof, goal) as status) = Tacticals.id_tac ~status
+(*
+(* term is in the form t1=t2; the tactic leaves two goals: in the first you have to          *)
+(* demonstrate the goal with the additional hyp that t1=t2, in the second the hyp is ~t1=t2  *)
+  let module C = Cic in
+  let module U = UriManager in
+  let module P = PrimitiveTactics in
+  let module T = Tacticals in
+   let _,metasenv,_,_ = proof in
+    let _,context,gty = List.find (function (m,_,_) -> m=goal) metasenv in
+     let termty = (CicTypeChecker.type_of_aux' metasenv context term) in
+      match termty with
+         (C.Appl [(C.MutInd (uri, 0, [])); _; t1; t2]) when (uri = (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind")) ->
+          
+          let term' = (* (t1=t2)\/~(t1=t2) *)
+           C.Appl [
+            (C.MutInd ((U.uri_of_string "cic:/Coq/Init/Logic/or.ind"), 0, [])) ; 
+            term ; 
+            C.Appl [
+             (C.MutInd ((U.uri_of_string "cic:/Coq/Init/Logic/eq.ind"), 1, [])) ; 
+             t1 ; 
+             C.Appl [C.Const ((U.uri_of_string "cic:/Coq/Init/Logic/not.con"), []) ; t2]
+            ]
+           ] 
+          in
+            T.thens 
+               ~start:(P.cut_tac ~term:term')
+               ~continuations:[
+                 T.then_ ~start:(P.intros_tac) ~continuation:(P.elim_intros_simpl_tac ~term:(C.Rel 1)) ; 
+                 decide_equality_tac]  
+               ~status
+      | (C.Appl [(C.MutInd (uri, 0, [])); _; t1; t2]) when (uri = (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind")) ->
+          let term' = (* (t1=t2) \/ ~(t1=t2) *)
+           C.Appl [
+            (C.MutInd ((U.uri_of_string "cic:/Coq/Init/Logic/or.ind"), 0, [])) ; 
+            term ; 
+            C.Appl [
+             (C.MutInd ((U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind"), 1, [])) ; 
+             t1 ; 
+             C.Appl [C.Const ((U.uri_of_string "cic:/Coq/Init/Logic/not.con"), []) ; t2]
+            ]
+           ] 
+          in
+            T.thens 
+               ~start:(P.cut_tac ~term:term')
+               ~continuations:[
+                 T.then_ ~start:(P.intros_tac) ~continuation:(P.elim_intros_simpl_tac ~term:(C.Rel 1)) ; 
+                 decide_equality_tac]  
+               ~status
+      | _ -> raise (ProofEngineTypes.Fail "Compare: Not an equality") 
+*)
+;;
+
+
+
+(* DISCRIMINTATE SENZA INJECTION 
+
+exception TwoDifferentSubtermsFound of (Cic.term * Cic.term * int) 
+
+let discriminate_tac ~term ~status:((proof, goal) as status) =
+  let module C = Cic in
+  let module U = UriManager in
+  let module P = PrimitiveTactics in
+  let module T = Tacticals in
+   let _,metasenv,_,_ = proof in
+    let _,context,_ = List.find (function (m,_,_) -> m=goal) metasenv in
+     let termty = (CicTypeChecker.type_of_aux' metasenv context term) in
+      match termty with
+         (C.Appl [(C.MutInd (equri, 0, [])) ; tty ; t1 ; t2]) 
+          when (U.eq equri (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind")) 
+            or (U.eq equri (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind")) -> (
+           match tty with
+              (C.MutInd (turi,typeno,exp_named_subst))
+            | (C.Appl (C.MutInd (turi,typeno,exp_named_subst)::_)) ->
+
+                let (t1',t2',consno2') = (* bruuutto: uso un eccezione per terminare con successo! buuu!! :-/ *)
+                 try
+                  let rec traverse t1 t2 =
+prerr_endline ("XXXX t1 " ^ CicPp.ppterm t1) ;
+prerr_endline ("XXXX t2 " ^ CicPp.ppterm t2) ;
+                   match t1,t2 with
+                      ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1)),
+                       (C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2)))
+                         when (uri1 = uri2) && (typeno1 = typeno2) && (consno1 = consno2) && (exp_named_subst1 = exp_named_subst2) ->
+                       t1,t2,0
+                    | ((C.Appl ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1))::applist1)),
+                       (C.Appl ((C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2))::applist2))) 
+                         when (uri1 = uri2) && (typeno1 = typeno2) && (consno1 = consno2) && (exp_named_subst1 = exp_named_subst2) ->
+                       let rec traverse_list l1 l2 =
+                         match l1,l2 with
+                            [],[] -> t1,t2,0
+                          | hd1::tl1,hd2::tl2 -> traverse hd1 hd2; traverse_list tl1 tl2
+                          | _ -> raise (ProofEngineTypes.Fail "Discriminate: i 2 termini hanno in testa lo stesso costruttore, ma applicato a un numero diverso di termini. possibile???")
+                       in traverse_list applist1 applist2
+
+                    | ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1)),
+                       (C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2)))
+                    | ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1)),
+                       (C.Appl ((C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2))::_)))
+                    | ((C.Appl ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1))::_)),
+                       (C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2)))
+                    | ((C.Appl ((C.MutConstruct (uri1,typeno1,consno1,exp_named_subst1))::_)),
+                       (C.Appl ((C.MutConstruct (uri2,typeno2,consno2,exp_named_subst2))::_)))
+                         when (consno1 <> consno2) || (exp_named_subst1 <> exp_named_subst2) ->
+                       raise (TwoDifferentSubtermsFound (t1,t2,consno2))
+                    | _ -> raise (ProofEngineTypes.Fail "Discriminate: not a discriminable equality")
+                  in traverse t1 t2
+                 with (TwoDifferentSubtermsFound (t1,t2,consno2)) -> (t1,t2,consno2)
+                in
+prerr_endline ("XXXX consno2' " ^ (string_of_int consno2')) ;
+                 if consno2' = 0 
+                  then raise (ProofEngineTypes.Fail "Discriminate: Discriminating terms are structurally equal")
+                  else
+
+                   let pattern = 
+                     (* a list of "True" except for the element in position consno2' which is "False" *)
+                     match (CicEnvironment.get_obj turi) with
+                        C.InductiveDefinition (ind_type_list,_,nr_ind_params)  ->
+prerr_endline ("XXXX nth " ^ (string_of_int (List.length ind_type_list)) ^ " " ^ (string_of_int typeno)) ;
+                         let _,_,_,constructor_list = (List.nth ind_type_list typeno) in 
+prerr_endline ("XXXX nth " ^ (string_of_int (List.length constructor_list)) ^ " " ^ (string_of_int consno2')) ;
+                          let false_constr_id,_ = List.nth constructor_list (consno2' - 1) in
+prerr_endline ("XXXX nth funzionano ") ;
+                           List.map 
+                            (function (id,cty) ->
+                              let red_ty = CicReduction.whd context cty in (* dubbio: e' corretto ridurre in questo context ??? *)
+                               let rec aux t k =
+                                match t with
+                                   C.Prod (_,_,target) when (k <= nr_ind_params) ->
+                                    aux target (k+1)
+                                 | C.Prod (binder,source,target) when (k > nr_ind_params) -> 
+                                    C.Lambda (binder,source,(aux target (k+1)))
+                                 | _ -> 
+                                    if (id = false_constr_id)
+                                     then (C.MutInd (U.uri_of_string "cic:/Coq/Init/Logic/False.ind") 0 [])
+                                     else (C.MutInd (U.uri_of_string "cic:/Coq/Init/Logic/True.ind") 0 [])
+                               in aux red_ty 1
+                            ) 
+                            constructor_list
+                      | _ -> raise (ProofEngineTypes.Fail "Discriminate: object is not an Inductive Definition: it's imposible")
+                   in
+
+                    let (proof',goals') = 
+                     EliminationTactics.elim_type_tac 
+                      ~term:(C.MutInd (U.uri_of_string "cic:/Coq/Init/Logic/False.ind") 0 [] ) 
+                      ~status 
+                    in
+                     (match goals' with
+                         [goal'] -> 
+                          let _,metasenv',_,_ = proof' in
+                           let _,context',gty' = List.find (function (m,_,_) -> m=goal') metasenv' in
+prerr_endline ("XXXX gty " ^ CicPp.ppterm gty') ;
+prerr_endline ("XXXX tty " ^ CicPp.ppterm tty) ;
+prerr_endline ("XXXX t1' " ^ CicPp.ppterm t1') ;
+prerr_endline ("XXXX t2' " ^ CicPp.ppterm t2') ;
+ignore (List.map (fun t -> prerr_endline ("XXXX t " ^ CicPp.ppterm t)) pattern) ;
+prerr_endline ("XXXX case " ^ CicPp.ppterm (C.Appl [
+                                  C.Lambda (
+                                   C.Name "x", tty,
+                                   C.MutCase (
+                                    turi, typeno,
+                                    (C.Lambda ((C.Name "x"),tty,(C.Sort C.Prop))),
+                                    (C.Rel 1), pattern
+                                   )
+                                  ); t2'])) ;
+                            T.then_
+                             ~start:
+                              (P.change_tac 
+                               ~what:gty' 
+                               ~with_what:
+                                (C.Appl [
+                                  C.Lambda (
+                                   C.Name "x", tty, 
+                                   C.MutCase (
+                                    turi, typeno,
+                                    (C.Lambda ((C.Name "x"),tty,(C.Sort C.Prop))),
+                                    (C.Rel 1), pattern
+                                   )
+                                  ); 
+                                  t2']
+                                )
+                              )
+                             ~continuation:
+                              (
+prerr_endline ("XXXX rewrite<-: " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' (C.Appl [(C.MutInd (equri,0,[])) ; tty ; t1' ; t2'])));
+prerr_endline ("XXXX rewrite<-: " ^ CicPp.ppterm (C.Appl [(C.MutInd (equri,0,[])) ; tty ; t1' ; t2'])) ;
+prerr_endline ("XXXX equri: " ^ U.string_of_uri equri) ;
+prerr_endline ("XXXX tty : " ^ CicPp.ppterm tty) ;
+prerr_endline ("XXXX tt1': " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' t1')) ;
+prerr_endline ("XXXX tt2': " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' t2')) ;
+if (CicTypeChecker.type_of_aux' metasenv' context' t1') <> tty then prerr_endline ("XXXX tt1': " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' t1')) ;
+if (CicTypeChecker.type_of_aux' metasenv' context' t2') <> tty then prerr_endline ("XXXX tt2': " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' t2')) ;
+if (CicTypeChecker.type_of_aux' metasenv' context' t1') <> (CicTypeChecker.type_of_aux' metasenv' context' t2') 
+ then prerr_endline ("XXXX tt1': " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' t1')) ; prerr_endline ("XXXX tt2': " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' t2')) ;
+
+                               let termty' = ProofEngineReduction.replace_lifting ~equality:(==) ~what:t1 ~with_what:t1' ~where:termty in
+                                let termty'' = ProofEngineReduction.replace_lifting ~equality:(==) ~what:t2 ~with_what:t2' ~where:termty' in
+
+prerr_endline ("XXXX rewrite<- " ^ CicPp.ppterm term ^ " : " ^ CicPp.ppterm (CicTypeChecker.type_of_aux' metasenv' context' term));
+                                 T.then_
+                                   ~start:(EqualityTactics.rewrite_back_simpl_tac ~term:term)
+                                   ~continuation:(IntroductionTactics.constructor_tac ~n:1) 
+                              )
+                             ~status:(proof',goal')
+                       | _ -> raise (ProofEngineTypes.Fail "Discriminate: ElimType False left more (or less) than one goal")
+                     )    
+            | _ -> raise (ProofEngineTypes.Fail "Discriminate: not a discriminable equality")
+           )
+       | _ -> raise (ProofEngineTypes.Fail "Discriminate: not an equality")
+;;
+
+*)
+
+
+
diff --git a/helm/ocaml/tactics/discriminationTactics.mli b/helm/ocaml/tactics/discriminationTactics.mli
new file mode 100644
index 000000000..f1153256f
--- /dev/null
+++ b/helm/ocaml/tactics/discriminationTactics.mli
@@ -0,0 +1,30 @@
+(* Copyright (C) 2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val injection_tac: term:Cic.term -> ProofEngineTypes.tactic
+val discriminate_tac: term:Cic.term -> ProofEngineTypes.tactic
+val decide_equality_tac: ProofEngineTypes.tactic
+val compare_tac: term:Cic.term -> ProofEngineTypes.tactic
+
diff --git a/helm/ocaml/tactics/eliminationTactics.ml b/helm/ocaml/tactics/eliminationTactics.ml
new file mode 100644
index 000000000..b6141094f
--- /dev/null
+++ b/helm/ocaml/tactics/eliminationTactics.ml
@@ -0,0 +1,220 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(** DEBUGGING *)
+
+  (** perform debugging output? *)
+let debug = false
+
+  (** debugging print *)
+let warn s =
+  if debug then
+    prerr_endline ("DECOMPOSE: " ^ s)
+
+
+
+(*
+let induction_tac ~term ~status:((proof,goal) as status) =
+  let module C = Cic in
+  let module R = CicReduction in
+  let module P = PrimitiveTactics in
+  let module T = Tacticals in
+  let module S = ProofEngineStructuralRules in
+  let module U = UriManager in 
+   let (_,metasenv,_,_) = proof in
+    let _,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+     let termty = CicTypeChecker.type_of_aux' metasenv context term in	(* per ora non serve *)
+
+     T.then_ ~start:(T.repeat_tactic 
+                       ~tactic:(T.then_ ~start:(VariousTactics.generalize_tac ~term) (* chissa' se cosi' funziona? *)
+                       ~continuation:(P.intros))
+             ~continuation:(P.elim_intros_simpl ~term)
+             ~status
+;;
+*)
+
+
+let elim_type_tac ~term ~status =
+  let module C = Cic in
+  let module P = PrimitiveTactics in
+  let module T = Tacticals in
+   T.thens
+    ~start: (P.cut_tac term)
+    ~continuations:[ P.elim_intros_simpl_tac ~term:(C.Rel 1) ; T.id_tac ]
+    ~status
+;;
+
+
+(* Decompose related stuff *)
+
+exception InteractiveUserUriChoiceNotRegistered
+
+let interactive_user_uri_choice =
+ (ref (fun ~selection_mode -> raise InteractiveUserUriChoiceNotRegistered) :
+  (selection_mode:[`SINGLE | `EXTENDED] ->
+      ?ok:string ->
+      ?enable_button_for_non_vars:bool ->
+      title:string -> msg:string -> string list -> string list) ref)
+;;
+
+exception IllFormedUri of string
+
+let cic_textual_parser_uri_of_string uri' =
+ try
+  (* Constant *)
+  if String.sub uri' (String.length uri' - 4) 4 = ".con" then
+   CicTextualParser0.ConUri (UriManager.uri_of_string uri')
+  else
+   if String.sub uri' (String.length uri' - 4) 4 = ".var" then
+    CicTextualParser0.VarUri (UriManager.uri_of_string uri')
+   else
+    (try
+      (* Inductive Type *)
+      let uri'',typeno = CicTextualLexer.indtyuri_of_uri uri' in
+       CicTextualParser0.IndTyUri (uri'',typeno)
+     with
+      _ ->
+       (* Constructor of an Inductive Type *)
+       let uri'',typeno,consno =
+        CicTextualLexer.indconuri_of_uri uri'
+       in
+        CicTextualParser0.IndConUri (uri'',typeno,consno)
+    )
+ with
+  _ -> raise (IllFormedUri uri')
+;;
+
+(*
+let constructor_uri_of_string uri = 
+  match cic_textual_parser_uri_of_string uri with
+     CicTextualParser0.IndTyUri (uri,typeno) -> (uri,typeno,[])
+   | _ -> assert false
+;;
+
+let call_back uris = 
+(* N.B.: nella finestra c'e' un campo "nessuno deei precedenti, prova questo" che non ha senso? *)
+(* N.B.: in questo passaggio perdo l'informazione su exp_named_subst !!!! *)
+(* domanda: due triple possono essere diverse solo per avere exp_named_subst diverse?? *)
+  let module U = UriManager in 
+   List.map 
+    (constructor_uri_of_string)
+    (!interactive_user_uri_choice 
+      ~selection_mode:`EXTENDED ~ok:"Ok" ~enable_button_for_non_vars:false 
+      ~title:"Decompose" ~msg:"Please, select the Inductive Types to decompose" 
+      (List.map 
+        (function (uri,typeno,_) -> U.string_of_uri uri ^ "#1/" ^ string_of_int (typeno+1)) 
+        uris)
+    ) 
+;;
+*)
+
+let decompose_tac ?(uris_choice_callback=(function l -> l)) term ~status:((proof,goal) as status) =
+  let module C = Cic in
+  let module R = CicReduction in
+  let module P = PrimitiveTactics in
+  let module T = Tacticals in
+  let module S = ProofEngineStructuralRules in
+   let _,metasenv,_,_ = proof in
+    let _,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+     let old_context_len = List.length context in
+     let termty = CicTypeChecker.type_of_aux' metasenv context term in
+
+      let rec make_list termty = 
+      (* N.B.: altamente inefficente? *)
+       let rec search_inductive_types urilist termty =
+        (* search in term the Inductive Types and return a list of uris as triples like this: (uri,typeno,exp_named_subst) *)
+        match termty with
+           (C.MutInd (uri,typeno,exp_named_subst)) (* when (not (List.mem (uri,typeno,exp_named_subst) urilist)) *) -> 
+               (uri,typeno,exp_named_subst)::urilist
+         | (C.Appl ((C.MutInd (uri,typeno,exp_named_subst))::applist)) (* when (not (List.mem (uri,typeno,exp_named_subst) urilist)) *) -> 
+               (uri,typeno,exp_named_subst)::(List.fold_left search_inductive_types urilist applist)
+         | _ -> urilist
+         (* N.B: in un caso tipo (and A !C:Prop.(or B C)) l'or *non* viene selezionato! *)
+       in 
+       let rec purge_duplicates urilist = 
+        let rec aux triple urilist =
+         match urilist with 
+            [] -> []
+          | hd::tl -> 
+             if (hd = triple) 
+              then aux triple tl
+              else hd::(aux triple tl)
+        in
+        match urilist with
+           [] -> []
+         | hd::tl -> hd::(purge_duplicates (aux hd tl))
+       in
+        purge_duplicates (search_inductive_types [] termty) 
+      in
+
+       let urilist =  
+          (* list of triples (uri,typeno,exp_named_subst) of Inductive Types found in term and chosen by the user *)
+          (* N.B.: due to a bug in uris_choice_callback exp_named_subst are not significant (they all are []) *)
+         uris_choice_callback (make_list termty) in
+
+        let rec elim_clear_tac ~term' ~nr_of_hyp_still_to_elim ~status:((proof,goal) as status) =
+         warn ("nr_of_hyp_still_to_elim=" ^ (string_of_int nr_of_hyp_still_to_elim));
+         if nr_of_hyp_still_to_elim <> 0 then
+          let _,metasenv,_,_ = proof in
+           let _,context,_ = List.find (function (m,_,_) -> m=goal) metasenv in
+            let old_context_len = List.length context in
+            let termty = CicTypeChecker.type_of_aux' metasenv context term' in
+             warn ("elim_clear termty= " ^ CicPp.ppterm termty);
+             match termty with
+                C.MutInd (uri,typeno,exp_named_subst)
+              | C.Appl((C.MutInd (uri,typeno,exp_named_subst))::_) 
+                 when (List.mem (uri,typeno,exp_named_subst) urilist) ->
+                   warn ("elim " ^ CicPp.ppterm termty);
+                   T.then_ 
+                      ~start:(P.elim_intros_simpl_tac ~term:term')
+                      ~continuation:(
+                        (* clear the hyp that has just been eliminated *)
+                        (fun ~status:((proof,goal) as status) -> 
+                          let _,metasenv,_,_ = proof in
+                           let _,context,_ = List.find (function (m,_,_) -> m=goal) metasenv in
+                            let new_context_len = List.length context in   
+                             warn ("newcon=" ^ (string_of_int new_context_len) ^ " & oldcon=" ^ (string_of_int old_context_len) ^ " & old_nr_of_hyp=" ^ (string_of_int nr_of_hyp_still_to_elim));
+                             let new_nr_of_hyp_still_to_elim = nr_of_hyp_still_to_elim + (new_context_len - old_context_len) - 1 in
+                             T.then_ 
+                                ~start:(
+                                  if (term'==term) (* if it's the first application of elim, there's no need to clear the hyp *) 
+                                   then begin prerr_endline ("%%%%%%% no clear"); T.id_tac end
+                                   else begin prerr_endline ("%%%%%%% clear " ^ (string_of_int (new_nr_of_hyp_still_to_elim))); (S.clear ~hyp:(List.nth context (new_nr_of_hyp_still_to_elim))) end)
+                                ~continuation:(elim_clear_tac ~term':(C.Rel new_nr_of_hyp_still_to_elim) ~nr_of_hyp_still_to_elim:new_nr_of_hyp_still_to_elim)
+                                ~status
+                        ))
+                      ~status
+              | _ ->
+                   let new_nr_of_hyp_still_to_elim = nr_of_hyp_still_to_elim - 1 in 
+                    warn ("fail; hyp=" ^ (string_of_int new_nr_of_hyp_still_to_elim));
+                    elim_clear_tac ~term':(C.Rel new_nr_of_hyp_still_to_elim) ~nr_of_hyp_still_to_elim:new_nr_of_hyp_still_to_elim ~status
+         else (* no hyp to elim left in this goal *)
+          T.id_tac ~status
+
+        in
+         elim_clear_tac ~term':term ~nr_of_hyp_still_to_elim:1 ~status
+;;
+
+
diff --git a/helm/ocaml/tactics/eliminationTactics.mli b/helm/ocaml/tactics/eliminationTactics.mli
new file mode 100644
index 000000000..92d9eee01
--- /dev/null
+++ b/helm/ocaml/tactics/eliminationTactics.mli
@@ -0,0 +1,34 @@
+(* Copyright (C) 2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val elim_type_tac: term:Cic.term -> ProofEngineTypes.tactic
+
+(* The default callback always decomposes the term as much as possible *)
+val decompose_tac:
+ ?uris_choice_callback:
+  ((UriManager.uri * int * (UriManager.uri * Cic.term) list) list ->
+   (UriManager.uri * int * (UriManager.uri * Cic.term) list) list) ->
+ Cic.term ->
+  ProofEngineTypes.tactic
diff --git a/helm/ocaml/tactics/equalityTactics.ml b/helm/ocaml/tactics/equalityTactics.ml
new file mode 100644
index 000000000..8cb794ff6
--- /dev/null
+++ b/helm/ocaml/tactics/equalityTactics.ml
@@ -0,0 +1,236 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+
+let rewrite_tac ~term:equality ~status:(proof,goal) =
+ let module C = Cic in
+ let module U = UriManager in
+  let curi,metasenv,pbo,pty = proof in
+  let metano,context,gty = List.find (function (m,_,_) -> m=goal) metasenv in
+   let eq_ind_r,ty,t1,t2 =
+    match CicTypeChecker.type_of_aux' metasenv context equality with
+       C.Appl [C.MutInd (uri,0,[]) ; ty ; t1 ; t2]
+        when U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind") ->
+         let eq_ind_r =
+          C.Const
+           (U.uri_of_string "cic:/Coq/Init/Logic/eq_ind_r.con",[])
+         in
+          eq_ind_r,ty,t1,t2
+     | C.Appl [C.MutInd (uri,0,[]) ; ty ; t1 ; t2]
+        when U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind") ->
+         let eqT_ind_r =
+          C.Const
+           (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT_ind_r.con",[])
+         in
+          eqT_ind_r,ty,t1,t2
+     | _ ->
+       raise
+        (ProofEngineTypes.Fail
+          "Rewrite: the argument is not a proof of an equality")
+   in
+    let pred =
+     let gty' = CicSubstitution.lift 1 gty in
+     let t1' = CicSubstitution.lift 1 t1 in
+     let gty'' =
+      ProofEngineReduction.replace_lifting
+       ~equality:ProofEngineReduction.alpha_equivalence
+       ~what:[t1'] ~with_what:[C.Rel 1] ~where:gty'
+     in
+      C.Lambda
+       (ProofEngineHelpers.mk_fresh_name context C.Anonymous ty, ty, gty'')
+    in
+    let fresh_meta = ProofEngineHelpers.new_meta proof in
+    let irl =
+     ProofEngineHelpers.identity_relocation_list_for_metavariable context in
+    let metasenv' = (fresh_meta,context,C.Appl [pred ; t2])::metasenv in
+
+     let (proof',goals) =
+      PrimitiveTactics.exact_tac
+       ~term:(C.Appl
+         [eq_ind_r ; ty ; t2 ; pred ; C.Meta (fresh_meta,irl) ; t1 ;equality])
+        ~status:((curi,metasenv',pbo,pty),goal)
+     in
+      assert (List.length goals = 0) ;
+      (proof',[fresh_meta])
+;;
+
+
+let rewrite_simpl_tac ~term ~status =
+ Tacticals.then_ 
+  ~start:(rewrite_tac ~term)
+  ~continuation:
+   (ReductionTactics.simpl_tac ~also_in_hypotheses:false ~terms:None)
+  ~status
+;;
+
+
+let rewrite_back_tac ~term:equality ~status:(proof,goal) =
+ let module C = Cic in
+ let module U = UriManager in
+  let curi,metasenv,pbo,pty = proof in
+  let metano,context,gty = List.find (function (m,_,_) -> m=goal) metasenv in
+   let eq_ind_r,ty,t1,t2 =
+    match CicTypeChecker.type_of_aux' metasenv context equality with
+       C.Appl [C.MutInd (uri,0,[]) ; ty ; t1 ; t2]
+        when U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind") ->
+         let eq_ind_r =
+          C.Const
+           (U.uri_of_string "cic:/Coq/Init/Logic/eq_ind.con",[])
+         in
+          eq_ind_r,ty,t2,t1
+     | C.Appl [C.MutInd (uri,0,[]) ; ty ; t1 ; t2]
+        when U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind") ->
+         let eqT_ind_r =
+          C.Const
+           (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT_ind.con",[])
+         in
+          eqT_ind_r,ty,t2,t1
+     | _ ->
+       raise
+        (ProofEngineTypes.Fail
+          "Rewrite: the argument is not a proof of an equality")
+   in
+    let pred =
+     let gty' = CicSubstitution.lift 1 gty in
+     let t1' = CicSubstitution.lift 1 t1 in
+     let gty'' =
+      ProofEngineReduction.replace_lifting
+       ~equality:ProofEngineReduction.alpha_equivalence
+       ~what:[t1'] ~with_what:[C.Rel 1] ~where:gty'
+     in
+      C.Lambda
+       (ProofEngineHelpers.mk_fresh_name context C.Anonymous ty, ty, gty'')
+    in
+    let fresh_meta = ProofEngineHelpers.new_meta proof in
+    let irl =
+     ProofEngineHelpers.identity_relocation_list_for_metavariable context in
+    let metasenv' = (fresh_meta,context,C.Appl [pred ; t2])::metasenv in
+
+     let (proof',goals) =
+      PrimitiveTactics.exact_tac
+       ~term:(C.Appl
+         [eq_ind_r ; ty ; t2 ; pred ; C.Meta (fresh_meta,irl) ; t1 ;equality])
+        ~status:((curi,metasenv',pbo,pty),goal)
+     in
+      assert (List.length goals = 0) ;
+      (proof',[fresh_meta])
+
+;;
+
+
+let rewrite_back_simpl_tac ~term ~status =
+ Tacticals.then_ 
+  ~start:(rewrite_back_tac ~term)
+  ~continuation:
+   (ReductionTactics.simpl_tac ~also_in_hypotheses:false ~terms:None)
+  ~status
+;;
+
+
+let replace_tac ~what ~with_what ~status:((proof, goal) as status) =
+  let module C = Cic in
+  let module U = UriManager in
+  let module P = PrimitiveTactics in
+  let module T = Tacticals in
+   let _,metasenv,_,_ = proof in
+    let _,context,_ = List.find (function (m,_,_) -> m=goal) metasenv in
+     let wty = CicTypeChecker.type_of_aux' metasenv context what in
+      try
+      if (wty = (CicTypeChecker.type_of_aux' metasenv context with_what))
+       then T.thens
+              ~start:(
+                P.cut_tac 
+                 (C.Appl [
+                   (C.MutInd ((U.uri_of_string "cic:/Coq/Init/Logic/eq.ind"), 0, [])) ; (* quale uguaglianza usare, eq o eqT ? *)
+                     wty ; 
+                     what ; 
+                     with_what]))
+              ~continuations:[
+                T.then_
+                   ~start:(rewrite_back_tac ~term:(C.Rel 1))
+                   ~continuation:(
+                     ProofEngineStructuralRules.clear
+                      ~hyp:(List.hd context)) ;
+                T.id_tac]
+              ~status
+       else raise (ProofEngineTypes.Fail "Replace: terms not replaceable")
+       with (Failure "hd") -> raise (ProofEngineTypes.Fail "Replace: empty context")
+;;
+
+
+(* All these tacs do is applying the right constructor/theorem *)
+
+let reflexivity_tac =
+  IntroductionTactics.constructor_tac ~n:1
+;;
+
+
+let symmetry_tac ~status:(proof, goal) =
+  let module C = Cic in
+  let module R = CicReduction in
+  let module U = UriManager in
+   let (_,metasenv,_,_) = proof in
+    let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+     match (R.whd context ty) with
+        (C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) when (U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind")) ->
+         PrimitiveTactics.apply_tac ~status:(proof,goal)
+          ~term: (C.Const (U.uri_of_string "cic:/Coq/Init/Logic/sym_eq.con", []))
+
+      | (C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) when (U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind")) ->
+         PrimitiveTactics.apply_tac ~status:(proof,goal)
+          ~term: (C.Const (U.uri_of_string "cic:/Coq/Init/Logic_Type/sym_eqT.con", []))
+
+      | _ -> raise (ProofEngineTypes.Fail "Symmetry failed")
+;;
+
+
+let transitivity_tac ~term ~status:((proof, goal) as status) =
+  let module C = Cic in
+  let module R = CicReduction in
+  let module U = UriManager in
+  let module T = Tacticals in
+   let (_,metasenv,_,_) = proof in
+    let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+     match (R.whd context ty) with
+        (C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) when (uri = (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind")) ->
+         T.thens
+          ~start:(PrimitiveTactics.apply_tac
+            ~term: (C.Const (U.uri_of_string "cic:/Coq/Init/Logic/trans_eq.con", [])))
+          ~continuations:
+            [PrimitiveTactics.exact_tac ~term ; T.id_tac ; T.id_tac]
+          ~status
+
+      | (C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) when (uri = (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind")) ->
+         T.thens
+          ~start:(PrimitiveTactics.apply_tac
+            ~term: (C.Const (U.uri_of_string "cic:/Coq/Init/Logic_Type/trans_eqT.con", [])))
+          ~continuations:
+            [T.id_tac ; T.id_tac ; PrimitiveTactics.exact_tac ~term]
+          ~status
+
+      | _ -> raise (ProofEngineTypes.Fail "Transitivity failed")
+;;
+
+
diff --git a/helm/ocaml/tactics/equalityTactics.mli b/helm/ocaml/tactics/equalityTactics.mli
new file mode 100644
index 000000000..7d57a0c11
--- /dev/null
+++ b/helm/ocaml/tactics/equalityTactics.mli
@@ -0,0 +1,35 @@
+(* Copyright (C) 2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val rewrite_tac: term:Cic.term -> ProofEngineTypes.tactic
+val rewrite_simpl_tac: term:Cic.term -> ProofEngineTypes.tactic
+val rewrite_back_tac: term:Cic.term -> ProofEngineTypes.tactic
+val rewrite_back_simpl_tac: term:Cic.term -> ProofEngineTypes.tactic
+val replace_tac: what:Cic.term -> with_what:Cic.term -> ProofEngineTypes.tactic
+
+val reflexivity_tac: ProofEngineTypes.tactic
+val symmetry_tac: ProofEngineTypes.tactic
+val transitivity_tac: term:Cic.term -> ProofEngineTypes.tactic
+
diff --git a/helm/gTopLevel/fourier.ml b/helm/ocaml/tactics/fourier.ml
similarity index 77%
rename from helm/gTopLevel/fourier.ml
rename to helm/ocaml/tactics/fourier.ml
index c1a40e6e1..d7728c0b3 100644
--- a/helm/gTopLevel/fourier.ml
+++ b/helm/ocaml/tactics/fourier.ml
@@ -21,7 +21,7 @@ Pages: 326-327
 http://gallica.bnf.fr/
 *)
 
-
+(** @author The Coq Development Team *)
 
 
 (* Un peu de calcul sur les rationnels... 
@@ -30,10 +30,14 @@ i.e. le num
 *)
 
 
+(** Type for coefficents *)
+type rational = {
+num:int; (** Numerator *)
+den:int;  (** Denumerator *)
+};;
 
-type rational = {num:int;
-                 den:int}
-;;
+(** Debug function.
+    @param x the rational to print*)
 let print_rational x =
         print_int x.num;
         print_string "/";
@@ -42,8 +46,9 @@ let print_rational x =
 
 let rec pgcd x y = if y = 0 then x else pgcd y (x mod y);;
 
-
+(** The constant 0*)
 let r0 = {num=0;den=1};;
+(** The constant 1*)
 let r1 = {num=1;den=1};;
 
 let rnorm x = let x = (if x.den<0 then {num=(-x.num);den=(-x.den)} else x) in
@@ -51,22 +56,41 @@ let rnorm x = let x = (if x.den<0 then {num=(-x.num);den=(-x.den)} else x) in
               else (let d=pgcd x.num x.den in
 		    let d= (if d<0 then -d else d) in
                     {num=(x.num)/d;den=(x.den)/d});;
- 
+
+(** Calculates the opposite of a rational.
+    @param x The rational
+    @return -x*)
 let rop x = rnorm {num=(-x.num);den=x.den};;
 
+(** Sums two rationals.
+    @param x A rational
+    @param y Another rational
+    @return x+y*)
 let rplus x y = rnorm {num=x.num*y.den + y.num*x.den;den=x.den*y.den};;
-
+(** Substracts two rationals.
+    @param x A rational
+    @param y Another rational
+    @return x-y*)
 let rminus x y = rnorm {num=x.num*y.den - y.num*x.den;den=x.den*y.den};;
-
+(** Multiplyes two rationals.
+    @param x A rational
+    @param y Another rational
+    @return x*y*)
 let rmult x y = rnorm {num=x.num*y.num;den=x.den*y.den};;
-
+(** Inverts arational.
+    @param x A rational
+    @return x{^ -1} *)
 let rinv x = rnorm {num=x.den;den=x.num};;
-
+(** Divides two rationals.
+    @param x A rational
+    @param y Another rational
+    @return x/y*)
 let rdiv x y = rnorm {num=x.num*y.den;den=x.den*y.num};;
 
 let rinf x y = x.num*y.den < y.num*x.den;;
 let rinfeq x y = x.num*y.den <= y.num*x.den;;
 
+
 (* {coef;hist;strict}, où coef=[c1; ...; cn; d], représente l'inéquation
 c1x1+...+cnxn < d si strict=true, <= sinon,
 hist donnant les coefficients (positifs) d'une combinaison linéaire qui permet d'obtenir l'inéquation à partir de celles du départ.
@@ -147,12 +171,14 @@ let deduce_add lneg lpos =
 (* élimination de la première variable à partir d'une liste d'inéquations:
 opération qu'on itère dans l'algorithme de Fourier.
 *)
-let deduce1 s =
+let deduce1 s i=
     match (partitionne s) with 
       [lneg;lnul;lpos] ->
-    let lnew = deduce_add lneg lpos in
-    (List.map ie_tl lnul)@lnew
-     |_->assert false
+         let lnew = deduce_add lneg lpos in
+	 (match lneg with [] -> print_string("non posso ridurre "^string_of_int i^"\n")|_->();
+	  match lpos with [] -> print_string("non posso ridurre "^string_of_int i^"\n")|_->());
+         (List.map ie_tl lnul)@lnew
+   |_->assert false
 ;;
 (* algorithme de Fourier: on élimine successivement toutes les variables.
 *)
@@ -160,18 +186,25 @@ let deduce lie =
    let n = List.length (fst (List.hd lie)) in
    let lie=ref (add_hist lie) in
    for i=1 to n-1 do
-      lie:= deduce1 !lie;
+      lie:= deduce1 !lie i;
    done;
    !lie
 ;;
 
-(* donne [] si le système a des solutions,
+(* donne [] si le système a des  find solutions,
 sinon donne [c,s,lc]
 où lc est la combinaison linéaire des inéquations de départ
 qui donne 0 < c si s=true
        ou 0 <= c sinon
 cette inéquation étant absurde.
 *)
+(** Tryes to find if the system admits solutions.
+    @param lie the list of inequations 
+    @return a list that can be empty if the system has solutions. Otherwise it returns a
+            one elements list [\[(c,s,lc)\]]. {b c} is the rational that can be obtained solving the system,
+	    {b s} is true if the inequation that proves that the system is absurd is of type [c < 0], false if 
+	    [c <= 0], {b lc} is a list of rational that represents the liear combination to obtain the
+	    absurd inequation *)
 let unsolvable lie =
    let lr = deduce lie in
    let res = ref [] in
diff --git a/helm/ocaml/tactics/fourier.mli b/helm/ocaml/tactics/fourier.mli
new file mode 100644
index 000000000..8b26bc21a
--- /dev/null
+++ b/helm/ocaml/tactics/fourier.mli
@@ -0,0 +1,27 @@
+type rational = { num : int; den : int; } 
+val print_rational : rational -> unit
+val pgcd : int -> int -> int
+val r0 : rational
+val r1 : rational
+val rnorm : rational -> rational
+val rop : rational -> rational
+val rplus : rational -> rational -> rational
+val rminus : rational -> rational -> rational
+val rmult : rational -> rational -> rational
+val rinv : rational -> rational
+val rdiv : rational -> rational -> rational
+val rinf : rational -> rational -> bool
+val rinfeq : rational -> rational -> bool
+type ineq = { coef : rational list; hist : rational list; strict : bool; } 
+val pop : 'a -> 'a list ref -> unit
+val partitionne : ineq list -> ineq list list
+val add_hist : (rational list * bool) list -> ineq list
+val ie_add : ineq -> ineq -> ineq
+val ie_emult : rational -> ineq -> ineq
+val ie_tl : ineq -> ineq
+val hd_coef : ineq -> rational
+val deduce_add : ineq list -> ineq list -> ineq list
+val deduce1 : ineq list -> int -> ineq list
+val deduce : (rational list * bool) list -> ineq list
+val unsolvable :
+  (rational list * bool) list -> (rational * bool * rational list) list
diff --git a/helm/ocaml/tactics/fourierR.ml b/helm/ocaml/tactics/fourierR.ml
new file mode 100644
index 000000000..b1aa1a256
--- /dev/null
+++ b/helm/ocaml/tactics/fourierR.ml
@@ -0,0 +1,1233 @@
+(* Copyright (C) 2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+
+(******************** THE FOURIER TACTIC ***********************)
+
+(* La tactique Fourier ne fonctionne de manière sûre que si les coefficients 
+des inéquations et équations sont entiers. En attendant la tactique Field.
+*)
+
+open Fourier
+
+
+let debug x = print_string ("____ "^x) ; flush stdout;;
+
+let debug_pcontext x = 
+ let str = ref "" in
+ List.iter (fun y -> match y with Some(Cic.Name(a),_) -> str := !str ^ 
+  a ^ " " | _ ->()) x ;
+ debug ("contesto : "^ (!str) ^ "\n")
+;;
+
+(******************************************************************************
+Operations on linear combinations.
+
+Opérations sur les combinaisons linéaires affines.
+La partie homogène d'une combinaison linéaire est en fait une table de hash 
+qui donne le coefficient d'un terme du calcul des constructions, 
+qui est zéro si le terme n'y est pas. 
+*)
+
+
+
+(**
+	The type for linear combinations
+*)
+type flin = {fhom:(Cic.term , rational)Hashtbl.t;fcste:rational}	     
+;;
+
+(**
+	@return an empty flin
+*)
+let flin_zero () = {fhom = Hashtbl.create 50;fcste=r0}
+;;
+
+(**
+	@param f a flin
+	@param x a Cic.term
+	@return the rational associated with x (coefficient)
+*)
+let flin_coef f x = 
+	try
+		(Hashtbl.find f.fhom x)
+	with
+		_ -> r0
+;;
+			
+(**
+	Adds c to the coefficient of x
+	@param f a flin
+	@param x a Cic.term
+	@param c a rational
+	@return the new flin
+*)
+let flin_add f x c = 
+    match x with
+    Cic.Rel(n) ->(
+      let cx = flin_coef f x in
+      Hashtbl.remove f.fhom x;
+      Hashtbl.add f.fhom x (rplus cx c);
+      f)
+    |_->debug ("Internal error in Fourier! this is not a Rel "^CicPp.ppterm x^"\n");
+      let cx = flin_coef f x in
+      Hashtbl.remove f.fhom x;
+      Hashtbl.add f.fhom x (rplus cx c);
+      f
+;;
+(**
+	Adds c to f.fcste
+	@param f a flin
+	@param c a rational
+	@return the new flin
+*)
+let flin_add_cste f c =              
+    {fhom=f.fhom;
+     fcste=rplus f.fcste c}
+;;
+
+(**
+	@return a empty flin with r1 in fcste
+*)
+let flin_one () = flin_add_cste (flin_zero()) r1;;
+
+(**
+	Adds two flin
+*)
+let flin_plus f1 f2 = 
+    let f3 = flin_zero() in
+    Hashtbl.iter (fun x c -> let _=flin_add f3 x c in ()) f1.fhom;
+    Hashtbl.iter (fun x c -> let _=flin_add f3 x c in ()) f2.fhom;
+    flin_add_cste (flin_add_cste f3 f1.fcste) f2.fcste;
+;;
+
+(**
+	Substracts two flin
+*)
+let flin_minus f1 f2 = 
+    let f3 = flin_zero() in
+    Hashtbl.iter (fun x c -> let _=flin_add f3 x c in ()) f1.fhom;
+    Hashtbl.iter (fun x c -> let _=flin_add f3 x (rop c) in ()) f2.fhom;
+    flin_add_cste (flin_add_cste f3 f1.fcste) (rop f2.fcste);
+;;
+
+(**
+	@return a times f
+*)
+let flin_emult a f =
+    let f2 = flin_zero() in
+    Hashtbl.iter (fun x c -> let _=flin_add f2 x (rmult a c) in ()) f.fhom;
+    flin_add_cste f2 (rmult a f.fcste);
+;;
+
+   
+(*****************************************************************************)
+
+
+(**
+	@param t a term
+	@raise Failure if conversion is impossible
+	@return rational proiection of t
+*)
+let rec rational_of_term t =
+  (* fun to apply f to the first and second rational-term of l *)
+  let rat_of_binop f l =
+  	let a = List.hd l and
+	    b = List.hd(List.tl l) in
+	f (rational_of_term a) (rational_of_term b)
+  in
+  (* as before, but f is unary *)
+  let rat_of_unop f l =
+  	f (rational_of_term (List.hd l))
+  in
+  match t with
+  | Cic.Cast (t1,t2) -> (rational_of_term t1)
+  | Cic.Appl (t1::next) ->
+        (match t1 with
+           Cic.Const (u,boh) ->
+               (match (UriManager.string_of_uri u) with
+		 "cic:/Coq/Reals/Rdefinitions/Ropp.con" -> 
+		      rat_of_unop rop next 
+		|"cic:/Coq/Reals/Rdefinitions/Rinv.con" -> 
+                      rat_of_unop rinv next 
+                |"cic:/Coq/Reals/Rdefinitions/Rmult.con" -> 
+                      rat_of_binop rmult next
+                |"cic:/Coq/Reals/Rdefinitions/Rdiv.con" -> 
+                      rat_of_binop rdiv next
+                |"cic:/Coq/Reals/Rdefinitions/Rplus.con" -> 
+                      rat_of_binop rplus next
+                |"cic:/Coq/Reals/Rdefinitions/Rminus.con" -> 
+                      rat_of_binop rminus next
+                | _ -> failwith "not a rational")
+          | _ -> failwith "not a rational")
+  | Cic.Const (u,boh) ->
+        (match (UriManager.string_of_uri u) with
+	       "cic:/Coq/Reals/Rdefinitions/R1.con" -> r1
+              |"cic:/Coq/Reals/Rdefinitions/R0.con" -> r0
+              |  _ -> failwith "not a rational")
+  |  _ -> failwith "not a rational"
+;;
+
+(* coq wrapper
+let rational_of_const = rational_of_term;;
+*)
+let fails f a =
+ try
+   let tmp = (f a) in
+   false
+ with 
+   _-> true
+ ;;
+
+let rec flin_of_term t =
+	let fl_of_binop f l =
+		let a = List.hd l and
+		    b = List.hd(List.tl l) in
+		f (flin_of_term a)  (flin_of_term b)
+	in
+  try(
+    match t with
+  | Cic.Cast (t1,t2) -> (flin_of_term t1)
+  | Cic.Appl (t1::next) ->
+	begin
+	match t1 with
+        Cic.Const (u,boh) ->
+            begin
+	    match (UriManager.string_of_uri u) with
+	     "cic:/Coq/Reals/Rdefinitions/Ropp.con" -> 
+                  flin_emult (rop r1) (flin_of_term (List.hd next))
+	    |"cic:/Coq/Reals/Rdefinitions/Rplus.con"-> 
+                  fl_of_binop flin_plus next 
+	    |"cic:/Coq/Reals/Rdefinitions/Rminus.con"->
+                  fl_of_binop flin_minus next
+	    |"cic:/Coq/Reals/Rdefinitions/Rmult.con"->
+	     	begin
+		let arg1 = (List.hd next) and
+		    arg2 = (List.hd(List.tl next)) 
+		in
+		if fails rational_of_term arg1 
+		   then
+		   if fails rational_of_term arg2
+		      then
+		      ( (* prodotto tra 2 incognite ????? impossibile*)
+		      failwith "Sistemi lineari!!!!\n" 
+		      )
+		      else
+		      (
+		      match arg1 with
+		      Cic.Rel(n) -> (*trasformo al volo*)
+		                    (flin_add (flin_zero()) arg1 (rational_of_term arg2))
+ 		      |_-> (* test this *)
+		           let tmp = flin_of_term arg1 in
+			   flin_emult  (rational_of_term arg2) (tmp)
+		      )
+		   else
+		   if fails rational_of_term arg2
+		      then
+		      (
+		      match arg2 with
+		      Cic.Rel(n) -> (*trasformo al volo*)
+		                    (flin_add (flin_zero()) arg2 (rational_of_term arg1))
+ 		      |_-> (* test this *)
+		           let tmp = flin_of_term arg2 in
+			   flin_emult (rational_of_term arg1) (tmp)
+
+		      )
+		      else
+		      (  (*prodotto tra razionali*)
+		      (flin_add_cste (flin_zero()) (rmult (rational_of_term arg1) (rational_of_term arg2)))  
+		      )
+  			(*try
+			begin
+			(*let a = rational_of_term arg1 in
+			debug("ho fatto rational of term di "^CicPp.ppterm arg1^
+			 " e ho ottenuto "^string_of_int a.num^"/"^string_of_int a.den^"\n");*)
+			let a = flin_of_term arg1  
+                   	try 
+				begin
+				let b = (rational_of_term arg2) in
+				debug("ho fatto rational of term di "^CicPp.ppterm arg2^
+				 " e ho ottenuto "^string_of_int b.num^"/"^string_of_int b.den^"\n");
+			    	(flin_add_cste (flin_zero()) (rmult a b))
+				end
+		   	with 
+				_ -> debug ("ho fallito2 su "^CicPp.ppterm arg2^"\n");
+				     (flin_add (flin_zero()) arg2 a)
+			end
+	      	with 
+			_-> debug ("ho fallito1 su "^CicPp.ppterm arg1^"\n");
+			    (flin_add(flin_zero()) arg1 (rational_of_term arg2))
+			    *)
+		end
+	    |"cic:/Coq/Reals/Rdefinitions/Rinv.con"->
+	       let a=(rational_of_term (List.hd next)) in
+	       flin_add_cste (flin_zero()) (rinv a)
+	    |"cic:/Coq/Reals/Rdefinitions/Rdiv.con"->
+	    	begin
+	      	let b=(rational_of_term (List.hd(List.tl next))) in
+	       	try 
+			begin
+			let a = (rational_of_term (List.hd next)) in
+		        (flin_add_cste (flin_zero()) (rdiv a b))
+			end
+	       	with 
+			_-> (flin_add (flin_zero()) (List.hd next) (rinv b))
+		end
+            |_->assert false
+	    end
+	|_ -> assert false
+	end
+  | Cic.Const (u,boh) ->
+        begin
+	match (UriManager.string_of_uri u) with
+	 "cic:/Coq/Reals/Rdefinitions/R1.con" -> flin_one ()
+        |"cic:/Coq/Reals/Rdefinitions/R0.con" -> flin_zero ()
+        |_-> assert false
+	end
+  |_-> assert false)
+  with _ -> debug("eccezione = "^CicPp.ppterm t^"\n");flin_add (flin_zero()) t r1
+;;
+
+(* coq wrapper
+let flin_of_constr = flin_of_term;;
+*)
+
+(**
+	Translates a flin to (c,x) list
+	@param f a flin
+	@return something like (c1,x1)::(c2,x2)::...::(cn,xn)
+*)
+let flin_to_alist f =
+    let res=ref [] in
+    Hashtbl.iter (fun x c -> res:=(c,x)::(!res)) f;
+    !res
+;;
+
+(* Représentation des hypothèses qui sont des inéquations ou des équations.
+*)
+
+(**
+	The structure for ineq
+*)
+type hineq={hname:Cic.term; (* le nom de l'hypothèse *)
+            htype:string; (* Rlt, Rgt, Rle, Rge, eqTLR ou eqTRL *)
+            hleft:Cic.term;
+            hright:Cic.term;
+            hflin:flin;
+            hstrict:bool}
+;;
+
+(* Transforme une hypothese h:t en inéquation flin<0 ou flin<=0
+*)
+
+let ineq1_of_term (h,t) =
+    match t with (* match t *)
+       Cic.Appl (t1::next) ->
+         let arg1= List.hd next in
+         let arg2= List.hd(List.tl next) in
+         (match t1 with (* match t1 *)
+           Cic.Const (u,boh) ->
+            (match UriManager.string_of_uri u with (* match u *)
+		 "cic:/Coq/Reals/Rdefinitions/Rlt.con" ->
+		 	   [{hname=h;
+                           htype="Rlt";
+		           hleft=arg1;
+			   hright=arg2;
+			   hflin= flin_minus (flin_of_term arg1)
+                                             (flin_of_term arg2);
+			   hstrict=true}]
+		|"cic:/Coq/Reals/Rdefinitions/Rgt.con" ->
+		           [{hname=h;
+                           htype="Rgt";
+		           hleft=arg2;
+			   hright=arg1;
+			   hflin= flin_minus (flin_of_term arg2)
+                                             (flin_of_term arg1);
+			   hstrict=true}]
+		|"cic:/Coq/Reals/Rdefinitions/Rle.con" ->
+                           [{hname=h;
+                           htype="Rle";
+		           hleft=arg1;
+			   hright=arg2;
+			   hflin= flin_minus (flin_of_term arg1)
+                                             (flin_of_term arg2);
+			   hstrict=false}]
+		|"cic:/Coq/Reals/Rdefinitions/Rge.con" ->
+                           [{hname=h;
+                           htype="Rge";
+		           hleft=arg2;
+			   hright=arg1;
+			   hflin= flin_minus (flin_of_term arg2)
+                                             (flin_of_term arg1);
+			   hstrict=false}]
+                |_->assert false)(* match u *)
+          | Cic.MutInd (u,i,o) ->
+              (match UriManager.string_of_uri u with 
+		 "cic:/Coq/Init/Logic_Type/eqT.ind" ->  
+		 	   let t0= arg1 in
+                           let arg1= arg2 in
+                           let arg2= List.hd(List.tl (List.tl next)) in
+		    (match t0 with
+                         Cic.Const (u,boh) ->
+			   (match UriManager.string_of_uri u with
+			      "cic:/Coq/Reals/Rdefinitions/R.con"->
+                         [{hname=h;
+                           htype="eqTLR";
+		           hleft=arg1;
+			   hright=arg2;
+			   hflin= flin_minus (flin_of_term arg1)
+                                             (flin_of_term arg2);
+			   hstrict=false};
+                          {hname=h;
+                           htype="eqTRL";
+		           hleft=arg2;
+			   hright=arg1;
+			   hflin= flin_minus (flin_of_term arg2)
+                                             (flin_of_term arg1);
+			   hstrict=false}]
+                           |_-> assert false)
+                         |_-> assert false)
+                   |_-> assert false)
+          |_-> assert false)(* match t1 *)
+        |_-> assert false (* match t *)
+;;
+(* coq wrapper 
+let ineq1_of_constr = ineq1_of_term;;
+*)
+
+(* Applique la méthode de Fourier à une liste d'hypothèses (type hineq)
+*)
+
+let rec print_rl l =
+ match l with
+ []-> ()
+ | a::next -> Fourier.print_rational a ; print_string " " ; print_rl next
+;;
+
+let rec print_sys l =
+ match l with
+ [] -> ()
+ | (a,b)::next -> (print_rl a;
+ 		print_string (if b=true then "strict\n"else"\n");
+		print_sys next)
+ ;;
+
+(*let print_hash h =
+	Hashtbl.iter (fun x y -> print_string ("("^"-"^","^"-"^")")) h
+;;*)
+
+let fourier_lineq lineq1 = 
+   let nvar=ref (-1) in
+   let hvar=Hashtbl.create 50 in (* la table des variables des inéquations *)
+   List.iter (fun f ->
+               Hashtbl.iter (fun x c ->
+				 try (Hashtbl.find hvar x;())
+				 with _-> nvar:=(!nvar)+1;
+   				          Hashtbl.add hvar x (!nvar);
+					  debug("aggiungo una var "^
+					   string_of_int !nvar^" per "^
+					    CicPp.ppterm x^"\n"))
+                            f.hflin.fhom)
+             lineq1;
+   (*print_hash hvar;*)
+   debug("Il numero di incognite e' "^string_of_int (!nvar+1)^"\n");
+   let sys= List.map (fun h->
+               let v=Array.create ((!nvar)+1) r0 in
+               Hashtbl.iter (fun x c -> v.(Hashtbl.find hvar x) <- c) 
+                  h.hflin.fhom;
+               ((Array.to_list v)@[rop h.hflin.fcste],h.hstrict))
+             lineq1 in
+   debug ("chiamo unsolvable sul sistema di "^ 
+    string_of_int (List.length sys) ^"\n");
+   print_sys sys;
+   unsolvable sys
+;;
+
+(*****************************************************************************
+Construction de la preuve en cas de succès de la méthode de Fourier,
+i.e. on obtient une contradiction.
+*)
+
+
+let _eqT = Cic.MutInd((UriManager.uri_of_string
+ "cic:/Coq/Init/Logic_Type/eqT.ind"), 0, []) ;;
+let _False = Cic.MutInd ((UriManager.uri_of_string
+ "cic:/Coq/Init/Logic/False.ind"), 0, []) ;;
+let _not = Cic.Const ((UriManager.uri_of_string
+ "cic:/Coq/Init/Logic/not.con"), []);;
+let _R0 = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/Reals/Rdefinitions/R0.con"), []) ;;
+let _R1 = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/Reals/Rdefinitions/R1.con"), []) ;;
+let _R = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/Reals/Rdefinitions/R.con"), []) ;;
+let _Rfourier_eqLR_to_le=Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rfourier_eqLR_to_le.con"), []) ;;
+let _Rfourier_eqRL_to_le=Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rfourier_eqRL_to_le.con"), []) ;;
+let _Rfourier_ge_to_le  =Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rfourier_ge_to_le.con"), []) ;;
+let _Rfourier_gt_to_lt 	=Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rfourier_gt_to_lt.con"), []) ;;
+let _Rfourier_le=Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rfourier_le.con"), []) ;;
+let _Rfourier_le_le =Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rfourier_le_le.con"), []) ;;
+let _Rfourier_le_lt =Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rfourier_le_lt.con"), []) ;;
+let _Rfourier_lt=Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rfourier_lt.con"), []) ;;
+let _Rfourier_lt_le =Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rfourier_lt_le.con"), []) ;;
+let _Rfourier_lt_lt =Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rfourier_lt_lt.con"), []) ;;
+let _Rfourier_not_ge_lt = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rfourier_not_ge_lt.con"), []) ;;
+let _Rfourier_not_gt_le = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rfourier_not_gt_le.con"), []) ;;
+let _Rfourier_not_le_gt = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rfourier_not_le_gt.con"), []) ;;
+let _Rfourier_not_lt_ge = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rfourier_not_lt_ge.con"), []) ;;
+let _Rinv  = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/Reals/Rdefinitions/Rinv.con"), []) ;;
+let _Rinv_R1 = Cic.Const((UriManager.uri_of_string 
+ "cic:/Coq/Reals/Rbase/Rinv_R1.con" ), []) ;;
+let _Rle = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/Reals/Rdefinitions/Rle.con"), []) ;;
+let _Rle_mult_inv_pos =  Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rle_mult_inv_pos.con"), []) ;;
+let _Rle_not_lt = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rle_not_lt.con"), []) ;;
+let _Rle_zero_1 = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rle_zero_1.con"), []) ;;
+let _Rle_zero_pos_plus1 =  Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rle_zero_pos_plus1.con"), []) ;;
+(*let _Rle_zero_zero = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rle_zero_zero.con"), []) ;;*)
+let _Rlt = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/Reals/Rdefinitions/Rlt.con"), []) ;;
+let _Rlt_mult_inv_pos = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rlt_mult_inv_pos.con"), []) ;;
+let _Rlt_not_le =  Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rlt_not_le.con"), []) ;;
+let _Rlt_zero_1 = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rlt_zero_1.con"), []) ;;
+let _Rlt_zero_pos_plus1 = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rlt_zero_pos_plus1.con"), []) ;;
+let _Rminus = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/Reals/Rdefinitions/Rminus.con"), []) ;;
+let _Rmult = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/Reals/Rdefinitions/Rmult.con"), []) ;;
+let _Rnot_le_le =Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rnot_le_le.con"), []) ;;
+let _Rnot_lt0 = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rnot_lt0.con"), []) ;;
+let _Rnot_lt_lt =Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/fourier/Fourier_util/Rnot_lt_lt.con"), []) ;;
+let _Ropp = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/Reals/Rdefinitions/Ropp.con"), []) ;;
+let _Rplus = Cic.Const ((UriManager.uri_of_string 
+ "cic:/Coq/Reals/Rdefinitions/Rplus.con"), []) ;;
+
+(******************************************************************************)
+
+let is_int x = (x.den)=1
+;;
+
+(* fraction = couple (num,den) *)
+let rec rational_to_fraction x= (x.num,x.den)
+;;
+    
+(* traduction -3 -> (Ropp (Rplus R1 (Rplus R1 R1)))
+*)
+
+let rec int_to_real_aux n =
+  match n with
+    0 -> _R0 (* o forse R0 + R0 ????? *)
+  | 1 -> _R1
+  | _ -> Cic.Appl [ _Rplus ; _R1 ; int_to_real_aux (n-1) ]
+;;	
+	
+
+let int_to_real n =
+   let x = int_to_real_aux (abs n) in
+   if n < 0 then
+   	Cic.Appl [ _Ropp ; x ] 
+   else
+   	x
+;;
+
+
+(* -1/2 -> (Rmult (Ropp R1) (Rinv (Rplus R1 R1)))
+*)
+
+let rational_to_real x =
+   let (n,d)=rational_to_fraction x in 
+   Cic.Appl [ _Rmult ; int_to_real n ; Cic.Appl [ _Rinv ; int_to_real d ]  ]
+;;
+
+(* preuve que 0 m=goal) metasenv in
+     debug ("th = "^ CicPp.ppterm t ^"\n"); 
+     debug ("ty = "^ CicPp.ppterm ty^"\n"); 
+   in
+   let tacn=ref 
+     (fun ~status -> pall "n0" ~status _Rlt_zero_1 ;
+       PrimitiveTactics.apply_tac ~term:_Rlt_zero_1 ~status ) in
+   let tacd=ref 
+     (fun ~status -> pall "d0" ~status _Rlt_zero_1 ;
+       PrimitiveTactics.apply_tac ~term:_Rlt_zero_1 ~status ) in
+
+
+  for i=1 to n-1 do 
+       tacn:=(Tacticals.then_ ~start:(fun ~status -> pall ("n"^string_of_int i) 
+        ~status _Rlt_zero_pos_plus1;
+	 PrimitiveTactics.apply_tac ~term:_Rlt_zero_pos_plus1 ~status) 
+	  ~continuation:!tacn); 
+  done;
+  for i=1 to d-1 do
+       tacd:=(Tacticals.then_ ~start:(fun ~status -> pall "d" 
+        ~status _Rlt_zero_pos_plus1 ;PrimitiveTactics.apply_tac 
+	 ~term:_Rlt_zero_pos_plus1 ~status) ~continuation:!tacd); 
+  done;
+
+
+
+debug("TAC ZERO INF POS\n");
+
+(Tacticals.thens ~start:(PrimitiveTactics.apply_tac ~term:_Rlt_mult_inv_pos) 
+  ~continuations:[
+   !tacn ;
+   !tacd ] 
+  ~status)
+;;
+
+
+
+(* preuve que 0<=n*1/d
+*)
+ 
+let tac_zero_infeq_pos gl (n,d) ~status =
+ (*let cste = pf_parse_constr gl in*)
+ debug("inizio tac_zero_infeq_pos\n");
+ let tacn = ref 
+  (*(if n=0 then
+    (PrimitiveTactics.apply_tac ~term:_Rle_zero_zero ) 
+   else*)
+    (PrimitiveTactics.apply_tac ~term:_Rle_zero_1 )
+ (* ) *)
+  in
+  let tacd=ref (PrimitiveTactics.apply_tac ~term:_Rlt_zero_1 ) in
+  for i=1 to n-1 do 
+      tacn:=(Tacticals.then_ ~start:(PrimitiveTactics.apply_tac 
+       ~term:_Rle_zero_pos_plus1) ~continuation:!tacn); 
+  done;
+  for i=1 to d-1 do
+      tacd:=(Tacticals.then_ ~start:(PrimitiveTactics.apply_tac 
+       ~term:_Rlt_zero_pos_plus1) ~continuation:!tacd); 
+  done;
+  let r = 
+  (Tacticals.thens ~start:(PrimitiveTactics.apply_tac 
+   ~term:_Rle_mult_inv_pos) ~continuations:[!tacn;!tacd]) ~status in
+   debug("fine tac_zero_infeq_pos\n");
+   r
+;;
+
+
+ 
+(* preuve que 0<(-n)*(1/d) => False 
+*)
+
+let tac_zero_inf_false gl (n,d) ~status=
+  debug("inizio tac_zero_inf_false\n");
+    if n=0 then 
+     (debug "1\n";let r =(PrimitiveTactics.apply_tac ~term:_Rnot_lt0 ~status) in
+     debug("fine\n");
+     r)
+    else
+     (debug "2\n";let r = (Tacticals.then_ ~start:(
+       fun ~status:(proof,goal as status) -> 
+       let curi,metasenv,pbo,pty = proof in
+       let metano,context,ty =List.find (function (m,_,_) -> m=goal) metasenv in
+         debug("!!!!!!!!!1: unify "^CicPp.ppterm _Rle_not_lt^" with "
+         ^ CicPp.ppterm ty ^"\n");
+       let r = PrimitiveTactics.apply_tac ~term:_Rle_not_lt ~status in
+       debug("!!!!!!!!!2\n");
+       r
+       )
+     ~continuation:(tac_zero_infeq_pos gl (-n,d))) ~status in
+     debug("fine\n");
+     r
+     )
+;;
+
+(* preuve que 0<=n*(1/d) => False ; n est negatif
+*)
+
+let tac_zero_infeq_false gl (n,d) ~status:(proof,goal as status)=
+debug("stat tac_zero_infeq_false\n");
+let r = 
+     let curi,metasenv,pbo,pty = proof in
+     let metano,context,ty =List.find (function (m,_,_) -> m=goal) metasenv in
+     
+     debug("faccio fold di " ^ CicPp.ppterm
+            (Cic.Appl
+              [_Rle ; _R0 ;
+               Cic.Appl
+                [_Rmult ; int_to_real n ; Cic.Appl [_Rinv ; int_to_real d]]
+              ]
+            ) ^ "\n") ;
+     debug("apply di _Rlt_not_le a "^ CicPp.ppterm ty ^"\n");
+     (*CSC: Patch to undo the over-simplification of RewriteSimpl *)
+     Tacticals.then_
+      ~start:
+        (ReductionTactics.fold_tac ~reduction:CicReduction.whd
+          ~also_in_hypotheses:false
+          ~term:
+            (Cic.Appl
+              [_Rle ; _R0 ;
+               Cic.Appl
+                [_Rmult ; int_to_real n ; Cic.Appl [_Rinv ; int_to_real d]]
+              ]
+            )
+        )
+      ~continuation:
+        (Tacticals.then_ ~start:(PrimitiveTactics.apply_tac ~term:_Rlt_not_le)
+	  ~continuation:(tac_zero_inf_pos (-n,d))) ~status in
+ debug("end tac_zero_infeq_false\n");
+ r
+(*PORTING
+ Tacticals.id_tac ~status
+*)
+;;
+
+
+(* *********** ********** ******** ??????????????? *********** **************)
+
+let apply_type_tac ~cast:t ~applist:al ~status:(proof,goal) = 
+  let curi,metasenv,pbo,pty = proof in
+  let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+  let fresh_meta = ProofEngineHelpers.new_meta proof in
+  let irl =
+   ProofEngineHelpers.identity_relocation_list_for_metavariable context in
+  let metasenv' = (fresh_meta,context,t)::metasenv in
+   let proof' = curi,metasenv',pbo,pty in
+    let proof'',goals =
+     PrimitiveTactics.apply_tac 
+      (*~term:(Cic.Appl ((Cic.Cast (Cic.Meta (fresh_meta,irl),t))::al)) (* ??? *)*)
+      ~term:(Cic.Appl ((Cic.Meta (fresh_meta,irl))::al)) (* ??? *)
+       ~status:(proof',goal)
+    in
+     proof'',fresh_meta::goals
+;;
+
+
+
+
+   
+let my_cut ~term:c ~status:(proof,goal)=
+  let curi,metasenv,pbo,pty = proof in
+  let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+
+debug("my_cut di "^CicPp.ppterm c^"\n");
+
+
+  let fresh_meta = ProofEngineHelpers.new_meta proof in
+  let irl =
+   ProofEngineHelpers.identity_relocation_list_for_metavariable context in
+  let metasenv' = (fresh_meta,context,c)::metasenv in
+   let proof' = curi,metasenv',pbo,pty in
+    let proof'',goals =
+     apply_type_tac ~cast:(Cic.Prod(Cic.Name "Anonymous",c,
+      CicSubstitution.lift 1 ty)) ~applist:[Cic.Meta(fresh_meta,irl)] 
+       ~status:(proof',goal)
+    in
+     (* We permute the generated goals to be consistent with Coq *)
+     match goals with
+        [] -> assert false
+      | he::tl -> proof'',he::fresh_meta::tl
+;;
+
+
+let exact = PrimitiveTactics.exact_tac;;
+
+let tac_use h ~status:(proof,goal as status) = 
+debug("Inizio TC_USE\n");
+let curi,metasenv,pbo,pty = proof in
+let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+debug ("hname = "^ CicPp.ppterm h.hname ^"\n"); 
+debug ("ty = "^ CicPp.ppterm ty^"\n"); 
+
+let res = 
+match h.htype with
+  "Rlt" -> exact ~term:h.hname ~status
+  |"Rle" -> exact ~term:h.hname ~status
+  |"Rgt" -> (Tacticals.then_ ~start:(PrimitiveTactics.apply_tac 
+             ~term:_Rfourier_gt_to_lt) 
+	      ~continuation:(exact ~term:h.hname)) ~status
+  |"Rge" -> (Tacticals.then_ ~start:(PrimitiveTactics.apply_tac 
+             ~term:_Rfourier_ge_to_le)
+              ~continuation:(exact ~term:h.hname)) ~status
+  |"eqTLR" -> (Tacticals.then_ ~start:(PrimitiveTactics.apply_tac 
+               ~term:_Rfourier_eqLR_to_le)
+                ~continuation:(exact ~term:h.hname)) ~status
+  |"eqTRL" -> (Tacticals.then_ ~start:(PrimitiveTactics.apply_tac 
+               ~term:_Rfourier_eqRL_to_le)
+                ~continuation:(exact ~term:h.hname)) ~status
+  |_->assert false
+in
+debug("Fine TAC_USE\n");
+res
+;;
+
+
+
+let is_ineq (h,t) =
+    match t with
+       Cic.Appl ( Cic.Const(u,boh)::next) ->
+         (match (UriManager.string_of_uri u) with
+		 "cic:/Coq/Reals/Rdefinitions/Rlt.con" -> true
+		|"cic:/Coq/Reals/Rdefinitions/Rgt.con" -> true
+		|"cic:/Coq/Reals/Rdefinitions/Rle.con" -> true
+		|"cic:/Coq/Reals/Rdefinitions/Rge.con" -> true
+		|"cic:/Coq/Init/Logic_Type/eqT.con" ->
+                   (match (List.hd next) with
+                       Cic.Const (uri,_) when
+                        UriManager.string_of_uri uri =
+                        "cic:/Coq/Reals/Rdefinitions/R.con" -> true
+                     | _ -> false)
+                |_->false)
+     |_->false
+;;
+
+let list_of_sign s = List.map (fun (x,_,z)->(x,z)) s;;
+
+let mkAppL a =
+   Cic.Appl(Array.to_list a)
+;;
+
+(* Résolution d'inéquations linéaires dans R *)
+let rec strip_outer_cast c = match c with
+  | Cic.Cast (c,_) -> strip_outer_cast c
+  | _ -> c
+;;
+
+(*let find_in_context id context =
+  let rec find_in_context_aux c n =
+  	match c with
+	[] -> failwith (id^" not found in context")      
+	| a::next -> (match a with 
+			Some (Cic.Name(name),_) when name = id -> n 
+			      (*? magari al posto di _ qualcosaltro?*)
+			| _ -> find_in_context_aux next (n+1))
+  in 
+  find_in_context_aux context 1 
+;;
+
+(* mi sembra quadratico *)
+let rec filter_real_hyp context cont =
+  match context with
+  [] -> []
+  | Some(Cic.Name(h),Cic.Decl(t))::next -> (
+  				let n = find_in_context h cont in
+				debug("assegno "^string_of_int n^" a "^CicPp.ppterm t^"\n");
+  			[(Cic.Rel(n),t)] @ filter_real_hyp next cont)
+  | a::next -> debug("  no\n"); filter_real_hyp next cont
+;;*)
+let filter_real_hyp context _ =
+  let rec filter_aux context num =
+   match context with
+  [] -> []
+  | Some(Cic.Name(h),Cic.Decl(t))::next -> 
+  		(
+  		(*let n = find_in_context h cont in*)
+		debug("assegno "^string_of_int num^" a "^h^":"^CicPp.ppterm t^"\n");
+  		[(Cic.Rel(num),t)] @ filter_aux next (num+1)
+		)
+  | a::next -> filter_aux next (num+1)
+  in
+  filter_aux context 1
+;;
+
+
+(* lifts everithing at the conclusion level *)	
+let rec superlift c n=
+  match c with
+  [] -> []
+  | Some(name,Cic.Decl(a))::next  -> [Some(name,Cic.Decl(
+                  CicSubstitution.lift n a))] @ superlift next (n+1)
+  | Some(name,Cic.Def(a))::next   -> [Some(name,Cic.Def(
+                  CicSubstitution.lift n a))] @ superlift next (n+1)
+  | _::next -> superlift next (n+1) (*??  ??*)
+ 
+;;
+
+let equality_replace a b ~status =
+debug("inizio EQ\n");
+ let module C = Cic in
+  let proof,goal = status in
+  let curi,metasenv,pbo,pty = proof in
+  let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+   let a_eq_b = C.Appl [ _eqT ; _R ; a ; b ] in
+   let fresh_meta = ProofEngineHelpers.new_meta proof in
+   let irl =
+    ProofEngineHelpers.identity_relocation_list_for_metavariable context in
+   let metasenv' = (fresh_meta,context,a_eq_b)::metasenv in
+debug("chamo rewrite tac su"^CicPp.ppterm (C.Meta (fresh_meta,irl)));
+   let (proof,goals) =
+    EqualityTactics.rewrite_simpl_tac ~term:(C.Meta (fresh_meta,irl))
+     ~status:((curi,metasenv',pbo,pty),goal)
+   in
+   let new_goals = fresh_meta::goals in
+debug("fine EQ -> goals : "^string_of_int( List.length new_goals)  ^" = "
+  ^string_of_int( List.length goals)^"+ meta\n");
+    (proof,new_goals)
+;;
+
+let tcl_fail a ~status:(proof,goal) =
+	match a with
+	1 -> raise (ProofEngineTypes.Fail "fail-tactical")
+	|_-> (proof,[goal])
+;;
+
+(* Galla: moved in variousTactics.ml 
+let assumption_tac ~status:(proof,goal)=
+  let curi,metasenv,pbo,pty = proof in
+  let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+  let num = ref 0 in
+  let tac_list = List.map 
+  	( fun x -> num := !num + 1;
+		match x with
+		  Some(Cic.Name(nm),t) -> (nm,exact ~term:(Cic.Rel(!num)))
+		  | _ -> ("fake",tcl_fail 1)
+	)  
+  	context 
+  in
+  Tacticals.try_tactics ~tactics:tac_list ~status:(proof,goal)
+;;
+*)
+(* Galla: moved in negationTactics.ml
+(* !!!!! fix !!!!!!!!!! *)
+let contradiction_tac ~status:(proof,goal)=
+	Tacticals.then_ 
+                (*inutile sia questo che quello prima  della chiamata*)
+		~start:PrimitiveTactics.intros_tac
+		~continuation:(Tacticals.then_ 
+			~start:(VariousTactics.elim_type_tac ~term:_False) 
+			~continuation:(assumption_tac))
+	~status:(proof,goal) 
+;;
+*)
+
+(* ********************* TATTICA ******************************** *)
+
+let rec fourier ~status:(s_proof,s_goal)=
+  let s_curi,s_metasenv,s_pbo,s_pty = s_proof in
+  let s_metano,s_context,s_ty = List.find (function (m,_,_) -> m=s_goal) 
+   s_metasenv in
+	
+  debug ("invoco fourier_tac sul goal "^string_of_int(s_goal)^" e contesto :\n");
+  debug_pcontext s_context;
+
+  let fhyp = String.copy "new_hyp_for_fourier" in 
+   
+(* here we need to negate the thesis, but to do this we need to apply the right
+theoreme,so let's parse our thesis *)
+  
+  let th_to_appl = ref _Rfourier_not_le_gt in   
+  (match s_ty with
+   Cic.Appl ( Cic.Const(u,boh)::args) ->
+    (match UriManager.string_of_uri u with
+       "cic:/Coq/Reals/Rdefinitions/Rlt.con" -> th_to_appl := 
+               _Rfourier_not_ge_lt
+       |"cic:/Coq/Reals/Rdefinitions/Rle.con" -> th_to_appl := 
+               _Rfourier_not_gt_le
+       |"cic:/Coq/Reals/Rdefinitions/Rgt.con" -> th_to_appl := 
+               _Rfourier_not_le_gt
+       |"cic:/Coq/Reals/Rdefinitions/Rge.con" -> th_to_appl := 
+               _Rfourier_not_lt_ge
+       |_-> failwith "fourier can't be applyed")
+   |_-> failwith "fourier can't be applyed"); 
+   (* fix maybe strip_outer_cast goes here?? *)
+
+   (* now let's change our thesis applying the th and put it with hp *) 
+
+   let proof,gl =
+    Tacticals.then_ 
+     ~start:(PrimitiveTactics.apply_tac ~term:!th_to_appl)
+     ~continuation:(PrimitiveTactics.intros_tac ())
+     ~status:(s_proof,s_goal) in
+   let goal = if List.length gl = 1 then List.hd gl 
+                                    else failwith "a new goal" in
+
+   debug ("port la tesi sopra e la nego. contesto :\n");
+   debug_pcontext s_context;
+
+   (* now we have all the right environment *)
+   
+   let curi,metasenv,pbo,pty = proof in
+   let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+
+
+   (* now we want to convert hp to inequations, but first we must lift
+      everyting to thesis level, so that a variable has the save Rel(n) 
+      in each hp ( needed by ineq1_of_term ) *)
+    
+    (* ? fix if None  ?????*)
+    (* fix change superlift with a real name *)
+
+  let l_context = superlift context 1 in
+  let hyps = filter_real_hyp l_context l_context in
+  
+  debug ("trasformo in diseq. "^ string_of_int (List.length hyps)^" ipotesi\n");
+  
+  let lineq =ref [] in
+  
+  (* transform hyps into inequations *)
+  
+  List.iter (fun h -> try (lineq:=(ineq1_of_term h)@(!lineq))
+		        with _-> ())
+              hyps;
+
+	    
+  debug ("applico fourier a "^ string_of_int (List.length !lineq)^
+         " disequazioni\n");
+
+  let res=fourier_lineq (!lineq) in
+  let tac=ref Tacticals.id_tac in
+  if res=[] then 
+  	(print_string "Tactic Fourier fails.\n";flush stdout;
+	 failwith "fourier_tac fails")
+  else 
+  (
+  match res with (*match res*)
+  [(cres,sres,lc)]->
+  
+     (* in lc we have the coefficient to "reduce" the system *)
+     
+     print_string "Fourier's method can prove the goal...\n";flush stdout;
+         
+     debug "I coeff di moltiplicazione rit sono: ";
+     
+     let lutil=ref [] in
+     List.iter 
+        (fun (h,c) -> if c<>r0 then (lutil:=(h,c)::(!lutil);
+	   (* DBG *)Fourier.print_rational(c);print_string " "(* DBG *))
+				     )
+        (List.combine (!lineq) lc); 
+	
+     print_string (" quindi lutil e' lunga "^
+      string_of_int (List.length (!lutil))^"\n");		   
+       
+     (* on construit la combinaison linéaire des inéquation *)
+     
+     (match (!lutil) with (*match (!lutil) *)
+       (h1,c1)::lutil ->
+       debug ("elem di lutil ");Fourier.print_rational c1;print_string "\n"; 
+	  
+       let s=ref (h1.hstrict) in
+	  
+          
+       let t1 = ref (Cic.Appl [_Rmult;rational_to_real c1;h1.hleft] ) in
+       let t2 = ref (Cic.Appl [_Rmult;rational_to_real c1;h1.hright]) in
+
+       List.iter (fun (h,c) ->
+	       s:=(!s)||(h.hstrict);
+	       t1:=(Cic.Appl [_Rplus;!t1;Cic.Appl 
+	             [_Rmult;rational_to_real c;h.hleft ]  ]);
+	       t2:=(Cic.Appl [_Rplus;!t2;Cic.Appl 
+	             [_Rmult;rational_to_real c;h.hright]  ]))
+               lutil;
+	       
+       let ineq=Cic.Appl [(if (!s) then _Rlt else _Rle);!t1;!t2 ] in
+       let tc=rational_to_real cres in
+
+
+(* ora ho i termini che descrivono i passi di fourier per risolvere il sistema *)
+       
+       debug "inizio a costruire tac1\n";
+       Fourier.print_rational(c1);
+	  
+       let tac1=ref ( fun ~status -> 
+	 if h1.hstrict then 
+	   (Tacticals.thens 
+	     ~start:(
+	      fun ~status -> 
+	      debug ("inizio t1 strict\n");
+	      let curi,metasenv,pbo,pty = proof in
+	      let metano,context,ty = List.find 
+	       (function (m,_,_) -> m=goal) metasenv in
+	      debug ("th = "^ CicPp.ppterm _Rfourier_lt ^"\n"); 
+	      debug ("ty = "^ CicPp.ppterm ty^"\n"); 
+              PrimitiveTactics.apply_tac ~term:_Rfourier_lt ~status)
+            ~continuations:[tac_use h1;tac_zero_inf_pos  
+             (rational_to_fraction c1)] 
+	    ~status
+	   )
+           else 
+	   (Tacticals.thens 
+	     ~start:(PrimitiveTactics.apply_tac ~term:_Rfourier_le)
+             ~continuations:[tac_use h1;tac_zero_inf_pos
+	      (rational_to_fraction c1)] ~status
+	   )
+	 )
+       	    
+       in
+       s:=h1.hstrict;
+       List.iter (fun (h,c) -> 
+         (if (!s) then 
+	   (if h.hstrict then 
+	     (debug("tac1 1\n");
+	     tac1:=(Tacticals.thens 
+	       ~start:(PrimitiveTactics.apply_tac 
+	        ~term:_Rfourier_lt_lt)
+	       ~continuations:[!tac1;tac_use h;tac_zero_inf_pos
+	        (rational_to_fraction c)])
+	     )
+	   else 
+	     (debug("tac1 2\n");
+	     Fourier.print_rational(c1);
+	     tac1:=(Tacticals.thens 
+	      ~start:(
+	        fun ~status -> 
+	        debug("INIZIO TAC 1 2\n");
+	        let curi,metasenv,pbo,pty = proof in
+	        let metano,context,ty = List.find (function (m,_,_) -> m=goal) 
+	         metasenv in
+	        debug ("th = "^ CicPp.ppterm _Rfourier_lt_le ^"\n"); 
+	        debug ("ty = "^ CicPp.ppterm ty^"\n"); 
+                PrimitiveTactics.apply_tac ~term:_Rfourier_lt_le ~status)
+	      ~continuations:[!tac1;tac_use h;tac_zero_inf_pos 
+	        (rational_to_fraction c)])
+             )
+           )
+	 else 
+           (if h.hstrict then 
+	     (debug("tac1 3\n");
+	     tac1:=(Tacticals.thens 
+	       ~start:(PrimitiveTactics.apply_tac ~term:_Rfourier_le_lt)
+	       ~continuations:[!tac1;tac_use h;tac_zero_inf_pos  
+                (rational_to_fraction c)])
+	     )
+	   else 
+	     (debug("tac1 4\n");
+	     tac1:=(Tacticals.thens 
+	       ~start:(PrimitiveTactics.apply_tac ~term:_Rfourier_le_le)
+	       ~continuations:[!tac1;tac_use h;tac_zero_inf_pos  
+                (rational_to_fraction c)])
+	     )
+           )
+	 );
+	 s:=(!s)||(h.hstrict)) lutil;(*end List.iter*)
+       	      
+       let tac2 = 
+         if sres then 
+	   tac_zero_inf_false goal (rational_to_fraction cres)
+         else 
+	   tac_zero_infeq_false goal (rational_to_fraction cres)
+       in
+       tac:=(Tacticals.thens 
+         ~start:(my_cut ~term:ineq) 
+         ~continuations:[(*Tacticals.id_tac;Tacticals.id_tac*)(**)Tacticals.then_  
+	   ~start:(fun ~status:(proof,goal as status) ->
+             let curi,metasenv,pbo,pty = proof in
+             let metano,context,ty = List.find (function (m,_,_) -> m=goal) 
+	      metasenv in
+             PrimitiveTactics.change_tac ~what:ty 
+	      ~with_what:(Cic.Appl [ _not; ineq]) ~status)
+	   ~continuation:(Tacticals.then_ 
+             ~start:(PrimitiveTactics.apply_tac ~term:
+	       (if sres then _Rnot_lt_lt else _Rnot_le_le))
+	     ~continuation:(Tacticals.thens 
+	       ~start:( 
+		 fun ~status ->
+		 debug("t1 ="^CicPp.ppterm !t1 ^"t2 ="^CicPp.ppterm !t2 ^"tc="^ CicPp.ppterm tc^"\n");
+		 let r = equality_replace (Cic.Appl [_Rminus;!t2;!t1] ) tc 
+		  ~status
+		 in
+		 (match r with (p,gl) -> 
+		   debug("eq1 ritorna "^string_of_int(List.length gl)^"\n" ));
+                 r)
+	       ~continuations:[(Tacticals.thens 
+		 ~start:(
+		   fun ~status ->
+		   let r = equality_replace (Cic.Appl[_Rinv;_R1]) _R1 ~status in
+		   (match r with (p,gl) ->
+		     debug("eq2 ritorna "^string_of_int(List.length gl)^"\n" ));
+		   r)
+		 ~continuations:
+                   [PrimitiveTactics.apply_tac ~term:_Rinv_R1
+		 ;Tacticals.try_tactics 
+		   ~tactics:[ "ring", (fun ~status -> 
+				        debug("begin RING\n");
+					let r = Ring.ring_tac  ~status in
+					debug ("end RING\n");
+					r)
+			; "id", Tacticals.id_tac] 
+		 ])
+	       ;(*Tacticals.id_tac*)
+	        Tacticals.then_ 
+	         ~start:
+		  (
+		  fun ~status:(proof,goal as status) ->
+		   let curi,metasenv,pbo,pty = proof in
+        	   let metano,context,ty = List.find (function (m,_,_) -> m=
+		    goal) metasenv in
+		   (* check if ty is of type *)
+		   let w1 = 
+		     debug("qui c'e' gia' l'or "^CicPp.ppterm ty^"\n");
+		     (match ty with
+		     Cic.Prod (Cic.Anonymous,a,b) -> (Cic.Appl [_not;a])
+		     |_ -> assert false)
+		   in
+		   let r = PrimitiveTactics.change_tac ~what:ty ~with_what:w1 ~status in
+		   debug("fine MY_CHNGE\n");
+		   r
+		   
+		  ) 
+		 ~continuation:(*PORTINGTacticals.id_tac*)tac2]))
+	 ;(*Tacticals.id_tac*)!tac1]);(*end tac:=*)
+
+    |_-> assert false)(*match (!lutil) *)
+  |_-> assert false); (*match res*)
+  debug ("finalmente applico tac\n");
+  (
+  let r = !tac ~status:(proof,goal) in
+  debug("\n\n]]]]]]]]]]]]]]]]]) That's all folks ([[[[[[[[[[[[[[[[[[[\n\n");r
+  
+  ) 
+;;
+
+let fourier_tac ~status:(proof,goal) = fourier ~status:(proof,goal);;
+
+
diff --git a/helm/gTopLevel/fourierR.mli b/helm/ocaml/tactics/fourierR.mli
similarity index 61%
rename from helm/gTopLevel/fourierR.mli
rename to helm/ocaml/tactics/fourierR.mli
index fbd55e685..e5790ec0f 100644
--- a/helm/gTopLevel/fourierR.mli
+++ b/helm/ocaml/tactics/fourierR.mli
@@ -1,2 +1,5 @@
+(* 
+val rewrite_tac: term:Cic.term -> ProofEngineTypes.tactic
 val rewrite_simpl_tac: term:Cic.term -> ProofEngineTypes.tactic
+*)
 val fourier_tac: ProofEngineTypes.tactic
diff --git a/helm/ocaml/tactics/introductionTactics.ml b/helm/ocaml/tactics/introductionTactics.ml
new file mode 100644
index 000000000..6318f4890
--- /dev/null
+++ b/helm/ocaml/tactics/introductionTactics.ml
@@ -0,0 +1,60 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+
+let constructor_tac ~n ~status:(proof, goal) =
+  let module C = Cic in
+  let module R = CicReduction in
+   let (_,metasenv,_,_) = proof in
+    let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+     match (R.whd context ty) with
+        (C.MutInd (uri, typeno, exp_named_subst))
+      | (C.Appl ((C.MutInd (uri, typeno, exp_named_subst))::_)) ->
+         PrimitiveTactics.apply_tac 
+          ~term: (C.MutConstruct (uri, typeno, n, exp_named_subst))
+          ~status:(proof, goal)
+      | _ -> raise (ProofEngineTypes.Fail "Constructor: failed")
+;;
+
+
+let exists_tac ~status =
+  constructor_tac ~n:1 ~status
+;;
+
+
+let split_tac ~status =
+  constructor_tac ~n:1 ~status
+;;
+
+
+let left_tac ~status =
+  constructor_tac ~n:1 ~status
+;;
+
+
+let right_tac ~status =
+  constructor_tac ~n:2 ~status
+;;
+
diff --git a/helm/ocaml/tactics/introductionTactics.mli b/helm/ocaml/tactics/introductionTactics.mli
new file mode 100644
index 000000000..c3a12720b
--- /dev/null
+++ b/helm/ocaml/tactics/introductionTactics.mli
@@ -0,0 +1,31 @@
+(* Copyright (C) 2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val constructor_tac: n:int -> ProofEngineTypes.tactic
+
+val exists_tac: ProofEngineTypes.tactic
+val split_tac: ProofEngineTypes.tactic
+val left_tac: ProofEngineTypes.tactic
+val right_tac: ProofEngineTypes.tactic
diff --git a/helm/ocaml/tactics/negationTactics.ml b/helm/ocaml/tactics/negationTactics.ml
new file mode 100644
index 000000000..25c29918f
--- /dev/null
+++ b/helm/ocaml/tactics/negationTactics.ml
@@ -0,0 +1,73 @@
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+
+let absurd_tac ~term ~status:((proof,goal) as status) =
+  let module C = Cic in
+  let module U = UriManager in
+  let module P = PrimitiveTactics in
+   let _,metasenv,_,_ = proof in
+    let _,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+     if ((CicTypeChecker.type_of_aux' metasenv context term) = (C.Sort C.Prop)) (* ma questo controllo serve?? *)
+      then P.apply_tac 
+              ~term:(C.Appl [(C.Const ((U.uri_of_string "cic:/Coq/Init/Logic/absurd.con") , [] )) ; term ; ty]) ~status
+      else raise (ProofEngineTypes.Fail "Absurd: Not a Proposition")
+;;
+
+
+let contradiction_tac ~status =
+  let module C = Cic in
+  let module U = UriManager in
+  let module P = PrimitiveTactics in
+  let module T = Tacticals in
+   try
+    T.then_
+      ~start:(P.intros_tac ())
+      ~continuation:(
+        T.then_
+           ~start:
+             (EliminationTactics.elim_type_tac 
+                ~term:
+                  (C.MutInd ((U.uri_of_string "cic:/Coq/Init/Logic/False.ind"), 0, [])))
+           ~continuation: VariousTactics.assumption_tac)
+    ~status
+   with 
+    (ProofEngineTypes.Fail "Assumption: No such assumption") -> raise (ProofEngineTypes.Fail "Contradiction: No such assumption")
+    (* sarebbe piu' elegante se Assumtion sollevasse un'eccezione tutta sua che questa cattura, magari con l'aiuto di try_tactics *)
+;;
+
+(* Questa era in fourierR.ml
+(* !!!!! fix !!!!!!!!!! *)
+let contradiction_tac ~status:(proof,goal)=
+        Tacticals.then_
+                ~start:(PrimitiveTactics.intros_tac ~name:"bo?" ) (*inutile sia questo che quello prima  della chiamata*)
+                ~continuation:(Tacticals.then_
+                        ~start:(VariousTactics.elim_type_tac ~term:_False)
+                        ~continuation:(assumption_tac))
+        ~status:(proof,goal)
+;;
+*)
+
+
diff --git a/helm/ocaml/tactics/negationTactics.mli b/helm/ocaml/tactics/negationTactics.mli
new file mode 100644
index 000000000..bfa3e8d5d
--- /dev/null
+++ b/helm/ocaml/tactics/negationTactics.mli
@@ -0,0 +1,28 @@
+(* Copyright (C) 2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val absurd_tac: term:Cic.term -> ProofEngineTypes.tactic
+val contradiction_tac: ProofEngineTypes.tactic
+
diff --git a/helm/gTopLevel/primitiveTactics.ml b/helm/ocaml/tactics/primitiveTactics.ml
similarity index 67%
rename from helm/gTopLevel/primitiveTactics.ml
rename to helm/ocaml/tactics/primitiveTactics.ml
index bf65d1a7b..91cd6198e 100644
--- a/helm/gTopLevel/primitiveTactics.ml
+++ b/helm/ocaml/tactics/primitiveTactics.ml
@@ -29,9 +29,7 @@ open ProofEngineTypes
 exception NotAnInductiveTypeToEliminate
 exception NotTheRightEliminatorShape
 exception NoHypothesesFound
-
-(* TODO problemone del fresh_name, aggiungerlo allo status? *)
-let fresh_name () = "FOO"
+exception WrongUriToVariable of string
 
 (* lambda_abstract newmeta ty *)
 (* returns a triple [bo],[context],[ty'] where              *)
@@ -39,18 +37,13 @@ let fresh_name () = "FOO"
 (* and [bo] = Lambda/LetIn [context].(Meta [newmeta])       *)
 (* So, lambda_abstract is the core of the implementation of *)
 (* the Intros tactic.                                       *)
-let lambda_abstract context newmeta ty name =
+let lambda_abstract context newmeta ty mk_fresh_name =
  let module C = Cic in
   let rec collect_context context =
    function
       C.Cast (te,_)   -> collect_context context te
     | C.Prod (n,s,t)  ->
-       let n' =
-        match n with
-           C.Name _ -> n
-(*CSC: generatore di nomi? Chiedere il nome? *)
-         | C.Anonimous -> C.Name name
-       in
+       let n' = mk_fresh_name context n ~typ:s in
         let (context',ty,bo) =
          collect_context ((Some (n',(C.Decl s)))::context) t
         in
@@ -74,7 +67,9 @@ let eta_expand metasenv context t arg =
    function
       t' when t' = S.lift n arg -> C.Rel (1 + n)
     | C.Rel m  -> if m <= n then C.Rel m else C.Rel (m+1)
-    | C.Var _
+    | C.Var (uri,exp_named_subst) ->
+       let exp_named_subst' = aux_exp_named_subst n exp_named_subst in
+        C.Var (uri,exp_named_subst')
     | C.Meta _
     | C.Sort _
     | C.Implicit as t -> t
@@ -83,11 +78,17 @@ let eta_expand metasenv context t arg =
     | C.Lambda (nn,s,t) -> C.Lambda (nn, aux n s, aux (n+1) t)
     | C.LetIn (nn,s,t) -> C.LetIn (nn, aux n s, aux (n+1) t)
     | C.Appl l -> C.Appl (List.map (aux n) l)
-    | C.Const _ as t -> t
-    | C.MutInd _
-    | C.MutConstruct _ as t -> t
-    | C.MutCase (sp,cookingsno,i,outt,t,pl) ->
-       C.MutCase (sp,cookingsno,i,aux n outt, aux n t,
+    | C.Const (uri,exp_named_subst) ->
+       let exp_named_subst' = aux_exp_named_subst n exp_named_subst in
+        C.Const (uri,exp_named_subst')
+    | C.MutInd (uri,i,exp_named_subst) ->
+       let exp_named_subst' = aux_exp_named_subst n exp_named_subst in
+        C.MutInd (uri,i,exp_named_subst')
+    | C.MutConstruct (uri,i,j,exp_named_subst) ->
+       let exp_named_subst' = aux_exp_named_subst n exp_named_subst in
+        C.MutConstruct (uri,i,j,exp_named_subst')
+    | C.MutCase (sp,i,outt,t,pl) ->
+       C.MutCase (sp,i,aux n outt, aux n t,
         List.map (aux n) pl)
     | C.Fix (i,fl) ->
        let tylen = List.length fl in
@@ -105,41 +106,16 @@ let eta_expand metasenv context t arg =
            fl
         in
          C.CoFix (i, substitutedfl)
+  and aux_exp_named_subst n =
+   List.map (function uri,t -> uri,aux n t)
   in
    let argty =
     T.type_of_aux' metasenv context arg
    in
-    (C.Appl [C.Lambda ((C.Name "dummy"),argty,aux 0 t) ; arg])
-
-(*CSC: The call to the Intros tactic is embedded inside the code of the *)
-(*CSC: Elim tactic. Do we already need tacticals?                       *)
-(* Auxiliary function for apply: given a type (a backbone), it returns its   *)
-(* head, a META environment in which there is new a META for each hypothesis,*)
-(* a list of arguments for the new applications and the indexes of the first *)
-(* and last new METAs introduced. The nth argument in the list of arguments  *)
-(* is the nth new META lambda-abstracted as much as possible. Hence, this    *)
-(* functions already provides the behaviour of Intros on the new goals.      *)
-let new_metasenv_for_apply_intros proof context ty =
- let module C = Cic in
- let module S = CicSubstitution in
-  let rec aux newmeta =
-   function
-      C.Cast (he,_) -> aux newmeta he
-    | C.Prod (name,s,t) ->
-       let newcontext,ty',newargument =
-         lambda_abstract context newmeta s (fresh_name ())
-       in
-        let (res,newmetasenv,arguments,lastmeta) =
-         aux (newmeta + 1) (S.subst newargument t)
-        in
-         res,(newmeta,newcontext,ty')::newmetasenv,newargument::arguments,lastmeta
-    | t -> t,[],[],newmeta
-  in
-   let newmeta = new_meta ~proof in
-    (* WARNING: here we are using the invariant that above the most *)
-    (* recente new_meta() there are no used metas.                  *)
-    let (res,newmetasenv,arguments,lastmeta) = aux newmeta ty in
-     res,newmetasenv,arguments,newmeta,lastmeta
+    let fresh_name =
+     ProofEngineHelpers.mk_fresh_name context (Cic.Name "Heta") ~typ:argty
+    in
+     (C.Appl [C.Lambda (fresh_name,argty,aux 0 t) ; arg])
 
 (*CSC: ma serve solamente la prima delle new_uninst e l'unione delle due!!! *)
 let classify_metas newmeta in_subst_domain subst_in metasenv =
@@ -174,7 +150,7 @@ let classify_metas newmeta in_subst_domain subst_in metasenv =
 (* a list of arguments for the new applications and the indexes of the first *)
 (* and last new METAs introduced. The nth argument in the list of arguments  *)
 (* is just the nth new META.                                                 *)
-let new_metasenv_for_apply proof context ty =
+let new_metasenv_for_apply newmeta proof context ty =
  let module C = Cic in
  let module S = CicSubstitution in
   let rec aux newmeta =
@@ -189,11 +165,56 @@ let new_metasenv_for_apply proof context ty =
           res,(newmeta,context,s)::newmetasenv,newargument::arguments,lastmeta
     | t -> t,[],[],newmeta
   in
-   let newmeta = new_meta ~proof in
-    (* WARNING: here we are using the invariant that above the most *)
-    (* recente new_meta() there are no used metas.                  *)
-    let (res,newmetasenv,arguments,lastmeta) = aux newmeta ty in
-     res,newmetasenv,arguments,newmeta,lastmeta
+   (* WARNING: here we are using the invariant that above the most *)
+   (* recente new_meta() there are no used metas.                  *)
+   let (res,newmetasenv,arguments,lastmeta) = aux newmeta ty in
+    res,newmetasenv,arguments,lastmeta
+
+(* Useful only inside apply_tac *)
+let
+ generalize_exp_named_subst_with_fresh_metas context newmeta uri exp_named_subst
+=
+ let module C = Cic in
+  let params =
+   match CicEnvironment.get_obj uri with
+      C.Constant (_,_,_,params)
+    | C.CurrentProof (_,_,_,_,params)
+    | C.Variable (_,_,_,params)
+    | C.InductiveDefinition (_,params,_) -> params
+  in
+   let exp_named_subst_diff,new_fresh_meta,newmetasenvfragment,exp_named_subst'=
+    let next_fresh_meta = ref newmeta in
+    let newmetasenvfragment = ref [] in
+    let exp_named_subst_diff = ref [] in
+     let rec aux =
+      function
+         [],[] -> []
+       | uri::tl,[] ->
+          let ty =
+           match CicEnvironment.get_obj uri with
+              C.Variable (_,_,ty,_) ->
+               CicSubstitution.subst_vars !exp_named_subst_diff ty
+            | _ -> raise (WrongUriToVariable (UriManager.string_of_uri uri))
+          in
+           let irl = identity_relocation_list_for_metavariable context in
+           let subst_item = uri,C.Meta (!next_fresh_meta,irl) in
+            newmetasenvfragment :=
+             (!next_fresh_meta,context,ty)::!newmetasenvfragment ;
+            exp_named_subst_diff := !exp_named_subst_diff @ [subst_item] ;
+            incr next_fresh_meta ;
+            subst_item::(aux (tl,[]))
+       | uri::tl1,((uri',_) as s)::tl2 ->
+          assert (UriManager.eq uri uri') ;
+          s::(aux (tl1,tl2))
+       | [],_ -> assert false
+     in
+      let exp_named_subst' = aux (params,exp_named_subst) in
+       !exp_named_subst_diff,!next_fresh_meta,
+        List.rev !newmetasenvfragment, exp_named_subst'
+   in
+prerr_endline ("@@@ " ^ CicPp.ppterm (Cic.Var (uri,exp_named_subst)) ^ " |--> " ^ CicPp.ppterm (Cic.Var (uri,exp_named_subst'))) ;
+    new_fresh_meta,newmetasenvfragment,exp_named_subst',exp_named_subst_diff
+;;
 
 let apply_tac ~term ~status:(proof, goal) =
   (* Assumption: The term "term" must be closed in the current context *)
@@ -202,12 +223,51 @@ let apply_tac ~term ~status:(proof, goal) =
  let module C = Cic in
   let (_,metasenv,_,_) = proof in
   let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
-   let termty = CicTypeChecker.type_of_aux' metasenv context term in
+  let newmeta = new_meta ~proof in
+   let exp_named_subst_diff,newmeta',newmetasenvfragment,term' =
+    match term with
+       C.Var (uri,exp_named_subst) ->
+        let newmeta',newmetasenvfragment,exp_named_subst',exp_named_subst_diff =
+         generalize_exp_named_subst_with_fresh_metas context newmeta uri
+          exp_named_subst
+        in
+         exp_named_subst_diff,newmeta',newmetasenvfragment,
+          C.Var (uri,exp_named_subst')
+     | C.Const (uri,exp_named_subst) ->
+        let newmeta',newmetasenvfragment,exp_named_subst',exp_named_subst_diff =
+         generalize_exp_named_subst_with_fresh_metas context newmeta uri
+          exp_named_subst
+        in
+         exp_named_subst_diff,newmeta',newmetasenvfragment,
+          C.Const (uri,exp_named_subst')
+     | C.MutInd (uri,tyno,exp_named_subst) ->
+        let newmeta',newmetasenvfragment,exp_named_subst',exp_named_subst_diff =
+         generalize_exp_named_subst_with_fresh_metas context newmeta uri
+          exp_named_subst
+        in
+         exp_named_subst_diff,newmeta',newmetasenvfragment,
+          C.MutInd (uri,tyno,exp_named_subst')
+     | C.MutConstruct (uri,tyno,consno,exp_named_subst) ->
+        let newmeta',newmetasenvfragment,exp_named_subst',exp_named_subst_diff =
+         generalize_exp_named_subst_with_fresh_metas context newmeta uri
+          exp_named_subst
+        in
+         exp_named_subst_diff,newmeta',newmetasenvfragment,
+          C.MutConstruct (uri,tyno,consno,exp_named_subst')
+     | _ -> [],newmeta,[],term
+   in
+   let metasenv' = metasenv@newmetasenvfragment in
+prerr_endline ("^^^^^TERM': " ^ CicPp.ppterm term') ; 
+   let termty =
+    CicSubstitution.subst_vars exp_named_subst_diff
+     (CicTypeChecker.type_of_aux' metasenv' context term)
+   in
+prerr_endline ("^^^^^TERMTY: " ^ CicPp.ppterm termty) ; 
     (* newmeta is the lowest index of the new metas introduced *)
-    let (consthead,newmetas,arguments,newmeta,_) =
-     new_metasenv_for_apply proof context termty
+    let (consthead,newmetas,arguments,_) =
+     new_metasenv_for_apply newmeta' proof context termty
     in
-     let newmetasenv = newmetas@metasenv in
+     let newmetasenv = metasenv'@newmetas in
       let subst,newmetasenv' =
        CicUnification.fo_unif newmetasenv context consthead ty
       in
@@ -219,12 +279,14 @@ let apply_tac ~term ~status:(proof, goal) =
           classify_metas newmeta in_subst_domain subst_in newmetasenv'
         in
          let bo' =
-          if List.length newmetas = 0 then
-           term
-          else
-           let arguments' = List.map apply_subst arguments in
-            Cic.Appl (term::arguments')
+          apply_subst
+           (if List.length newmetas = 0 then
+             term'
+            else
+             Cic.Appl (term'::arguments)
+           )
          in
+prerr_endline ("XXXX " ^ CicPp.ppterm (if List.length newmetas = 0 then term' else Cic.Appl (term'::arguments)) ^ " |>>> " ^ CicPp.ppterm bo') ;
           let newmetasenv'' = new_uninstantiatedmetas@old_uninstantiatedmetas in
           let (newproof, newmetasenv''') =
            let subst_in = CicUnification.apply_subst ((metano,bo')::subst) in
@@ -242,33 +304,43 @@ let apply_tac ~term ~status =
   with CicUnification.UnificationFailed as e ->
     raise (Fail (Printexc.to_string e))
 
-let intros_tac ~name ~status:(proof, goal) =
+let intros_tac
+ ?(mk_fresh_name_callback = ProofEngineHelpers.mk_fresh_name) ()
+ ~status:(proof, goal)
+=
  let module C = Cic in
  let module R = CicReduction in
   let (_,metasenv,_,_) = proof in
   let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
    let newmeta = new_meta ~proof in
-    let (context',ty',bo') = lambda_abstract context newmeta ty name in
+    let (context',ty',bo') =
+     lambda_abstract context newmeta ty mk_fresh_name_callback
+    in
      let (newproof, _) =
        subst_meta_in_proof proof metano bo' [newmeta,context',ty']
      in
       (newproof, [newmeta])
 
-let cut_tac ~term ~status:(proof, goal) =
+let cut_tac
+ ?(mk_fresh_name_callback = ProofEngineHelpers.mk_fresh_name)
+ term ~status:(proof, goal)
+=
  let module C = Cic in
   let curi,metasenv,pbo,pty = proof in
   let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
    let newmeta1 = new_meta ~proof in
    let newmeta2 = newmeta1 + 1 in
+   let fresh_name =
+    mk_fresh_name_callback context (Cic.Name "Hcut") ~typ:term in
    let context_for_newmeta1 =
-    (Some (C.Name "dummy_for_cut",C.Decl term))::context in
+    (Some (fresh_name,C.Decl term))::context in
    let irl1 =
     identity_relocation_list_for_metavariable context_for_newmeta1 in
    let irl2 = identity_relocation_list_for_metavariable context in
     let newmeta1ty = CicSubstitution.lift 1 ty in
     let bo' =
      C.Appl
-      [C.Lambda (C.Name "dummy_for_cut",term,C.Meta (newmeta1,irl1)) ;
+      [C.Lambda (fresh_name,term,C.Meta (newmeta1,irl1)) ;
        C.Meta (newmeta2,irl2)]
     in
      let (newproof, _) =
@@ -277,18 +349,23 @@ let cut_tac ~term ~status:(proof, goal) =
      in
       (newproof, [newmeta1 ; newmeta2])
 
-let letin_tac ~term ~status:(proof, goal) =
+let letin_tac
+ ?(mk_fresh_name_callback = ProofEngineHelpers.mk_fresh_name)
+ term ~status:(proof, goal)
+=
  let module C = Cic in
   let curi,metasenv,pbo,pty = proof in
   let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
    let _ = CicTypeChecker.type_of_aux' metasenv context term in
     let newmeta = new_meta ~proof in
+    let fresh_name =
+     mk_fresh_name_callback context (Cic.Name "Hletin") ~typ:term in
     let context_for_newmeta =
-     (Some (C.Name "dummy_for_letin",C.Def term))::context in
+     (Some (fresh_name,C.Def term))::context in
     let irl =
      identity_relocation_list_for_metavariable context_for_newmeta in
      let newmetaty = CicSubstitution.lift 1 ty in
-     let bo' = C.LetIn (C.Name "dummy_for_letin",term,C.Meta (newmeta,irl)) in
+     let bo' = C.LetIn (fresh_name,term,C.Meta (newmeta,irl)) in
       let (newproof, _) =
         subst_meta_in_proof
           proof metano bo'[newmeta,context_for_newmeta,newmetaty]
@@ -312,9 +389,9 @@ let exact_tac ~term ~status:(proof, goal) =
   raise (Fail "The type of the provided term is not the one expected.")
 
 
-(* not really "primite" tactics .... *)
+(* not really "primitive" tactics .... *)
 
-let elim_intros_simpl_tac ~term ~status:(proof, goal) =
+let elim_tac ~term ~status:(proof, goal) =
  let module T = CicTypeChecker in
  let module U = UriManager in
  let module R = CicReduction in
@@ -322,20 +399,17 @@ let elim_intros_simpl_tac ~term ~status:(proof, goal) =
   let (curi,metasenv,_,_) = proof in
   let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
    let termty = T.type_of_aux' metasenv context term in
-   let uri,cookingno,typeno,args =
+   let uri,exp_named_subst,typeno,args =
     match termty with
-       C.MutInd (uri,cookingno,typeno) -> (uri,cookingno,typeno,[])
-     | C.Appl ((C.MutInd (uri,cookingno,typeno))::args) ->
-         (uri,cookingno,typeno,args)
-     | _ ->
-         prerr_endline ("MALFATTORE" ^ (CicPp.ppterm termty));
-         flush stderr;
-         raise NotAnInductiveTypeToEliminate
+       C.MutInd (uri,typeno,exp_named_subst) -> (uri,exp_named_subst,typeno,[])
+     | C.Appl ((C.MutInd (uri,typeno,exp_named_subst))::args) ->
+         (uri,exp_named_subst,typeno,args)
+     | _ -> raise NotAnInductiveTypeToEliminate
    in
     let eliminator_uri =
      let buri = U.buri_of_uri uri in
      let name = 
-      match CicEnvironment.get_cooked_obj uri cookingno with
+      match CicEnvironment.get_obj uri with
          C.InductiveDefinition (tys,_,_) ->
           let (name,_,_,_) = List.nth tys typeno in
            name
@@ -350,18 +424,11 @@ let elim_intros_simpl_tac ~term ~status:(proof, goal) =
      in
       U.uri_of_string (buri ^ "/" ^ name ^ ext ^ ".con")
     in
-     let eliminator_cookingno =
-      UriManager.relative_depth curi eliminator_uri 0
-     in
-     let eliminator_ref = C.Const (eliminator_uri,eliminator_cookingno) in
-      let ety =
-       T.type_of_aux' [] [] eliminator_ref
-      in
-       let (econclusion,newmetas,arguments,newmeta,lastmeta) =
-(*
-        new_metasenv_for_apply context ety
-*)
-        new_metasenv_for_apply_intros proof context ety
+     let eliminator_ref = C.Const (eliminator_uri,exp_named_subst) in
+      let ety = T.type_of_aux' metasenv context eliminator_ref in
+      let newmeta = new_meta ~proof in
+       let (econclusion,newmetas,arguments,lastmeta) =
+         new_metasenv_for_apply newmeta proof context ety
        in
         (* Here we assume that we have only one inductive hypothesis to *)
         (* eliminate and that it is the last hypothesis of the theorem. *)
@@ -390,22 +457,8 @@ let elim_intros_simpl_tac ~term ~status:(proof, goal) =
           (* to refine the term.                            *)
           let emeta, fargs =
            match ueconclusion with
-(*CSC: Code to be used for Apply
               C.Appl ((C.Meta (emeta,_))::fargs) -> emeta,fargs
             | C.Meta (emeta,_) -> emeta,[]
-*)
-(*CSC: Code to be used for ApplyIntros *)
-              C.Appl (he::fargs) ->
-               let rec find_head =
-                function
-                   C.Meta (emeta,_) -> emeta
-                 | C.Lambda (_,_,t) -> find_head t
-                 | C.LetIn (_,_,t) -> find_head t
-                 | _ ->raise NotTheRightEliminatorShape
-               in
-                find_head he,fargs
-            | C.Meta (emeta,_) -> emeta,[]
-(* *)
             | _ -> raise NotTheRightEliminatorShape
           in
            let ty' = CicUnification.apply_subst subst1 ty in
@@ -424,7 +477,6 @@ da subst1!!!! Dovrei rimuoverle o sono innocue?*)
                List.exists eq_to_i subst1 ||
                List.exists eq_to_i subst2
              in
-(*CSC: codice per l'elim
               (* When unwinding the META that corresponds to the elimination *)
               (* predicate (which is emeta), we must also perform one-step   *)
               (* beta-reduction. apply_subst doesn't need the context. Hence *)
@@ -434,13 +486,6 @@ da subst1!!!! Dovrei rimuoverle o sono innocue?*)
                 CicUnification.apply_subst_reducing
                  subst2 (Some (emeta,List.length fargs)) t'
               in
-*)
-(*CSC: codice per l'elim_intros_simpl. Non effettua semplificazione. *)
-              let apply_subst context t =
-               let t' = CicUnification.apply_subst (subst1@subst2) t in
-                ProofEngineReduction.simpl context t'
-              in
-(* *)
                 let old_uninstantiatedmetas,new_uninstantiatedmetas =
                  classify_metas newmeta in_subst_domain apply_subst
                   newmetasenv''
@@ -458,26 +503,28 @@ da subst1!!!! Dovrei rimuoverle o sono innocue?*)
                      (* we also substitute metano with bo'.             *)
                      (*CSC: Nota: sostituire nuovamente subst1 e' superfluo, *)
                      (*CSC: no?                                              *)
-(*CSC: codice per l'elim
                      let apply_subst' t =
                       let t' = CicUnification.apply_subst subst1 t in
                        CicUnification.apply_subst_reducing
                         ((metano,bo')::subst2)
                         (Some (emeta,List.length fargs)) t'
                      in
-*)
-(*CSC: codice per l'elim_intros_simpl *)
-                     let apply_subst' t =
-                      CicUnification.apply_subst
-                       ((metano,bo')::(subst1@subst2)) t
-                     in
-(* *)
                       subst_meta_and_metasenv_in_proof
                         proof metano apply_subst' newmetasenv'''
                     in
                      (newproof,
                       List.map (function (i,_,_) -> i) new_uninstantiatedmetas)
+;;
 
+(* The simplification is performed only on the conclusion *)
+let elim_intros_simpl_tac ~term =
+ Tacticals.then_ ~start:(elim_tac ~term)
+  ~continuation:
+   (Tacticals.thens
+     ~start:(intros_tac ())
+     ~continuations:
+       [ReductionTactics.simpl_tac ~also_in_hypotheses:false ~terms:None])
+;;
 
 exception NotConvertible
 
@@ -493,7 +540,8 @@ let change_tac ~what ~with_what ~status:(proof, goal) =
   if CicReduction.are_convertible context what with_what then
    begin
     let replace =
-     ProofEngineReduction.replace ~equality:(==) ~what ~with_what
+     ProofEngineReduction.replace
+      ~equality:(==) ~what:[what] ~with_what:[with_what]
     in
     let ty' = replace ty in
     let context' =
diff --git a/helm/gTopLevel/primitiveTactics.mli b/helm/ocaml/tactics/primitiveTactics.mli
similarity index 80%
rename from helm/gTopLevel/primitiveTactics.mli
rename to helm/ocaml/tactics/primitiveTactics.mli
index 93db3ea10..bef3bb2e8 100644
--- a/helm/gTopLevel/primitiveTactics.mli
+++ b/helm/ocaml/tactics/primitiveTactics.mli
@@ -28,11 +28,14 @@ val apply_tac:
 val exact_tac:
   term: Cic.term -> ProofEngineTypes.tactic
 val intros_tac:
-  name: string -> ProofEngineTypes.tactic
+  ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type -> unit ->
+   ProofEngineTypes.tactic
 val cut_tac:
-  term: Cic.term -> ProofEngineTypes.tactic 
+  ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type -> Cic.term ->
+   ProofEngineTypes.tactic 
 val letin_tac:
-  term: Cic.term -> ProofEngineTypes.tactic 
+  ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type -> Cic.term ->
+   ProofEngineTypes.tactic 
 
 val elim_intros_simpl_tac:
   term: Cic.term -> ProofEngineTypes.tactic 
diff --git a/helm/gTopLevel/proofEngineHelpers.ml b/helm/ocaml/tactics/proofEngineHelpers.ml
similarity index 79%
rename from helm/gTopLevel/proofEngineHelpers.ml
rename to helm/ocaml/tactics/proofEngineHelpers.ml
index d191340ea..16be77edb 100644
--- a/helm/gTopLevel/proofEngineHelpers.ml
+++ b/helm/ocaml/tactics/proofEngineHelpers.ml
@@ -23,6 +23,43 @@
  * http://cs.unibo.it/helm/.
  *)
 
+(* mk_fresh_name context name typ                      *)
+(* returns an identifier which is fresh in the context *)
+(* and that resembles [name] as much as possible.      *)
+(* [typ] will be the type of the variable              *)
+let mk_fresh_name context name ~typ =
+ let module C = Cic in
+  let basename =
+   match name with
+      C.Anonymous ->
+       (*CSC: great space for improvements here *)
+       (try
+         (match CicTypeChecker.type_of_aux' [] context typ with
+             C.Sort C.Prop -> "H"
+           | C.Sort C.Set -> "x"
+           | _ -> "H"
+         )
+        with CicTypeChecker.TypeCheckerFailure _ -> "H"
+       )
+    | C.Name name ->
+       Str.global_replace (Str.regexp "[0-9]*$") "" name
+  in
+   let already_used name =
+    List.exists (function Some (C.Name n,_) -> n=name | _ -> false) context
+   in
+    if not (already_used basename) then
+     C.Name basename
+    else
+     let rec try_next n =
+      let name' = basename ^ string_of_int n in
+       if already_used name' then
+        try_next (n+1)
+       else
+        C.Name name'
+     in
+      try_next 1
+;;
+
 (* identity_relocation_list_for_metavariable i canonical_context         *)
 (* returns the identity relocation list, which is the list [1 ; ... ; n] *)
 (* where n = List.length [canonical_context]                             *)
diff --git a/helm/gTopLevel/proofEngineHelpers.mli b/helm/ocaml/tactics/proofEngineHelpers.mli
similarity index 79%
rename from helm/gTopLevel/proofEngineHelpers.mli
rename to helm/ocaml/tactics/proofEngineHelpers.mli
index c5593235c..0e2244f43 100644
--- a/helm/gTopLevel/proofEngineHelpers.mli
+++ b/helm/ocaml/tactics/proofEngineHelpers.mli
@@ -23,9 +23,15 @@
  * http://cs.unibo.it/helm/.
  *)
 
+(* mk_fresh_name context name typ                      *)
+(* returns an identifier which is fresh in the context *)
+(* and that resembles [name] as much as possible.      *)
+(* [typ] will be the type of the variable              *)
+val mk_fresh_name : ProofEngineTypes.mk_fresh_name_type
+
 (* identity_relocation_list_for_metavariable i canonical_context         *)
-(* returns the identity relocation list, which is the list [1 ; ... ; n] *)
-(* where n = List.length [canonical_context]                             *)
+(* returns the identity relocation list, which is the list               *)
+(* [Rel 1 ; ... ; Rel n] where n = List.length [canonical_context]       *)
 val identity_relocation_list_for_metavariable :
   'a option list -> Cic.term option list
 
diff --git a/helm/ocaml/tactics/proofEngineReduction.ml b/helm/ocaml/tactics/proofEngineReduction.ml
new file mode 100644
index 000000000..c70be1fb7
--- /dev/null
+++ b/helm/ocaml/tactics/proofEngineReduction.ml
@@ -0,0 +1,867 @@
+(* Copyright (C) 2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(******************************************************************************)
+(*                                                                            *)
+(*                               PROJECT HELM                                 *)
+(*                                                                            *)
+(*                Claudio Sacerdoti Coen                *)
+(*                                 12/04/2002                                 *)
+(*                                                                            *)
+(*                                                                            *)
+(******************************************************************************)
+
+
+(* The code of this module is derived from the code of CicReduction *)
+
+exception Impossible of int;;
+exception ReferenceToConstant;;
+exception ReferenceToVariable;;
+exception ReferenceToCurrentProof;;
+exception ReferenceToInductiveDefinition;;
+exception WrongUriToInductiveDefinition;;
+exception WrongUriToConstant;;
+exception RelToHiddenHypothesis;;
+
+let alpha_equivalence =
+ let module C = Cic in
+  let rec aux t t' =
+   if t = t' then true
+   else
+    match t,t' with
+       C.Var (uri1,exp_named_subst1), C.Var (uri2,exp_named_subst2) ->
+        UriManager.eq uri1 uri2 &&
+         aux_exp_named_subst exp_named_subst1 exp_named_subst2
+     | C.Cast (te,ty), C.Cast (te',ty') ->
+        aux te te' && aux ty ty'
+     | C.Prod (_,s,t), C.Prod (_,s',t') ->
+        aux s s' && aux t t'
+     | C.Lambda (_,s,t), C.Lambda (_,s',t') ->
+        aux s s' && aux t t'
+     | C.LetIn (_,s,t), C.LetIn(_,s',t') ->
+        aux s s' && aux t t'
+     | C.Appl l, C.Appl l' ->
+        (try
+          List.fold_left2
+           (fun b t1 t2 -> b && aux t1 t2) true l l'
+         with
+          Invalid_argument _ -> false)
+     | C.Const (uri,exp_named_subst1), C.Const (uri',exp_named_subst2) ->
+        UriManager.eq uri uri' &&
+         aux_exp_named_subst exp_named_subst1 exp_named_subst2
+     | C.MutInd (uri,i,exp_named_subst1), C.MutInd (uri',i',exp_named_subst2) ->
+        UriManager.eq uri uri' && i = i' &&
+         aux_exp_named_subst exp_named_subst1 exp_named_subst2
+     | C.MutConstruct (uri,i,j,exp_named_subst1),
+       C.MutConstruct (uri',i',j',exp_named_subst2) ->
+        UriManager.eq uri uri' && i = i' && j = j' &&
+         aux_exp_named_subst exp_named_subst1 exp_named_subst2
+     | C.MutCase (sp,i,outt,t,pl), C.MutCase (sp',i',outt',t',pl') ->
+        UriManager.eq sp sp' && i = i' &&
+         aux outt outt' && aux t t' &&
+          (try
+            List.fold_left2
+             (fun b t1 t2 -> b && aux t1 t2) true pl pl'
+           with
+            Invalid_argument _ -> false)
+     | C.Fix (i,fl), C.Fix (i',fl') ->
+        i = i' &&
+        (try
+          List.fold_left2
+           (fun b (_,i,ty,bo) (_,i',ty',bo') ->
+             b && i = i' && aux ty ty' && aux bo bo'
+           ) true fl fl'
+         with
+          Invalid_argument _ -> false)
+     | C.CoFix (i,fl), C.CoFix (i',fl') ->
+        i = i' &&
+        (try
+          List.fold_left2
+           (fun b (_,ty,bo) (_,ty',bo') ->
+             b && aux ty ty' && aux bo bo'
+           ) true fl fl'
+         with
+          Invalid_argument _ -> false)
+     | _,_ -> false (* we already know that t != t' *)
+  and aux_exp_named_subst exp_named_subst1 exp_named_subst2 =
+   try
+     List.fold_left2
+      (fun b (uri1,t1) (uri2,t2) ->
+        b && UriManager.eq uri1 uri2 && aux t1 t2
+      ) true exp_named_subst1 exp_named_subst2
+    with
+     Invalid_argument _ -> false
+  in
+   aux
+;;
+
+exception WhatAndWithWhatDoNotHaveTheSameLength;;
+
+(* "textual" replacement of several subterms with other ones *)
+let replace ~equality ~what ~with_what ~where =
+ let module C = Cic in
+  let find_image t =
+   let rec find_image_aux =
+    function
+       [],[] -> raise Not_found
+     | what::tl1,with_what::tl2 ->
+        if equality t what then with_what else find_image_aux (tl1,tl2)
+     | _,_ -> raise WhatAndWithWhatDoNotHaveTheSameLength
+   in
+    find_image_aux (what,with_what)
+  in
+  let rec aux t =
+   try
+    find_image t
+   with Not_found ->
+    match t with
+       C.Rel _ -> t
+     | C.Var (uri,exp_named_subst) ->
+        C.Var (uri,List.map (function (uri,t) -> uri, aux t) exp_named_subst)
+     | C.Meta _ -> t
+     | C.Sort _ -> t
+     | C.Implicit as t -> t
+     | C.Cast (te,ty) -> C.Cast (aux te, aux ty)
+     | C.Prod (n,s,t) -> C.Prod (n, aux s, aux t)
+     | C.Lambda (n,s,t) -> C.Lambda (n, aux s, aux t)
+     | C.LetIn (n,s,t) -> C.LetIn (n, aux s, aux t)
+     | C.Appl l ->
+        (* Invariant enforced: no application of an application *)
+        (match List.map aux l with
+            (C.Appl l')::tl -> C.Appl (l'@tl)
+          | l' -> C.Appl l')
+     | C.Const (uri,exp_named_subst) ->
+        C.Const (uri,List.map (function (uri,t) -> uri, aux t) exp_named_subst)
+     | C.MutInd (uri,i,exp_named_subst) ->
+        C.MutInd
+         (uri,i,List.map (function (uri,t) -> uri, aux t) exp_named_subst)
+     | C.MutConstruct (uri,i,j,exp_named_subst) ->
+        C.MutConstruct
+         (uri,i,j,List.map (function (uri,t) -> uri, aux t) exp_named_subst)
+     | C.MutCase (sp,i,outt,t,pl) ->
+        C.MutCase (sp,i,aux outt, aux t,List.map aux pl)
+     | C.Fix (i,fl) ->
+        let substitutedfl =
+         List.map
+          (fun (name,i,ty,bo) -> (name, i, aux ty, aux bo))
+           fl
+        in
+         C.Fix (i, substitutedfl)
+     | C.CoFix (i,fl) ->
+        let substitutedfl =
+         List.map
+          (fun (name,ty,bo) -> (name, aux ty, aux bo))
+           fl
+        in
+         C.CoFix (i, substitutedfl)
+   in
+    aux where
+;;
+
+(* replaces in a term a term with another one. *)
+(* Lifting are performed as usual.             *)
+let replace_lifting ~equality ~what ~with_what ~where =
+ let module C = Cic in
+ let module S = CicSubstitution in
+  let find_image what t =
+   let rec find_image_aux =
+    function
+       [],[] -> raise Not_found
+     | what::tl1,with_what::tl2 ->
+        if equality t what then with_what else find_image_aux (tl1,tl2)
+     | _,_ -> raise WhatAndWithWhatDoNotHaveTheSameLength
+   in
+    find_image_aux (what,with_what)
+  in
+  let rec substaux k what t =
+   try
+    S.lift (k-1) (find_image what t)
+   with Not_found ->
+    match t with
+      C.Rel n as t -> t
+    | C.Var (uri,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map (function (uri,t) -> uri,substaux k what t) exp_named_subst
+       in
+        C.Var (uri,exp_named_subst')
+    | C.Meta (i, l) as t -> 
+       let l' =
+        List.map
+         (function
+             None -> None
+           | Some t -> Some (substaux k what t)
+         ) l
+       in
+        C.Meta(i,l')
+    | C.Sort _ as t -> t
+    | C.Implicit as t -> t
+    | C.Cast (te,ty) -> C.Cast (substaux k what te, substaux k what ty)
+    | C.Prod (n,s,t) ->
+       C.Prod
+        (n, substaux k what s, substaux (k + 1) (List.map (S.lift 1) what) t)
+    | C.Lambda (n,s,t) ->
+       C.Lambda
+        (n, substaux k what s, substaux (k + 1) (List.map (S.lift 1) what) t)
+    | C.LetIn (n,s,t) ->
+       C.LetIn
+        (n, substaux k what s, substaux (k + 1) (List.map (S.lift 1) what) t)
+    | C.Appl (he::tl) ->
+       (* Invariant: no Appl applied to another Appl *)
+       let tl' = List.map (substaux k what) tl in
+        begin
+         match substaux k what he with
+            C.Appl l -> C.Appl (l@tl')
+          | _ as he' -> C.Appl (he'::tl')
+        end
+    | C.Appl _ -> assert false
+    | C.Const (uri,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map (function (uri,t) -> uri,substaux k what t) exp_named_subst
+       in
+       C.Const (uri,exp_named_subst')
+    | C.MutInd (uri,i,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map (function (uri,t) -> uri,substaux k what t) exp_named_subst
+       in
+        C.MutInd (uri,i,exp_named_subst')
+    | C.MutConstruct (uri,i,j,exp_named_subst) ->
+       let exp_named_subst' =
+        List.map (function (uri,t) -> uri,substaux k what t) exp_named_subst
+       in
+        C.MutConstruct (uri,i,j,exp_named_subst')
+    | C.MutCase (sp,i,outt,t,pl) ->
+       C.MutCase (sp,i,substaux k what outt, substaux k what t,
+        List.map (substaux k what) pl)
+    | C.Fix (i,fl) ->
+       let len = List.length fl in
+       let substitutedfl =
+        List.map
+         (fun (name,i,ty,bo) ->
+           (name, i, substaux k what ty,
+             substaux (k+len) (List.map (S.lift len) what) bo)
+         ) fl
+       in
+        C.Fix (i, substitutedfl)
+    | C.CoFix (i,fl) ->
+       let len = List.length fl in
+       let substitutedfl =
+        List.map
+         (fun (name,ty,bo) ->
+           (name, substaux k what ty,
+             substaux (k+len) (List.map (S.lift len) what) bo)
+         ) fl
+       in
+        C.CoFix (i, substitutedfl)
+ in
+  substaux 1 what where
+;;
+
+(* replaces in a term a list of terms with other ones. *)
+(* Lifting are performed as usual.                     *)
+let replace_lifting_csc nnn ~equality ~what ~with_what ~where =
+ let module C = Cic in
+ let module S = CicSubstitution in
+  let find_image t =
+   let rec find_image_aux =
+    function
+       [],[] -> raise Not_found
+     | what::tl1,with_what::tl2 ->
+        if equality t what then with_what else find_image_aux (tl1,tl2)
+     | _,_ -> raise WhatAndWithWhatDoNotHaveTheSameLength
+   in
+    find_image_aux (what,with_what)
+  in
+  let rec substaux k t =
+   try
+    S.lift (k-1) (find_image t)
+   with Not_found ->
+    match t with
+       C.Rel n as t ->
+        if n < k then C.Rel n else C.Rel (n + nnn)
+     | C.Var (uri,exp_named_subst) ->
+        let exp_named_subst' =
+         List.map (function (uri,t) -> uri,substaux k t) exp_named_subst
+        in
+         C.Var (uri,exp_named_subst')
+     | C.Meta (i, l) as t -> 
+        let l' =
+         List.map
+          (function
+              None -> None
+            | Some t -> Some (substaux k t)
+          ) l
+        in
+         C.Meta(i,l')
+     | C.Sort _ as t -> t
+     | C.Implicit as t -> t
+     | C.Cast (te,ty) -> C.Cast (substaux k te, substaux k ty)
+     | C.Prod (n,s,t) ->
+        C.Prod (n, substaux k s, substaux (k + 1) t)
+     | C.Lambda (n,s,t) ->
+        C.Lambda (n, substaux k s, substaux (k + 1) t)
+     | C.LetIn (n,s,t) ->
+        C.LetIn (n, substaux k s, substaux (k + 1) t)
+     | C.Appl (he::tl) ->
+        (* Invariant: no Appl applied to another Appl *)
+        let tl' = List.map (substaux k) tl in
+         begin
+          match substaux k he with
+             C.Appl l -> C.Appl (l@tl')
+           | _ as he' -> C.Appl (he'::tl')
+         end
+     | C.Appl _ -> assert false
+     | C.Const (uri,exp_named_subst) ->
+        let exp_named_subst' =
+         List.map (function (uri,t) -> uri,substaux k t) exp_named_subst
+        in
+        C.Const (uri,exp_named_subst')
+     | C.MutInd (uri,i,exp_named_subst) ->
+        let exp_named_subst' =
+         List.map (function (uri,t) -> uri,substaux k t) exp_named_subst
+        in
+         C.MutInd (uri,i,exp_named_subst')
+     | C.MutConstruct (uri,i,j,exp_named_subst) ->
+        let exp_named_subst' =
+         List.map (function (uri,t) -> uri,substaux k t) exp_named_subst
+        in
+         C.MutConstruct (uri,i,j,exp_named_subst')
+     | C.MutCase (sp,i,outt,t,pl) ->
+        C.MutCase (sp,i,substaux k outt, substaux k t,
+         List.map (substaux k) pl)
+     | C.Fix (i,fl) ->
+        let len = List.length fl in
+        let substitutedfl =
+         List.map
+          (fun (name,i,ty,bo) ->
+            (name, i, substaux k ty, substaux (k+len) bo))
+           fl
+        in
+         C.Fix (i, substitutedfl)
+     | C.CoFix (i,fl) ->
+        let len = List.length fl in
+        let substitutedfl =
+         List.map
+          (fun (name,ty,bo) ->
+            (name, substaux k ty, substaux (k+len) bo))
+           fl
+        in
+         C.CoFix (i, substitutedfl)
+ in
+  substaux 1 where
+;;
+
+(* Takes a well-typed term and fully reduces it. *)
+(*CSC: It does not perform reduction in a Case *)
+let reduce context =
+ let rec reduceaux context l =
+  let module C = Cic in
+  let module S = CicSubstitution in
+   function
+      C.Rel n as t ->
+       (match List.nth context (n-1) with
+           Some (_,C.Decl _) -> if l = [] then t else C.Appl (t::l)
+         | Some (_,C.Def bo) -> reduceaux context l (S.lift n bo)
+	 | None -> raise RelToHiddenHypothesis
+       )
+    | C.Var (uri,exp_named_subst) ->
+       let exp_named_subst' =
+        reduceaux_exp_named_subst context l exp_named_subst
+       in
+       (match CicEnvironment.get_obj uri with
+           C.Constant _ -> raise ReferenceToConstant
+         | C.CurrentProof _ -> raise ReferenceToCurrentProof
+         | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+         | C.Variable (_,None,_,_) ->
+            let t' = C.Var (uri,exp_named_subst') in
+             if l = [] then t' else C.Appl (t'::l)
+         | C.Variable (_,Some body,_,_) ->
+            (reduceaux context l
+              (CicSubstitution.subst_vars exp_named_subst' body))
+       )
+    | C.Meta _ as t -> if l = [] then t else C.Appl (t::l)
+    | C.Sort _ as t -> t (* l should be empty *)
+    | C.Implicit as t -> t
+    | C.Cast (te,ty) ->
+       C.Cast (reduceaux context l te, reduceaux context l ty)
+    | C.Prod (name,s,t) ->
+       assert (l = []) ;
+       C.Prod (name,
+        reduceaux context [] s,
+        reduceaux ((Some (name,C.Decl s))::context) [] t)
+    | C.Lambda (name,s,t) ->
+       (match l with
+           [] ->
+            C.Lambda (name,
+             reduceaux context [] s,
+             reduceaux ((Some (name,C.Decl s))::context) [] t)
+         | he::tl -> reduceaux context tl (S.subst he t)
+           (* when name is Anonimous the substitution should be superfluous *)
+       )
+    | C.LetIn (n,s,t) ->
+       reduceaux context l (S.subst (reduceaux context [] s) t)
+    | C.Appl (he::tl) ->
+       let tl' = List.map (reduceaux context []) tl in
+        reduceaux context (tl'@l) he
+    | C.Appl [] -> raise (Impossible 1)
+    | C.Const (uri,exp_named_subst) ->
+       let exp_named_subst' =
+        reduceaux_exp_named_subst context l exp_named_subst
+       in
+        (match CicEnvironment.get_obj uri with
+            C.Constant (_,Some body,_,_) ->
+             (reduceaux context l
+               (CicSubstitution.subst_vars exp_named_subst' body))
+          | C.Constant (_,None,_,_) ->
+             let t' = C.Const (uri,exp_named_subst') in
+              if l = [] then t' else C.Appl (t'::l)
+          | C.Variable _ -> raise ReferenceToVariable
+          | C.CurrentProof (_,_,body,_,_) ->
+             (reduceaux context l
+               (CicSubstitution.subst_vars exp_named_subst' body))
+          | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+        )
+    | C.MutInd (uri,i,exp_named_subst) ->
+       let exp_named_subst' =
+        reduceaux_exp_named_subst context l exp_named_subst
+       in
+        let t' = C.MutInd (uri,i,exp_named_subst') in
+         if l = [] then t' else C.Appl (t'::l)
+    | C.MutConstruct (uri,i,j,exp_named_subst) as t ->
+       let exp_named_subst' =
+        reduceaux_exp_named_subst context l exp_named_subst
+       in
+        let t' = C.MutConstruct (uri,i,j,exp_named_subst') in
+         if l = [] then t' else C.Appl (t'::l)
+    | C.MutCase (mutind,i,outtype,term,pl) ->
+       let decofix =
+        function
+           C.CoFix (i,fl) as t ->
+            let tys =
+             List.map (function (name,ty,_) -> Some (C.Name name, C.Decl ty)) fl
+            in
+             let (_,_,body) = List.nth fl i in
+              let body' =
+               let counter = ref (List.length fl) in
+                List.fold_right
+                 (fun _ -> decr counter ; S.subst (C.CoFix (!counter,fl)))
+                 fl
+                 body
+              in
+               reduceaux context [] body'
+         | C.Appl (C.CoFix (i,fl) :: tl) ->
+            let tys =
+             List.map (function (name,ty,_) -> Some (C.Name name, C.Decl ty)) fl
+            in
+             let (_,_,body) = List.nth fl i in
+              let body' =
+               let counter = ref (List.length fl) in
+                List.fold_right
+                 (fun _ -> decr counter ; S.subst (C.CoFix (!counter,fl)))
+                 fl
+                 body
+              in
+               let tl' = List.map (reduceaux context []) tl in
+                reduceaux context tl' body'
+         | t -> t
+       in
+        (match decofix (reduceaux context [] term) with
+            C.MutConstruct (_,_,j,_) -> reduceaux context l (List.nth pl (j-1))
+          | C.Appl (C.MutConstruct (_,_,j,_) :: tl) ->
+             let (arity, r) =
+              match CicEnvironment.get_obj mutind with
+                 C.InductiveDefinition (tl,_,r) ->
+                   let (_,_,arity,_) = List.nth tl i in
+                    (arity,r)
+               | _ -> raise WrongUriToInductiveDefinition
+             in
+              let ts =
+               let rec eat_first =
+                function
+                   (0,l) -> l
+                 | (n,he::tl) when n > 0 -> eat_first (n - 1, tl)
+                 | _ -> raise (Impossible 5)
+               in
+                eat_first (r,tl)
+              in
+               reduceaux context (ts@l) (List.nth pl (j-1))
+         | C.Cast _ | C.Implicit ->
+            raise (Impossible 2) (* we don't trust our whd ;-) *)
+         | _ ->
+           let outtype' = reduceaux context [] outtype in
+           let term' = reduceaux context [] term in
+           let pl' = List.map (reduceaux context []) pl in
+            let res =
+             C.MutCase (mutind,i,outtype',term',pl')
+            in
+             if l = [] then res else C.Appl (res::l)
+       )
+    | C.Fix (i,fl) ->
+       let tys =
+        List.map (function (name,_,ty,_) -> Some (C.Name name, C.Decl ty)) fl
+       in
+        let t' () =
+         let fl' =
+          List.map
+           (function (n,recindex,ty,bo) ->
+             (n,recindex,reduceaux context [] ty, reduceaux (tys@context) [] bo)
+           ) fl
+         in
+          C.Fix (i, fl')
+        in
+         let (_,recindex,_,body) = List.nth fl i in
+          let recparam =
+           try
+            Some (List.nth l recindex)
+           with
+            _ -> None
+          in
+           (match recparam with
+               Some recparam ->
+                (match reduceaux context [] recparam with
+                    C.MutConstruct _
+                  | C.Appl ((C.MutConstruct _)::_) ->
+                     let body' =
+                      let counter = ref (List.length fl) in
+                       List.fold_right
+                        (fun _ -> decr counter ; S.subst (C.Fix (!counter,fl)))
+                        fl
+                        body
+                     in
+                      (* Possible optimization: substituting whd recparam in l*)
+                      reduceaux context l body'
+                  | _ -> if l = [] then t' () else C.Appl ((t' ())::l)
+                )
+             | None -> if l = [] then t' () else C.Appl ((t' ())::l)
+           )
+    | C.CoFix (i,fl) ->
+       let tys =
+        List.map (function (name,ty,_) -> Some (C.Name name, C.Decl ty)) fl
+       in
+        let t' =
+         let fl' =
+          List.map
+           (function (n,ty,bo) ->
+             (n,reduceaux context [] ty, reduceaux (tys@context) [] bo)
+           ) fl
+         in
+          C.CoFix (i, fl')
+        in
+         if l = [] then t' else C.Appl (t'::l)
+ and reduceaux_exp_named_subst context l =
+  List.map (function uri,t -> uri,reduceaux context [] t)
+ in
+  reduceaux context []
+;;
+
+exception WrongShape;;
+exception AlreadySimplified;;
+
+(* Takes a well-typed term and                                               *)
+(*  1) Performs beta-iota-zeta reduction until delta reduction is needed     *)
+(*  2) Attempts delta-reduction. If the residual is a Fix lambda-abstracted  *)
+(*     w.r.t. zero or more variables and if the Fix can be reduced, than it  *)
+(*     is reduced, the delta-reduction is succesfull and the whole algorithm *)
+(*     is applied again to the new redex; Step 3) is applied to the result   *)
+(*     of the recursive simplification. Otherwise, if the Fix can not be     *)
+(*     reduced, than the delta-reductions fails and the delta-redex is       *)
+(*     not reduced. Otherwise, if the delta-residual is not the              *)
+(*     lambda-abstraction of a Fix, then it is reduced and the result is     *)
+(*     directly returned, without performing step 3).                        *) 
+(*  3) Folds the application of the constant to the arguments that did not   *)
+(*     change in every iteration, i.e. to the actual arguments for the       *)
+(*     lambda-abstractions that precede the Fix.                             *)
+(*CSC: It does not perform simplification in a Case *)
+let simpl context =
+ (* reduceaux is equal to the reduceaux locally defined inside *)
+ (* reduce, but for the const case.                            *) 
+ (**** Step 1 ****)
+ let rec reduceaux context l =
+  let module C = Cic in
+  let module S = CicSubstitution in
+   function
+      C.Rel n as t ->
+       (match List.nth context (n-1) with
+           Some (_,C.Decl _) -> if l = [] then t else C.Appl (t::l)
+         | Some (_,C.Def bo) ->
+            try_delta_expansion l t (S.lift n bo)
+	 | None -> raise RelToHiddenHypothesis
+       )
+    | C.Var (uri,exp_named_subst) ->
+       let exp_named_subst' =
+        reduceaux_exp_named_subst context l exp_named_subst
+       in
+        (match CicEnvironment.get_obj uri with
+            C.Constant _ -> raise ReferenceToConstant
+          | C.CurrentProof _ -> raise ReferenceToCurrentProof
+          | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+          | C.Variable (_,None,_,_) ->
+            let t' = C.Var (uri,exp_named_subst') in
+             if l = [] then t' else C.Appl (t'::l)
+          | C.Variable (_,Some body,_,_) ->
+             reduceaux context l
+              (CicSubstitution.subst_vars exp_named_subst' body)
+        )
+    | C.Meta _ as t -> if l = [] then t else C.Appl (t::l)
+    | C.Sort _ as t -> t (* l should be empty *)
+    | C.Implicit as t -> t
+    | C.Cast (te,ty) ->
+       C.Cast (reduceaux context l te, reduceaux context l ty)
+    | C.Prod (name,s,t) ->
+       assert (l = []) ;
+       C.Prod (name,
+        reduceaux context [] s,
+        reduceaux ((Some (name,C.Decl s))::context) [] t)
+    | C.Lambda (name,s,t) ->
+       (match l with
+           [] ->
+            C.Lambda (name,
+             reduceaux context [] s,
+             reduceaux ((Some (name,C.Decl s))::context) [] t)
+         | he::tl -> reduceaux context tl (S.subst he t)
+           (* when name is Anonimous the substitution should be superfluous *)
+       )
+    | C.LetIn (n,s,t) ->
+       reduceaux context l (S.subst (reduceaux context [] s) t)
+    | C.Appl (he::tl) ->
+       let tl' = List.map (reduceaux context []) tl in
+        reduceaux context (tl'@l) he
+    | C.Appl [] -> raise (Impossible 1)
+    | C.Const (uri,exp_named_subst) ->
+       let exp_named_subst' =
+        reduceaux_exp_named_subst context l exp_named_subst
+       in
+        (match CicEnvironment.get_obj uri with
+           C.Constant (_,Some body,_,_) ->
+            try_delta_expansion l
+             (C.Const (uri,exp_named_subst'))
+             (CicSubstitution.subst_vars exp_named_subst' body)
+         | C.Constant (_,None,_,_) ->
+            let t' = C.Const (uri,exp_named_subst') in
+             if l = [] then t' else C.Appl (t'::l)
+         | C.Variable _ -> raise ReferenceToVariable
+         | C.CurrentProof (_,_,body,_,_) -> reduceaux context l body
+         | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
+       )
+    | C.MutInd (uri,i,exp_named_subst) ->
+       let exp_named_subst' =
+        reduceaux_exp_named_subst context l exp_named_subst
+       in
+        let t' = C.MutInd (uri,i,exp_named_subst') in
+         if l = [] then t' else C.Appl (t'::l)
+    | C.MutConstruct (uri,i,j,exp_named_subst) ->
+       let exp_named_subst' =
+        reduceaux_exp_named_subst context l exp_named_subst
+       in
+        let t' = C.MutConstruct(uri,i,j,exp_named_subst') in
+         if l = [] then t' else C.Appl (t'::l)
+    | C.MutCase (mutind,i,outtype,term,pl) ->
+       let decofix =
+        function
+           C.CoFix (i,fl) as t ->
+            let tys =
+             List.map (function (name,ty,_) -> Some (C.Name name, C.Decl ty)) fl            in
+             let (_,_,body) = List.nth fl i in
+              let body' =
+               let counter = ref (List.length fl) in
+                List.fold_right
+                 (fun _ -> decr counter ; S.subst (C.CoFix (!counter,fl)))
+                 fl
+                 body
+              in
+               reduceaux context [] body'
+         | C.Appl (C.CoFix (i,fl) :: tl) ->
+            let tys =
+             List.map (function (name,ty,_) -> Some (C.Name name, C.Decl ty)) fl            in
+             let (_,_,body) = List.nth fl i in
+              let body' =
+               let counter = ref (List.length fl) in
+                List.fold_right
+                 (fun _ -> decr counter ; S.subst (C.CoFix (!counter,fl)))
+                 fl
+                 body
+              in
+               let tl' = List.map (reduceaux context []) tl in
+                reduceaux context tl body'
+         | t -> t
+       in
+        (match decofix (reduceaux context [] term) with
+            C.MutConstruct (_,_,j,_) -> reduceaux context l (List.nth pl (j-1))
+          | C.Appl (C.MutConstruct (_,_,j,_) :: tl) ->
+             let (arity, r) =
+              match CicEnvironment.get_obj mutind with
+                 C.InductiveDefinition (tl,ingredients,r) ->
+                   let (_,_,arity,_) = List.nth tl i in
+                    (arity,r)
+               | _ -> raise WrongUriToInductiveDefinition
+             in
+              let ts =
+               let rec eat_first =
+                function
+                   (0,l) -> l
+                 | (n,he::tl) when n > 0 -> eat_first (n - 1, tl)
+                 | _ -> raise (Impossible 5)
+               in
+                eat_first (r,tl)
+              in
+               reduceaux context (ts@l) (List.nth pl (j-1))
+         | C.Cast _ | C.Implicit ->
+            raise (Impossible 2) (* we don't trust our whd ;-) *)
+         | _ ->
+           let outtype' = reduceaux context [] outtype in
+           let term' = reduceaux context [] term in
+           let pl' = List.map (reduceaux context []) pl in
+            let res =
+             C.MutCase (mutind,i,outtype',term',pl')
+            in
+             if l = [] then res else C.Appl (res::l)
+       )
+    | C.Fix (i,fl) ->
+       let tys =
+        List.map (function (name,_,ty,_) -> Some (C.Name name, C.Decl ty)) fl
+       in
+        let t' () =
+         let fl' =
+          List.map
+           (function (n,recindex,ty,bo) ->
+             (n,recindex,reduceaux context [] ty, reduceaux (tys@context) [] bo)
+           ) fl
+         in
+          C.Fix (i, fl')
+        in
+         let (_,recindex,_,body) = List.nth fl i in
+          let recparam =
+           try
+            Some (List.nth l recindex)
+           with
+            _ -> None
+          in
+           (match recparam with
+               Some recparam ->
+                (match reduceaux context [] recparam with
+                    C.MutConstruct _
+                  | C.Appl ((C.MutConstruct _)::_) ->
+                     let body' =
+                      let counter = ref (List.length fl) in
+                       List.fold_right
+                        (fun _ -> decr counter ; S.subst (C.Fix (!counter,fl)))
+                        fl
+                        body
+                     in
+                      (* Possible optimization: substituting whd recparam in l*)
+                      reduceaux context l body'
+                  | _ -> if l = [] then t' () else C.Appl ((t' ())::l)
+                )
+             | None -> if l = [] then t' () else C.Appl ((t' ())::l)
+           )
+    | C.CoFix (i,fl) ->
+       let tys =
+        List.map (function (name,ty,_) -> Some (C.Name name, C.Decl ty)) fl
+       in
+        let t' =
+         let fl' =
+          List.map
+           (function (n,ty,bo) ->
+             (n,reduceaux context [] ty, reduceaux (tys@context) [] bo)
+           ) fl
+         in
+         C.CoFix (i, fl')
+       in
+         if l = [] then t' else C.Appl (t'::l)
+ and reduceaux_exp_named_subst context l =
+  List.map (function uri,t -> uri,reduceaux context [] t)
+ (**** Step 2 ****)
+ and try_delta_expansion l term body =
+  let module C = Cic in
+  let module S = CicSubstitution in
+   try
+    let res,constant_args =
+     let rec aux rev_constant_args l =
+      function
+         C.Lambda (name,s,t) as t' ->
+          begin
+           match l with
+              [] -> raise WrongShape
+            | he::tl ->
+               (* when name is Anonimous the substitution should *)
+               (* be superfluous                                 *)
+               aux (he::rev_constant_args) tl (S.subst he t)
+          end
+       | C.LetIn (_,s,t) ->
+          aux rev_constant_args l (S.subst s t)
+       | C.Fix (i,fl) as t ->
+          let tys =
+           List.map (function (name,_,ty,_) ->
+            Some (C.Name name, C.Decl ty)) fl
+          in
+           let (_,recindex,_,body) = List.nth fl i in
+            let recparam =
+             try
+              List.nth l recindex
+             with
+              _ -> raise AlreadySimplified
+            in
+             (match CicReduction.whd context recparam with
+                 C.MutConstruct _
+               | C.Appl ((C.MutConstruct _)::_) ->
+                  let body' =
+                   let counter = ref (List.length fl) in
+                    List.fold_right
+                     (function _ ->
+                       decr counter ; S.subst (C.Fix (!counter,fl))
+                     ) fl body
+                  in
+                   (* Possible optimization: substituting whd *)
+                   (* recparam in l                           *)
+                   reduceaux context l body',
+                    List.rev rev_constant_args
+               | _ -> raise AlreadySimplified
+             )
+       | _ -> raise WrongShape
+     in
+      aux [] l body
+    in
+     (**** Step 3 ****)
+     let term_to_fold, delta_expanded_term_to_fold =
+      match constant_args with
+         [] -> term,body
+       | _ -> C.Appl (term::constant_args), C.Appl (body::constant_args)
+     in
+      let simplified_term_to_fold =
+       reduceaux context [] delta_expanded_term_to_fold
+      in
+       replace (=) [simplified_term_to_fold] [term_to_fold] res
+   with
+      WrongShape ->
+       (* The constant does not unfold to a Fix lambda-abstracted  *)
+       (* w.r.t. zero or more variables. We just perform reduction.*)
+       reduceaux context l body
+    | AlreadySimplified ->
+       (* If we performed delta-reduction, we would find a Fix   *)
+       (* not applied to a constructor. So, we refuse to perform *)
+       (* delta-reduction.                                       *)
+       if l = [] then term else C.Appl (term::l)
+ in
+  reduceaux context []
+;;
diff --git a/helm/gTopLevel/proofEngineReduction.mli b/helm/ocaml/tactics/proofEngineReduction.mli
similarity index 76%
rename from helm/gTopLevel/proofEngineReduction.mli
rename to helm/ocaml/tactics/proofEngineReduction.mli
index aa0a3a648..02e56ba6a 100644
--- a/helm/gTopLevel/proofEngineReduction.mli
+++ b/helm/ocaml/tactics/proofEngineReduction.mli
@@ -24,8 +24,7 @@
  *)
 
 exception Impossible of int
-exception ReferenceToDefinition
-exception ReferenceToAxiom
+exception ReferenceToConstant
 exception ReferenceToVariable
 exception ReferenceToCurrentProof
 exception ReferenceToInductiveDefinition
@@ -33,13 +32,17 @@ exception WrongUriToInductiveDefinition
 exception RelToHiddenHypothesis
 exception WrongShape
 exception AlreadySimplified
+exception WhatAndWithWhatDoNotHaveTheSameLength;;
 
-val syntactic_equality : alpha_equivalence:bool -> Cic.term -> Cic.term -> bool
+val alpha_equivalence: Cic.term -> Cic.term -> bool
 val replace :
   equality:(Cic.term -> 'a -> bool) ->
-  what:'a -> with_what:Cic.term -> where:Cic.term -> Cic.term
+  what:'a list -> with_what:Cic.term list -> where:Cic.term -> Cic.term
 val replace_lifting :
   equality:(Cic.term -> Cic.term -> bool) ->
-  what:Cic.term -> with_what:Cic.term -> where:Cic.term -> Cic.term
+  what:Cic.term list -> with_what:Cic.term list -> where:Cic.term -> Cic.term
+val replace_lifting_csc :
+  int -> equality:(Cic.term -> Cic.term -> bool) ->
+  what:Cic.term list -> with_what:Cic.term list -> where:Cic.term -> Cic.term
 val reduce : Cic.context -> Cic.term -> Cic.term
 val simpl : Cic.context -> Cic.term -> Cic.term
diff --git a/helm/gTopLevel/proofEngineStructuralRules.ml b/helm/ocaml/tactics/proofEngineStructuralRules.ml
similarity index 98%
rename from helm/gTopLevel/proofEngineStructuralRules.ml
rename to helm/ocaml/tactics/proofEngineStructuralRules.ml
index e01f95e9f..d89420f58 100644
--- a/helm/gTopLevel/proofEngineStructuralRules.ml
+++ b/helm/ocaml/tactics/proofEngineStructuralRules.ml
@@ -36,7 +36,7 @@ let clearbody ~hyp ~status:(proof, goal) =
         let string_of_name =
          function
             C.Name n -> n
-          | C.Anonimous -> "_"
+          | C.Anonymous -> "_"
         in
         let metasenv' =
          List.map
@@ -101,7 +101,7 @@ let clear ~hyp:hyp_to_clear ~status:(proof, goal) =
         let string_of_name =
          function
             C.Name n -> n
-          | C.Anonimous -> "_"
+          | C.Anonymous -> "_"
         in
         let metasenv' =
          List.map
diff --git a/helm/ocaml/tactics/proofEngineStructuralRules.mli b/helm/ocaml/tactics/proofEngineStructuralRules.mli
new file mode 100644
index 000000000..32ba812ac
--- /dev/null
+++ b/helm/ocaml/tactics/proofEngineStructuralRules.mli
@@ -0,0 +1,27 @@
+(* Copyright (C) 2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val clearbody: hyp: Cic.hypothesis -> ProofEngineTypes.tactic
+val clear: hyp: Cic.hypothesis -> ProofEngineTypes.tactic
diff --git a/helm/gTopLevel/proofEngineTypes.ml b/helm/ocaml/tactics/proofEngineTypes.ml
similarity index 86%
rename from helm/gTopLevel/proofEngineTypes.ml
rename to helm/ocaml/tactics/proofEngineTypes.ml
index f5e75fc47..178be54d4 100644
--- a/helm/gTopLevel/proofEngineTypes.ml
+++ b/helm/ocaml/tactics/proofEngineTypes.ml
@@ -29,13 +29,17 @@
 type proof = UriManager.uri * Cic.metasenv * Cic.term * Cic.term
   (** current goal, integer index *)
 type goal = int
+type status = proof * goal
   (**
     a tactic: make a transition from one status to another one or, usually,
     raise a "Fail" (@see Fail) exception in case of failure
   *)
   (** an unfinished proof with the optional current goal *)
-type tactic = status:(proof * goal) -> proof * goal list
+type tactic = status:status -> proof * goal list
 
   (** tactic failure *)
 exception Fail of string
 
+  (** constraint: the returned value will always be constructed by Cic.Name **)
+type mk_fresh_name_type =
+ Cic.context -> Cic.name -> typ:Cic.term -> Cic.name
diff --git a/helm/ocaml/tactics/reductionTactics.ml b/helm/ocaml/tactics/reductionTactics.ml
new file mode 100644
index 000000000..b29873a1f
--- /dev/null
+++ b/helm/ocaml/tactics/reductionTactics.ml
@@ -0,0 +1,127 @@
+(* Copyright (C) 2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(*
+let reduction_tac ~reduction ~status:(proof,goal) =
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+  let new_ty = reduction context ty in
+   let new_metasenv = 
+    List.map
+    (function
+      (n,_,_) when n = metano -> (metano,context,new_ty)
+      | _ as t -> t
+    ) metasenv
+   in
+    (curi,new_metasenv,pbo,pty), [metano]
+;;
+*)
+
+(* The default of term is the thesis of the goal to be prooved *)
+let reduction_tac ~also_in_hypotheses ~reduction ~terms ~status:(proof,goal) =
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+  let terms =
+   match terms with None -> [ty] | Some l -> l
+  in
+  (* We don't know if [term] is a subterm of [ty] or a subterm of *)
+  (* the type of one metavariable. So we replace it everywhere.   *)
+  (*CSC: Il vero problema e' che non sapendo dove sia il term non *)
+  (*CSC: sappiamo neppure quale sia il suo contesto!!!! Insomma,  *)
+  (*CSC: e' meglio prima cercare il termine e scoprirne il        *)
+  (*CSC: contesto, poi ridurre e infine rimpiazzare.              *)
+   let replace context where=
+(*CSC: Per il momento se la riduzione fallisce significa solamente che *)
+(*CSC: siamo nel contesto errato. Metto il try, ma che schifo!!!!      *)
+(*CSC: Anche perche' cosi' catturo anche quelle del replace che non dovrei *)
+   try
+    let terms' = List.map (reduction context) terms in
+     ProofEngineReduction.replace ~equality:(==) ~what:terms ~with_what:terms'
+      ~where:where
+   with
+    _ -> where
+   in
+    let ty' = replace context ty in
+    let context' =
+     if also_in_hypotheses then
+      List.fold_right
+       (fun entry context ->
+         match entry with
+            Some (name,Cic.Def  t) ->
+             (Some (name,Cic.Def  (replace context t)))::context
+          | Some (name,Cic.Decl t) ->
+             (Some (name,Cic.Decl (replace context t)))::context
+          | None -> None::context
+       ) context []
+     else
+      context
+    in
+     let metasenv' = 
+      List.map
+       (function
+           (n,_,_) when n = metano -> (metano,context',ty')
+         | _ as t -> t
+       ) metasenv
+     in
+      (curi,metasenv',pbo,pty), [metano]
+;;
+
+let simpl_tac = reduction_tac ~reduction:ProofEngineReduction.simpl ;;
+let reduce_tac = reduction_tac ~reduction:ProofEngineReduction.reduce ;;
+let whd_tac = reduction_tac ~reduction:CicReduction.whd ;;
+
+let fold_tac ~reduction ~also_in_hypotheses ~term ~status:(proof,goal) =
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+  let term' = reduction context term in
+   (* We don't know if [term] is a subterm of [ty] or a subterm of *)
+   (* the type of one metavariable. So we replace it everywhere.   *)
+   (*CSC: ma si potrebbe ovviare al problema. Ma non credo *)
+   (*CSC: che si guadagni nulla in fatto di efficienza.    *) 
+   let replace =
+    ProofEngineReduction.replace ~equality:(=) ~what:[term'] ~with_what:[term]
+   in
+    let ty' = replace ty in
+    let metasenv' =
+     let context' =
+      if also_in_hypotheses then
+       List.map
+        (function
+            Some (n,Cic.Decl t) -> Some (n,Cic.Decl (replace t))
+          | Some (n,Cic.Def t)  -> Some (n,Cic.Def  (replace t))
+          | None -> None
+        ) context
+      else
+       context
+     in
+      List.map
+       (function
+           (n,_,_) when n = metano -> (metano,context',ty')
+         | _ as t -> t
+       ) metasenv
+     
+    in
+     (curi,metasenv',pbo,pty), [metano]
+;;
diff --git a/helm/ocaml/tactics/reductionTactics.mli b/helm/ocaml/tactics/reductionTactics.mli
new file mode 100644
index 000000000..f97b4cf63
--- /dev/null
+++ b/helm/ocaml/tactics/reductionTactics.mli
@@ -0,0 +1,39 @@
+(* Copyright (C) 2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(* The default of term is the thesis of the goal to be prooved *)
+val simpl_tac:
+ also_in_hypotheses:bool -> terms:(Cic.term list option) ->
+  ProofEngineTypes.tactic
+val reduce_tac:
+ also_in_hypotheses:bool -> terms:(Cic.term list option) ->
+  ProofEngineTypes.tactic
+val whd_tac:
+ also_in_hypotheses:bool -> terms:(Cic.term list option) ->
+  ProofEngineTypes.tactic
+
+val fold_tac:
+ reduction:(Cic.context -> Cic.term -> Cic.term) ->
+ also_in_hypotheses:bool -> term:Cic.term -> ProofEngineTypes.tactic
diff --git a/helm/gTopLevel/ring.ml b/helm/ocaml/tactics/ring.ml
similarity index 71%
rename from helm/gTopLevel/ring.ml
rename to helm/ocaml/tactics/ring.ml
index 953ed6444..c7015a755 100644
--- a/helm/gTopLevel/ring.ml
+++ b/helm/ocaml/tactics/ring.ml
@@ -48,8 +48,13 @@ let warn s =
 
 let eqt_uri = uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind"
 let refl_eqt_uri = (eqt_uri, 0, 1)
-let sym_eqt_uri =
-  uri_of_string "cic:/Coq/Init/Logic_Type/Equality_is_a_congruence/sym_eqT.con"
+let equality_is_a_congruence_A =
+ uri_of_string "cic:/Coq/Init/Logic_Type/Equality_is_a_congruence/A.var"
+let equality_is_a_congruence_x =
+ uri_of_string "cic:/Coq/Init/Logic_Type/Equality_is_a_congruence/x.var"
+let equality_is_a_congruence_y =
+ uri_of_string "cic:/Coq/Init/Logic_Type/Equality_is_a_congruence/y.var"
+let sym_eqt_uri = uri_of_string "cic:/Coq/Init/Logic_Type/sym_eqT.con"
 let bool_uri = uri_of_string "cic:/Coq/Init/Datatypes/bool.ind"
 let true_uri = (bool_uri, 0, 1)
 let false_uri = (bool_uri, 0, 2)
@@ -63,8 +68,7 @@ let r1_uri = uri_of_string "cic:/Coq/Reals/Rdefinitions/R1.con"
 let rtheory_uri = uri_of_string "cic:/Coq/Reals/Rbase/RTheory.con"
 
 let apolynomial_uri =
-  uri_of_string
-    "cic:/Coq/ring/Ring_abstract/abstract_rings/apolynomial.ind"
+  uri_of_string "cic:/Coq/ring/Ring_abstract/apolynomial.ind"
 let apvar_uri = (apolynomial_uri, 0, 1)
 let ap0_uri = (apolynomial_uri, 0, 2)
 let ap1_uri = (apolynomial_uri, 0, 3)
@@ -72,28 +76,41 @@ let applus_uri = (apolynomial_uri, 0, 4)
 let apmult_uri = (apolynomial_uri, 0, 5)
 let apopp_uri = (apolynomial_uri, 0, 6)
 
-let varmap_uri =
-  uri_of_string "cic:/Coq/ring/Quote/variables_map/varmap.ind"
+let quote_varmap_A_uri = uri_of_string "cic:/Coq/ring/Quote/variables_map/A.var"
+let varmap_uri = uri_of_string "cic:/Coq/ring/Quote/varmap.ind"
 let empty_vm_uri = (varmap_uri, 0, 1)
 let node_vm_uri = (varmap_uri, 0, 2)
-let varmap_find_uri =
-  uri_of_string "cic:/Coq/ring/Quote/variables_map/varmap_find.con"
-let index_uri =
-  uri_of_string "cic:/Coq/ring/Quote/variables_map/index.ind"
+let varmap_find_uri = uri_of_string "cic:/Coq/ring/Quote/varmap_find.con"
+let index_uri = uri_of_string "cic:/Coq/ring/Quote/index.ind"
 let left_idx_uri = (index_uri, 0, 1)
 let right_idx_uri = (index_uri, 0, 2)
 let end_idx_uri = (index_uri, 0, 3)
 
-let interp_ap_uri =
-  uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/interp_ap.con"
+let abstract_rings_A_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/A.var"
+let abstract_rings_Aplus_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/Aplus.var"
+let abstract_rings_Amult_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/Amult.var"
+let abstract_rings_Aone_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/Aone.var"
+let abstract_rings_Azero_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/Azero.var"
+let abstract_rings_Aopp_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/Aopp.var"
+let abstract_rings_Aeq_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/Aeq.var"
+let abstract_rings_vm_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/vm.var"
+let abstract_rings_T_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/T.var"
+let interp_ap_uri = uri_of_string "cic:/Coq/ring/Ring_abstract/interp_ap.con"
 let interp_sacs_uri =
-  uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/interp_sacs.con"
+  uri_of_string "cic:/Coq/ring/Ring_abstract/interp_sacs.con"
 let apolynomial_normalize_uri =
-  uri_of_string
-    "cic:/Coq/ring/Ring_abstract/abstract_rings/apolynomial_normalize.con"
+  uri_of_string "cic:/Coq/ring/Ring_abstract/apolynomial_normalize.con"
 let apolynomial_normalize_ok_uri =
-  uri_of_string
-    "cic:/Coq/ring/Ring_abstract/abstract_rings/apolynomial_normalize_ok.con"
+  uri_of_string "cic:/Coq/ring/Ring_abstract/apolynomial_normalize_ok.con"
 
 (** CIC PREDICATES *)
 
@@ -157,30 +174,29 @@ let context_of_status ~status:(proof, goal as status) =
     Create a Cic term consisting of a constant
     @param uri URI of the constant
     @proof current proof
+    @exp_named_subst explicit named substitution
   *)
-let mkConst ~uri ~proof =
-  let cookingsno = relative_depth (uri_of_proof ~proof) uri 0 in
-  Cic.Const (uri, cookingsno)
+let mkConst ~uri ~exp_named_subst =
+  Cic.Const (uri, exp_named_subst)
 
   (**
     Create a Cic term consisting of a constructor
     @param uri triple  where uri is the uri of an inductive
     type, typeno is the type number in a mutind structure (0 based), consno is
     the constructor number (1 based)
-    @param proof current proof
+    @exp_named_subst explicit named substitution
   *)
-let mkCtor ~uri:(uri, typeno, consno) ~proof =
-  let cookingsno = relative_depth (uri_of_proof ~proof) uri 0 in
-  Cic.MutConstruct (uri, cookingsno, typeno, consno)
+let mkCtor ~uri:(uri, typeno, consno) ~exp_named_subst =
+ Cic.MutConstruct (uri, typeno, consno, exp_named_subst)
 
   (**
     Create a Cic term consisting of a type member of a mutual induction
     @param uri pair  where uri is the uri of a mutual inductive
     type and typeno is the type number (0 based) in the mutual induction
+    @exp_named_subst explicit named substitution
   *)
-let mkMutInd ~uri:(uri, typeno) ~proof =
-  let cookingsno = relative_depth (uri_of_proof ~proof) uri 0 in
-  Cic.MutInd (uri, cookingsno, typeno)
+let mkMutInd ~uri:(uri, typeno) ~exp_named_subst =
+ Cic.MutInd (uri, typeno, exp_named_subst)
 
 (** EXCEPTIONS *)
 
@@ -195,12 +211,12 @@ exception GoalUnringable
   (**
     Check whether the ring tactic can be applied on a given term (i.e. that is
     an equality on reals)
-    @param term term to be tested
+    @param term to be tested
     @return true if the term is ringable, false otherwise
   *)
 let ringable =
   let is_equality = function
-    | Cic.MutInd uri _ 0 when (eq uri eqt_uri) -> true
+    | Cic.MutInd (uri, 0, []) when (eq uri eqt_uri) -> true
     | _ -> false
   in
   let is_real = function
@@ -238,17 +254,17 @@ let split_eq = function
     @return an index representing the same node in a varmap (@see varmap_uri),
     the returned index is as defined in index (@see index_uri)
   *)
-let path_of_int n proof =
+let path_of_int n =
   let rec digits_of_int n =
     if n=1 then [] else (n mod 2 = 1)::(digits_of_int (n lsr 1))
   in
   List.fold_right
     (fun digit path ->
       Cic.Appl [
-        mkCtor (if (digit = true) then right_idx_uri else left_idx_uri) proof;
+        mkCtor (if (digit = true) then right_idx_uri else left_idx_uri) [];
         path])
     (List.rev (digits_of_int n)) (* remove leading true (i.e. digit 1) *)
-    (mkCtor end_idx_uri proof)
+    (mkCtor end_idx_uri [])
 
   (**
     Build a variable map (@see varmap_uri) from a variables array.
@@ -259,15 +275,12 @@ let path_of_int n proof =
                                                       / \
                                                      y   z
     @param vars variables array
-    @param proof current proof
     @return a cic term representing the variable map containing vars variables
   *)
-let btree_of_array ~vars ~proof =
-  let r = mkConst r_uri proof in                (* cic objects *)
-  let empty_vm = mkCtor empty_vm_uri proof in
-  let empty_vm_r = Cic.Appl [empty_vm; r] in
-  let node_vm = mkCtor node_vm_uri proof in
-  let node_vm_r = Cic.Appl [node_vm; r] in
+let btree_of_array ~vars =
+  let r = mkConst r_uri [] in                (* cic objects *)
+  let empty_vm_r = mkCtor empty_vm_uri [quote_varmap_A_uri,r] in
+  let node_vm_r = mkCtor node_vm_uri [quote_varmap_A_uri,r] in
   let size = Array.length vars in
   let halfsize = size lsr 1 in
   let rec aux n =   (* build the btree starting from position n *)
@@ -278,9 +291,9 @@ let btree_of_array ~vars ~proof =
     if n > size then
       empty_vm_r
     else if n > halfsize then  (* no more children *)
-      Cic.Appl [node_vm; r; vars.(n-1); empty_vm_r; empty_vm_r]
+      Cic.Appl [node_vm_r; vars.(n-1); empty_vm_r; empty_vm_r]
     else  (* still children *)
-      Cic.Appl [node_vm; r; vars.(n-1); aux (n*2); aux (n*2+1)]
+      Cic.Appl [node_vm_r; vars.(n-1); aux (n*2); aux (n*2+1)]
   in
   aux 1
 
@@ -288,11 +301,10 @@ let btree_of_array ~vars ~proof =
     abstraction function:
     concrete polynoms       ----->      (abstract polynoms, varmap)
     @param terms list of conrete polynoms
-    @param proof current proof
     @return a pair  where aterms is a list of abstract polynoms
     and varmap is the variable map needed to interpret them
   *)
-let abstract_poly ~terms ~proof =
+let abstract_poly ~terms =
   let varhash = Hashtbl.create 19 in (* vars hash, to speed up lookup *)
   let varlist = ref [] in  (* vars list in reverse order *)
   let counter = ref 1 in  (* index of next new variable *)
@@ -300,23 +312,23 @@ let abstract_poly ~terms ~proof =
     (* "bop" -> binary operator | "uop" -> unary operator *)
     | Cic.Appl (bop::t1::t2::[])
       when (cic_is_const ~uri:(Some rplus_uri) bop) -> (* +. *)
-        Cic.Appl [mkCtor applus_uri proof; aux t1; aux t2]
+        Cic.Appl [mkCtor applus_uri []; aux t1; aux t2]
     | Cic.Appl (bop::t1::t2::[])
       when (cic_is_const ~uri:(Some rmult_uri) bop) -> (* *. *)
-        Cic.Appl [mkCtor apmult_uri proof; aux t1; aux t2]
+        Cic.Appl [mkCtor apmult_uri []; aux t1; aux t2]
     | Cic.Appl (uop::t::[])
       when (cic_is_const ~uri:(Some ropp_uri) uop) -> (* ~-. *)
-        Cic.Appl [mkCtor apopp_uri proof; aux t]
+        Cic.Appl [mkCtor apopp_uri []; aux t]
     | t when (cic_is_const ~uri:(Some r0_uri) t) -> (* 0. *)
-        mkCtor ap0_uri proof
+        mkCtor ap0_uri []
     | t when (cic_is_const ~uri:(Some r1_uri) t) -> (* 1. *)
-        mkCtor ap1_uri proof
+        mkCtor ap1_uri []
     | t ->  (* variable *)
       try
         Hashtbl.find varhash t (* use an old var *)
       with Not_found -> begin (* create a new var *)
         let newvar =
-          Cic.Appl [mkCtor apvar_uri proof; path_of_int !counter proof]
+          Cic.Appl [mkCtor apvar_uri []; path_of_int !counter]
         in
         incr counter;
         varlist := t :: !varlist;
@@ -326,7 +338,7 @@ let abstract_poly ~terms ~proof =
   in
   let aterms = List.map aux terms in  (* abstract vars *)
   let varmap =  (* build varmap *)
-    btree_of_array ~vars:(Array.of_list (List.rev !varlist)) ~proof
+    btree_of_array ~vars:(Array.of_list (List.rev !varlist))
   in
   (aterms, varmap)
 
@@ -338,39 +350,53 @@ let abstract_poly ~terms ~proof =
           t'''  = apolynomial_normalize_ok(varmap, at)
     at is the abstract term built from t, t is a single member of aterms
   *)
-let build_segments ~terms ~proof =
-  let r = mkConst r_uri proof in              (* cic objects *)
-  let rplus = mkConst rplus_uri proof in
-  let rmult = mkConst rmult_uri proof in
-  let ropp = mkConst ropp_uri proof in
-  let r0 = mkConst r0_uri proof in
-  let r1 = mkConst r1_uri proof in
-  let interp_ap = mkConst interp_ap_uri proof in
-  let interp_sacs = mkConst interp_sacs_uri proof in
-  let apolynomial_normalize = mkConst apolynomial_normalize_uri proof in
-  let apolynomial_normalize_ok = mkConst apolynomial_normalize_ok_uri proof in
-  let rtheory = mkConst rtheory_uri proof in
+let build_segments ~terms =
+  let r = mkConst r_uri [] in              (* cic objects *)
+  let rplus = mkConst rplus_uri [] in
+  let rmult = mkConst rmult_uri [] in
+  let ropp = mkConst ropp_uri [] in
+  let r1 = mkConst r1_uri [] in
+  let r0 = mkConst r0_uri [] in
+  let theory_args_subst varmap =
+   [abstract_rings_A_uri, r ;
+    abstract_rings_Aplus_uri, rplus ;
+    abstract_rings_Amult_uri, rmult ;
+    abstract_rings_Aone_uri, r1 ;
+    abstract_rings_Azero_uri, r0 ;
+    abstract_rings_Aopp_uri, ropp ;
+    abstract_rings_vm_uri, varmap] in
+  let theory_args_subst' eq varmap t =
+   [abstract_rings_A_uri, r ;
+    abstract_rings_Aplus_uri, rplus ;
+    abstract_rings_Amult_uri, rmult ;
+    abstract_rings_Aone_uri, r1 ;
+    abstract_rings_Azero_uri, r0 ;
+    abstract_rings_Aopp_uri, ropp ;
+    abstract_rings_Aeq_uri, eq ;
+    abstract_rings_vm_uri, varmap ;
+    abstract_rings_T_uri, t] in
+  let interp_ap varmap =
+   mkConst interp_ap_uri (theory_args_subst varmap) in
+  let interp_sacs varmap =
+   mkConst interp_sacs_uri (theory_args_subst varmap) in
+  let apolynomial_normalize = mkConst apolynomial_normalize_uri [] in
+  let apolynomial_normalize_ok eq varmap t =
+   mkConst apolynomial_normalize_ok_uri (theory_args_subst' eq varmap t) in
+  let rtheory = mkConst rtheory_uri [] in
   let lxy_false =   (** Cic funcion "fun (x,y):R -> false" *)
-    Cic.Lambda (Cic.Anonimous, r,
-      Cic.Lambda (Cic.Anonimous, r,
-        mkCtor false_uri proof))
+    Cic.Lambda (Cic.Anonymous, r,
+      Cic.Lambda (Cic.Anonymous, r,
+        mkCtor false_uri []))
   in
-  let theory_args = [r; rplus; rmult; r1; r0; ropp] in
-  let (aterms, varmap) = abstract_poly ~terms ~proof in  (* abstract polys *)
+  let (aterms, varmap) = abstract_poly ~terms in  (* abstract polys *)
   List.map    (* build ring segments *)
-    (fun t ->
-      Cic.Appl ((interp_ap :: theory_args) @ [varmap; t]),
-      Cic.Appl (
-        interp_sacs ::
-          (theory_args @
-          [varmap; Cic.Appl [apolynomial_normalize; t]])),
-      Cic.Appl (
-        (apolynomial_normalize_ok :: theory_args) @
-        [lxy_false; varmap; rtheory; t]))
-    aterms
-
-let id_tac ~status:(proof,goal) =
- (proof,[goal])
+   (fun t ->
+     Cic.Appl [interp_ap varmap ; t],
+     Cic.Appl (
+       [interp_sacs varmap ; Cic.Appl [apolynomial_normalize; t]]),
+     Cic.Appl [apolynomial_normalize_ok lxy_false varmap rtheory ; t]
+   ) aterms
+
 
 let status_of_single_goal_tactic_result =
  function
@@ -378,6 +404,7 @@ let status_of_single_goal_tactic_result =
   | _ ->
     raise (Fail "status_of_single_goal_tactic_result: the tactic did not produce exactly a new goal")
 
+(* Galla: spostata in variousTactics.ml 
   (**
     auxiliary tactic "elim_type"
     @param status current proof engine status
@@ -386,7 +413,8 @@ let status_of_single_goal_tactic_result =
 let elim_type_tac ~term ~status =
   warn "in Ring.elim_type_tac";
   Tacticals.thens ~start:(cut_tac ~term)
-   ~continuations:[elim_intros_simpl_tac ~term:(Cic.Rel 1) ; id_tac] ~status
+   ~continuations:[elim_simpl_intros_tac ~term:(Cic.Rel 1) ; Tacticals.id_tac] ~status
+*)
 
   (**
     auxiliary tactic, use elim_type and try to close 2nd subgoal using proof
@@ -395,10 +423,12 @@ let elim_type_tac ~term ~status =
     @param proof term used to prove second subgoal generated by elim_type
   *)
 let elim_type2_tac ~term ~proof ~status =
+  let module E = EliminationTactics in
   warn "in Ring.elim_type2";
-  Tacticals.thens ~start:(elim_type_tac ~term)
-   ~continuations:[id_tac ; exact_tac ~term:proof] ~status
+  Tacticals.thens ~start:(E.elim_type_tac ~term)
+   ~continuations:[Tacticals.id_tac ; exact_tac ~term:proof] ~status
 
+(* Galla: spostata in variousTactics.ml
   (**
     Reflexivity tactic, try to solve current goal using "refl_eqT"
     Warning: this isn't equale to the coq's Reflexivity because this one tries
@@ -407,12 +437,13 @@ let elim_type2_tac ~term ~proof ~status =
   *)
 let reflexivity_tac ~status:(proof, goal) =
   warn "in Ring.reflexivity_tac";
-  let refl_eqt = mkCtor ~uri:refl_eqt_uri ~proof:proof in
+  let refl_eqt = mkCtor ~uri:refl_eqt_uri ~exp_named_subst:[] in
   try
     apply_tac ~status:(proof, goal) ~term:refl_eqt
   with (Fail _) as e ->
     let e_str = Printexc.to_string e in
     raise (Fail ("Reflexivity failed with exception: " ^ e_str))
+*)
 
   (** lift an 8-uple of debrujins indexes of n *)
 let lift ~n (a,b,c,d,e,f,g,h) =
@@ -448,15 +479,14 @@ let purge_hyps_tac ~count ~status:(proof, goal as status) =
     Ring tactic, does associative and commutative rewritings in Reals ring
     @param status current proof engine status
   *)
-let ring_tac ~status:(proof, goal) =
+let ring_tac ~status:((proof, goal) as status) =
   warn "in Ring tactic";
-  let status = (proof, goal) in
-  let eqt = mkMutInd (eqt_uri, 0) proof in
-  let r = mkConst r_uri proof in
+  let eqt = mkMutInd (eqt_uri, 0) [] in
+  let r = mkConst r_uri [] in
   let metasenv = metasenv_of_status ~status in
   let (metano, context, ty) = conj_of_metano goal metasenv in
   let (t1, t2) = split_eq ty in (* goal like t1 = t2 *)
-  match (build_segments ~terms:[t1; t2] ~proof) with
+  match (build_segments ~terms:[t1; t2]) with
   | (t1', t1'', t1'_eq_t1'')::(t2', t2'', t2'_eq_t2'')::[] -> begin
       List.iter  (* debugging, feel free to remove *)
         (fun (descr, term) ->
@@ -471,13 +501,19 @@ let ring_tac ~status:(proof, goal) =
         Tacticals.try_tactics
           ~status
           ~tactics:[
-            "reflexivity", reflexivity_tac;
-            "exact t1'_eq_t1''", exact_tac ~term:t1'_eq_t1'';
-            "exact t2'_eq_t2''", exact_tac ~term:t2'_eq_t2'';
-            "exact sym_eqt su t1 ...", exact_tac ~term:(
-              Cic.Appl [
-                mkConst sym_eqt_uri proof; mkConst r_uri proof;
-                t1''; t1; t1'_eq_t1'']);
+            "reflexivity", EqualityTactics.reflexivity_tac ;
+            "exact t1'_eq_t1''", exact_tac ~term:t1'_eq_t1'' ;
+            "exact t2'_eq_t2''", exact_tac ~term:t2'_eq_t2'' ;
+            "exact sym_eqt su t1 ...", exact_tac
+            ~term:(
+              Cic.Appl
+               [mkConst sym_eqt_uri
+                 [equality_is_a_congruence_A, mkConst r_uri [] ;
+                  equality_is_a_congruence_x, t1'' ;
+                  equality_is_a_congruence_y, t1
+                 ] ;
+                t1'_eq_t1''
+               ]) ;
             "elim_type eqt su t1 ...", (fun ~status ->
               let status' = (* status after 1st elim_type use *)
                 let context = context_of_status ~status in
@@ -506,11 +542,16 @@ let ring_tac ~status:(proof, goal) =
                   ~tactics:[
                     "exact t2'_eq_t2''", exact_tac ~term:t2'_eq_t2'';
                     "exact sym_eqt su t2 ...",
-                      exact_tac ~term:(
-                        Cic.Appl [
-                          mkConst sym_eqt_uri proof;
-                          mkConst r_uri proof;
-                          t2''; t2; t2'_eq_t2'']);
+                      exact_tac
+                       ~term:(
+                         Cic.Appl
+                          [mkConst sym_eqt_uri
+                            [equality_is_a_congruence_A, mkConst r_uri [] ;
+                             equality_is_a_congruence_x, t2'' ;
+                             equality_is_a_congruence_y, t2
+                            ] ;
+                           t2'_eq_t2''
+                          ]) ;
                     "elim_type eqt su t2 ...", (fun ~status ->
                       let status' =
                         let context = context_of_status ~status in
@@ -532,7 +573,7 @@ let ring_tac ~status:(proof, goal) =
                       in
                       try (* try to solve main goal *)
                         warn "trying reflexivity ....";
-                        reflexivity_tac ~status:status'
+                        EqualityTactics.reflexivity_tac ~status:status'
                       with (Fail _) ->  (* leave conclusion to the user *)
                         warn "reflexivity failed, solution's left as an ex :-)";
                         purge_hyps_tac ~count:!new_hyps ~status:status')]
diff --git a/helm/gTopLevel/ring.mli b/helm/ocaml/tactics/ring.mli
similarity index 70%
rename from helm/gTopLevel/ring.mli
rename to helm/ocaml/tactics/ring.mli
index 224f150cc..b6eb34b69 100644
--- a/helm/gTopLevel/ring.mli
+++ b/helm/ocaml/tactics/ring.mli
@@ -2,7 +2,11 @@
   (* ring tactics *)
 val ring_tac: ProofEngineTypes.tactic
 
+(*Galla: spostata in variuosTactics.ml
   (* auxiliary tactics *)
 val elim_type_tac: term: Cic.term -> ProofEngineTypes.tactic
+*)
+
+(* spostata in variousTactics.ml
 val reflexivity_tac: ProofEngineTypes.tactic
-val id_tac : ProofEngineTypes.tactic
+*)
diff --git a/helm/ocaml/tactics/tacticChaser.ml b/helm/ocaml/tactics/tacticChaser.ml
new file mode 100644
index 000000000..6f83c3fd6
--- /dev/null
+++ b/helm/ocaml/tactics/tacticChaser.ml
@@ -0,0 +1,103 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(******************************************************************************)
+(*                                                                            *)
+(*                               PROJECT HELM                                 *)
+(*                                                                            *)
+(*                Claudio Sacerdoti Coen                *)
+(*                                 18/02/2003                                 *)
+(*                                                                            *)
+(*                                                                            *)
+(******************************************************************************)
+
+  (* search arguments on which Apply tactic doesn't fail *)
+let searchPattern mqi_handle ?(output_html = (fun _ -> ())) ~choose_must () ~status =
+ let ((_, metasenv, _, _), metano) = status in
+ let (_, ey ,ty) = List.find (function (m,_,_) -> m=metano) metasenv in
+  let list_of_must,only = MQueryLevels.out_restr metasenv ey ty in
+  let must = choose_must list_of_must only in
+  let torigth_restriction (u,b) =
+   let p =
+    if b then
+     "http://www.cs.unibo.it/helm/schemas/schema-helm#MainConclusion" 
+    else
+     "http://www.cs.unibo.it/helm/schemas/schema-helm#InConclusion"
+    in
+    (u,p,None)
+  in
+  let rigth_must = List.map torigth_restriction must in
+  let rigth_only = Some (List.map torigth_restriction only) in
+  let result =
+	 MQueryInterpreter.execute mqi_handle 
+	    (MQueryGenerator.query_of_constraints None
+		(rigth_must,[],[]) (rigth_only,None,None)) in 
+	let uris =
+	 List.map
+		(function uri,_ ->
+			MQueryMisc.wrong_xpointer_format_from_wrong_xpointer_format' uri
+		) result in
+	 let uris',exc =
+		let rec filter_out =
+		 function
+				[] -> [],""
+			| uri::tl ->
+				 let tl',exc = filter_out tl in
+					try
+					 if
+						(try
+						 ignore
+							(PrimitiveTactics.apply_tac
+							 ~term:(MQueryMisc.term_of_cic_textual_parser_uri
+								(MQueryMisc.cic_textual_parser_uri_of_string uri))
+							 ~status);
+						 true
+						with ProofEngineTypes.Fail _ -> false)
+					 then
+						uri::tl',exc
+					 else
+						tl',exc
+					with
+           (ProofEngineTypes.Fail _) as e ->
+						 let exc' =
+						  "
 ^ Exception raised trying to apply " ^
+							 uri ^ ": " ^ Printexc.to_string e ^ " 
" ^ exc
+						 in
+						  tl',exc'
+		in
+		 filter_out uris
+	 in
+		let html' =
+		 " 
Objects that can actually be applied: 
 " ^
+		 String.concat "
" uris' ^ exc ^
+		 " 
Number of false matches: " ^
+			string_of_int (List.length uris - List.length uris') ^ "
" ^
+		 " 
Number of good matches: " ^
+			string_of_int (List.length uris') ^ "
"
+		in
+		 output_html html' ;
+		 uris'
+;;
+
diff --git a/helm/ocaml/tactics/tacticChaser.mli b/helm/ocaml/tactics/tacticChaser.mli
new file mode 100644
index 000000000..f514360ac
--- /dev/null
+++ b/helm/ocaml/tactics/tacticChaser.mli
@@ -0,0 +1,33 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val searchPattern : MQIConn.handle ->
+  ?output_html:(string -> unit) ->
+    (* boolean value: true = in main position *)
+  choose_must:((MQueryGenerator.uri * bool) list list ->
+               (MQueryGenerator.uri * bool) list ->
+               (MQueryGenerator.uri * bool) list) ->
+  unit -> status: ProofEngineTypes.status -> string list
+
diff --git a/helm/ocaml/tactics/tacticals.ml b/helm/ocaml/tactics/tacticals.ml
new file mode 100644
index 000000000..d499acb9a
--- /dev/null
+++ b/helm/ocaml/tactics/tacticals.ml
@@ -0,0 +1,249 @@
+(* Copyright (C) 2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+open CicReduction
+open ProofEngineTypes
+open UriManager
+
+(** DEBUGGING *)
+
+  (** perform debugging output? *)
+let debug = false
+
+  (** debugging print *)
+let warn s =
+  if debug then
+    prerr_endline ("TACTICALS WARNING: " ^ s)
+
+
+(** TACTIC{,AL}S *)
+
+  (* not a tactical, but it's used only here (?) *)
+
+let id_tac ~status:(proof,goal) =
+  (proof,[goal])
+
+
+  (**
+    naive implementation of ORELSE tactical, try a sequence of tactics in turn:
+    if one fails pass to the next one and so on, eventually raises (failure "no
+    tactics left")
+    TODO warning: not tail recursive due to "try .. with" boxing
+
+    Galla: is this exactly Coq's "First"?
+
+  *)
+let rec try_tactics ~(tactics: (string * tactic) list) ~status =
+  warn "in Tacticals.try_tactics";
+  match tactics with
+  | (descr, tac)::tactics ->
+      warn ("Tacticals.try_tactics IS TRYING " ^ descr);
+      (try
+        let res = tac ~status in
+        warn ("Tacticals.try_tactics: " ^ descr ^ " succedeed!!!");
+        res
+       with
+        e ->
+         match e with
+            (Fail _)
+          | (CicTypeChecker.TypeCheckerFailure (CicTypeChecker.NotWellTyped _))
+          | (CicUnification.UnificationFailed) ->
+              warn (
+                "Tacticals.try_tactics failed with exn: " ^
+                Printexc.to_string e);
+              try_tactics ~tactics ~status
+        | _ -> raise e (* [e] must not be caught ; let's re-raise it *)
+      )
+  | [] -> raise (Fail "try_tactics: no tactics left")
+
+
+
+let thens ~start ~continuations ~status =
+ let (proof,new_goals) = start ~status in
+  try
+   List.fold_left2
+    (fun (proof,goals) goal tactic ->
+      let (proof',new_goals') = tactic ~status:(proof,goal) in
+       (proof',goals@new_goals')
+    ) (proof,[]) new_goals continuations
+  with
+   Invalid_argument _ -> raise (Fail "thens: wrong number of new goals")
+
+
+
+let then_ ~start ~continuation ~status =
+ let (proof,new_goals) = start ~status in
+  List.fold_left
+   (fun (proof,goals) goal ->
+     let (proof',new_goals') = continuation ~status:(proof,goal) in
+      (proof',goals@new_goals')
+   ) (proof,[]) new_goals
+
+
+(* Galla *)
+(* si suppone che tutte le tattiche sollevino solamente Fail? *)
+
+
+(* TODO: x debug: i due tatticali seguenti non contano quante volte hanno applicato la tattica *)
+
+(* This keep on appling tactic until it fails *)
+(* When  generates more than one goal, you have a tree of
+   application on the tactic, repeat_tactic works in depth on this tree *)
+
+let rec repeat_tactic ~tactic ~status =
+  warn "in repeat_tactic";
+  try let (proof, goallist) = tactic ~status in
+   let rec step proof goallist =
+    match goallist with
+       [] -> (proof, [])
+     | head::tail -> 
+        let (proof', goallist') = repeat_tactic ~tactic ~status:(proof, head) in
+         let (proof'', goallist'') = step proof' tail in
+          proof'', goallist'@goallist''
+   in
+    step proof goallist
+  with 
+   (Fail _) as e ->
+    warn ("Tacticals.repeat_tactic failed after nth time with exception: " ^ Printexc.to_string e) ;
+    id_tac ~status
+;;
+
+
+
+(* This tries to apply tactic n times *)
+
+let rec do_tactic ~n ~tactic ~status =
+  warn "in do_tactic";
+  try 
+   let (proof, goallist) = 
+    if (n>0) then tactic ~status 
+             else id_tac ~status in
+(*             else (proof, []) in *)(* perche' non va bene questo? stessa questione di ##### ? *)
+   let rec step proof goallist =
+    match goallist with
+       [] -> (proof, [])
+     | head::tail -> 
+        let (proof', goallist') = do_tactic ~n:(n-1) ~tactic ~status:(proof, head) in
+        let (proof'', goallist'') = step proof' tail in
+         proof'', goallist'@goallist''
+   in
+    step proof goallist
+  with 
+   (Fail _) as e ->
+    warn ("Tacticals.do_tactic failed after nth time with exception: " ^ Printexc.to_string e) ;
+    id_tac ~status
+;;
+
+
+
+(* This applies tactic and catches its possible failure *)
+
+let rec try_tactic ~tactic ~status =
+  warn "in Tacticals.try_tactic";
+  try
+   tactic ~status
+  with
+   (Fail _) as e -> 
+    warn ( "Tacticals.try_tactic failed with exn: " ^ Printexc.to_string e);
+    id_tac ~status
+;;
+
+
+(* This tries tactics until one of them doesn't _solve_ the goal *)
+(* TODO: si puo' unificare le 2(due) chiamate ricorsive? *)
+
+let rec solve_tactics ~(tactics: (string * tactic) list) ~status =
+  warn "in Tacticals.solve_tactics";
+  match tactics with
+  | (descr, currenttactic)::moretactics ->
+      warn ("Tacticals.solve_tactics is trying " ^ descr);
+      (try
+        let (proof, goallist) = currenttactic ~status in
+         match goallist with 
+            [] -> warn ("Tacticals.solve_tactics: " ^ descr ^ " solved the goal!!!");
+(* questo significa che non ci sono piu' goal, o che current_tactic non ne ha aperti di nuovi? (la 2a!) ##### *)
+(* nel secondo caso basta per dire che solve_tactics has solved the goal? (si!) *)
+                  (proof, goallist)
+          | _ -> warn ("Tacticals.solve_tactics: try the next tactic");
+                 solve_tactics ~tactics:(moretactics) ~status
+       with
+        (Fail _) as e ->
+         warn ("Tacticals.solve_tactics: current tactic failed with exn: " ^ Printexc.to_string e);
+         solve_tactics ~tactics ~status
+      )
+  | [] -> raise (Fail "solve_tactics cannot solve the goal");
+          id_tac ~status
+;;
+
+
+
+
+
+
+
+
+
+
+  (** tattica di prova per debuggare i tatticali *)
+(*
+let thens' ~start ~continuations ~status =
+ let (proof,new_goals) = start ~status in
+  try
+   List.fold_left2
+    (fun (proof,goals) goal tactic ->
+      let (proof',new_goals') = tactic ~status:(proof,goal) in
+       (proof',goals@new_goals')
+    ) (proof,[]) new_goals continuations
+  with
+   Invalid_argument _ -> raise (Fail "thens: wrong number of new goals")
+
+let prova_tac =
+ let apply_T_tac ~status:((proof,goal) as status) =
+  let curi,metasenv,pbo,pty = proof in
+  let metano,context,gty = List.find (function (m,_,_) -> m=goal) metasenv in
+   let rel =
+    let rec find n =
+     function
+        [] -> assert false
+      | (Some (Cic.Name name,_))::_ when name = "T" -> n
+      | _::tl -> find (n+1) tl
+    in
+     prerr_endline ("eseguo find");
+     find 1 context
+   in
+    prerr_endline ("eseguo apply");    
+    apply_tac ~term:(Cic.Rel rel) ~status
+ in
+(*  do_tactic ~n:2 *)
+  repeat_tactic
+   ~tactic:
+    (then_
+      ~start:(intros_tac ~name:"pippo")
+      ~continuation:(thens' ~start:apply_T_tac ~continuations:[id_tac ; apply_tac ~term:(Cic.Rel 1)]))
+(* id_tac *)
+;;
+*)
+
+
diff --git a/helm/gTopLevel/tacticals.mli b/helm/ocaml/tactics/tacticals.mli
similarity index 75%
rename from helm/gTopLevel/tacticals.mli
rename to helm/ocaml/tactics/tacticals.mli
index d2cadf4c8..b1861b5fa 100644
--- a/helm/gTopLevel/tacticals.mli
+++ b/helm/ocaml/tactics/tacticals.mli
@@ -23,12 +23,39 @@
  * http://cs.unibo.it/helm/.
  *)
 
+
+val id_tac : ProofEngineTypes.tactic
+
+
+
   (* pseudo tacticals *)
 val try_tactics:
   tactics: (string * ProofEngineTypes.tactic) list -> ProofEngineTypes.tactic
+
 val thens:
  start: ProofEngineTypes.tactic ->
  continuations: ProofEngineTypes.tactic list -> ProofEngineTypes.tactic
+
 val then_:
  start: ProofEngineTypes.tactic ->
  continuation: ProofEngineTypes.tactic -> ProofEngineTypes.tactic
+
+
+val repeat_tactic: 
+ tactic: ProofEngineTypes.tactic -> ProofEngineTypes.tactic
+
+val do_tactic:
+ n: int ->
+ tactic: ProofEngineTypes.tactic -> ProofEngineTypes.tactic 
+
+val try_tactic:
+ tactic: ProofEngineTypes.tactic -> ProofEngineTypes.tactic 
+
+val solve_tactics:
+ tactics: (string * ProofEngineTypes.tactic) list -> ProofEngineTypes.tactic
+
+
+
+(*
+val prova_tac : ProofEngineTypes.tactic
+*)
diff --git a/helm/ocaml/tactics/variousTactics.ml b/helm/ocaml/tactics/variousTactics.ml
new file mode 100644
index 000000000..390d97fb7
--- /dev/null
+++ b/helm/ocaml/tactics/variousTactics.ml
@@ -0,0 +1,96 @@
+(* Copyright (C) 2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+
+(* TODO se ce n'e' piu' di una, prende la prima che trova... sarebbe meglio
+chiedere: find dovrebbe restituire una lista di hyp (?) da passare all'utonto con una
+funzione di callback che restituisce la (sola) hyp da applicare *)
+
+let assumption_tac ~status:((proof,goal) as status) =
+  let module C = Cic in
+  let module R = CicReduction in
+  let module S = CicSubstitution in
+   let _,metasenv,_,_ = proof in
+    let _,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+     let rec find n = function 
+        hd::tl -> 
+         (match hd with
+             (Some (_, C.Decl t)) when
+               (R.are_convertible context (S.lift n t) ty) -> n
+           | (Some (_, C.Def t)) when
+               (R.are_convertible context
+                (CicTypeChecker.type_of_aux' metasenv context (S.lift n t)) ty) -> n 
+           | _ -> find (n+1) tl
+         )
+      | [] -> raise (ProofEngineTypes.Fail "Assumption: No such assumption")
+     in PrimitiveTactics.apply_tac ~status ~term:(C.Rel (find 1 context))
+;;
+
+(* ANCORA DA DEBUGGARE *)
+
+exception AllSelectedTermsMustBeConvertible;;
+
+(* serve una funzione che cerchi nel ty dal basso a partire da term, i lambda
+e li aggiunga nel context, poi si conta la lunghezza di questo nuovo
+contesto e si lifta di tot... COSA SIGNIFICA TUTTO CIO'?????? *)
+
+let generalize_tac
+ ?(mk_fresh_name_callback = ProofEngineHelpers.mk_fresh_name)
+ terms ~status:((proof,goal) as status)
+=
+  let module C = Cic in
+  let module P = PrimitiveTactics in
+  let module T = Tacticals in
+   let _,metasenv,_,_ = proof in
+   let _,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+    let typ =
+     match terms with
+        [] -> assert false
+      | he::tl ->
+         (* We need to check that all the convertibility of all the terms *)
+         List.iter
+          (function t ->
+            if not (CicReduction.are_convertible context he t) then 
+             raise AllSelectedTermsMustBeConvertible
+          ) tl ;
+         (CicTypeChecker.type_of_aux' metasenv context he)
+    in
+     T.thens 
+      ~start:
+        (P.cut_tac 
+         (C.Prod(
+           (mk_fresh_name_callback context C.Anonymous typ), 
+           typ,
+           (ProofEngineReduction.replace_lifting_csc 1
+             ~equality:(==) 
+             ~what:terms
+             ~with_what:(List.map (function _ -> C.Rel 1) terms)
+             ~where:ty)
+         )))
+      ~continuations: [(P.apply_tac ~term:(C.Rel 1)) ; T.id_tac]
+      ~status
+;;
+
+
diff --git a/helm/ocaml/tactics/variousTactics.mli b/helm/ocaml/tactics/variousTactics.mli
new file mode 100644
index 000000000..2b45aa156
--- /dev/null
+++ b/helm/ocaml/tactics/variousTactics.mli
@@ -0,0 +1,31 @@
+(* Copyright (C) 2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+exception AllSelectedTermsMustBeConvertible;;
+
+val assumption_tac: ProofEngineTypes.tactic
+val generalize_tac:
+ ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type -> Cic.term list ->
+  ProofEngineTypes.tactic
diff --git a/helm/ocaml/tex_cic_textual_parser/.cvsignore b/helm/ocaml/tex_cic_textual_parser/.cvsignore
new file mode 100644
index 000000000..1569cb433
--- /dev/null
+++ b/helm/ocaml/tex_cic_textual_parser/.cvsignore
@@ -0,0 +1 @@
+*.cm[iaox] *.cmxa texCicTextualParser.ml texCicTextualParser.mli texCicTextualLexer.ml
diff --git a/helm/ocaml/tex_cic_textual_parser/.depend b/helm/ocaml/tex_cic_textual_parser/.depend
new file mode 100644
index 000000000..71156776a
--- /dev/null
+++ b/helm/ocaml/tex_cic_textual_parser/.depend
@@ -0,0 +1,9 @@
+texCicTextualParserContext.cmi: texCicTextualParser.cmi 
+texCicTextualParser.cmo: texCicTextualParser0.cmo texCicTextualParser.cmi 
+texCicTextualParser.cmx: texCicTextualParser0.cmx texCicTextualParser.cmi 
+texCicTextualParserContext.cmo: texCicTextualParser.cmi \
+    texCicTextualParser0.cmo texCicTextualParserContext.cmi 
+texCicTextualParserContext.cmx: texCicTextualParser.cmx \
+    texCicTextualParser0.cmx texCicTextualParserContext.cmi 
+texCicTextualLexer.cmo: texCicTextualParser.cmi 
+texCicTextualLexer.cmx: texCicTextualParser.cmx 
diff --git a/helm/ocaml/tex_cic_textual_parser/Makefile b/helm/ocaml/tex_cic_textual_parser/Makefile
new file mode 100644
index 000000000..b57b3a8ba
--- /dev/null
+++ b/helm/ocaml/tex_cic_textual_parser/Makefile
@@ -0,0 +1,14 @@
+PACKAGE = tex_cic_textual_parser
+REQUIRES = helm-cic helm-cic_textual_parser
+PREDICATES =
+
+INTERFACE_FILES = texCicTextualParser.mli texCicTextualParserContext.mli
+IMPLEMENTATION_FILES = texCicTextualParser0.ml $(INTERFACE_FILES:%.mli=%.ml) \
+                       texCicTextualLexer.ml
+EXTRA_OBJECTS_TO_INSTALL = texCicTextualParser0.ml texCicTextualParser0.cmi \
+                           texCicTextualLexer.mll texCicTextualParser.mly
+
+EXTRA_OBJECTS_TO_CLEAN = texCicTextualParser.ml texCicTextualParser.mli \
+                         texCicTextualLexer.ml
+
+include ../Makefile.common
diff --git a/helm/ocaml/tex_cic_textual_parser/texCicTextualLexer.mll b/helm/ocaml/tex_cic_textual_parser/texCicTextualLexer.mll
new file mode 100644
index 000000000..01ddd0cf3
--- /dev/null
+++ b/helm/ocaml/tex_cic_textual_parser/texCicTextualLexer.mll
@@ -0,0 +1,122 @@
+(* Copyright (C) 2000, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+{
+ open TexCicTextualParser;;
+ module L = Lexing;;
+ module U = UriManager;;
+
+ let indtyuri_of_uri uri =
+  let index_sharp =  String.index uri '#' in
+  let index_num = index_sharp + 3 in
+   try
+    (UriManager.uri_of_string (String.sub uri 0 index_sharp),
+     int_of_string(String.sub uri index_num (String.length uri - index_num)) - 1
+    )
+   with
+    Failure msg ->
+     raise (CicTextualParser0.LexerFailure "Not an inductive URI")
+ ;;
+
+ let indconuri_of_uri uri =
+  let index_sharp =  String.index uri '#' in
+  let index_div = String.rindex uri '/' in
+  let index_con = index_div + 1 in
+   try
+    (UriManager.uri_of_string (String.sub uri 0 index_sharp),
+     int_of_string
+      (String.sub uri (index_sharp + 3) (index_div - index_sharp - 3)) - 1,
+     int_of_string
+      (String.sub uri index_con (String.length uri - index_con))
+    )
+   with
+    Failure msg ->
+     raise (CicTextualParser0.LexerFailure "Not a constructor URI")
+ ;;
+
+ (* TeX unquoting for "_" *)
+ let unquote str =
+  Str.global_replace (Str.regexp "\\\\_") "_" str
+ ;;
+}
+let dollar = '$'
+let num = ['1'-'9']['0'-'9']* | '0'
+let letter = ['A'-'Z' 'a'-'z']
+let alfa = letter | ['_' ''' '-'] | "\\_"
+let ident = letter (alfa | num)*
+let baseuri = '/'(ident '/')* ident '.'
+let conuri = baseuri "con"
+let varuri = baseuri "var"
+let indtyuri = baseuri "ind#1/" num
+let indconuri = baseuri "ind#1/" num "/" num
+let blanks = [' ' '\t' '\n' '~' '{' '}'] | "\\;" | "\\rm"
+rule token =
+ parse
+    blanks      { token lexbuf } (* skip blanks *)
+  | "\\Case"    { CASE }
+  | "\\Fix"     { FIX }
+  | "\\CoFix"   { COFIX }
+  | "\\Set"     { SET }
+  | "\\Prop"    { PROP }
+  | "\\Type"    { TYPE }
+  | ident       { ID (unquote (L.lexeme lexbuf)) }
+  | conuri      { CONURI
+                   (U.uri_of_string ("cic:" ^ (unquote (L.lexeme lexbuf)))) }
+  | varuri      { VARURI
+                   (U.uri_of_string ("cic:" ^ (unquote (L.lexeme lexbuf)))) }
+  | indtyuri    { INDTYURI
+                   (indtyuri_of_uri ("cic:" ^ (unquote (L.lexeme lexbuf)))) }
+  | indconuri   { INDCONURI
+                   (indconuri_of_uri("cic:" ^ (unquote (L.lexeme lexbuf)))) }
+  | num         { NUM (int_of_string (L.lexeme lexbuf)) }
+  | '?' num     { let lexeme = L.lexeme lexbuf in
+                   META
+                    (int_of_string
+                     (String.sub lexeme 1 (String.length lexeme - 1))) }
+  | ":>"        { CAST }
+  | ":="        { LETIN }
+  | '?'         { IMPLICIT }
+  | '('         { LPAREN }
+  | ')'         { RPAREN }
+  | "\\["         { LBRACKET }
+  | "\\]"         { RBRACKET }
+  | "\\{"       { LCURLY }
+  | "\\}"       { RCURLY }
+  | ';'         { SEMICOLON }
+  | "\\lambda"  { LAMBDA }
+  | "\\pi"      { PROD }
+  | "\\forall"  { PROD }
+  | ':'         { COLON }
+  | '.'         { DOT }
+  | "\\to"      { ARROW }
+  | '_'         { NONE }
+  | dollar      { DOLLAR }
+  | eof         { EOF }
+  (* Arithmetical operators *)
+  | '+'         { PLUS }
+  | '-'         { MINUS }
+  | '*'         { TIMES }
+  | '='         { EQ }
+{}
diff --git a/helm/ocaml/tex_cic_textual_parser/texCicTextualParser.mly b/helm/ocaml/tex_cic_textual_parser/texCicTextualParser.mly
new file mode 100644
index 000000000..e26145e28
--- /dev/null
+++ b/helm/ocaml/tex_cic_textual_parser/texCicTextualParser.mly
@@ -0,0 +1,598 @@
+/* Copyright (C) 2000, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ */
+
+%{
+ open Cic;;
+ module U = UriManager;;
+
+ exception InvalidSuffix of string;;
+ exception InductiveTypeURIExpected;;
+ exception UnknownIdentifier of string;;
+ exception ExplicitNamedSubstitutionAppliedToRel;;
+ exception TheLeftHandSideOfAnExplicitNamedSubstitutionMustBeAVariable;;
+ 
+ (* merge removing duplicates of two lists free of duplicates *)
+ let union dom1 dom2 =
+  let rec filter =
+   function
+      [] -> []
+    | he::tl ->
+       if List.mem he dom1 then filter tl else he::(filter tl)
+  in
+   dom1 @ (filter dom2)
+ ;;
+
+ let get_index_in_list e =
+  let rec aux i =
+   function
+      [] -> raise Not_found
+    | (Some he)::_ when he = e -> i
+    | _::tl -> aux (i+1) tl
+  in
+   aux 1
+ ;;
+
+ (* Returns the first meta whose number is above the *)
+ (* number of the higher meta.                       *)
+ (*CSC: cut&pasted from proofEngine.ml *)
+ let new_meta () =
+  let rec aux =
+   function
+      None,[] -> 1
+    | Some n,[] -> n
+    | None,(n,_,_)::tl -> aux (Some n,tl)
+    | Some m,(n,_,_)::tl -> if n > m then aux (Some n,tl) else aux (Some m,tl)
+  in
+   1 + aux (None,!TexCicTextualParser0.metasenv)
+ ;;
+
+ (* identity_relocation_list_for_metavariable i canonical_context         *)
+ (* returns the identity relocation list, which is the list [1 ; ... ; n] *)
+ (* where n = List.length [canonical_context]                             *)
+ (*CSC: ma mi basta la lunghezza del contesto canonico!!!*)
+ (*CSC: cut&pasted from proofEngine.ml *)
+ let identity_relocation_list_for_metavariable canonical_context =
+  let canonical_context_length = List.length canonical_context in
+   let rec aux =
+    function
+       (_,[]) -> []
+     | (n,None::tl) -> None::(aux ((n+1),tl))
+     | (n,_::tl) -> (Some (Cic.Rel n))::(aux ((n+1),tl))
+   in
+    aux (1,canonical_context)
+ ;;
+
+ let deoptionize_exp_named_subst =
+  function
+     None -> [], (function _ -> [])
+   | Some (dom,mk_exp_named_subst) -> dom,mk_exp_named_subst
+ ;;
+
+ let term_of_con_uri uri exp_named_subst =
+  Const (uri,exp_named_subst)
+ ;;
+
+ let term_of_var_uri uri exp_named_subst =
+  Var (uri,exp_named_subst)
+ ;;
+
+ let term_of_indty_uri (uri,tyno) exp_named_subst =
+  MutInd (uri, tyno, exp_named_subst)
+ ;;
+
+ let term_of_indcon_uri (uri,tyno,consno) exp_named_subst =
+  MutConstruct (uri, tyno, consno, exp_named_subst)
+ ;;
+
+ let term_of_uri uri =
+  match uri with
+     CicTextualParser0.ConUri uri ->
+      term_of_con_uri uri
+   | CicTextualParser0.VarUri uri ->
+      term_of_var_uri uri
+   | CicTextualParser0.IndTyUri (uri,tyno) ->
+      term_of_indty_uri (uri,tyno) 
+   | CicTextualParser0.IndConUri (uri,tyno,consno) ->
+      term_of_indcon_uri (uri,tyno,consno)
+ ;;
+
+ let var_uri_of_id id interp =
+  let module CTP0 = CicTextualParser0 in
+   match interp (CicTextualParser0.Id id) with
+      None -> raise (UnknownIdentifier id)
+    | Some (CTP0.Uri (CTP0.VarUri uri)) -> uri
+    | Some _ -> raise TheLeftHandSideOfAnExplicitNamedSubstitutionMustBeAVariable
+ ;;
+
+ let indty_uri_of_id id interp =
+  let module CTP0 = CicTextualParser0 in
+   match interp (CicTextualParser0.Id id) with
+      None -> raise (UnknownIdentifier id)
+    | Some (CTP0.Uri (CTP0.IndTyUri (uri,tyno))) -> (uri,tyno)
+    | Some _ -> raise InductiveTypeURIExpected
+ ;;
+
+ let mk_implicit () =
+  let newmeta = new_meta () in
+   let new_canonical_context = [] in
+    let irl =
+     identity_relocation_list_for_metavariable new_canonical_context
+    in
+     TexCicTextualParser0.metasenv :=
+      [newmeta, new_canonical_context, Sort Type ;
+       newmeta+1, new_canonical_context, Meta (newmeta,irl);
+       newmeta+2, new_canonical_context, Meta (newmeta+1,irl)
+      ] @ !TexCicTextualParser0.metasenv ;
+     [], function _ -> Meta (newmeta+2,irl)
+ ;;
+%}
+%token  ID
+%token  META
+%token  NUM
+%token  CONURI
+%token  VARURI
+%token  INDTYURI
+%token  INDCONURI
+%token LPAREN RPAREN PROD LAMBDA COLON DOT SET PROP TYPE CAST IMPLICIT NONE
+%token LETIN FIX COFIX SEMICOLON LCURLY RCURLY CASE ARROW LBRACKET RBRACKET EOF
+%token DOLLAR
+%token PLUS MINUS TIMES EQ
+%right ARROW
+%right EQ
+%right PLUS MINUS
+%right TIMES
+%start main
+%type  Cic.term)> main
+%%
+main:
+ | EOF { raise CicTextualParser0.Eof } /* FG: was never raised */
+ | DOLLAR DOLLAR EOF {raise CicTextualParser0.Eof }
+ | DOLLAR DOLLAR DOLLAR DOLLAR EOF {raise CicTextualParser0.Eof }
+ | expr EOF { $1 }
+ | DOLLAR expr DOLLAR EOF { $2 }
+ | DOLLAR DOLLAR expr DOLLAR DOLLAR EOF { $3 }
+ | expr SEMICOLON { $1 } /*  FG: to read several terms in a row
+                          *  Do we need to clear some static variables? 
+			  */
+;
+expr2:
+   NUM
+   { [], function interp ->
+      let rec cic_int_of_int =
+       function
+          0 ->
+           Cic.MutConstruct
+            (UriManager.uri_of_string "cic:/Coq/Init/Datatypes/nat.ind",
+             0,1,[])
+        | n ->
+          Cic.Appl
+           [ Cic.MutConstruct
+              (UriManager.uri_of_string "cic:/Coq/Init/Datatypes/nat.ind",
+               0,2,[]) ;
+             cic_int_of_int (n - 1)
+           ]
+      in
+       cic_int_of_int $1
+   }
+ | expr2 PLUS expr2
+   { let dom1,mk_expr1 = $1 in
+     let dom2,mk_expr2 = $3 in
+      let dom = union dom1 dom2 in
+       dom, function interp ->
+        Cic.Appl
+         [Cic.Const
+           (UriManager.uri_of_string "cic:/Coq/Init/Peano/plus.con",[]) ;
+          (mk_expr1 interp) ;
+          (mk_expr2 interp)
+         ]
+   }
+ | expr2 MINUS expr2
+   { let dom1,mk_expr1 = $1 in
+     let dom2,mk_expr2 = $3 in
+      let dom = union dom1 dom2 in
+       dom, function interp ->
+        Cic.Appl
+         [Cic.Const
+           (UriManager.uri_of_string "cic:/Coq/Arith/Minus/minus.con",[]) ;
+          (mk_expr1 interp) ;
+          (mk_expr2 interp)
+         ]
+   }
+ | expr2 TIMES expr2
+   { let dom1,mk_expr1 = $1 in
+     let dom2,mk_expr2 = $3 in
+      let dom = union dom1 dom2 in
+       dom, function interp ->
+        Cic.Appl
+         [Cic.Const
+           (UriManager.uri_of_string "cic:/Coq/Init/Peano/mult.con",[]) ;
+          (mk_expr1 interp) ;
+          (mk_expr2 interp)
+         ]
+   }
+ | expr2 EQ expr2
+   { let dom1,mk_expr1 = $1 in
+     let dom2,mk_expr2 = $3 in
+     let dom3,mk_expr3 = mk_implicit () in
+      let dom = union dom1 (union dom2 dom3) in
+       dom, function interp ->
+        Cic.Appl
+         [Cic.MutInd
+           (UriManager.uri_of_string "cic:/Coq/Init/Logic/eq.ind",0,[]) ;
+          (mk_expr3 interp) ;
+          (mk_expr1 interp) ;
+          (mk_expr2 interp)
+         ]
+   }
+ | CONURI exp_named_subst
+   { let dom,mk_exp_named_subst = deoptionize_exp_named_subst $2 in
+      dom, function interp -> term_of_con_uri $1 (mk_exp_named_subst interp)
+   }
+ | VARURI exp_named_subst
+   { let dom,mk_exp_named_subst = deoptionize_exp_named_subst $2 in
+      dom, function interp -> term_of_var_uri $1 (mk_exp_named_subst interp)
+   }
+ | INDTYURI exp_named_subst
+   { let dom,mk_exp_named_subst = deoptionize_exp_named_subst $2 in
+      dom, function interp -> term_of_indty_uri $1 (mk_exp_named_subst interp)
+   }
+ | INDCONURI exp_named_subst
+   { let dom,mk_exp_named_subst = deoptionize_exp_named_subst $2 in
+      dom, function interp -> term_of_indcon_uri $1 (mk_exp_named_subst interp)
+   }
+ | ID exp_named_subst
+   { try
+      let res =
+       Rel (get_index_in_list (Name $1) !TexCicTextualParser0.binders)
+      in
+       (match $2 with
+           None -> ([], function _ -> res)
+         | Some _ -> raise (ExplicitNamedSubstitutionAppliedToRel)
+       )
+     with
+      Not_found ->
+       let dom1,mk_exp_named_subst = deoptionize_exp_named_subst $2 in
+        let dom = union dom1 [CicTextualParser0.Id $1] in
+         dom,
+          function interp ->
+           match interp (CicTextualParser0.Id $1) with
+	      None  -> raise (UnknownIdentifier $1)
+	    | Some (CicTextualParser0.Uri uri) ->
+               term_of_uri uri (mk_exp_named_subst interp)
+            | Some CicTextualParser0.Implicit ->
+               (*CSC: not very clean; to maximize code reusage *)
+               snd (mk_implicit ()) ""
+            | Some (CicTextualParser0.Term mk_term) ->
+               (mk_term interp)
+   }
+ | CASE LPAREN expr COLON INDTYURI SEMICOLON expr RPAREN LCURLY branches RCURLY
+    { let dom1,mk_expr1 = $3 in
+      let dom2,mk_expr2 = $7 in
+      let dom3,mk_expr3 = $10 in
+       let dom = union dom1 (union dom2 dom3) in
+        dom,
+        function interp ->
+         MutCase
+          (fst $5,snd $5,(mk_expr2 interp),(mk_expr1 interp),(mk_expr3 interp))
+    }
+ | CASE LPAREN expr COLON ID SEMICOLON expr RPAREN LCURLY branches RCURLY
+    { let dom1,mk_expr1 = $3 in
+      let dom2,mk_expr2 = $7 in
+      let dom3,mk_expr3 = $10 in
+       let dom =
+        union [CicTextualParser0.Id $5] (union dom1 (union dom2 dom3))
+       in
+        dom,
+        function interp ->
+         let uri,typeno = indty_uri_of_id $5 interp in
+          MutCase
+           (uri,typeno,(mk_expr2 interp),(mk_expr1 interp),
+             (mk_expr3 interp))
+    }
+ | fixheader LCURLY exprseplist RCURLY
+    { let dom1,foo,ids_and_indexes,mk_types = $1 in
+      let dom2,mk_exprseplist = $3 in
+       let dom = union dom1 dom2 in
+        for i = 1 to List.length ids_and_indexes do
+         TexCicTextualParser0.binders := List.tl !TexCicTextualParser0.binders
+        done ;
+        dom,
+         function interp ->
+          let types = mk_types interp in
+          let fixfunsbodies = (mk_exprseplist interp) in
+           let idx =
+            let rec find idx =
+             function
+                [] -> raise Not_found
+              | (name,_)::_  when name = foo -> idx
+              | _::tl -> find (idx+1) tl
+            in
+             find 0 ids_and_indexes
+           in
+            let fixfuns =
+             List.map2 (fun ((name,recindex),ty) bo -> (name,recindex,ty,bo))
+              (List.combine ids_and_indexes types) fixfunsbodies
+            in
+             Fix (idx,fixfuns)
+    }
+ | cofixheader LCURLY exprseplist RCURLY
+    { let dom1,foo,ids,mk_types = $1 in
+      let dom2,mk_exprseplist = $3 in
+       let dom = union dom1 dom2 in
+        dom,
+         function interp ->
+          let types = mk_types interp in
+          let fixfunsbodies = (mk_exprseplist interp) in
+           let idx =
+            let rec find idx =
+             function
+                [] -> raise Not_found
+              | name::_  when name = foo -> idx
+              | _::tl -> find (idx+1) tl
+            in
+             find 0 ids
+           in
+            let fixfuns =
+             List.map2 (fun (name,ty) bo -> (name,ty,bo))
+              (List.combine ids types) fixfunsbodies
+            in
+             for i = 1 to List.length fixfuns do
+              TexCicTextualParser0.binders :=
+               List.tl !TexCicTextualParser0.binders
+             done ;
+             CoFix (idx,fixfuns)
+    }
+ | IMPLICIT
+    { mk_implicit () }
+ | SET  { [], function _ -> Sort Set }
+ | PROP { [], function _ -> Sort Prop }
+ | TYPE { [], function _ -> Sort Type }
+ | LPAREN expr CAST expr RPAREN
+    { let dom1,mk_expr1 = $2 in
+      let dom2,mk_expr2 = $4 in
+       let dom = union dom1 dom2 in
+        dom, function interp -> Cast ((mk_expr1 interp),(mk_expr2 interp))
+    }
+ | META LBRACKET substitutionlist RBRACKET
+    { let dom,mk_substitutionlist = $3 in
+       dom, function interp -> Meta ($1, mk_substitutionlist interp)
+    } 
+ | LPAREN expr exprlist RPAREN
+    { let length,dom2,mk_exprlist = $3 in
+       match length with
+          0 -> $2
+        | _ ->
+          let dom1,mk_expr1 = $2 in
+           let dom = union dom1 dom2 in
+            dom,
+             function interp ->
+              Appl ((mk_expr1 interp)::(mk_exprlist interp))
+    }
+;
+exp_named_subst :
+    { None }
+ | LCURLY named_substs RCURLY
+    { Some $2 }
+;
+named_substs :
+   VARURI LETIN expr2
+    { let dom,mk_expr = $3 in
+       dom, function interp -> [$1, mk_expr interp] }
+ | ID LETIN expr2
+    { let dom1,mk_expr = $3 in
+       let dom = union [CicTextualParser0.Id $1] dom1 in
+        dom, function interp -> [var_uri_of_id $1 interp, mk_expr interp] }
+ | VARURI LETIN expr2 SEMICOLON named_substs
+    { let dom1,mk_expr = $3 in
+      let dom2,mk_named_substs = $5 in
+       let dom = union dom1 dom2 in
+        dom, function interp -> ($1, mk_expr interp)::(mk_named_substs interp)
+    }
+ | ID LETIN expr2 SEMICOLON named_substs
+    { let dom1,mk_expr = $3 in
+      let dom2,mk_named_substs = $5 in
+       let dom = union [CicTextualParser0.Id $1] (union dom1 dom2) in
+        dom,
+         function interp ->
+          (var_uri_of_id $1 interp, mk_expr interp)::(mk_named_substs interp)
+    }
+;
+expr :
+   pihead expr
+    { TexCicTextualParser0.binders := List.tl !TexCicTextualParser0.binders ;
+      let dom1,mk_expr1 = snd $1 in
+      let dom2,mk_expr2 = $2 in
+       let dom = union dom1 dom2 in
+        dom, function interp -> Prod (fst $1, mk_expr1 interp, mk_expr2 interp)
+    }
+ | lambdahead expr
+    { TexCicTextualParser0.binders := List.tl !TexCicTextualParser0.binders ;
+      let dom1,mk_expr1 = snd $1 in
+      let dom2,mk_expr2 = $2 in
+       let dom = union dom1 dom2 in
+        dom,function interp -> Lambda (fst $1, mk_expr1 interp, mk_expr2 interp)
+    }
+ | letinhead expr
+    { TexCicTextualParser0.binders := List.tl !TexCicTextualParser0.binders ;
+      let dom1,mk_expr1 = snd $1 in
+      let dom2,mk_expr2 = $2 in
+       let dom = union dom1 dom2 in
+        dom, function interp -> LetIn (fst $1, mk_expr1 interp, mk_expr2 interp)
+    }
+ | expr2
+    { $1 }
+;
+fixheader:
+   FIX ID LCURLY fixfunsdecl RCURLY
+    { let dom,ids_and_indexes,mk_types = $4 in
+       let bs =
+        List.rev_map (function (name,_) -> Some (Name name)) ids_and_indexes
+       in
+        TexCicTextualParser0.binders := bs@(!TexCicTextualParser0.binders) ;
+        dom, $2, ids_and_indexes, mk_types
+    }
+;
+fixfunsdecl:
+   ID LPAREN NUM RPAREN COLON expr
+    { let dom,mk_expr = $6 in
+       dom, [$1,$3], function interp -> [mk_expr interp]
+    }
+ | ID LPAREN NUM RPAREN COLON expr SEMICOLON fixfunsdecl
+    { let dom1,mk_expr = $6 in
+      let dom2,ids_and_indexes,mk_types = $8 in
+       let dom = union dom1 dom2 in
+        dom, ($1,$3)::ids_and_indexes,
+         function interp -> (mk_expr interp)::(mk_types interp)
+    }
+;
+cofixheader:
+   COFIX ID LCURLY cofixfunsdecl RCURLY
+    { let dom,ids,mk_types = $4 in
+       let bs =
+        List.rev_map (function name -> Some (Name name)) ids
+       in
+        TexCicTextualParser0.binders := bs@(!TexCicTextualParser0.binders) ;
+        dom, $2, ids, mk_types
+    }
+;
+cofixfunsdecl:
+   ID COLON expr
+    { let dom,mk_expr = $3 in
+       dom, [$1], function interp -> [mk_expr interp]
+    }
+ | ID COLON expr SEMICOLON cofixfunsdecl
+    { let dom1,mk_expr = $3 in
+      let dom2,ids,mk_types = $5 in
+       let dom = union dom1 dom2 in
+        dom, $1::ids,
+         function interp -> (mk_expr interp)::(mk_types interp)
+    }
+;
+pihead:
+   PROD ID COLON expr DOT
+    { TexCicTextualParser0.binders :=
+       (Some (Name $2))::!TexCicTextualParser0.binders;
+      let dom,mk_expr = $4 in
+       Cic.Name $2, (dom, function interp -> mk_expr interp)
+    }
+ | expr2 ARROW
+   { TexCicTextualParser0.binders :=
+      (Some Anonymous)::!TexCicTextualParser0.binders ;
+     let dom,mk_expr = $1 in
+      Anonymous, (dom, function interp -> mk_expr interp)
+   }
+ | PROD ID DOT
+    { TexCicTextualParser0.binders :=
+       (Some (Name $2))::!TexCicTextualParser0.binders;
+      let newmeta = new_meta () in
+       let new_canonical_context = [] in
+        let irl =
+         identity_relocation_list_for_metavariable new_canonical_context
+        in
+         TexCicTextualParser0.metasenv :=
+          [newmeta, new_canonical_context, Sort Type ;
+           newmeta+1, new_canonical_context, Meta (newmeta,irl)
+          ] @ !TexCicTextualParser0.metasenv ;
+         Cic.Name $2, ([], function _ -> Meta (newmeta+1,irl))
+    }
+;
+lambdahead:
+   LAMBDA ID COLON expr DOT
+    { TexCicTextualParser0.binders :=
+       (Some (Name $2))::!TexCicTextualParser0.binders;
+      let dom,mk_expr = $4 in
+       Cic.Name $2, (dom, function interp -> mk_expr interp)
+    }
+ | LAMBDA ID DOT
+    { TexCicTextualParser0.binders :=
+       (Some (Name $2))::!TexCicTextualParser0.binders;
+      let newmeta = new_meta () in
+       let new_canonical_context = [] in
+        let irl =
+         identity_relocation_list_for_metavariable new_canonical_context
+        in
+         TexCicTextualParser0.metasenv :=
+          [newmeta, new_canonical_context, Sort Type ;
+           newmeta+1, new_canonical_context, Meta (newmeta,irl)
+          ] @ !TexCicTextualParser0.metasenv ;
+         Cic.Name $2, ([], function _ -> Meta (newmeta+1,irl))
+    }
+;
+letinhead:
+  LAMBDA ID LETIN expr DOT
+   { TexCicTextualParser0.binders :=
+      (Some (Name $2))::!TexCicTextualParser0.binders ;
+     let dom,mk_expr = $4 in
+      Cic.Name $2, (dom, function interp -> mk_expr interp)
+   }
+;
+branches:
+    { [], function _ -> [] }
+ | expr SEMICOLON branches
+    { let dom1,mk_expr = $1 in
+      let dom2,mk_branches = $3 in
+       let dom = union dom1 dom2 in
+        dom, function interp -> (mk_expr interp)::(mk_branches interp)
+    }
+ | expr
+    { let dom,mk_expr = $1 in
+       dom, function interp -> [mk_expr interp]
+    }
+;
+exprlist:
+    
+    { 0, [], function _ -> [] }
+ | expr exprlist
+    { let dom1,mk_expr = $1 in
+      let length,dom2,mk_exprlist = $2 in
+       let dom = union dom1 dom2 in
+        length+1, dom, function interp -> (mk_expr interp)::(mk_exprlist interp)
+    }
+;
+exprseplist:
+   expr
+    { let dom,mk_expr = $1 in
+       dom, function interp -> [mk_expr interp]
+    }
+ | expr SEMICOLON exprseplist
+    { let dom1,mk_expr = $1 in
+      let dom2,mk_exprseplist = $3 in
+       let dom = union dom1 dom2 in
+        dom, function interp -> (mk_expr interp)::(mk_exprseplist interp)
+    }
+;
+substitutionlist:
+    { [], function _ -> [] }
+ | expr SEMICOLON substitutionlist
+    { let dom1,mk_expr = $1 in
+      let dom2,mk_substitutionlist = $3 in
+       let dom = union dom1 dom2 in
+        dom,
+         function interp ->(Some (mk_expr interp))::(mk_substitutionlist interp)
+    }
+ | NONE SEMICOLON substitutionlist
+    { let dom,mk_exprsubstitutionlist = $3 in
+       dom, function interp -> None::(mk_exprsubstitutionlist interp)
+    }
diff --git a/helm/ocaml/cic_proof_checking/cicCooking.mli b/helm/ocaml/tex_cic_textual_parser/texCicTextualParser0.ml
similarity index 74%
rename from helm/ocaml/cic_proof_checking/cicCooking.mli
rename to helm/ocaml/tex_cic_textual_parser/texCicTextualParser0.ml
index 960fb6fae..133f2e0bb 100644
--- a/helm/ocaml/cic_proof_checking/cicCooking.mli
+++ b/helm/ocaml/tex_cic_textual_parser/texCicTextualParser0.ml
@@ -23,12 +23,5 @@
  * http://cs.unibo.it/helm/.
  *)
 
-exception Impossible
-exception NotImplemented of int * string
-exception WrongUriToConstant
-exception WrongUriToVariable of string
-exception WrongUriToInductiveDefinition
-
-(* init register the cooking function defined in this module so that it *)
-(* will be used to retrieve the cooked objects from the environment     *)
-val init : unit -> unit
+let binders = ref ([] : (Cic.name option) list);;
+let metasenv = ref ([] : Cic.metasenv);;
diff --git a/helm/ocaml/tex_cic_textual_parser/texCicTextualParserContext.ml b/helm/ocaml/tex_cic_textual_parser/texCicTextualParserContext.ml
new file mode 100644
index 000000000..28581bc58
--- /dev/null
+++ b/helm/ocaml/tex_cic_textual_parser/texCicTextualParserContext.ml
@@ -0,0 +1,36 @@
+(* Copyright (C) 2000, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+let main ~context ~metasenv lexer lexbuf =
+ (* Warning: higly non-reentrant code!!! *)
+ TexCicTextualParser0.binders := context ;
+ TexCicTextualParser0.metasenv := metasenv ;
+ let dom,mk_term = TexCicTextualParser.main lexer lexbuf in
+  dom,
+   function interp ->
+    let term = mk_term interp in 
+    let metasenv = !TexCicTextualParser0.metasenv in
+     metasenv,term
+;;
diff --git a/helm/ocaml/tex_cic_textual_parser/texCicTextualParserContext.mli b/helm/ocaml/tex_cic_textual_parser/texCicTextualParserContext.mli
new file mode 100644
index 000000000..492b52d09
--- /dev/null
+++ b/helm/ocaml/tex_cic_textual_parser/texCicTextualParserContext.mli
@@ -0,0 +1,31 @@
+(* Copyright (C) 2000, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+val main :
+  context:((Cic.name option) list) ->
+  metasenv:Cic.metasenv ->
+  (Lexing.lexbuf  -> TexCicTextualParser.token) -> Lexing.lexbuf ->
+   CicTextualParser0.interpretation_domain_item list *
+    (CicTextualParser0.interpretation -> (Cic.metasenv * Cic.term))
diff --git a/helm/ocaml/urimanager/uriManager.ml b/helm/ocaml/urimanager/uriManager.ml
index f45e65bf3..df707c956 100644
--- a/helm/ocaml/urimanager/uriManager.ml
+++ b/helm/ocaml/urimanager/uriManager.ml
@@ -141,3 +141,20 @@ let annuri_of_uri uri =
 let uri_is_annuri uri =
  Str.string_match (Str.regexp ".*\.ann$") (string_of_uri uri) 0
 ;;
+
+let bodyuri_of_uri uri =
+ let struri = string_of_uri uri in
+  if Str.string_match (Str.regexp ".*\.con$") (string_of_uri uri) 0 then
+   let newuri = Array.copy uri in
+    newuri.(Array.length uri - 2) <- struri ^ ".body" ;
+    Some newuri
+  else
+   None
+;;
+
+let innertypesuri_of_uri uri =
+ let cicuri = cicuri_of_uri uri in
+  let newuri = Array.copy cicuri in
+   newuri.(Array.length cicuri - 2) <- (string_of_uri cicuri) ^ ".types" ;
+   newuri
+;;
diff --git a/helm/ocaml/urimanager/uriManager.mli b/helm/ocaml/urimanager/uriManager.mli
index 2cdd27e3d..8afb4e345 100644
--- a/helm/ocaml/urimanager/uriManager.mli
+++ b/helm/ocaml/urimanager/uriManager.mli
@@ -23,6 +23,8 @@
  * http://cs.unibo.it/helm/.
  *)
 
+exception IllFormedUri of string;;
+
 type uri
 
 val eq : uri -> uri -> bool
@@ -49,3 +51,10 @@ val annuri_of_uri : uri -> uri
 
 (* given an uri, tells if it refers to an annotation *)
 val uri_is_annuri : uri -> bool
+
+(* given an uri of a constant, it gives back the uri of its body             *)
+(* it gives back None if the uri refers to a Variable or MutualInductiveType *)
+val bodyuri_of_uri : uri -> uri option
+
+(* given an uri, it gives back the uri of its inner types             *)
+val innertypesuri_of_uri : uri -> uri
diff --git a/helm/ocaml/xml/xml.ml b/helm/ocaml/xml/xml.ml
index 302aef23f..6670e1f19 100644
--- a/helm/ocaml/xml/xml.ml
+++ b/helm/ocaml/xml/xml.ml
@@ -53,49 +53,69 @@ let xml_empty name attrs = [< 'Empty(name,attrs) >]
 let xml_nempty name attrs content = [< 'NEmpty(name,attrs,content) >]
 let xml_cdata str = [< 'Str str >]
 
-(* Usage:                                                                   *)
-(*  pp tokens None     pretty prints the output on stdout                   *)
-(*  pp tokens (Some filename) pretty prints the output on the file filename *)
-let pp ?(quiet=false) strm fn =
- let channel = ref stdout in
+(** low level for other PPs: pretty print each token of strm applying 'f' to a
+canonical string representation of each token *)
+let pp_gen f strm =
  let rec pp_r m =
   parser
-    [< 'Str a ; s >] ->
+  | [< 'Str a ; s >] ->
       print_spaces m ;
-      fprint_string (a ^ "\n") ;
+      f (a ^ "\n") ;
       pp_r m s
   | [< 'Empty(n,l) ; s >] ->
       print_spaces m ;
-      fprint_string ("<" ^ n) ;
-      List.iter (function (n,v) -> fprint_string (" " ^ n ^ "=\"" ^ v ^ "\"")) l;
-      fprint_string "/>\n" ;
+      f ("<" ^ n) ;
+      List.iter (fun (n,v) -> f (" " ^ n ^ "=\"" ^ v ^ "\"")) l;
+      f "/>\n" ;
       pp_r m s
   | [< 'NEmpty(n,l,c) ; s >] ->
       print_spaces m ;
-      fprint_string ("<" ^ n) ;
-      List.iter (function (n,v) -> fprint_string (" " ^ n ^ "=\"" ^ v ^ "\"")) l;
-      fprint_string ">\n" ;
+      f ("<" ^ n) ;
+      List.iter (fun (n,v) -> f (" " ^ n ^ "=\"" ^ v ^ "\"")) l;
+      f ">\n" ;
       pp_r (m+1) c ;
       print_spaces m ;
-      fprint_string ("\n") ;
+      f ("\n") ;
       pp_r m s
   | [< >] -> ()
  and print_spaces m =
-  for i = 1 to m do fprint_string "  " done
- and fprint_string str =
-  output_string !channel str
+  for i = 1 to m do f "  " done
  in
+ pp_r 0 strm
+;;
+
+(** pretty printer on output channels *)
+let pp_to_outchan strm oc =
+  pp_gen (fun s -> output_string oc s) strm;
+  flush oc
+;;
+
+(** pretty printer to string *)
+let pp_to_string strm =
+  let buf = Buffer.create 10240 in
+  pp_gen (Buffer.add_string buf) strm;
+  Buffer.contents buf
+;;
+
+(** pretty printer to file *)
+(* Usage:                                                                   *)
+(*  pp tokens None     pretty prints the output on stdout                   *)
+(*  pp tokens (Some filename) pretty prints the output on the file filename *)
+let pp ?(quiet=false) strm fn =
   match fn with
-     Some filename ->
-       channel := open_out filename ;
-       pp_r 0 strm ;
-       close_out !channel ;
-       if not quiet then
+  | Some filename ->
+      let outchan = open_out filename in
+      (try
+        pp_to_outchan strm outchan;
+      with e ->
+        close_out outchan;
+        raise e);
+      close_out outchan;
+      if not quiet then
         begin
-         print_string ("\nWriting on file \"" ^ filename ^
-          "\" was succesfull\n");
-         flush stdout
+          print_string ("\nWriting on file \"" ^ filename ^
+            "\" was succesfull\n");
+          flush stdout
         end
-   | None ->
-       pp_r 0 strm
+  | None -> pp_to_outchan strm stdout
 ;;
diff --git a/helm/ocaml/xml/xml.mli b/helm/ocaml/xml/xml.mli
index a68110b29..c52ae8ecd 100644
--- a/helm/ocaml/xml/xml.mli
+++ b/helm/ocaml/xml/xml.mli
@@ -58,3 +58,6 @@ val xml_cdata : string -> token Stream.t
 (*  pp tokens None     pretty prints the output on stdout                   *)
 (*  pp tokens (Some filename) pretty prints the output on the file filename *)
 val pp : ?quiet:bool -> token Stream.t -> string option -> unit
+val pp_to_outchan : token Stream.t -> out_channel -> unit
+val pp_to_string : token Stream.t -> string
+
-- 
2.39.2