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
|
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
(*
Syntax for the subtac terms and types.
Elaborated from correctness/psyntax.ml4 by Jean-Christophe Filliâtre *)
(* $Id$ *)
(*i camlp4deps: "parsing/grammar.cma" i*)
open Options
open Util
open Names
open Nameops
open Vernacentries
open Reduction
open Term
open Libnames
open Topconstr
(* We define new entries for programs, with the use of this module
* Subtac. These entries are named Subtac.<foo>
*)
module Gram = Pcoq.Gram
module Vernac = Pcoq.Vernac_
module Tactic = Pcoq.Tactic
module SubtacGram =
struct
let gec s = Gram.Entry.create ("Subtac."^s)
(* types *)
let subtac_gallina_loc : Vernacexpr.vernac_expr located Gram.Entry.e = gec "subtac_gallina_loc"
let subtac_nameopt : identifier option Gram.Entry.e = gec "subtac_nameopt"
end
open SubtacGram
open Util
open Pcoq
let sigref = mkRefC (Qualid (dummy_loc, Libnames.qualid_of_string "Coq.Init.Specif.sig"))
GEXTEND Gram
GLOBAL: subtac_gallina_loc Constr.binder_let Constr.binder subtac_nameopt;
subtac_gallina_loc:
[ [ g = Vernac.gallina -> loc, g ] ]
;
subtac_nameopt:
[ [ "ofb"; id=Prim.ident -> Some (id)
| -> None ] ]
;
Constr.binder_let:
[ [ "("; id=Prim.name; ":"; t=Constr.lconstr; "|"; c=Constr.lconstr; ")" ->
let typ = mkAppC (sigref, [mkLambdaC ([id], t, c)]) in
LocalRawAssum ([id], typ)
] ];
Constr.binder:
[ [ "("; id=Prim.name; ":"; c=Constr.lconstr; "|"; p=Constr.lconstr; ")" ->
([id],mkAppC (sigref, [mkLambdaC ([id], c, p)]))
| "("; id=Prim.name; ":"; c=Constr.lconstr; ")" ->
([id],c)
| "("; id=Prim.name; lid=LIST1 Prim.name; ":"; c=Constr.lconstr; ")" ->
(id::lid,c)
] ];
END
type 'a gallina_loc_argtype = (Vernacexpr.vernac_expr located, 'a) Genarg.abstract_argument_type
let (wit_subtac_gallina_loc : Genarg.tlevel gallina_loc_argtype),
(globwit_subtac_gallina_loc : Genarg.glevel gallina_loc_argtype),
(rawwit_subtac_gallina_loc : Genarg.rlevel gallina_loc_argtype) =
Genarg.create_arg "subtac_gallina_loc"
type 'a nameopt_argtype = (identifier option, 'a) Genarg.abstract_argument_type
let (wit_subtac_nameopt : Genarg.tlevel nameopt_argtype),
(globwit_subtac_nameopt : Genarg.glevel nameopt_argtype),
(rawwit_subtac_nameopt : Genarg.rlevel nameopt_argtype) =
Genarg.create_arg "subtac_nameopt"
VERNAC COMMAND EXTEND Subtac
[ "Program" subtac_gallina_loc(g) ] -> [ Subtac.subtac g ]
END
VERNAC COMMAND EXTEND Subtac_Obligations
| [ "Obligation" integer(num) "of" ident(name) ":" lconstr(t) ] -> [ Subtac_obligations.subtac_obligation (num, Some name, Some t) ]
| [ "Obligation" integer(num) "of" ident(name) ] -> [ Subtac_obligations.subtac_obligation (num, Some name, None) ]
| [ "Obligation" integer(num) ":" lconstr(t) ] -> [ Subtac_obligations.subtac_obligation (num, None, Some t) ]
| [ "Obligation" integer(num) ] -> [ Subtac_obligations.subtac_obligation (num, None, None) ]
| [ "Next" "Obligation" "of" ident(name) ] -> [ Subtac_obligations.next_obligation (Some name) ]
| [ "Next" "Obligation" ] -> [ Subtac_obligations.next_obligation None ]
END
VERNAC COMMAND EXTEND Subtac_Solve_Obligations
| [ "Solve" "Obligations" "of" ident(name) "using" tactic(t) ] -> [ Subtac_obligations.solve_obligations (Some name) (Tacinterp.interp t) ]
| [ "Solve" "Obligations" "using" tactic(t) ] -> [ Subtac_obligations.solve_obligations None (Tacinterp.interp t) ]
| [ "Admit" "Obligations" "of" ident(name) ] -> [ Subtac_obligations.admit_obligations (Some name) ]
| [ "Admit" "Obligations" ] -> [ Subtac_obligations.admit_obligations None ]
END
VERNAC COMMAND EXTEND Subtac_Set_Solver
| [ "Obligations" "Tactic" ":=" tactic(t) ] -> [ Subtac_obligations.set_default_tactic (Tacinterp.interp t) ]
END
VERNAC COMMAND EXTEND Subtac_Show_Obligations
| [ "Obligations" "of" ident(name) ] -> [ Subtac_obligations.show_obligations (Some name) ]
| [ "Obligations" ] -> [ Subtac_obligations.show_obligations None ]
END
|
