X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fgrafite_parser%2FgrafiteDisambiguate.ml;h=516c4af20301e1a6946995cbe44c60fd05491448;hb=5649890273cf8e660bba744e84ce5fee1e5efe69;hp=ececcf967934f82ee5ccbbeb150b07b85e405b15;hpb=5d1cece5f42866b34566a0f616aa3b46a77359a3;p=helm.git

diff --git a/helm/software/components/grafite_parser/grafiteDisambiguate.ml b/helm/software/components/grafite_parser/grafiteDisambiguate.ml
index ececcf967..516c4af20 100644
--- a/helm/software/components/grafite_parser/grafiteDisambiguate.ml
+++ b/helm/software/components/grafite_parser/grafiteDisambiguate.ml
@@ -36,16 +36,20 @@ type lazy_tactic =
   (Cic.term, Cic.lazy_term, Cic.lazy_term GrafiteAst.reduction, string) 
     GrafiteAst.tactic
 
-let singleton = function
+let singleton msg = function
   | [x], _ -> x
-  | _ -> assert false
-;;
+  | l, _   ->
+      let debug = 
+         Printf.sprintf "GrafiteDisambiguate.singleton (%s): %u interpretations"
+	 msg (List.length l)
+      in
+      HLog.debug debug; assert false
 
   (** @param term not meaningful when context is given *)
 let disambiguate_term text prefix_len lexicon_status_ref context metasenv term =
   let lexicon_status = !lexicon_status_ref in
   let (diff, metasenv, cic, _) =
-    singleton
+    singleton "first"
       (GrafiteDisambiguator.disambiguate_term ~dbd:(LibraryDb.instance ())
         ~aliases:lexicon_status.LexiconEngine.aliases
         ~universe:(Some lexicon_status.LexiconEngine.multi_aliases)
@@ -65,7 +69,7 @@ let disambiguate_lazy_term text prefix_len lexicon_status_ref term =
   (fun context metasenv ugraph ->
     let lexicon_status = !lexicon_status_ref in
     let (diff, metasenv, cic, ugraph) =
-      singleton
+      singleton "second"
         (GrafiteDisambiguator.disambiguate_term ~dbd:(LibraryDb.instance ())
           ~initial_ugraph:ugraph ~aliases:lexicon_status.LexiconEngine.aliases
           ~universe:(Some lexicon_status.LexiconEngine.multi_aliases)
@@ -99,12 +103,23 @@ let disambiguate_reduction_kind text prefix_len lexicon_status_ref = function
       let t = disambiguate_lazy_term text prefix_len lexicon_status_ref t in
       `Unfold (Some t)
   | `Normalize
-  | `Reduce
   | `Simpl
   | `Unfold None
   | `Whd as kind -> kind
 ;;
 
+let disambiguate_auto_params 
+  disambiguate_term metasenv context (terms, params) 
+=
+    let metasenv, terms = 
+      List.fold_right 
+       (fun t (metasenv, terms) ->
+         let metasenv,t = disambiguate_term context metasenv t in
+         metasenv,t::terms) terms (metasenv, [])
+    in
+    metasenv, (terms, params)
+;;
+
 let rec disambiguate_tactic 
   lexicon_status_ref context metasenv (text,prefix_len,tactic) 
 =
@@ -118,6 +133,9 @@ let rec disambiguate_tactic
     disambiguate_lazy_term text prefix_len lexicon_status_ref in
   let disambiguate_tactic metasenv tac =
    disambiguate_tactic lexicon_status_ref context metasenv (text,prefix_len,tac)
+  in
+  let disambiguate_auto_params m p = 
+    disambiguate_auto_params disambiguate_term m context p
   in
    match tactic with
     (* Higher  order tactics *)
@@ -178,11 +196,13 @@ let rec disambiguate_tactic
         let metasenv,cic = disambiguate_term context metasenv term in
         metasenv,GrafiteAst.Apply (loc, cic)
     | GrafiteAst.ApplyS (loc, term, params) ->
+        let metasenv, params = disambiguate_auto_params metasenv params in
         let metasenv,cic = disambiguate_term context metasenv term in
         metasenv,GrafiteAst.ApplyS (loc, cic, params)
     | GrafiteAst.Assumption loc ->
         metasenv,GrafiteAst.Assumption loc
     | GrafiteAst.AutoBatch (loc,params) ->
+        let metasenv, params = disambiguate_auto_params metasenv params in
         metasenv,GrafiteAst.AutoBatch (loc,params)
     | GrafiteAst.Cases (loc, what, idents) ->
         let metasenv,what = disambiguate_term context metasenv what in
@@ -214,11 +234,18 @@ let rec disambiguate_tactic
         metasenv,GrafiteAst.Cut (loc, ident, cic)
     | GrafiteAst.Decompose (loc, names) ->
          metasenv,GrafiteAst.Decompose (loc, names)
-    | GrafiteAst.Demodulate loc ->
-        metasenv,GrafiteAst.Demodulate loc
-    | GrafiteAst.Destruct (loc,term) ->
-        let metasenv,term = disambiguate_term context metasenv term in
-        metasenv,GrafiteAst.Destruct(loc,term)
+    | GrafiteAst.Demodulate (loc, params) ->
+        let metasenv, params = disambiguate_auto_params metasenv params in
+        metasenv,GrafiteAst.Demodulate (loc, params)
+    | GrafiteAst.Destruct (loc, Some terms) ->
+        let map term (metasenv, terms) =
+           let metasenv, term = disambiguate_term context metasenv term in
+           metasenv, term :: terms
+        in
+        let metasenv, terms = List.fold_right map terms (metasenv, []) in 
+	metasenv, GrafiteAst.Destruct(loc, Some terms)
+    | GrafiteAst.Destruct (loc, None) ->
+        metasenv,GrafiteAst.Destruct(loc,None)
     | GrafiteAst.Exact (loc, term) -> 
         let metasenv,cic = disambiguate_term context metasenv term in
         metasenv,GrafiteAst.Exact (loc, cic)
@@ -262,12 +289,12 @@ let rec disambiguate_tactic
        let metasenv,term = disambiguate_term context metasenv term in
         metasenv,GrafiteAst.Inversion (loc, term)
     | GrafiteAst.LApply (loc, linear, depth, to_what, what, ident) ->
-       let f term to_what =
-          let metasenv,term = disambiguate_term context metasenv term in
-          term :: to_what
+       let f term (metasenv, to_what) =
+          let metasenv, term = disambiguate_term context metasenv term in
+          metasenv, term :: to_what
        in
-       let to_what = List.fold_right f to_what [] in 
-       let metasenv,what = disambiguate_term context metasenv what in
+       let metasenv, to_what = List.fold_right f to_what (metasenv, []) in 
+       let metasenv, what = disambiguate_term context metasenv what in
        metasenv,GrafiteAst.LApply (loc, linear, depth, to_what, what, ident)
     | GrafiteAst.Left loc ->
        metasenv,GrafiteAst.Left loc
@@ -294,8 +321,6 @@ let rec disambiguate_tactic
         metasenv,GrafiteAst.Ring loc
     | GrafiteAst.Split loc ->
         metasenv,GrafiteAst.Split loc
-    | GrafiteAst.Subst loc ->
-        metasenv, GrafiteAst.Subst loc
     | GrafiteAst.Symmetry loc ->
         metasenv,GrafiteAst.Symmetry loc
     | GrafiteAst.Transitivity (loc, term) -> 
@@ -394,14 +419,20 @@ let rec disambiguate_tactic
 	let metasenv,cic'= disambiguate_term context metasenv term2 in
         let metasenv,cic'' =
 	 match term3 with
-	    `Auto _ as t -> metasenv,t
+          | `SolveWith term ->
+	     let metasenv,term = disambiguate_term context metasenv term in
+             metasenv, `SolveWith term
+	  | `Auto params -> 
+              let metasenv, params = disambiguate_auto_params metasenv params in
+              metasenv,`Auto params
 	  | `Term t -> 
 	     let metasenv,t = disambiguate_term context metasenv t in
-	      metasenv,`Term t in
+	      metasenv,`Term t
+          | `Proof as t -> metasenv,t in
 	metasenv,GrafiteAst.RewritingStep (loc, cic, cic', cic'', cont)   
 
 
-let disambiguate_obj lexicon_status ~baseuri metasenv (text,prefix_len,obj) =
+let disambiguate_obj lexicon_status ?baseuri metasenv (text,prefix_len,obj) =
   let uri =
    match obj with
     | CicNotationPt.Inductive (_,(name,_,_,_)::_)
@@ -413,7 +444,7 @@ let disambiguate_obj lexicon_status ~baseuri metasenv (text,prefix_len,obj) =
     | CicNotationPt.Inductive _ -> assert false
     | CicNotationPt.Theorem _ -> None in
   let (diff, metasenv, cic, _) =
-    singleton
+    singleton "third"
       (GrafiteDisambiguator.disambiguate_obj ~dbd:(LibraryDb.instance ())
         ~aliases:lexicon_status.LexiconEngine.aliases
         ~universe:(Some lexicon_status.LexiconEngine.multi_aliases) ~uri 
@@ -421,7 +452,7 @@ let disambiguate_obj lexicon_status ~baseuri metasenv (text,prefix_len,obj) =
   let lexicon_status = LexiconEngine.set_proof_aliases lexicon_status diff in
   lexicon_status, metasenv, cic
   
-let disambiguate_command lexicon_status ~baseuri metasenv (text,prefix_len,cmd)=
+let disambiguate_command lexicon_status ?baseuri metasenv (text,prefix_len,cmd)=
   match cmd with
    | GrafiteAst.Index(loc,key,uri) ->
        let lexicon_status_ref = ref lexicon_status in 
@@ -446,7 +477,7 @@ let disambiguate_command lexicon_status ~baseuri metasenv (text,prefix_len,cmd)=
        lexicon_status,metasenv,cmd
    | GrafiteAst.Obj (loc,obj) ->
        let lexicon_status,metasenv,obj =
-        disambiguate_obj lexicon_status ~baseuri metasenv (text,prefix_len,obj)in
+        disambiguate_obj lexicon_status ?baseuri metasenv (text,prefix_len,obj)in
        lexicon_status, metasenv, GrafiteAst.Obj (loc,obj)
    | GrafiteAst.Relation (loc,id,a,aeq,refl,sym,trans) ->
       let lexicon_status_ref = ref lexicon_status in 
@@ -487,7 +518,10 @@ let disambiguate_macro
    | GrafiteAst.Check (loc,term) ->
       let metasenv,term = disambiguate_term context metasenv term in
        metasenv,GrafiteAst.Check (loc,term)
-   | GrafiteAst.AutoInteractive _
+   | GrafiteAst.AutoInteractive (loc, params) -> 
+      let metasenv, params = 
+        disambiguate_auto_params disambiguate_term metasenv context params in
+      metasenv, GrafiteAst.AutoInteractive (loc, params)
    | GrafiteAst.Hint _
    | GrafiteAst.WLocate _
    | GrafiteAst.Inline _ as macro ->