From 2053e46c8d6a4da32b4155d346d1b04da3686d06 Mon Sep 17 00:00:00 2001 From: msozeau Date: Wed, 14 Mar 2012 09:52:41 +0000 Subject: Everything compiles again. git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@15034 85f007b7-540e-0410-9357-904b9bb8a0f7 --- pretyping/program.ml | 84 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 84 insertions(+) create mode 100644 pretyping/program.ml (limited to 'pretyping/program.ml') diff --git a/pretyping/program.ml b/pretyping/program.ml new file mode 100644 index 000000000..bb0cbe1c7 --- /dev/null +++ b/pretyping/program.ml @@ -0,0 +1,84 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* anomaly (locstr^": cannot find "^(Libnames.string_of_path sp)) + +let coq_reference locstr dir s = find_reference locstr ("Coq"::dir) s +let coq_constant locstr dir s = Libnames.constr_of_global (coq_reference locstr dir s) + +let init_constant dir s () = coq_constant "Program" dir s +let init_reference dir s () = coq_reference "Program" dir s + +let sig_typ = init_constant ["Init"; "Specif"] "sig" +let sig_intro = init_constant ["Init"; "Specif"] "exist" +let sig_proj1 = init_constant ["Init"; "Specif"] "proj1_sig" + +let sigT_typ = init_constant ["Init"; "Specif"] "sigT" +let sigT_intro = init_constant ["Init"; "Specif"] "existT" +let sigT_proj1 = init_constant ["Init"; "Specif"] "projT1" +let sigT_proj2 = init_constant ["Init"; "Specif"] "projT2" + +let prod_typ = init_constant ["Init"; "Datatypes"] "prod" +let prod_intro = init_constant ["Init"; "Datatypes"] "pair" +let prod_proj1 = init_constant ["Init"; "Datatypes"] "fst" +let prod_proj2 = init_constant ["Init"; "Datatypes"] "snd" + +let coq_eq_ind = init_constant ["Init"; "Logic"] "eq" +let coq_eq_refl = init_constant ["Init"; "Logic"] "eq_refl" +let coq_eq_refl_ref = init_reference ["Init"; "Logic"] "eq_refl" +let coq_eq_rect = init_constant ["Init"; "Logic"] "eq_rect" + +let coq_JMeq_ind = init_constant ["Logic";"JMeq"] "JMeq" +let coq_JMeq_refl = init_constant ["Logic";"JMeq"] "JMeq_refl" + +let coq_not = init_constant ["Init";"Logic"] "not" +let coq_and = init_constant ["Init";"Logic"] "and" + +let mk_coq_not x = mkApp (delayed_force coq_not, [| x |]) + +let unsafe_fold_right f = function + hd :: tl -> List.fold_right f tl hd + | [] -> raise (Invalid_argument "unsafe_fold_right") + +let mk_coq_and l = + let and_typ = delayed_force coq_and in + unsafe_fold_right + (fun c conj -> + mkApp (and_typ, [| c ; conj |])) + l + +let with_program f c = + let mode = !Flags.program_mode in + Flags.program_mode := true; + let res = f c in + Flags.program_mode := mode; + res -- cgit v1.2.3