From 48d0870c093a15faaf3dbb327afa94f5da2a38ea Mon Sep 17 00:00:00 2001 From: herbelin Date: Sat, 17 Dec 2011 15:38:38 +0000 Subject: Improving pretty-printing of Ltac functions. git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@14801 85f007b7-540e-0410-9357-904b9bb8a0f7 --- parsing/pptactic.ml | 4 ++-- tactics/tacinterp.ml | 16 +++++++++++++--- 2 files changed, 15 insertions(+), 5 deletions(-) diff --git a/parsing/pptactic.ml b/parsing/pptactic.ml index f55ced809..3305acb77 100644 --- a/parsing/pptactic.ml +++ b/parsing/pptactic.ml @@ -906,8 +906,8 @@ let rec pr_tac inherited tac = pr_tac (lorelse,E) t2), lorelse | TacFail (n,l) -> - str "fail" ++ (if n=ArgArg 0 then mt () else pr_arg (pr_or_var int) n) ++ - prlist (pr_arg (pr_message_token pr_ident)) l, latom + hov 1 (str "fail" ++ (if n=ArgArg 0 then mt () else pr_arg (pr_or_var int) n) ++ + prlist (pr_arg (pr_message_token pr_ident)) l), latom | TacFirst tl -> str "first" ++ spc () ++ pr_seq_body (pr_tac ltop) tl, llet | TacSolve tl -> diff --git a/tactics/tacinterp.ml b/tactics/tacinterp.ml index f9fba20e6..a41cd6e72 100644 --- a/tactics/tacinterp.ml +++ b/tactics/tacinterp.ml @@ -2872,12 +2872,22 @@ let inMD : bool * (tacdef_kind * glob_tactic_expr) list -> obj = subst_function = subst_md; classify_function = classify_md} +let rec split_ltac_fun = function + | TacFun (l,t) -> (l,t) + | t -> ([],t) + +let pr_ltac_fun_arg = function + | None -> spc () ++ str "_" + | Some id -> spc () ++ pr_id id + let print_ltac id = try let kn = Nametab.locate_tactic id in - let t = lookup kn in - str "Ltac" ++ spc() ++ pr_qualid id ++ str " :=" ++ spc() ++ - Pptactic.pr_glob_tactic (Global.env ()) t + let l,t = split_ltac_fun (lookup kn) in + hv 2 ( + hov 2 (str "Ltac" ++ spc() ++ pr_qualid id ++ + prlist pr_ltac_fun_arg l ++ spc () ++ str ":=") + ++ spc() ++ Pptactic.pr_glob_tactic (Global.env ()) t) with Not_found -> errorlabstrm "print_ltac" -- cgit v1.2.3