]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/ocaml/cic_transformations/tacticAstPp.ml
version 0.7.1
[helm.git] / helm / ocaml / cic_transformations / tacticAstPp.ml
index 67b5733d2a0644ef7376a6eff154af6810af2942..bd26fb387492dcc6947b23945d7769a2bd64a03b 100644 (file)
@@ -30,7 +30,6 @@ open TacticAst
 let tactical_terminator = "."
 let tactic_terminator = tactical_terminator
 let command_terminator = tactical_terminator
-let tactical_separator = ";"
 
 let pp_term_ast term = CicAstPp.pp_term term
 let pp_term_cic term = CicPp.ppterm term
@@ -57,6 +56,12 @@ let pp_pattern (t, hyp, goal) =
   in
    pp_t t ^ " in " ^ pp_hyp_pattern hyp ^ " \\vdash " ^ pp_term_ast goal
 
+let pp_intros_specs = function
+   | None, []         -> ""
+   | Some num, []     -> Printf.sprintf " names %i" num
+   | None, idents     -> Printf.sprintf " names %s" (pp_idents idents)
+   | Some num, idents -> Printf.sprintf " names %i %s" num (pp_idents idents)
+
 let rec pp_tactic = function
   | Absurd (_, term) -> "absurd" ^ pp_term_ast term
   | Apply (_, term) -> "apply " ^ pp_term_ast term
@@ -76,14 +81,19 @@ let rec pp_tactic = function
   | Decompose (_, term) ->
       sprintf "decompose %s" (pp_term_ast term)
   | Discriminate (_, term) -> "discriminate " ^ pp_term_ast term
-  | Elim (_, term, using) ->
+  | Elim (_, term, using, num, idents) ->
       sprintf "elim " ^ pp_term_ast term ^
       (match using with None -> "" | Some term -> " using " ^ pp_term_ast term)
-  | ElimType (_, term) -> "elim type " ^ pp_term_ast term
+      ^ pp_intros_specs (num, idents) 
+  | ElimType (_, term, using, num, idents) ->
+      sprintf "elim type " ^ pp_term_ast term ^
+      (match using with None -> "" | Some term -> " using " ^ pp_term_ast term)
+      ^ pp_intros_specs (num, idents)
   | Exact (_, term) -> "exact " ^ pp_term_ast term
   | Exists _ -> "exists"
-  | Fold (_, kind, pattern) ->
-      sprintf "fold %s %s" (pp_reduction_kind kind) (pp_pattern pattern)
+  | Fold (_, kind, term, pattern) ->
+      sprintf "fold %s %s %s" (pp_reduction_kind kind)
+       (pp_term_ast term) (pp_pattern pattern)
   | FwdSimpl (_, hyp, idents) -> 
       sprintf "fwd %s%s" hyp 
         (match idents with [] -> "" | idents -> " " ^ pp_idents idents)
@@ -219,25 +229,30 @@ let pp_obj = function
 
 
 let pp_command = function
+  | Include (_,path) -> "include " ^ path
   | Qed _ -> "qed"
   | Drop _ -> "drop"
-  | Set (_, name, value) -> sprintf "Set \"%s\" \"%s\"" name value
-  | Coercion (_,_) -> "Coercion IMPLEMENT ME!!!!!"
+  | Set (_, name, value) -> sprintf "set \"%s\" \"%s\"" name value
+  | Coercion (_,term) -> sprintf "coercion %s" (pp_term_ast term)
   | Alias (_,s) -> pp_alias s
   | Obj (_,obj) -> pp_obj obj
+  | Default (_,what,uris) ->
+     sprintf "default \"%s\" %s" what
+      (String.concat " " (List.map UriManager.string_of_uri uris))
 
 let rec pp_tactical = function
   | Tactic (_, tac) -> pp_tactic tac
   | Do (_, count, tac) -> sprintf "do %d %s" count (pp_tactical tac)
   | Repeat (_, tac) -> "repeat " ^ pp_tactical tac
-  | Seq (_, tacs) -> pp_tacticals tacs
+  | Seq (_, tacs) -> pp_tacticals ~sep:"; " tacs
   | Then (_, tac, tacs) ->
-      sprintf "%s [%s]" (pp_tactical tac) (pp_tacticals tacs)
-  | Tries (_, tacs) -> sprintf "tries [%s]" (pp_tacticals tacs)
+      sprintf "%s; [%s]" (pp_tactical tac) (pp_tacticals ~sep:" | " tacs)
+  | First (_, tacs) -> sprintf "tries [%s]" (pp_tacticals ~sep:" | " tacs)
   | Try (_, tac) -> "try " ^ pp_tactical tac
+  | Solve (_, tac) -> sprintf "solve [%s]" (pp_tacticals ~sep:" | " tac)
 
-and pp_tacticals tacs =
-  String.concat (tactical_separator ^ " ") (List.map pp_tactical tacs)
+and pp_tacticals ~sep tacs =
+  String.concat sep (List.map pp_tactical tacs)
 
 let pp_tactical tac = pp_tactical tac ^ tactical_terminator
 let pp_tactic tac = pp_tactic tac ^ tactic_terminator
@@ -255,3 +270,13 @@ let pp_comment = function
 let pp_statement = function
   | Executable (_, ex) -> pp_executable ex
   | Comment (_, c) -> pp_comment c
+
+let pp_cic_command = function
+  | Include (_,path) -> "include " ^ path
+  | Qed _ -> "qed"
+  | Drop _ -> "drop"
+  | Coercion (_,term) -> sprintf "coercion %s" (CicPp.ppterm term)
+  | Set (_, _, _)
+  | Alias (_,_)
+  | Default (_,_,_)
+  | Obj (_,_) -> assert false (* not implemented *)