l3-ENSL/pieuvre
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

tactique apply généralisée, à commenter

Browse Source
This commit is contained in:
Marwan 2024-05-14 15:55:19 +02:00
parent b4ba9432cd
commit 00c1a116d1
1 changed files with 14 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
proof.ml
View File

@ -217,21 +217,21 @@ let tact_apply ((g, gs) : proof) (hyp_id : id) : proof =
| _ -> false | _ -> false
in in
let rec generate_goals (goal_ty : ty) (impl_ty : ty) (impl_h : hlam) 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 match impl_ty with
Arr (t1, t2) when t2 = goal_ty -> Arr (t1, t2) when t2 = goal_ty ->
let sub_h = Ref (ref Hole) in 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 Some (sub_h, t1, cs), gs
| Arr (t1, t2) -> | Arr (t1, t2) ->
(* nouveau sous but *) let sub_h = Ref (ref Hole) in
let sub_h = Ref (ref Hole) in (* preuve de t1 *) let new_h = Ref (ref Hole) in
let new_h = Ref (ref Hole) in (* suite de l'implication *) let _ = fill h sub_h in
let _ = fill impl_h (HApp (HApp (impl_h, sub_h), new_h)) in let impl_h = HApp (impl_h, new_h) in
let gs = (sub_h, t1, cs) :: gs 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" | _ -> failwith "impossible"
in in
let rec get_hyp : context -> (hlam * ty) = function let rec get_hyp : context -> (hlam * ty) = function
[] -> raise (TacticFailed "no such hypothesis in context") [] -> raise (TacticFailed "no such hypothesis in context")
@ -240,10 +240,12 @@ let tact_apply ((g, gs) : proof) (hyp_id : id) : proof =
in in
match g with match g with
None -> raise (TacticFailed "no current goal") None -> raise (TacticFailed "no current goal")
| Some (h, goal_ty, cs) -> | Some (goal_h, goal_ty, cs) ->
let h', t' = get_hyp cs in let impl_h, impl_ty = get_hyp cs in
if is_implied goal_ty t' let new_h = Ref (ref Hole) in
then generate_goals goal_ty t' h' h cs gs 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") else raise (TacticFailed "not an implication")
let tact_intros : proof -> proof = let tact_intros : proof -> proof =