
# 11 "plugins/firstorder/g_ground.mlg"
 

open Ltac_plugin
open Sequent
open Ground
open Goptions
open Tacmach
open Tacticals
open Tacinterp
open Stdarg
open Tacarg
open Procq.Prim


# 18 "plugins/firstorder/g_ground.ml"

let _ = Mltop.add_known_module "rocq-runtime.plugins.firstorder"

# 30 "plugins/firstorder/g_ground.mlg"
 

let { Goptions.get = ground_depth } =
  declare_nat_option_and_ref
    ~key:["Firstorder";"Depth"]
    ~value:3
    ()

let (set_default_solver, default_solver, print_default_solver) =
  Tactic_option.declare_tactic_option "Firstorder default solver"


# 35 "plugins/firstorder/g_ground.ml"

let () = Vernacextend.static_vernac_extend ~plugin:(Some "rocq-runtime.plugins.firstorder") ~command:"Firstorder_Set_Solver" ~classifier:(fun ~atts:_ _ -> Vernacextend.classify_as_sideeff) ?entry:None 
         [(Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal
          ("Set",
           Vernacextend.TyTerminal
           ("Firstorder",
            Vernacextend.TyTerminal
            ("Solver",
             Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_generic_tactic),
             Vernacextend.TyNil)))),
          (let coqpp_body t locality = Vernactypes.vtdefault (fun () -> 
# 44 "plugins/firstorder/g_ground.mlg"
                                                                                                           
      set_default_solver
        locality
        (Gentactic.intern (Global.env()) t)
  
# 55 "plugins/firstorder/g_ground.ml"
) in
            fun t ?loc ~atts () -> coqpp_body t (Attributes.parse 
# 44 "plugins/firstorder/g_ground.mlg"
                 Tactic_option.tac_option_locality
# 60 "plugins/firstorder/g_ground.ml"
 atts)),
          None))]

let () = Vernacextend.static_vernac_extend ~plugin:(Some "rocq-runtime.plugins.firstorder") ~command:"Firstorder_Print_Solver" ~classifier:(fun ~atts:_ _ -> Vernacextend.classify_as_query) ?entry:None 
         [(Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal
          ("Print",
           Vernacextend.TyTerminal
           ("Firstorder",
            Vernacextend.TyTerminal ("Solver", Vernacextend.TyNil))),
          (let coqpp_body () = Vernactypes.vtdefault (fun () -> 
# 52 "plugins/firstorder/g_ground.mlg"
                                        
    Feedback.msg_notice
      (Pp.(++) (Pp.str"Firstorder solver tactic is ") (print_default_solver ())) 
# 77 "plugins/firstorder/g_ground.ml"
) in
            fun ?loc ~atts () ->
            coqpp_body (Attributes.unsupported_attributes atts)),
          None))]


# 57 "plugins/firstorder/g_ground.mlg"
 

let gen_ground_tac ist taco ids bases =
  let flags = Ground.get_flags () in
  Proofview.tclOR begin
  Proofview.Goal.enter begin fun gl ->
      let solver=
        match taco with
        | Some tac -> tactic_of_value ist tac
        | None-> default_solver ()
      in
      let startseq k =
        Proofview.Goal.enter begin fun gl ->
        let seq=empty_seq (ground_depth ()) in
        let seq, sigma = extend_with_ref_list ~flags (pf_env gl) (project gl) ids seq in
        let seq, sigma = extend_with_auto_hints ~flags (pf_env gl) sigma bases seq in
        tclTHEN (Proofview.Unsafe.tclEVARS sigma) (k seq)
        end
      in
      let () =
        if Tacinterp.get_debug()=Tactic_debug.DebugOn 0
        then
          Feedback.msg_debug (Printer.Debug.pr_goal gl)
      in
      let result=ground_tac ~flags solver startseq in
      result
  end
  end
  (fun (e, info) -> Proofview.tclZERO ~info e)

(* special for compatibility with Intuition

let constant str = Rocqlib.get_constr str

let defined_connectives=lazy
  [[],EvalConstRef (destConst (constant "core.not.type"));
   [],EvalConstRef (destConst (constant "core.iff.type"))]

let normalize_evaluables=
  onAllHypsAndConcl
    (function
         None->unfold_in_concl (Lazy.force defined_connectives)
       | Some id->
           unfold_in_hyp (Lazy.force defined_connectives)
           (Tacexpr.InHypType id)) *)

open Ppconstr
open Printer
let pr_firstorder_using_raw _ _ _ = Pptactic.pr_auto_using pr_qualid
let pr_firstorder_using_glob _ _ _ = Pptactic.pr_auto_using (Pputils.pr_or_var (fun x -> pr_global (snd x)))
let pr_firstorder_using_typed _ _ _ = Pptactic.pr_auto_using pr_global


# 138 "plugins/firstorder/g_ground.ml"

let (wit_firstorder_using, firstorder_using) = Tacentries.argument_extend ~plugin:"rocq-runtime.plugins.firstorder" ~name:"firstorder_using" 
                                               {
                                               Tacentries.arg_parsing = 
                                               Vernacextend.Arg_rules
                                               ([(Procq.Production.make
                                                  (Procq.Rule.stop)
                                                  (fun loc -> 
# 117 "plugins/firstorder/g_ground.mlg"
           [] 
# 149 "plugins/firstorder/g_ground.ml"
));
                                                (Procq.Production.make
                                                 (Procq.Rule.next
                                                  (Procq.Rule.next
                                                   (Procq.Rule.stop)
                                                   ((Procq.Symbol.token (Procq.terminal "using"))))
                                                  ((Procq.Symbol.list1sep ((Procq.Symbol.nterm reference)) ((Procq.Symbol.rules 
                                                  [Procq.Rules.make (
                                                                    Procq.Rule.next_norec
                                                                    (Procq.Rule.stop)
                                                                    ((Procq.Symbol.token (Procq.terminal ","))))
                                                                    (fun _
                                                                    loc ->
                                                                    ())])) false)))
                                                 (fun l _ loc -> 
# 116 "plugins/firstorder/g_ground.mlg"
                                                l 
# 167 "plugins/firstorder/g_ground.ml"
))]);
                                               Tacentries.arg_tag = Some
                                                                    (Geninterp.Val.List 
                                                                    (Geninterp.val_tag (Genarg.topwit wit_reference)));
                                               Tacentries.arg_intern = 
                                               Tacentries.ArgInternWit (Genarg.ListArg 
                                               (wit_reference));
                                               Tacentries.arg_subst = 
                                               Tacentries.ArgSubstWit (Genarg.ListArg 
                                               (wit_reference));
                                               Tacentries.arg_interp = 
                                               Tacentries.ArgInterpWit (Genarg.ListArg 
                                               (wit_reference));
                                               Tacentries.arg_printer = 
                                               ((fun env sigma -> 
# 114 "plugins/firstorder/g_ground.mlg"
                   pr_firstorder_using_raw 
# 185 "plugins/firstorder/g_ground.ml"
), (fun env sigma -> 
                                               
# 115 "plugins/firstorder/g_ground.mlg"
                    pr_firstorder_using_glob 
# 190 "plugins/firstorder/g_ground.ml"
), (fun env sigma -> 
# 113 "plugins/firstorder/g_ground.mlg"
               pr_firstorder_using_typed 
# 194 "plugins/firstorder/g_ground.ml"
));
                                               }
let _ = (wit_firstorder_using, firstorder_using)

let () = Tacentries.tactic_extend "rocq-runtime.plugins.firstorder" "firstorder" ~level:0 
         [(Tacentries.TyML (Tacentries.TyIdent ("firstorder", Tacentries.TyArg (
                                                              Extend.TUopt (
                                                              Extend.TUentry (Genarg.get_arg_tag wit_tactic)), 
                                                              Tacentries.TyArg (
                                                              Extend.TUentry (Genarg.get_arg_tag wit_firstorder_using), 
                                                              Tacentries.TyNil))), 
           (fun t l ist -> 
# 122 "plugins/firstorder/g_ground.mlg"
        gen_ground_tac ist t l [] 
# 209 "plugins/firstorder/g_ground.ml"
)));
         (Tacentries.TyML (Tacentries.TyIdent ("firstorder", Tacentries.TyArg (
                                                             Extend.TUopt (
                                                             Extend.TUentry (Genarg.get_arg_tag wit_tactic)), 
                                                             Tacentries.TyIdent ("with", 
                                                             Tacentries.TyArg (
                                                             Extend.TUlist1 (
                                                             Extend.TUentry (Genarg.get_arg_tag wit_preident)), 
                                                             Tacentries.TyNil)))), 
          (fun t l ist -> 
# 124 "plugins/firstorder/g_ground.mlg"
        gen_ground_tac ist t [] l 
# 222 "plugins/firstorder/g_ground.ml"
)));
         (Tacentries.TyML (Tacentries.TyIdent ("firstorder", Tacentries.TyArg (
                                                             Extend.TUopt (
                                                             Extend.TUentry (Genarg.get_arg_tag wit_tactic)), 
                                                             Tacentries.TyArg (
                                                             Extend.TUentry (Genarg.get_arg_tag wit_firstorder_using), 
                                                             Tacentries.TyIdent ("with", 
                                                             Tacentries.TyArg (
                                                             Extend.TUlist1 (
                                                             Extend.TUentry (Genarg.get_arg_tag wit_preident)), 
                                                             Tacentries.TyNil))))), 
          (fun t l l' ist -> 
# 127 "plugins/firstorder/g_ground.mlg"
        gen_ground_tac ist t l l' 
# 237 "plugins/firstorder/g_ground.ml"
)))]

