]> matita.cs.unibo.it Git - helm.git/blob - helm/software/components/grafite_parser/grafiteDisambiguate.ml
More exceptions pretty-printed.
[helm.git] / helm / software / components / grafite_parser / grafiteDisambiguate.ml
1 (*
2  * 
3  * This file is part of HELM, an Hypertextual, Electronic
4  * Library of Mathematics, developed at the Computer Science
5  * Department, University of Bologna, Italy.
6  * 
7  * HELM is free software; you can redistribute it and/or
8  * modify it under the terms of the GNU General Public License
9  * as published by the Free Software Foundation; either version 2
10  * of the License, or (at your option) any later version.
11  * 
12  * HELM is distributed in the hope that it will be useful,
13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15  * GNU General Public License for more details.
16  *
17  * You should have received a copy of the GNU General Public License
18  * along with HELM; if not, write to the Free Software
19  * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
20  * MA  02111-1307, USA.
21  * 
22  * For details, see the HELM World-Wide-Web page,
23  * http://helm.cs.unibo.it/
24  *)
25
26 (* $Id$ *)
27
28 exception BaseUriNotSetYet
29
30 type tactic = 
31  (CicNotationPt.term, CicNotationPt.term, 
32   CicNotationPt.term GrafiteAst.reduction, string) 
33    GrafiteAst.tactic
34    
35 type lazy_tactic = 
36   (Cic.term, Cic.lazy_term, Cic.lazy_term GrafiteAst.reduction, string) 
37     GrafiteAst.tactic
38
39 let singleton = function
40   | [x], _ -> x
41   | _ -> assert false
42 ;;
43
44   (** @param term not meaningful when context is given *)
45 let disambiguate_term text prefix_len lexicon_status_ref context metasenv term =
46   let lexicon_status = !lexicon_status_ref in
47   let (diff, metasenv, cic, _) =
48     singleton
49       (GrafiteDisambiguator.disambiguate_term ~dbd:(LibraryDb.instance ())
50         ~aliases:lexicon_status.LexiconEngine.aliases
51         ~universe:(Some lexicon_status.LexiconEngine.multi_aliases)
52         ~context ~metasenv (text,prefix_len,term))
53   in
54   let lexicon_status = LexiconEngine.set_proof_aliases lexicon_status diff in
55   lexicon_status_ref := lexicon_status;
56   metasenv,cic
57 ;;
58
59   (** disambiguate_lazy_term (circa): term -> (unit -> status) * lazy_term
60    * rationale: lazy_term will be invoked in different context to obtain a term,
61    * each invocation will disambiguate the term and can add aliases. Once all
62    * disambiguations have been performed, the first returned function can be
63    * used to obtain the resulting aliases *)
64 let disambiguate_lazy_term text prefix_len lexicon_status_ref term =
65   (fun context metasenv ugraph ->
66     let lexicon_status = !lexicon_status_ref in
67     let (diff, metasenv, cic, ugraph) =
68       singleton
69         (GrafiteDisambiguator.disambiguate_term ~dbd:(LibraryDb.instance ())
70           ~initial_ugraph:ugraph ~aliases:lexicon_status.LexiconEngine.aliases
71           ~universe:(Some lexicon_status.LexiconEngine.multi_aliases)
72           ~context ~metasenv
73           (text,prefix_len,term)) in
74     let lexicon_status = LexiconEngine.set_proof_aliases lexicon_status diff in
75     lexicon_status_ref := lexicon_status;
76     cic, metasenv, ugraph)
77 ;;
78
79 let disambiguate_pattern 
80   text prefix_len lexicon_status_ref (wanted, hyp_paths, goal_path) 
81 =
82   let interp path = Disambiguate.interpretate_path [] path in
83   let goal_path = HExtlib.map_option interp goal_path in
84   let hyp_paths = List.map (fun (name, path) -> name, interp path) hyp_paths in
85   let wanted =
86    match wanted with
87       None -> None
88     | Some wanted ->
89        let wanted = 
90          disambiguate_lazy_term text prefix_len lexicon_status_ref wanted 
91        in
92        Some wanted
93   in
94   (wanted, hyp_paths, goal_path)
95 ;;
96
97 let disambiguate_reduction_kind text prefix_len lexicon_status_ref = function
98   | `Unfold (Some t) ->
99       let t = disambiguate_lazy_term text prefix_len lexicon_status_ref t in
100       `Unfold (Some t)
101   | `Normalize
102   | `Reduce
103   | `Simpl
104   | `Unfold None
105   | `Whd as kind -> kind
106 ;;
107
108 let rec disambiguate_tactic 
109   lexicon_status_ref context metasenv (text,prefix_len,tactic) 
110 =
111   let disambiguate_term = 
112     disambiguate_term text prefix_len lexicon_status_ref in
113   let disambiguate_pattern = 
114     disambiguate_pattern text prefix_len lexicon_status_ref in
115   let disambiguate_reduction_kind = 
116     disambiguate_reduction_kind text prefix_len lexicon_status_ref in
117   let disambiguate_lazy_term = 
118     disambiguate_lazy_term text prefix_len lexicon_status_ref in
119   let disambiguate_tactic metasenv tac =
120    disambiguate_tactic lexicon_status_ref context metasenv (text,prefix_len,tac)
121   in
122    match tactic with
123     (* Higher  order tactics *)
124     | GrafiteAst.Progress (loc,tac) ->
125         let metasenv,tac = disambiguate_tactic metasenv tac in
126         metasenv,GrafiteAst.Progress (loc,tac)
127     | GrafiteAst.Solve (loc,tacl) ->
128         let metasenv,tacl =
129          List.fold_right
130           (fun tac (metasenv,tacl) ->
131             let metasenv,tac = disambiguate_tactic metasenv tac in
132              metasenv,tac::tacl
133           ) tacl (metasenv,[])
134         in
135          metasenv,GrafiteAst.Solve (loc,tacl)
136     | GrafiteAst.Try (loc,tac) ->
137         let metasenv,tac = disambiguate_tactic metasenv tac in
138         metasenv,GrafiteAst.Try (loc,tac)
139     | GrafiteAst.First (loc,tacl) ->
140         let metasenv,tacl =
141          List.fold_right
142           (fun tac (metasenv,tacl) ->
143             let metasenv,tac = disambiguate_tactic metasenv tac in
144              metasenv,tac::tacl
145           ) tacl (metasenv,[])
146         in
147          metasenv,GrafiteAst.First (loc,tacl)
148     | GrafiteAst.Seq (loc,tacl) ->
149         let metasenv,tacl =
150          List.fold_right
151           (fun tac (metasenv,tacl) ->
152             let metasenv,tac = disambiguate_tactic metasenv tac in
153              metasenv,tac::tacl
154           ) tacl (metasenv,[])
155         in
156          metasenv,GrafiteAst.Seq (loc,tacl)
157     | GrafiteAst.Repeat (loc,tac) ->
158         let metasenv,tac = disambiguate_tactic metasenv tac in
159         metasenv,GrafiteAst.Repeat (loc,tac)
160     | GrafiteAst.Do (loc,n,tac) ->
161         let metasenv,tac = disambiguate_tactic metasenv tac in
162         metasenv,GrafiteAst.Do (loc,n,tac)
163     | GrafiteAst.Then (loc,tac,tacl) ->
164         let metasenv,tac = disambiguate_tactic metasenv tac in
165         let metasenv,tacl =
166          List.fold_right
167           (fun tac (metasenv,tacl) ->
168             let metasenv,tac = disambiguate_tactic metasenv tac in
169              metasenv,tac::tacl
170           ) tacl (metasenv,[])
171         in
172          metasenv,GrafiteAst.Then (loc,tac,tacl)
173     (* First order tactics *)
174     | GrafiteAst.Absurd (loc, term) -> 
175         let metasenv,cic = disambiguate_term context metasenv term in
176         metasenv,GrafiteAst.Absurd (loc, cic)
177     | GrafiteAst.Apply (loc, term) ->
178         let metasenv,cic = disambiguate_term context metasenv term in
179         metasenv,GrafiteAst.Apply (loc, cic)
180     | GrafiteAst.ApplyS (loc, term, params) ->
181         let metasenv,cic = disambiguate_term context metasenv term in
182         metasenv,GrafiteAst.ApplyS (loc, cic, params)
183     | GrafiteAst.Assumption loc ->
184         metasenv,GrafiteAst.Assumption loc
185     | GrafiteAst.AutoBatch (loc,params) ->
186         metasenv,GrafiteAst.AutoBatch (loc,params)
187     | GrafiteAst.Cases (loc, what, idents) ->
188         let metasenv,what = disambiguate_term context metasenv what in
189         metasenv,GrafiteAst.Cases (loc, what, idents)
190     | GrafiteAst.Change (loc, pattern, with_what) -> 
191         let with_what = disambiguate_lazy_term with_what in
192         let pattern = disambiguate_pattern pattern in
193         metasenv,GrafiteAst.Change (loc, pattern, with_what)
194     | GrafiteAst.Clear (loc,id) ->
195         metasenv,GrafiteAst.Clear (loc,id)
196     | GrafiteAst.ClearBody (loc,id) ->
197        metasenv,GrafiteAst.ClearBody (loc,id)
198     | GrafiteAst.Constructor (loc,n) ->
199         metasenv,GrafiteAst.Constructor (loc,n)
200     | GrafiteAst.Contradiction loc ->
201         metasenv,GrafiteAst.Contradiction loc
202     | GrafiteAst.Cut (loc, ident, term) -> 
203         let metasenv,cic = disambiguate_term context metasenv term in
204         metasenv,GrafiteAst.Cut (loc, ident, cic)
205     | GrafiteAst.Decompose (loc, names) ->
206          metasenv,GrafiteAst.Decompose (loc, names)
207     | GrafiteAst.Demodulate loc ->
208         metasenv,GrafiteAst.Demodulate loc
209     | GrafiteAst.Destruct (loc,term) ->
210         let metasenv,term = disambiguate_term context metasenv term in
211         metasenv,GrafiteAst.Destruct(loc,term)
212     | GrafiteAst.Exact (loc, term) -> 
213         let metasenv,cic = disambiguate_term context metasenv term in
214         metasenv,GrafiteAst.Exact (loc, cic)
215     | GrafiteAst.Elim (loc, what, Some using, pattern, specs) ->
216         let metasenv,what = disambiguate_term context metasenv what in
217         let metasenv,using = disambiguate_term context metasenv using in
218         let pattern = disambiguate_pattern pattern in
219         metasenv,GrafiteAst.Elim (loc, what, Some using, pattern, specs)
220     | GrafiteAst.Elim (loc, what, None, pattern, specs) ->
221         let metasenv,what = disambiguate_term context metasenv what in
222         let pattern = disambiguate_pattern pattern in
223         metasenv,GrafiteAst.Elim (loc, what, None, pattern, specs)
224     | GrafiteAst.ElimType (loc, what, Some using, specs) ->
225         let metasenv,what = disambiguate_term context metasenv what in
226         let metasenv,using = disambiguate_term context metasenv using in
227         metasenv,GrafiteAst.ElimType (loc, what, Some using, specs)
228     | GrafiteAst.ElimType (loc, what, None, specs) ->
229         let metasenv,what = disambiguate_term context metasenv what in
230         metasenv,GrafiteAst.ElimType (loc, what, None, specs)
231     | GrafiteAst.Exists loc ->
232         metasenv,GrafiteAst.Exists loc 
233     | GrafiteAst.Fail loc ->
234         metasenv,GrafiteAst.Fail loc
235     | GrafiteAst.Fold (loc,red_kind, term, pattern) ->
236         let pattern = disambiguate_pattern pattern in
237         let term = disambiguate_lazy_term term in
238         let red_kind = disambiguate_reduction_kind red_kind in
239         metasenv,GrafiteAst.Fold (loc, red_kind, term, pattern)
240     | GrafiteAst.FwdSimpl (loc, hyp, names) ->
241        metasenv,GrafiteAst.FwdSimpl (loc, hyp, names)  
242     | GrafiteAst.Fourier loc ->
243        metasenv,GrafiteAst.Fourier loc
244     | GrafiteAst.Generalize (loc,pattern,ident) ->
245         let pattern = disambiguate_pattern pattern in
246         metasenv,GrafiteAst.Generalize (loc,pattern,ident)
247     | GrafiteAst.IdTac loc ->
248         metasenv,GrafiteAst.IdTac loc
249     | GrafiteAst.Intros (loc, specs) ->
250         metasenv,GrafiteAst.Intros (loc, specs)
251     | GrafiteAst.Inversion (loc, term) ->
252        let metasenv,term = disambiguate_term context metasenv term in
253         metasenv,GrafiteAst.Inversion (loc, term)
254     | GrafiteAst.LApply (loc, linear, depth, to_what, what, ident) ->
255        let f term to_what =
256           let metasenv,term = disambiguate_term context metasenv term in
257           term :: to_what
258        in
259        let to_what = List.fold_right f to_what [] in 
260        let metasenv,what = disambiguate_term context metasenv what in
261        metasenv,GrafiteAst.LApply (loc, linear, depth, to_what, what, ident)
262     | GrafiteAst.Left loc ->
263        metasenv,GrafiteAst.Left loc
264     | GrafiteAst.LetIn (loc, term, name) ->
265         let metasenv,term = disambiguate_term context metasenv term in
266         metasenv,GrafiteAst.LetIn (loc,term,name)
267     | GrafiteAst.Reduce (loc, red_kind, pattern) ->
268         let pattern = disambiguate_pattern pattern in
269         let red_kind = disambiguate_reduction_kind red_kind in
270         metasenv,GrafiteAst.Reduce(loc, red_kind, pattern)
271     | GrafiteAst.Reflexivity loc ->
272         metasenv,GrafiteAst.Reflexivity loc
273     | GrafiteAst.Replace (loc, pattern, with_what) -> 
274         let pattern = disambiguate_pattern pattern in
275         let with_what = disambiguate_lazy_term with_what in
276         metasenv,GrafiteAst.Replace (loc, pattern, with_what)
277     | GrafiteAst.Rewrite (loc, dir, t, pattern, names) ->
278         let metasenv,term = disambiguate_term context metasenv t in
279         let pattern = disambiguate_pattern pattern in
280         metasenv,GrafiteAst.Rewrite (loc, dir, term, pattern, names)
281     | GrafiteAst.Right loc ->
282         metasenv,GrafiteAst.Right loc
283     | GrafiteAst.Ring loc ->
284         metasenv,GrafiteAst.Ring loc
285     | GrafiteAst.Split loc ->
286         metasenv,GrafiteAst.Split loc
287     | GrafiteAst.Subst loc ->
288         metasenv, GrafiteAst.Subst loc
289     | GrafiteAst.Symmetry loc ->
290         metasenv,GrafiteAst.Symmetry loc
291     | GrafiteAst.Transitivity (loc, term) -> 
292         let metasenv,cic = disambiguate_term context metasenv term in
293         metasenv,GrafiteAst.Transitivity (loc, cic)
294       (* Nuovi casi *)
295     | GrafiteAst.Assume (loc, id, term) -> 
296         let metasenv,cic = disambiguate_term context metasenv term in
297         metasenv,GrafiteAst.Assume (loc, id, cic)
298     | GrafiteAst.Suppose (loc, term, id, term') ->
299         let metasenv,cic = disambiguate_term context metasenv term in
300         let metasenv,cic' =
301            match term' with
302               None -> metasenv,None
303             | Some t ->
304                   let metasenv,t = disambiguate_term context metasenv t in
305                   metasenv,Some t in
306         metasenv,GrafiteAst.Suppose (loc, cic, id, cic')
307     | GrafiteAst.Bydone (loc,term) ->
308         let metasenv,cic = 
309            match term with
310               None -> metasenv,None
311              |Some t ->
312                  let metasenv,t = disambiguate_term context metasenv t in
313                  metasenv,Some t in
314                  metasenv,GrafiteAst.Bydone (loc, cic)
315     | GrafiteAst.We_need_to_prove (loc,term,id,term') ->
316         let metasenv,cic = disambiguate_term context metasenv term in
317         let metasenv,cic' = 
318             match term' with
319               None -> metasenv,None
320             | Some t ->
321                   let metasenv,t = disambiguate_term context metasenv t in
322                   metasenv,Some t in
323         metasenv,GrafiteAst.We_need_to_prove (loc,cic,id,cic')
324     | GrafiteAst.By_term_we_proved (loc,term,term',id,term'') ->
325         let metasenv,cic =
326            match term with 
327              None -> metasenv,None
328            | Some t ->
329                  let metasenv,t = disambiguate_term context metasenv t in
330                  metasenv,Some t in
331         let metasenv,cic' = disambiguate_term context metasenv term' in
332         let metasenv,cic'' = 
333             match term'' with
334               None -> metasenv,None
335            |  Some t ->  
336                     let metasenv,t = disambiguate_term context metasenv t in
337                      metasenv,Some t in
338         metasenv,GrafiteAst.By_term_we_proved (loc,cic,cic',id,cic'')
339     | GrafiteAst.We_proceed_by_cases_on (loc, term, term') ->
340         let metasenv,cic = disambiguate_term context metasenv term in
341         let metasenv,cic' = disambiguate_term context metasenv term' in
342         metasenv,GrafiteAst.We_proceed_by_cases_on (loc, cic, cic')
343     | GrafiteAst.We_proceed_by_induction_on (loc, term, term') ->
344         let metasenv,cic = disambiguate_term context metasenv term in
345         let metasenv,cic' = disambiguate_term context metasenv term' in
346         metasenv,GrafiteAst.We_proceed_by_induction_on (loc, cic, cic')
347    | GrafiteAst.Byinduction (loc, term, id) ->
348         let metasenv,cic = disambiguate_term context metasenv term in
349         metasenv,GrafiteAst.Byinduction(loc, cic, id)
350    | GrafiteAst.Thesisbecomes (loc, term) ->
351         let metasenv,cic = disambiguate_term context metasenv term in
352         metasenv,GrafiteAst.Thesisbecomes (loc, cic)
353    | GrafiteAst.ExistsElim (loc, term, id1, term1, id2, term2) ->
354         let metasenv,cic =
355            match term with
356              None -> metasenv,None
357            | Some t ->
358                  let metasenv,t = disambiguate_term context metasenv t in
359                  metasenv,Some t in
360         let metasenv,cic' = disambiguate_term context metasenv term1 in
361         let cic''= disambiguate_lazy_term term2 in
362         metasenv,GrafiteAst.ExistsElim(loc, cic, id1, cic', id2, cic'')
363    | GrafiteAst.AndElim (loc, term, id, term1, id1, term2) ->
364         let metasenv,cic = disambiguate_term context metasenv term in
365         let metasenv,cic'= disambiguate_term context metasenv term1 in
366         let metasenv,cic''= disambiguate_term context metasenv term2 in
367         metasenv,GrafiteAst.AndElim(loc, cic, id, cic', id1, cic'')   
368    | GrafiteAst.Case (loc, id, params) ->
369         let metasenv,params' =
370          List.fold_right
371           (fun (id,term) (metasenv,params) ->
372             let metasenv,cic = disambiguate_term context metasenv term in
373              metasenv,(id,cic)::params
374           ) params (metasenv,[])
375         in
376         metasenv,GrafiteAst.Case(loc, id, params')   
377    | GrafiteAst.RewritingStep (loc, term1, term2, term3, cont) ->
378         let metasenv,cic =
379          match term1 with
380             None -> metasenv,None
381           | Some (start,t) -> 
382              let metasenv,t = disambiguate_term context metasenv t in
383               metasenv,Some (start,t) in
384         let metasenv,cic'= disambiguate_term context metasenv term2 in
385         let metasenv,cic'' =
386          match term3 with
387             `Auto _ as t -> metasenv,t
388           | `Term t -> 
389              let metasenv,t = disambiguate_term context metasenv t in
390               metasenv,`Term t in
391         metasenv,GrafiteAst.RewritingStep (loc, cic, cic', cic'', cont)   
392
393
394 let disambiguate_obj lexicon_status ~baseuri metasenv (text,prefix_len,obj) =
395   let uri =
396    match obj with
397     | CicNotationPt.Inductive (_,(name,_,_,_)::_)
398     | CicNotationPt.Record (_,name,_,_) ->
399        (match baseuri with
400          | Some baseuri ->
401             Some (UriManager.uri_of_string (baseuri ^ "/" ^ name ^ ".ind"))
402          | None -> raise BaseUriNotSetYet)
403     | CicNotationPt.Inductive _ -> assert false
404     | CicNotationPt.Theorem _ -> None in
405   let (diff, metasenv, cic, _) =
406     singleton
407       (GrafiteDisambiguator.disambiguate_obj ~dbd:(LibraryDb.instance ())
408         ~aliases:lexicon_status.LexiconEngine.aliases
409         ~universe:(Some lexicon_status.LexiconEngine.multi_aliases) ~uri 
410         (text,prefix_len,obj)) in
411   let lexicon_status = LexiconEngine.set_proof_aliases lexicon_status diff in
412   lexicon_status, metasenv, cic
413   
414 let disambiguate_command lexicon_status ~baseuri metasenv (text,prefix_len,cmd)=
415   match cmd with
416    | GrafiteAst.Index(loc,key,uri) ->
417        let lexicon_status_ref = ref lexicon_status in 
418        let disambiguate_term =
419          disambiguate_term text prefix_len lexicon_status_ref [] in
420        let disambiguate_term_option metasenv =
421          function
422              None -> metasenv,None
423            | Some t ->
424                let metasenv,t = disambiguate_term metasenv t in
425                  metasenv, Some t
426        in
427        let metasenv,key = disambiguate_term_option metasenv key in
428        !lexicon_status_ref, metasenv,GrafiteAst.Index(loc,key,uri)
429    | GrafiteAst.Coercion _
430    | GrafiteAst.Default _
431    | GrafiteAst.Drop _
432    | GrafiteAst.Include _
433    | GrafiteAst.Print _
434    | GrafiteAst.Qed _
435    | GrafiteAst.Set _ as cmd ->
436        lexicon_status,metasenv,cmd
437    | GrafiteAst.Obj (loc,obj) ->
438        let lexicon_status,metasenv,obj =
439         disambiguate_obj lexicon_status ~baseuri metasenv (text,prefix_len,obj)in
440        lexicon_status, metasenv, GrafiteAst.Obj (loc,obj)
441    | GrafiteAst.Relation (loc,id,a,aeq,refl,sym,trans) ->
442       let lexicon_status_ref = ref lexicon_status in 
443       let disambiguate_term =
444        disambiguate_term text prefix_len lexicon_status_ref [] in
445       let disambiguate_term_option metasenv =
446        function
447           None -> metasenv,None
448        | Some t ->
449           let metasenv,t = disambiguate_term metasenv t in
450            metasenv, Some t
451       in
452       let metasenv,a = disambiguate_term metasenv a in
453       let metasenv,aeq = disambiguate_term metasenv aeq in
454       let metasenv,refl = disambiguate_term_option metasenv refl in
455       let metasenv,sym = disambiguate_term_option metasenv sym in
456       let metasenv,trans = disambiguate_term_option metasenv trans in
457        !lexicon_status_ref, metasenv,
458         GrafiteAst.Relation (loc,id,a,aeq,refl,sym,trans)
459
460 let disambiguate_macro 
461   lexicon_status_ref metasenv context (text,prefix_len, macro) 
462 =
463  let disambiguate_term = disambiguate_term text prefix_len lexicon_status_ref in
464   match macro with
465    | GrafiteAst.WMatch (loc,term) ->
466       let metasenv,term = disambiguate_term context metasenv term in
467        metasenv,GrafiteAst.WMatch (loc,term)
468    | GrafiteAst.WInstance (loc,term) ->
469       let metasenv,term = disambiguate_term context metasenv term in
470        metasenv,GrafiteAst.WInstance (loc,term)
471    | GrafiteAst.WElim (loc,term) ->
472       let metasenv,term = disambiguate_term context metasenv term in
473        metasenv,GrafiteAst.WElim (loc,term)
474    | GrafiteAst.WHint (loc,term) ->
475       let metasenv,term = disambiguate_term context metasenv term in
476        metasenv,GrafiteAst.WHint (loc,term)
477    | GrafiteAst.Check (loc,term) ->
478       let metasenv,term = disambiguate_term context metasenv term in
479        metasenv,GrafiteAst.Check (loc,term)
480    | GrafiteAst.AutoInteractive _
481    | GrafiteAst.Hint _
482    | GrafiteAst.WLocate _
483    | GrafiteAst.Inline _ as macro ->
484       metasenv,macro