/
pred.mli
251 lines (204 loc) · 8.22 KB
/
pred.mli
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
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
(****************************************************************************)
(* RelationExtraction - Extraction of inductive relations for Coq *)
(* *)
(* This program 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 3 of the License, or *)
(* (at your option) any later version. *)
(* *)
(* This program 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 this program. If not, see <http://www.gnu.org/licenses/>. *)
(* *)
(* Copyright 2011 CNAM-ENSIIE *)
(* Catherine Dubois <dubois@ensiie.fr> *)
(* David Delahaye <david.delahaye@cnam.fr> *)
(* Pierre-Nicolas Tollitte <tollitte@ensiie.fr> *)
(****************************************************************************)
open Host_stuff
(* Extraction failure with some reason. *)
exception RelationExtractionError of string
(***************)
(* Identifiers *)
(***************)
(* Identifier for everything. *)
type ident
val string_of_ident : ident -> string
val ident_of_string : string -> ident
(*********)
(* Types *)
(*********)
(* Generic type of a term *)
type clear_type =
| CTTuple of clear_type list (* Types of tuple's elements. *)
| CTSum of ident list (* List of constructors of a sum type. *)
| CTNone (* No type information. *)
type 'htyp term_type = (clear_type * 'htyp host_term_type)
type ('t, 'htyp) typed = ('t * 'htyp term_type)
(************)
(* ML Terms *)
(************)
(* Mode *)
type mode_option =
| MInput
| MOutput
| MSkip (* used for host language stuff, must be ignored *)
type mode = mode_option list
type 'htyp untyped_ml_pat =
(* Standard constructions *)
| MLPVar of ident
| MLPTuple of 'htyp ml_pat list
| MLPRecord of ident list * 'htyp ml_pat list
| MLPConstr of ident * 'htyp ml_pat list
| MLPConst of ident
| MLPWild
(* Additionnal stuff *)
(* Used for linearization. *)
| MLPATrue | MLPAFalse
(* Used by the fixpred library. *)
| MLPASome of 'htyp ml_pat | MLPANone
and 'htyp ml_pat = ('htyp untyped_ml_pat, 'htyp) typed
type 'htyp untyped_ml_term =
(* -- Begin: used by the specification -- *)
| MLTVar of ident
| MLTTuple of 'htyp ml_term list
| MLTRecord of ident list * 'htyp ml_term list
| MLTConstr of ident * 'htyp ml_term list
| MLTConst of ident
| MLTFun of ident * 'htyp ml_term list * mode option
| MLTFunNot of ident * 'htyp ml_term list * mode option
(* The "mode option" must be None for function and Some (...) for
predicates. *)
(* -- End: used by the specification -- *)
| MLTMatch of 'htyp ml_term * ('htyp ml_pat * 'htyp ml_term) list
(* Additionnal stuff *)
(* Used for linearization. ml_terms are always variables. *)
| MLTALin of ('htyp ml_term * 'htyp ml_term) list
(* Output of a complete extraction (only LTrue is used) : *)
| MLTATrue | MLTAFalse
(* Used by the fixpred library. *)
| MLTASome of 'htyp ml_term | MLTANone
(* Default case in pattern matching *)
| MLTADefault
and 'htyp ml_term = ('htyp untyped_ml_term, 'htyp) typed
(* Pretty printer *)
val pp_ml_term : 'htyp ml_term -> string
(******************)
(* Specifications *)
(******************)
(* A premisse in a property (or constructor) of a specification. *)
type 'htyp premisse =
| PMTerm of 'htyp ml_term
| PMNot of 'htyp premisse
| PMOr of 'htyp premisse list
| PMAnd of 'htyp premisse list
| PMChoice of 'htyp premisse list
(* A property (or constructor) of a specification. *)
type 'htyp property = {
prop_name : ident option;
prop_vars : ident list;
prop_prems : 'htyp premisse list;
prop_concl : 'htyp ml_term;
}
(* Type of a specification. *)
type 'htyp spec = {
spec_name : ident;
spec_args_types : 'htyp term_type list;
spec_props : 'htyp property list;
}
val pp_spec : 'htyp spec -> string
(****************)
(* ML functions *)
(****************)
(* A function in the ML-like intermediate language. *)
type 'htyp ml_fun = {
mlfun_name : ident;
mlfun_args : ident list;
mlfun_body : 'htyp ml_term;
}
(* Pretty printer *)
val pp_ml_fun : 'htyp ml_fun -> string
(*********)
(* Trees *)
(*********)
(* Predicate tree. Used to represent an inductive predicate before the code
generation. *)
type 'htyp tree
(* Pretty printer *)
val pp_tree : 'htyp tree -> string
(*****************)
(* Fix functions *)
(*****************)
type 'htyp fix_untyped_term =
(* Standard constructions. *)
| FixVar of ident
(* | FixRecord of ident list * fix_term list*)
| FixConstr of ident * 'htyp fix_term list
| FixConst of ident
| FixFun of ident * 'htyp fix_term list
| FixFunNot of ident * 'htyp fix_term list
| FixCase of 'htyp fix_term * (ident list * 'htyp fix_term) list
| FixLetin of ident * 'htyp fix_term * 'htyp fix_term
(* To be converted as standard constructions. *)
| FixSome of 'htyp fix_term
| FixNone
| FixTrue
| FixFalse
and 'htyp fix_term = ('htyp fix_untyped_term, 'htyp) typed
type 'htyp fix_fun = {
fixfun_name : ident;
fixfun_args : ident list;
fixfun_body : 'htyp fix_term;
}
val pp_fix_fun : 'htyp fix_fun -> string
(**************)
(* Extraction *)
(**************)
(* Extraction environment
This environment is used for one extraction command.
One function or several mutualy recursive functions can be extracted.
The mode of some other predicates can be given but they wont be extracted.
*)
type ('htyp, 'henv) extract_env = {
(* List of modes given of every predicates. If a predicate is not present in
this list, we assume that it is already extracted in full mode. *)
extr_modes : (ident * mode list) list;
(* List of predicates that will be extracted. A mode must be given for them
in extr_modes. The optional ident is the extracted function name.
The boolean flag must be true for relaxed extraction (with
pattern ordering in pattern matchings. *)
extr_extractions : (ident * (ident option * bool)) list;
(* List of specification of the extracted predicates. *)
extr_specs : (ident * 'htyp spec) list;
(* List of predicate trees built from the specification. *)
extr_trees : (ident * 'htyp tree) list;
(* List of ml functions translated from the predicate trees. *)
extr_mlfuns : (ident * 'htyp ml_fun) list;
(* List of fix functions compiled from the ml functions. *)
extr_fixfuns : (ident * 'htyp fix_fun) list;
(* Environment for the host language stuff. *)
extr_henv : 'henv host_env;
(* Functions for the host language stuff. *)
extr_hf : ('htyp, 'henv) host_functions;
}
val extr_get_modes : ('t, 'h) extract_env -> ident -> mode list
val extr_get_spec : ('t, 'h) extract_env -> ident -> 't spec
val extr_get_spec_ord : ('t, 'h) extract_env -> ident -> bool
val extr_get_tree : ('t, 'h) extract_env -> ident -> 't tree
val extr_get_mlfun : ('t, 'h) extract_env -> ident -> 't ml_fun
val extr_get_fixfun : ('t, 'h) extract_env -> ident -> 't fix_fun
val pp_extract_env : ('t, 'h) extract_env -> string
(* Get a fake type. *)
val unknown_type : ('htyp, 'henv) extract_env -> 'htyp term_type
(* Type a term with a fake type. *)
val fake_type : ('htyp, 'henv) extract_env -> 't -> ('t, 'htyp) typed
(* Extraction aborted because it's impossible to insert the property
in the tree. The string is the reason. *)
exception RelationExtractionProp of ident option * string
val make_trees : ('t, 'h) extract_env -> ('t, 'h) extract_env
val make_ml_funs : ('t, 'h) extract_env -> ('t, 'h) extract_env
(*val make_fix_funs : ('t, 'h) extract_env -> ('t, 'h) extract_env*)