
# 17 "vernac/g_obligations.mlg"
 

open Stdarg

let (set_default_tactic, get_default_tactic, print_default_tactic) =
  Tactic_option.declare_tactic_option "Program tactic"

let () =
  (* Delay to recover the tactic imperatively *)
  let tac = Proofview.tclBIND (Proofview.tclUNIT ()) begin fun () ->
      get_default_tactic ()
    end
  in
  Declare.Obls.default_tactic := tac

let with_tac f tac =
  let tac = Option.map (fun tac -> Gentactic.intern (Global.env()) tac) tac in
  f tac

let interp_gen tac =
  Proofview.Goal.enter begin fun gl ->
  let tac = Gentactic.intern ~strict:false (Proofview.Goal.env gl) tac in
  Gentactic.interp tac
  end

(* We define new entries for programs, with the use of this module
 * Subtac. These entries are named Subtac.<foo>
 *)

let pr_withtac env sigma = let open Pp in function
  | None -> mt ()
  | Some tac -> str "with" ++ spc () ++ Gentactic.print_raw env sigma tac

let generic_tactic = Pvernac.Vernac_.generic_tactic


# 40 "vernac/g_obligations.ml"

let (wit_withtac, withtac) =
  Vernacextend.vernac_argument_extend ~plugin:None ~name:"withtac" {
                                                                    Vernacextend.arg_parsing =
                                                                    Vernacextend.Arg_rules
                                                                    ([(
                                                                    Procq.Production.make
                                                                    (
                                                                    Procq.Rule.next
                                                                    (
                                                                    Procq.Rule.next
                                                                    (Procq.Rule.stop)
                                                                    ((Procq.Symbol.token (Procq.terminal "with"))))
                                                                    ((Procq.Symbol.nterm generic_tactic)))
                                                                    (fun tac
                                                                    _ loc ->
                                                                    
# 56 "vernac/g_obligations.mlg"
                                      Some tac 
# 60 "vernac/g_obligations.ml"
));
                                                                    (Procq.Production.make
                                                                    (Procq.Rule.stop)
                                                                    (fun
                                                                    loc -> 
                                                                    
# 55 "vernac/g_obligations.mlg"
           None 
# 69 "vernac/g_obligations.ml"
))]);
                                                                    Vernacextend.arg_printer = fun env sigma ->
                                                                    
# 54 "vernac/g_obligations.mlg"
                                            pr_withtac env sigma 
# 75 "vernac/g_obligations.ml"
;
                                                                    }
let _ = (wit_withtac, withtac)


# 59 "vernac/g_obligations.mlg"
 

open Declare.Obls

let obligation ~pm obl tac = with_tac (fun t -> obligation ~pm obl t) tac
let next_obligation ~pm ?final obl tac = with_tac (fun t -> next_obligation ~pm ?final obl t) tac

let classify_obbl _ = Vernacextend.(VtStartProof (Doesn'tGuaranteeOpacity,[]))


# 92 "vernac/g_obligations.ml"

let () = Vernacextend.static_vernac_extend ~plugin:None ~command:"Obligations" ~classifier:(fun ~atts ->  classify_obbl ) ?entry:None 
         [(Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal
          ("Obligation",
           Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_natural),
           Vernacextend.TyTerminal
           ("of",
            Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_identref),
            Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_withtac),
            Vernacextend.TyNil))))),
          (let coqpp_body num name tac () =
            Vernactypes.vtdeclareprogram (fun ~pm -> (
# 72 "vernac/g_obligations.mlg"
      obligation (num, Some name.CAst.v) tac 
# 109 "vernac/g_obligations.ml"
) ~pm) in
            fun num name tac ?loc ~atts () ->
            coqpp_body num name tac (Attributes.unsupported_attributes atts)),
          None));
         (Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal
          ("Obligation",
           Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_natural),
           Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_withtac),
           Vernacextend.TyNil))),
          (let coqpp_body num tac () =
            Vernactypes.vtdeclareprogram (fun ~pm -> (
# 74 "vernac/g_obligations.mlg"
      obligation (num, None) tac 
# 125 "vernac/g_obligations.ml"
) ~pm) in
            fun num tac ?loc ~atts () ->
            coqpp_body num tac (Attributes.unsupported_attributes atts)),
          None));
         (Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal
          ("Next",
           Vernacextend.TyTerminal
           ("Obligation",
            Vernacextend.TyTerminal
            ("of",
             Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_identref),
             Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_withtac),
             Vernacextend.TyNil))))),
          (let coqpp_body name tac () =
            Vernactypes.vtdeclareprogram (fun ~pm -> (
# 76 "vernac/g_obligations.mlg"
      next_obligation (Some name.CAst.v) tac 
# 145 "vernac/g_obligations.ml"
) ~pm) in
            fun name tac ?loc ~atts () ->
            coqpp_body name tac (Attributes.unsupported_attributes atts)),
          None));
         (Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal
          ("Next",
           Vernacextend.TyTerminal
           ("Obligation",
            Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_withtac),
            Vernacextend.TyNil))),
          (let coqpp_body tac () =
            Vernactypes.vtdeclareprogram (fun ~pm -> (
# 77 "vernac/g_obligations.mlg"
                                            next_obligation None tac 
# 162 "vernac/g_obligations.ml"
) ~pm) in
            fun tac ?loc ~atts () ->
            coqpp_body tac (Attributes.unsupported_attributes atts)),
          None));
         (Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal
          ("Final",
           Vernacextend.TyTerminal
           ("Obligation",
            Vernacextend.TyTerminal
            ("of",
             Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_identref),
             Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_withtac),
             Vernacextend.TyNil))))),
          (let coqpp_body name tac () =
            Vernactypes.vtdeclareprogram (fun ~pm -> (
# 79 "vernac/g_obligations.mlg"
      next_obligation ~final:true (Some name.CAst.v) tac 
# 182 "vernac/g_obligations.ml"
) ~pm) in
            fun name tac ?loc ~atts () ->
            coqpp_body name tac (Attributes.unsupported_attributes atts)),
          None));
         (Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal
          ("Final",
           Vernacextend.TyTerminal
           ("Obligation",
            Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_withtac),
            Vernacextend.TyNil))),
          (let coqpp_body tac () =
            Vernactypes.vtdeclareprogram (fun ~pm -> (
# 80 "vernac/g_obligations.mlg"
                                             next_obligation ~final:true None tac 
# 199 "vernac/g_obligations.ml"
) ~pm) in
            fun tac ?loc ~atts () ->
            coqpp_body tac (Attributes.unsupported_attributes atts)),
          None))]

let () = Vernacextend.static_vernac_extend ~plugin:None ~command:"Solve_Obligations" ~classifier:(fun ~atts:_ _ -> Vernacextend.classify_as_sideeff) ?entry:None 
         [(Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal
          ("Solve",
           Vernacextend.TyTerminal
           ("Obligations",
            Vernacextend.TyTerminal
            ("of",
             Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_identref),
             Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_withtac),
             Vernacextend.TyNil))))),
          (let coqpp_body name t () =
            Vernactypes.vtmodifyprogram (fun ~pm -> (
# 85 "vernac/g_obligations.mlg"
      try_solve_obligations (Some name.CAst.v) (Option.map interp_gen t) 
# 221 "vernac/g_obligations.ml"
) ~pm) in
            fun name t ?loc ~atts () ->
            coqpp_body name t (Attributes.unsupported_attributes atts)),
          None));
         (Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal
          ("Solve",
           Vernacextend.TyTerminal
           ("Obligations",
            Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_withtac),
            Vernacextend.TyNil))),
          (let coqpp_body t () =
            Vernactypes.vtmodifyprogram (fun ~pm -> (
# 87 "vernac/g_obligations.mlg"
      try_solve_obligations None (Option.map interp_gen t) 
# 238 "vernac/g_obligations.ml"
) ~pm) in
            fun t ?loc ~atts () ->
            coqpp_body t (Attributes.unsupported_attributes atts)),
          None))]

let () = Vernacextend.static_vernac_extend ~plugin:None ~command:"Solve_All_Obligations" ~classifier:(fun ~atts:_ _ -> Vernacextend.classify_as_sideeff) ?entry:None 
         [(Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal
          ("Solve",
           Vernacextend.TyTerminal
           ("All",
            Vernacextend.TyTerminal
            ("Obligations",
             Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_withtac),
             Vernacextend.TyNil)))),
          (let coqpp_body t () =
            Vernactypes.vtmodifyprogram (fun ~pm -> (
# 92 "vernac/g_obligations.mlg"
      solve_all_obligations (Option.map interp_gen t) 
# 259 "vernac/g_obligations.ml"
) ~pm) in
            fun t ?loc ~atts () ->
            coqpp_body t (Attributes.unsupported_attributes atts)),
          None))]

let () = Vernacextend.static_vernac_extend ~plugin:None ~command:"Admit_Obligations" ~classifier:(fun ~atts:_ _ -> Vernacextend.classify_as_sideeff) ?entry:None 
         [(Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal
          ("Admit",
           Vernacextend.TyTerminal
           ("Obligations",
            Vernacextend.TyTerminal
            ("of",
             Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_identref),
             Vernacextend.TyNil)))),
          (let coqpp_body name () =
            Vernactypes.vtmodifyprogram (fun ~pm -> (
# 96 "vernac/g_obligations.mlg"
                                                     admit_obligations (Some name.CAst.v) 
# 280 "vernac/g_obligations.ml"
) ~pm) in
            fun name ?loc ~atts () ->
            coqpp_body name (Attributes.unsupported_attributes atts)),
          None));
         (Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal
          ("Admit",
           Vernacextend.TyTerminal ("Obligations", Vernacextend.TyNil)),
          (let coqpp_body () =
            Vernactypes.vtmodifyprogram (fun ~pm -> (
# 97 "vernac/g_obligations.mlg"
                                 admit_obligations None 
# 294 "vernac/g_obligations.ml"
) ~pm) in
            fun ?loc ~atts () ->
            coqpp_body (Attributes.unsupported_attributes atts)),
          None))]

let () = Vernacextend.static_vernac_extend ~plugin:None ~command:"Set_Solver" ~classifier:(fun ~atts:_ _ -> Vernacextend.classify_as_sideeff) ?entry:None 
         [(Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal
          ("Obligation",
           Vernacextend.TyTerminal
           ("Tactic",
            Vernacextend.TyTerminal
            (":=",
             Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_generic_tactic),
             Vernacextend.TyNil)))),
          (let coqpp_body t locality = Vernactypes.vtdefault (fun () -> 
# 101 "vernac/g_obligations.mlg"
                                                                                                          
        set_default_tactic
          locality
          (Gentactic.intern (Global.env()) t);
  
# 318 "vernac/g_obligations.ml"
) in
            fun t ?loc ~atts () -> coqpp_body t (Attributes.parse 
# 101 "vernac/g_obligations.mlg"
                 Tactic_option.tac_option_locality
# 323 "vernac/g_obligations.ml"
 atts)),
          None))]

let () = Vernacextend.static_vernac_extend ~plugin:None ~command:"Show_Solver" ~classifier:(fun ~atts:_ _ -> Vernacextend.classify_as_query) ?entry:None 
         [(Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal
          ("Show",
           Vernacextend.TyTerminal
           ("Obligation",
            Vernacextend.TyTerminal ("Tactic", Vernacextend.TyNil))),
          (let coqpp_body () = Vernactypes.vtdefault (fun () -> 
# 109 "vernac/g_obligations.mlg"
                                       
    Feedback.msg_notice Pp.(str"Program obligation tactic is " ++ print_default_tactic ()) 
# 339 "vernac/g_obligations.ml"
) in
            fun ?loc ~atts () ->
            coqpp_body (Attributes.unsupported_attributes atts)),
          None))]

let () = Vernacextend.static_vernac_extend ~plugin:None ~command:"Show_Obligations" ~classifier:(fun ~atts:_ _ -> Vernacextend.classify_as_query) ?entry:None 
         [(Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal
          ("Obligations",
           Vernacextend.TyTerminal
           ("of",
            Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_identref),
            Vernacextend.TyNil))),
          (let coqpp_body name () =
            Vernactypes.vtreadprogram (fun ~pm -> (
# 114 "vernac/g_obligations.mlg"
                                             fun ~pm -> show_obligations ~pm (Some name.CAst.v) 
# 358 "vernac/g_obligations.ml"
) ~pm) in
            fun name ?loc ~atts () ->
            coqpp_body name (Attributes.unsupported_attributes atts)),
          None));
         (Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal ("Obligations", Vernacextend.TyNil),
          (let coqpp_body () =
            Vernactypes.vtreadprogram (fun ~pm -> (
# 115 "vernac/g_obligations.mlg"
                         fun ~pm -> show_obligations ~pm None 
# 370 "vernac/g_obligations.ml"
) ~pm) in
            fun ?loc ~atts () ->
            coqpp_body (Attributes.unsupported_attributes atts)),
          None))]

let () = Vernacextend.static_vernac_extend ~plugin:None ~command:"Show_Preterm" ~classifier:(fun ~atts:_ _ -> Vernacextend.classify_as_query) ?entry:None 
         [(Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal
          ("Preterm",
           Vernacextend.TyTerminal
           ("of",
            Vernacextend.TyNonTerminal (Extend.TUentry (Genarg.get_arg_tag wit_identref),
            Vernacextend.TyNil))),
          (let coqpp_body name () =
            Vernactypes.vtreadprogram (fun ~pm -> (
# 119 "vernac/g_obligations.mlg"
                                         fun ~pm -> Feedback.msg_notice (show_term ~pm (Some name.CAst.v)) 
# 389 "vernac/g_obligations.ml"
) ~pm) in
            fun name ?loc ~atts () ->
            coqpp_body name (Attributes.unsupported_attributes atts)),
          None));
         (Vernacextend.TyML
         (false,
          Vernacextend.TyTerminal ("Preterm", Vernacextend.TyNil),
          (let coqpp_body () =
            Vernactypes.vtreadprogram (fun ~pm -> (
# 120 "vernac/g_obligations.mlg"
                     fun ~pm -> Feedback.msg_notice (show_term ~pm None) 
# 401 "vernac/g_obligations.ml"
) ~pm) in
            fun ?loc ~atts () ->
            coqpp_body (Attributes.unsupported_attributes atts)),
          None))]

