aboutsummaryrefslogtreecommitdiff
path: root/plugins/funind/g_indfun.mlg
diff options
context:
space:
mode:
authorEmilio Jesus Gallego Arias2018-12-05 01:50:37 +0100
committerEmilio Jesus Gallego Arias2019-03-27 23:56:18 +0100
commit46a8fe0ef1c06ff1b64082ff87b8725dbbd4989b (patch)
treef21203d72c419fa92da5abb01ff866da8eb20792 /plugins/funind/g_indfun.mlg
parent2d8f2cc01d8d35baa39144274a700a9ebc66f794 (diff)
[plugins] [funind] Adapt to removal of imperative proof state.
Diffstat (limited to 'plugins/funind/g_indfun.mlg')
-rw-r--r--plugins/funind/g_indfun.mlg54
1 files changed, 26 insertions, 28 deletions
diff --git a/plugins/funind/g_indfun.mlg b/plugins/funind/g_indfun.mlg
index 6f67ab4d8b..4e8cf80ed2 100644
--- a/plugins/funind/g_indfun.mlg
+++ b/plugins/funind/g_indfun.mlg
@@ -177,7 +177,7 @@ let () =
(* TASSI: n'importe quoi ! *)
VERNAC COMMAND EXTEND Function
-| ["Function" ne_function_rec_definition_loc_list_sep(recsl,"with")]
+| ![ proof ] ["Function" ne_function_rec_definition_loc_list_sep(recsl,"with")]
=> { let hard = List.exists (function
| _,((_,(_,(CMeasureRec _|CWfRec _)),_,_,_),_) -> true
| _,((_,(_,CStructRec),_,_,_),_) -> false) recsl in
@@ -223,37 +223,34 @@ let warning_error names e =
}
VERNAC COMMAND EXTEND NewFunctionalScheme
-| ["Functional" "Scheme" ne_fun_scheme_arg_list_sep(fas,"with") ]
+| ![ proof ] ["Functional" "Scheme" ne_fun_scheme_arg_list_sep(fas,"with") ]
=> { Vernacextend.(VtSideff(List.map pi1 fas), VtLater) }
->
- {
+ { fun ~pstate ->
begin
- try
- Functional_principles_types.build_scheme fas
- with Functional_principles_types.No_graph_found ->
- begin
- match fas with
- | (_,fun_name,_)::_ ->
- begin
- begin
- make_graph (Smartlocate.global_with_alias fun_name)
- end
- ;
- try Functional_principles_types.build_scheme fas
- with Functional_principles_types.No_graph_found ->
- CErrors.user_err Pp.(str "Cannot generate induction principle(s)")
- | e when CErrors.noncritical e ->
- let names = List.map (fun (_,na,_) -> na) fas in
- warning_error names e
-
- end
+ try
+ Functional_principles_types.build_scheme fas; pstate
+ with
+ | Functional_principles_types.No_graph_found ->
+ begin
+ match fas with
+ | (_,fun_name,_)::_ ->
+ begin
+ let pstate = make_graph ~pstate (Smartlocate.global_with_alias fun_name) in
+ try Functional_principles_types.build_scheme fas; pstate
+ with
+ | Functional_principles_types.No_graph_found ->
+ CErrors.user_err Pp.(str "Cannot generate induction principle(s)")
+ | e when CErrors.noncritical e ->
+ let names = List.map (fun (_,na,_) -> na) fas in
+ warning_error names e; pstate
+ end
| _ -> assert false (* we can only have non empty list *)
- end
- | e when CErrors.noncritical e ->
- let names = List.map (fun (_,na,_) -> na) fas in
- warning_error names e
+ end
+ | e when CErrors.noncritical e ->
+ let names = List.map (fun (_,na,_) -> na) fas in
+ warning_error names e; pstate
end
-
}
END
(***** debug only ***)
@@ -266,5 +263,6 @@ END
(***** debug only ***)
VERNAC COMMAND EXTEND GenerateGraph CLASSIFIED AS QUERY
-| ["Generate" "graph" "for" reference(c)] -> { make_graph (Smartlocate.global_with_alias c) }
+| ![ proof ] ["Generate" "graph" "for" reference(c)] ->
+ { make_graph (Smartlocate.global_with_alias c) }
END