File: coqLib.ml

package info (click to toggle)
coq-quickchick 2.1.1-2
  • links: PTS, VCS
  • area: main
  • in suites: experimental
  • size: 2,432 kB
  • sloc: ml: 4,367; ansic: 789; makefile: 388; sh: 27; python: 4; lisp: 2; perl: 2
file content (169 lines) | stat: -rw-r--r-- 3,941 bytes parent folder | download | duplicates (4)
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]
   *)