+ let module PT = CicNotationPt in
+ let module GA = GrafiteAst in
+ let pp_t context t =
+ let names =
+ List.map (function Some (n,_) -> Some n | None -> None) context
+ in
+ CicPp.pp t names
+ in
+ let sort_of context t =
+ try
+ let ty,_ =
+ CicTypeChecker.type_of_aux' menv context t
+ CicUniv.oblivion_ugraph
+ in
+ let sort,_ = CicTypeChecker.type_of_aux' menv context ty
+ CicUniv.oblivion_ugraph
+ in
+ match sort with
+ | Cic.Sort Cic.Prop -> true
+ | _ -> false
+ with
+ CicTypeChecker.TypeCheckerFailure _ ->
+ HLog.error "auto proof to sript transformation error"; false
+ in
+ let floc = HExtlib.dummy_floc in
+ (* minimalisti cic.term -> pt.term *)
+ let print_term c t =
+ let rec aux c = function
+ | Cic.Rel _
+ | Cic.MutConstruct _
+ | Cic.MutInd _
+ | Cic.Const _ as t ->
+ PT.Ident (pp_t c t, None)
+ | Cic.Appl l -> PT.Appl (List.map (aux c) l)
+ | Cic.Implicit _ -> PT.Implicit `JustOne
+ | Cic.Lambda (Cic.Name n, s, t) ->
+ PT.Binder (`Lambda, (PT.Ident (n,None), Some (aux c s)),
+ aux (Some (Cic.Name n, Cic.Decl s)::c) t)
+ | Cic.Prod (Cic.Name n, s, t) ->
+ PT.Binder (`Forall, (PT.Ident (n,None), Some (aux c s)),
+ aux (Some (Cic.Name n, Cic.Decl s)::c) t)
+ | Cic.LetIn (Cic.Name n, s, ty, t) ->
+ PT.Binder (`Lambda, (PT.Ident (n,None), Some (aux c s)),
+ aux (Some (Cic.Name n, Cic.Def (s,ty))::c) t)
+ | Cic.Meta _ -> PT.Implicit `JustOne
+ | Cic.Sort (Cic.Type u) -> PT.Sort (`Type u)
+ | Cic.Sort Cic.Set -> PT.Sort `Set
+ | Cic.Sort (Cic.CProp u) -> PT.Sort (`CProp u)
+ | Cic.Sort Cic.Prop -> PT.Sort `Prop
+ | _ as t -> PT.Ident ("ERROR: "^CicPp.ppterm t, None)
+ in
+ aux c t
+ in
+ (* prints an applicative proof, that is an auto proof.
+ * don't use in the general case! *)
+ let rec print_proof context = function
+ | Cic.Rel _
+ | Cic.Const _ as t ->
+ [GA.Executable (floc,
+ GA.Tactic (floc,
+ Some (GA.Apply (floc, print_term context t)), GA.Dot floc))]
+ | Cic.Appl (he::tl) ->
+ let tl = List.map (fun t -> t, sort_of context t) tl in
+ let subgoals =
+ HExtlib.filter_map (function (t,true) -> Some t | _ -> None) tl
+ in
+ let args =
+ List.map (function | (t,true) -> Cic.Implicit None | (t,_) -> t) tl
+ in
+ if List.length subgoals > 1 then
+ (* branch *)
+ [GA.Executable (floc,
+ GA.Tactic (floc,
+ Some (GA.Apply (floc, print_term context (Cic.Appl (he::args)))),
+ GA.Semicolon floc))] @
+ [GA.Executable (floc, GA.Tactic (floc, None, GA.Branch floc))] @
+ (HExtlib.list_concat
+ ~sep:[GA.Executable (floc, GA.Tactic (floc, None,GA.Shift floc))]
+ (List.map (print_proof context) subgoals)) @
+ [GA.Executable (floc, GA.Tactic (floc, None,GA.Merge floc))]
+ else
+ (* simple apply *)
+ [GA.Executable (floc,
+ GA.Tactic (floc,
+ Some (GA.Apply
+ (floc, print_term context (Cic.Appl (he::args)) )), GA.Dot floc))]
+ @
+ (match subgoals with
+ | [] -> []
+ | [x] -> print_proof context x
+ | _ -> assert false)
+ | Cic.Lambda (Cic.Name n, ty, bo) ->
+ [GA.Executable (floc,
+ GA.Tactic (floc,
+ Some (GA.Cut (floc, Some n, (print_term context ty))),
+ GA.Branch floc))] @
+ (print_proof (Some (Cic.Name n, Cic.Decl ty)::context) bo) @
+ [GA.Executable (floc, GA.Tactic (floc, None,GA.Shift floc))] @
+ [GA.Executable (floc, GA.Tactic (floc,
+ Some (GA.Assumption floc),GA.Merge floc))]
+ | _ -> []
+ (*
+ debug_print (lazy (CicPp.ppterm t));
+ assert false
+ *)