tactique apply généralisée, à commenter
This commit is contained in:
parent
b4ba9432cd
commit
00c1a116d1
26
proof.ml
26
proof.ml
@ -217,21 +217,21 @@ let tact_apply ((g, gs) : proof) (hyp_id : id) : proof =
|
||||
| _ -> false
|
||||
in
|
||||
let rec generate_goals (goal_ty : ty) (impl_ty : ty) (impl_h : hlam)
|
||||
(goal_h : hlam) (cs : context) (gs : goal list) : proof =
|
||||
(goal_h : hlam) (h : hlam) (cs : context) (gs : goal list) : proof =
|
||||
match impl_ty with
|
||||
Arr (t1, t2) when t2 = goal_ty ->
|
||||
let sub_h = Ref (ref Hole) in
|
||||
let _ = fill goal_h (HApp (impl_h, sub_h)) in
|
||||
let _ = fill h sub_h in
|
||||
let _ = fill goal_h impl_h in
|
||||
Some (sub_h, t1, cs), gs
|
||||
| Arr (t1, t2) ->
|
||||
(* nouveau sous but *)
|
||||
let sub_h = Ref (ref Hole) in (* preuve de t1 *)
|
||||
let new_h = Ref (ref Hole) in (* suite de l'implication *)
|
||||
let _ = fill impl_h (HApp (HApp (impl_h, sub_h), new_h)) in
|
||||
let sub_h = Ref (ref Hole) in
|
||||
let new_h = Ref (ref Hole) in
|
||||
let _ = fill h sub_h in
|
||||
let impl_h = HApp (impl_h, new_h) in
|
||||
let gs = (sub_h, t1, cs) :: gs in
|
||||
generate_goals goal_ty t2 new_h goal_h cs gs
|
||||
generate_goals goal_ty t2 impl_h goal_h new_h cs gs
|
||||
| _ -> failwith "impossible"
|
||||
|
||||
in
|
||||
let rec get_hyp : context -> (hlam * ty) = function
|
||||
[] -> raise (TacticFailed "no such hypothesis in context")
|
||||
@ -240,10 +240,12 @@ let tact_apply ((g, gs) : proof) (hyp_id : id) : proof =
|
||||
in
|
||||
match g with
|
||||
None -> raise (TacticFailed "no current goal")
|
||||
| Some (h, goal_ty, cs) ->
|
||||
let h', t' = get_hyp cs in
|
||||
if is_implied goal_ty t'
|
||||
then generate_goals goal_ty t' h' h cs gs
|
||||
| Some (goal_h, goal_ty, cs) ->
|
||||
let impl_h, impl_ty = get_hyp cs in
|
||||
let new_h = Ref (ref Hole) in
|
||||
let impl_h_2 = HApp (impl_h, new_h) in
|
||||
if is_implied goal_ty impl_ty
|
||||
then generate_goals goal_ty impl_ty impl_h_2 goal_h new_h cs gs
|
||||
else raise (TacticFailed "not an implication")
|
||||
|
||||
let tact_intros : proof -> proof =
|
||||
|
Loading…
x
Reference in New Issue
Block a user