]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/software/components/grafite_engine/grafiteEngine.ml
Quick&dirty implementation of neqd:
[helm.git] / helm / software / components / grafite_engine / grafiteEngine.ml
index c6bebbc397e00cf5dfad8a7645e5fbb3078ff670..26e3aab2d05d4066def1e1e64fcbe267746226d1 100644 (file)
@@ -86,11 +86,11 @@ let rec tactic_of_ast status ast =
   | GrafiteAst.ApplyP (_, term) -> Tactics.applyP term
   | GrafiteAst.ApplyS (_, term, params) ->
      Tactics.applyS ~term ~params ~dbd:(LibraryDb.instance ())
-       ~universe:status.GrafiteTypes.universe
+       ~automation_cache:status.GrafiteTypes.automation_cache
   | GrafiteAst.Assumption _ -> Tactics.assumption
   | GrafiteAst.AutoBatch (_,params) ->
       Tactics.auto ~params ~dbd:(LibraryDb.instance ()) 
-       ~universe:status.GrafiteTypes.universe
+       ~automation_cache:status.GrafiteTypes.automation_cache
   | GrafiteAst.Cases (_, what, pattern, (howmany, names)) ->
       Tactics.cases_intros ?howmany ~mk_fresh_name_callback:(namer_of names)
         ~pattern what
@@ -112,7 +112,7 @@ let rec tactic_of_ast status ast =
   | GrafiteAst.Demodulate (_, params) -> 
       Tactics.demodulate 
        ~dbd:(LibraryDb.instance ()) ~params 
-          ~universe:status.GrafiteTypes.universe
+          ~automation_cache:status.GrafiteTypes.automation_cache
   | GrafiteAst.Destruct (_,xterms) -> Tactics.destruct xterms
   | GrafiteAst.Elim (_, what, using, pattern, (depth, names)) ->
       Tactics.elim_intros ?using ?depth ~mk_fresh_name_callback:(namer_of names)
@@ -183,12 +183,12 @@ let rec tactic_of_ast status ast =
   | GrafiteAst.Suppose (_, t, id, t1) -> Declarative.suppose t id t1
   | GrafiteAst.By_just_we_proved (_, just, ty, id, t1) ->
      Declarative.by_just_we_proved ~dbd:(LibraryDb.instance())
-      ~universe:status.GrafiteTypes.universe just ty id t1
+      ~automation_cache:status.GrafiteTypes.automation_cache just ty id t1
   | GrafiteAst.We_need_to_prove (_, t, id, t2) ->
      Declarative.we_need_to_prove t id t2
   | GrafiteAst.Bydone (_, t) ->
      Declarative.bydone ~dbd:(LibraryDb.instance())
-      ~universe:status.GrafiteTypes.universe t
+      ~automation_cache:status.GrafiteTypes.automation_cache t
   | GrafiteAst.We_proceed_by_cases_on (_, t, t1) ->
      Declarative.we_proceed_by_cases_on t t1
   | GrafiteAst.We_proceed_by_induction_on (_, t, t1) ->
@@ -197,14 +197,14 @@ let rec tactic_of_ast status ast =
   | GrafiteAst.Thesisbecomes (_, t) -> Declarative.thesisbecomes t
   | GrafiteAst.ExistsElim (_, just, id1, t1, id2, t2) ->
      Declarative.existselim ~dbd:(LibraryDb.instance())
-      ~universe:status.GrafiteTypes.universe just id1 t1 id2 t2
+      ~automation_cache:status.GrafiteTypes.automation_cache just id1 t1 id2 t2
   | GrafiteAst.Case (_,id,params) -> Declarative.case id params
   | GrafiteAst.AndElim(_,just,id1,t1,id2,t2) ->
      Declarative.andelim ~dbd:(LibraryDb.instance ())
-      ~universe:status.GrafiteTypes.universe just id1 t1 id2 t2
+      ~automation_cache:status.GrafiteTypes.automation_cache just id1 t1 id2 t2
   | GrafiteAst.RewritingStep (_,termine,t1,t2,cont) ->
      Declarative.rewritingstep ~dbd:(LibraryDb.instance ())
-      ~universe:status.GrafiteTypes.universe termine t1 t2 cont
+      ~automation_cache:status.GrafiteTypes.automation_cache termine t1 t2 cont
 
 let classify_tactic tactic = 
   match tactic with
@@ -470,9 +470,9 @@ let coercion_moo_statement_of (uri,arity, saturations,_) =
   GrafiteAst.Coercion
    (HExtlib.dummy_floc, CicUtil.term_of_uri uri, false, arity, saturations)
 
-let eval_unification_hint status t = 
+let eval_unification_hint status t 
   (* XXX no undo *)        
-  NCicUnifHint.add_user_provided_hint t;
+  NCicUnifHint.add_user_provided_hint t n;
   status,[]
 ;;
 
@@ -571,7 +571,58 @@ let eval_tactical status tac =
   status
 
 let add_obj = GrafiteSync.add_obj ~pack_coercion_obj:CicRefine.pack_coercion_obj
-      
+
+let eval_ng_punct (_text, _prefix_len, punct) =
+  match punct with
+  | GrafiteAst.Dot _ -> NTactics.dot_tac 
+  | GrafiteAst.Semicolon _ -> fun x -> x
+  | GrafiteAst.Branch _ -> NTactics.branch_tac 
+  | GrafiteAst.Shift _ -> NTactics.shift_tac 
+  | GrafiteAst.Pos (_,l) -> NTactics.pos_tac l
+  | GrafiteAst.Wildcard _ -> NTactics.wildcard_tac 
+  | GrafiteAst.Merge _ -> NTactics.merge_tac 
+;;
+
+let eval_ng_tac (text, prefix_len, tac) =
+  match tac with
+  | GrafiteAst.NApply (_loc, t) -> NTactics.apply_tac (text,prefix_len,t) 
+  | GrafiteAst.NAssert (_loc, seqs) ->
+     NTactics.assert_tac
+      ((List.map
+        (function (hyps,concl) ->
+          List.map
+           (function
+              (id,`Decl t) -> id,`Decl (text,prefix_len,t)
+             |(id,`Def (b,t))->id,`Def((text,prefix_len,b),(text,prefix_len,t))
+           ) hyps,
+          (text,prefix_len,concl))
+       ) seqs)
+  | GrafiteAst.NCases (_loc, what, where) ->
+      NTactics.cases_tac 
+        ~what:(text,prefix_len,what)
+        ~where:(text,prefix_len,where)
+  | GrafiteAst.NCase1 (_loc,n) -> NTactics.case1_tac n
+  | GrafiteAst.NChange (_loc, pat, ww) -> 
+      NTactics.change_tac 
+       ~where:(text,prefix_len,pat) ~with_what:(text,prefix_len,ww) 
+  | GrafiteAst.NElim (_loc, what, where) ->
+      NTactics.elim_tac 
+        ~what:(text,prefix_len,what)
+        ~where:(text,prefix_len,where)
+  | GrafiteAst.NEval (_loc, where, reduction) ->
+      NTactics.eval_tac ~reduction ~where:(text,prefix_len,where)
+  | GrafiteAst.NGeneralize (_loc, where) -> 
+      NTactics.generalize_tac ~where:(text,prefix_len,where)
+  | GrafiteAst.NId _ -> (fun x -> x)
+  | GrafiteAst.NIntro (_loc,n) -> NTactics.intro_tac n
+  | GrafiteAst.NLetIn (_loc,where,what,name) ->
+      NTactics.letin_tac ~where:(text,prefix_len,where) 
+        ~what:(text,prefix_len,what) name
+  | GrafiteAst.NRewrite (_loc,dir,what,where) ->
+     NTactics.rewrite_tac ~dir ~what:(text,prefix_len,what)
+      ~where:(text,prefix_len,where)
+;;
+
 let rec eval_command = {ec_go = fun ~disambiguate_command opts status
 (text,prefix_len,cmd) ->
  let status,cmd = disambiguate_command status (text,prefix_len,cmd) in
@@ -580,9 +631,14 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status
   | GrafiteAst.Index (loc,None,uri) -> 
        assert false (* TODO: for user input *)
   | GrafiteAst.Index (loc,Some key,uri) -> 
-      let universe = Universe.index 
-       status.GrafiteTypes.universe key (CicUtil.term_of_uri uri) in
-      let status = {status with GrafiteTypes.universe = universe} in
+      let universe = 
+        status.GrafiteTypes.automation_cache.AutomationCache.univ
+      in
+      let universe = Universe.index universe key (CicUtil.term_of_uri uri) in
+      let cache = { 
+        status.GrafiteTypes.automation_cache with AutomationCache.univ = universe } 
+      in
+      let status = { status with GrafiteTypes.automation_cache = cache } in
 (* debug
       let msg =
        let candidates = Universe.get_candidates status.GrafiteTypes.universe key in
@@ -593,12 +649,37 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status
 *)
       let status = GrafiteTypes.add_moo_content [cmd] status in
       status,[] 
+  | GrafiteAst.Select (_,uri) as cmd ->
+      if List.mem cmd status.GrafiteTypes.moo_content_rev then status, []
+      else 
+       let cache = 
+         AutomationCache.add_term_to_active status.GrafiteTypes.automation_cache
+           [] [] [] (CicUtil.term_of_uri uri) None
+       in
+       let status = { status with GrafiteTypes.automation_cache = cache } in
+       let status = GrafiteTypes.add_moo_content [cmd] status in
+       status, []
+  | GrafiteAst.Pump (_,steps) ->
+      let cache = 
+        AutomationCache.pump status.GrafiteTypes.automation_cache steps
+      in
+      let status = { status with GrafiteTypes.automation_cache = cache } in
+      status, []
   | GrafiteAst.PreferCoercion (loc, coercion) ->
      eval_prefer_coercion status coercion
   | GrafiteAst.Coercion (loc, uri, add_composites, arity, saturations) ->
      eval_coercion status ~add_composites uri arity saturations 
-  | GrafiteAst.UnificationHint (loc, t) ->
-     eval_unification_hint status t
+  | GrafiteAst.Inverter (loc, name, indty, params) ->
+     let buri = GrafiteTypes.get_baseuri status in 
+     let uri = UriManager.uri_of_string (buri ^ "/" ^ name ^ ".con") in
+     let indty_uri = 
+       try CicUtil.uri_of_term indty
+       with Invalid_argument _ ->
+         raise (Invalid_argument "not an inductive type to invert")
+     in
+     Inversion_principle.build_inverter ~add_obj status uri indty_uri params
+  | GrafiteAst.UnificationHint (loc, t, n) ->
+     eval_unification_hint status t n
   | GrafiteAst.Default (loc, what, uris) as cmd ->
      LibraryObjects.set_default what uris;
      GrafiteTypes.add_moo_content [cmd] status,[]
@@ -660,11 +741,64 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status
          GrafiteTypes.proof_status = GrafiteTypes.No_proof},
         (*CSC: I throw away the arities *)
         uri::lemmas
+  | GrafiteAst.NQed loc ->
+      (match status.GrafiteTypes.ng_status with
+       | GrafiteTypes.ProofMode
+          { NTacStatus.istatus =
+             {NTacStatus.pstatus = pstatus; lstatus=lexicon_status} } ->
+            let uri,height,menv,subst,obj = pstatus in
+             if menv <> [] then
+              raise
+               (GrafiteTypes.Command_error"You can't Qed an incomplete theorem")
+             else
+              let obj =
+prerr_endline "CSC: here we should fix the height!!!";
+prerr_endline (NUri.string_of_uri uri);
+               uri,height,[],[],NTacStatus.apply_subst_obj subst obj
+              in
+               NCicLibrary.add_obj uri obj;
+               {status with 
+                 GrafiteTypes.ng_status = 
+                  GrafiteTypes.CommandMode lexicon_status },[]
+       | _ -> raise (GrafiteTypes.Command_error "Not in proof mode"))
   | GrafiteAst.Relation (loc, id, a, aeq, refl, sym, trans) -> 
      Setoids.add_relation id a aeq refl sym trans;
      status, [] (*CSC: TO BE FIXED *)
   | GrafiteAst.Set (loc, name, value) -> status, []
 (*       GrafiteTypes.set_option status name value,[] *)
+  | GrafiteAst.NObj (loc,obj) ->
+     let ty, name = 
+       match obj with
+       | CicNotationPt.Theorem (_,name,ty,_) -> ty, name
+       | _ -> assert false
+     in
+     (* CSC: ".con"??? it is like that for now *)
+     let suri = "cic:/ng_matita/" ^ name ^ ".con" in
+     let nlexicon_status =
+       match status.GrafiteTypes.ng_status with
+       | GrafiteTypes.ProofMode _ -> assert false
+       | GrafiteTypes.CommandMode ls -> ls
+     in
+     let nmenv, nsubst, nlexicon_status, nty = 
+       GrafiteDisambiguate.disambiguate_nterm None
+       nlexicon_status [] [] [] (text,prefix_len,ty)
+     in
+     let nmenv, nsubst, nlexicon_status, nbo = 
+       GrafiteDisambiguate.disambiguate_nterm (Some nty)
+       nlexicon_status [] nmenv nsubst ("",0,CicNotationPt.Implicit)
+     in
+     let ninitial_stack = Continuationals.Stack.of_nmetasenv nmenv in
+     prerr_endline ("nuovo lemma: " ^ NCicPp.ppmetasenv ~subst:nsubst nmenv);
+     { status with
+        GrafiteTypes.ng_status = 
+           GrafiteTypes.ProofMode { NTacStatus.gstatus = ninitial_stack; 
+          istatus = { 
+            NTacStatus.pstatus = 
+             NUri.uri_of_string suri, 0, nmenv, nsubst, 
+              (NCic.Constant ([],"",Some nbo,nty,(`Provided,`Definition,`Regular)));
+            lstatus = nlexicon_status} }   
+     },
+      []
   | GrafiteAst.Obj (loc,obj) ->
      let ext,name =
       match obj with
@@ -716,7 +850,8 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status
          let initial_stack = Continuationals.Stack.of_metasenv metasenv' in
          { status with GrafiteTypes.proof_status =
             GrafiteTypes.Incomplete_proof
-             { GrafiteTypes.proof = initial_proof; stack = initial_stack } },
+            { GrafiteTypes.proof = initial_proof; stack = initial_stack } ;
+         },
           []
      | _ ->
          if metasenv <> [] then
@@ -755,6 +890,14 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status
   | GrafiteAst.Tactic (_, None, punct) ->
       eval_tactical status
        (punctuation_tactical_of_ast (text,prefix_len,punct)),[]
+  | GrafiteAst.NTactic (_(*loc*), tac, punct) ->
+      (match  status.GrafiteTypes.ng_status with
+      | GrafiteTypes.CommandMode _ -> assert false
+      | GrafiteTypes.ProofMode nstatus ->
+         let nstatus = eval_ng_tac (text,prefix_len,tac) nstatus in
+         let nstatus = eval_ng_punct (text,prefix_len,punct) nstatus in
+         NTacStatus.pp_tac_status nstatus;
+         { status with GrafiteTypes.ng_status = GrafiteTypes.ProofMode nstatus }, [])
   | GrafiteAst.NonPunctuationTactical (_, tac, punct) ->
      let status = 
       eval_tactical status