1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169
|
open GenericLib
let gExIntro_impl (witness : coq_expr) (proof : coq_expr) : coq_expr =
gApp (gInject "ex_intro") [hole; witness; proof]
let gExIntro (x : string) (pred : var -> coq_expr) (witness : coq_expr) (proof : coq_expr) : coq_expr =
gApp (gInject "ex_intro") [(gFun [x] (fun [x] -> pred x)); witness; proof]
let gEx (x : string) (pred : var -> coq_expr) : coq_expr =
gApp (gInject "ex") [(gFun [x] (fun [x] -> pred x))]
let gConjIntro p1 p2 =
gApp (gInject "conj") [p1; p2]
let gEqType e1 e2 =
gApp (gInject "eq") [e1; e2]
let gConj p1 p2 =
gApp (gInject "and") [p1; p2]
let gProjL p =
gApp ~explicit:true (gInject "Logic.proj1") [hole; hole; p]
let gProjR p =
gApp ~explicit:true (gInject "Logic.proj2") [hole; hole; p]
let gImpl p1 p2 =
gApp (gInject "Basics.impl") [p1; p2]
let gForall typ f =
gApp ~explicit:true (gInject "Nat_util.all") [typ; f]
let gProd e1 e2 =
gApp (gInject "Coq.Init.Datatypes.prod") [e1; e2]
let gLeq e1 e2 =
gApp (gInject "leq") [e1; e2]
let gLe e1 e2 =
gApp (gInject "le") [e1; e2]
let gIsTrueLeq e1 e2 =
gApp
(gInject "is_true")
[gApp (gInject "leq") [e1; e2]]
let gOrIntroL p =
gApp (gInject "or_introl") [p]
let gOrIntroR p =
gApp (gInject "or_intror") [p]
let gEqRefl p =
gApp (gInject "Logic.eq_refl") [p]
let gI = gInject "I"
let gTrueb = gInject "true"
let gFalseb = gInject "false"
let gT = gInject "True"
let gTrue = gInject "True"
let gFalse = gInject "False"
let gTt = gInject "tt"
let gIff p1 p2 =
gApp (gInject "iff") [p1; p2]
let gIsTrue x =
gApp (gInject "is_true") [x]
let gIsTrueTrue =
gApp (gInject "is_true") [gInject "true"]
let false_ind x1 x2 =
gApp (gInject "False_ind") [x1; x2]
(* TODO extend gMatch to write the return type? *)
let discriminate h =
false_ind hole
(gMatch h [(injectCtr "Logic.eq_refl", [], fun [] -> gI)])
let rewrite pred h hin =
gApp ~explicit:true (gInject "eq_ind") [hole; hole; pred; hin; hole; h]
(* gMatch h [(injectCtr "erefl", [], fun [] -> hin)] *)
let rewrite_sym typ h hin =
gApp (gInject "eq_ind_r") [typ; hin; h]
let lt0_False hlt =
gApp (gInject "lt0_False") [hlt]
let nat_ind ret_type base_case ind_case =
gApp (gInject "nat_ind") [ret_type; base_case; ind_case]
let appn fn n arg =
gApp (gInject "appn") [fn; n; arg]
let matchDec c left right =
gMatch c [ (injectCtr "left" , ["eq" ], left)
; (injectCtr "right", ["neq"], right)
]
let matchDecOpt c left right =
gMatch c [ (injectCtr "left" , ["eq" ], left)
; (injectCtr "right", ["neq"], right)
]
let plus x y =
gApp (gInject "Nat.add") [x;y]
let plus_leq_compat_l p =
gApp ~explicit:true (gInject "plus_leq_compat_l") [hole; hole; hole; p]
let leq_addl n1 n2 =
gApp (gInject "leq_addl") [n1; n2]
(* Leo, can we have a real gProp? *)
let gProp = gInject "prop"
let succ_neq_zero x =
gApp ~explicit:true (gInject "PeanoNat.Nat.neq_succ_0") [x]
let succ_neq_zero_app x h =
gApp ~explicit:true (gInject "PeanoNat.Nat.neq_succ_0") [x; h]
let isSome x =
gApp (gInject "isSome") [x]
let isSomeSome x =
gApp ~explicit:true (gInject "isSomeSome") [hole; x]
let diff_false_true h =
gApp (gInject "Bool.diff_false_true") [h]
let gSnd x =
gApp ~explicit:true (gInject "snd") [hole; hole; x]
let gFst x =
gApp ~explicit:true (gInject "fst") [hole; hole; x]
let is_true b =
gApp ~explicit:true (gInject "is_true") [b]
let forall_nil typ =
gApp ~explicit:true (gInject "List.Forall_nil") [typ; hole]
let forall_cons typ pleq p =
gApp ~explicit:true (gInject "List.Forall_cons") [typ; hole; hole; hole; pleq; p]
let ltnOSn =
gApp ~explicit:true (gInject "ltn0Sn") [hole]
let ltnOSn_pair =
gApp ~explicit:true (gInject "ltn0Sn_pair") [hole; hole; hole]
(*
let le_S_n hleq =
gApp (gInject "le_S_n") [hole; hole; hleq]
let nle_succ_0 hleq =
gApp (gInject "PeanoNat.Nat.nle_succ_0") [hole; hleq]
*)
|