]> matita.cs.unibo.it Git - helm.git/blobdiff - matita/components/grafite/grafiteAstPp.ml
Merge branch 'declarative' into matita-lablgtk3
[helm.git] / matita / components / grafite / grafiteAstPp.ml
index 2e088bd77f7b4773fb9102396fd9ef836d3f2be4..42d7df86492625b3b8c00340affcce2f5ad995e2 100644 (file)
@@ -1,14 +1,14 @@
 (* Copyright (C) 2004, HELM Team.
- * 
+ *
  * This file is part of HELM, an Hypertextual, Electronic
  * Library of Mathematics, developed at the Computer Science
  * Department, University of Bologna, Italy.
- * 
+ *
  * HELM is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License
  * as published by the Free Software Foundation; either version 2
  * of the License, or (at your option) any later version.
- * 
+ *
  * HELM is distributed in the hope that it will be useful,
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
@@ -18,7 +18,7 @@
  * along with HELM; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  * MA  02111-1307, USA.
- * 
+ *
  * For details, see the HELM World-Wide-Web page,
  * http://helm.cs.unibo.it/
  *)
@@ -32,8 +32,8 @@ let tactical_terminator = ""
 let tactic_terminator = tactical_terminator
 let command_terminator = tactical_terminator
 
-let pp_tactic_pattern status ~map_unicode_to_tex (what, hyp, goal) = 
-  if what = None && hyp = [] && goal = None then "" else 
+let pp_tactic_pattern status ~map_unicode_to_tex (what, hyp, goal) =
+  if what = None && hyp = [] && goal = None then "" else
   let what_text =
     match what with
     | None -> ""
@@ -51,6 +51,22 @@ let pp_tactic_pattern status ~map_unicode_to_tex (what, hyp, goal) =
   in
    Printf.sprintf "%sin %s%s" what_text hyp_text goal_text
 
+let pp_auto_params params status =
+    match params with
+    | (None,flags) -> String.concat " " (List.map (fun a,b -> a ^ "=" ^ b) flags)
+    | (Some l,flags) -> (String.concat "," (List.map (NotationPp.pp_term status) l)) ^
+    String.concat " " (List.map (fun a,b -> a ^ "=" ^ b) flags)
+;;
+
+let pp_just status just =
+ match just with
+    `Term term -> "using (" ^ NotationPp.pp_term status term ^ ") "
+  | `Auto params ->
+          match params with
+          | (None,[]) -> ""
+          | params -> "by " ^ pp_auto_params params status ^ " "
+;;
+
 let rec pp_ntactic status ~map_unicode_to_tex =
  let pp_tactic_pattern = pp_tactic_pattern ~map_unicode_to_tex in
  function
@@ -70,13 +86,13 @@ let rec pp_ntactic status ~map_unicode_to_tex =
   | NConstructor (_,Some x,l) -> "@" ^ string_of_int x ^ " " ^
       String.concat " " (List.map (NotationPp.pp_term status) l)
   | NCase1 (_,n) -> "*" ^ n ^ ":"
-  | NChange (_,_what,wwhat) -> "nchange " ^ "...to be implemented..." ^ 
+  | NChange (_,_what,wwhat) -> "nchange " ^ "...to be implemented..." ^
       " with " ^ NotationPp.pp_term status wwhat
   | NCut (_,t) -> "ncut " ^ NotationPp.pp_term status t
 (*| NDiscriminate (_,t) -> "ndiscriminate " ^ NotationPp.pp_term status t
   | NSubst (_,t) -> "nsubst " ^ NotationPp.pp_term status t *)
   | NClear (_,l) -> "nclear " ^ String.concat " " l
-  | NDestruct (_,_dom,_skip) -> "ndestruct ..." 
+  | NDestruct (_,_dom,_skip) -> "ndestruct ..."
   | NElim (_,what,_where) -> "nelim " ^ NotationPp.pp_term status what ^
       "...to be implemented..." ^ " " ^ "...to be implemented..."
   | NId _ -> "nid"
@@ -97,16 +113,58 @@ let rec pp_ntactic status ~map_unicode_to_tex =
   | NPosbyname (_, s) -> s ^ ":"
   | NWildcard _ -> "*:"
   | NMerge _ -> "]"
-  | NFocus (_,l) -> 
-      Printf.sprintf "focus %s" 
+  | NFocus (_,l) ->
+      Printf.sprintf "focus %s"
         (String.concat " " (List.map string_of_int l))
   | NUnfocus _ -> "unfocus"
   | NSkip _ -> "skip"
   | NTry (_,tac) -> "ntry " ^ pp_ntactic status ~map_unicode_to_tex tac
   | NAssumption _ -> "nassumption"
-  | NBlock (_,l) -> 
+  | NBlock (_,l) ->
      "(" ^ String.concat " " (List.map (pp_ntactic status ~map_unicode_to_tex) l)^ ")"
   | NRepeat (_,t) -> "nrepeat " ^ pp_ntactic status ~map_unicode_to_tex t
+  | Assume (_, ident, term) -> "assume " ^ ident ^ ":(" ^ (NotationPp.pp_term status term) ^ ")"
+  | Suppose (_,term,ident) -> "suppose (" ^ (NotationPp.pp_term status term) ^ ") (" ^ ident ^ ") "
+  | By_just_we_proved (_, just, term1, ident) -> pp_just status just  ^ " we proved (" ^
+                                                 (NotationPp.pp_term status term1) ^ ")" ^ (match ident with
+        None -> "" | Some ident -> "(" ^ident^ ")")
+  | We_need_to_prove (_,term,ident) -> "we need to prove (" ^ (NotationPp.pp_term status term) ^ ") " ^
+                                         (match ident with None -> "" | Some id -> "(" ^ id ^ ")")
+  | BetaRewritingStep (_,t) -> "that is equivalent to (" ^ (NotationPp.pp_term status t) ^ ")"
+  | Bydone (_, just) -> pp_just status just ^ "done"
+  | ExistsElim (_, just, ident, term, term1, ident1) -> pp_just status just ^ "let " ^ ident ^ ": ("
+  ^ (NotationPp.pp_term status term) ^ ") such that (" ^ (NotationPp.pp_term status term1) ^ ") (" ^ ident1 ^ ")"
+  | AndElim (_, just, term1, ident1, term2, ident2) -> pp_just status just ^ " we have (" ^
+  (NotationPp.pp_term status term1) ^ ") (" ^ ident1 ^ ") " ^ "and (" ^ (NotationPp.pp_term status
+  term2)
+  ^ ") (" ^ ident2 ^ ")"
+  | Thesisbecomes (_, t) -> "the thesis becomes (" ^ (NotationPp.pp_term status t) ^ ")"
+  | RewritingStep (_, rhs, just, cont) ->
+      "= (" ^
+      (NotationPp.pp_term status rhs) ^ ")" ^
+      (match just with
+      | `Auto params -> let s = pp_auto_params params status in
+                        if s <> "" then " by " ^ s
+                        else ""
+      | `Term t -> " exact (" ^ (NotationPp.pp_term status t) ^ ")"
+      | `Proof -> " proof"
+      | `SolveWith t -> " using (" ^ (NotationPp.pp_term status t) ^ ")"
+      )
+      ^ (if cont then " done" else "")
+  | Obtain (_,id,t1) -> "obtain (" ^ id ^ ")" ^ " (" ^ (NotationPp.pp_term status t1) ^ ")"
+  | Conclude (_,t1) -> "conclude (" ^ (NotationPp.pp_term status t1) ^ ")"
+  | We_proceed_by_cases_on (_, term, term1) -> "we proceed by cases on (" ^ NotationPp.pp_term
+  status term ^ ") to prove (" ^ NotationPp.pp_term status  term1 ^ ")"
+  | We_proceed_by_induction_on (_, term, term1) -> "we proceed by induction on (" ^
+  NotationPp.pp_term status  term ^ ") to prove (" ^ NotationPp.pp_term status  term1 ^ ")"
+  | Byinduction (_, term, ident) -> "by induction hypothesis we know (" ^ NotationPp.pp_term status
+  term ^ ") (" ^ ident ^ ")"
+  | Case (_, id, args) ->
+     "case " ^ id ^
+       String.concat " "
+        (List.map (function (id,term) -> "(" ^ id ^ ": (" ^ NotationPp.pp_term status  term ^  "))")
+         args)
+  | PrintStack _ -> "print_stack"
 ;;
 
 let pp_nmacro status = function
@@ -128,7 +186,7 @@ let pp_alias = function
         desc
   | Number_alias (instance,desc) ->
       sprintf "alias num (instance %d) = \"%s\"." instance desc
-  
+
 let pp_associativity = function
   | Gramext.LeftA -> "left associative"
   | Gramext.RightA -> "right associative"
@@ -144,18 +202,18 @@ let pp_argument_pattern = function
       done;
       sprintf "%s%s" (Buffer.contents eta_buf) name
 
-let pp_interpretation dsc symbol arg_patterns cic_appl_pattern = 
+let pp_interpretation dsc symbol arg_patterns cic_appl_pattern =
   sprintf "interpretation \"%s\" '%s %s = %s."
     dsc symbol
     (String.concat " " (List.map pp_argument_pattern arg_patterns))
     (NotationPp.pp_cic_appl_pattern cic_appl_pattern)
+
 let pp_dir_opt = function
   | None -> ""
   | Some `LeftToRight -> "> "
   | Some `RightToLeft -> "< "
 
-let pp_notation status dir_opt l1_pattern assoc prec l2_pattern = 
+let pp_notation status dir_opt l1_pattern assoc prec l2_pattern =
   sprintf "notation %s\"%s\" %s %s for %s."
     (pp_dir_opt dir_opt)
     (pp_l1_pattern status l1_pattern)
@@ -164,22 +222,22 @@ let pp_notation status dir_opt l1_pattern assoc prec l2_pattern =
     (pp_l2_pattern status l2_pattern)
 
 let pp_ncommand status = function
-  | UnificationHint (_,t, n) -> 
+  | UnificationHint (_,t, n) ->
       "unification hint " ^ string_of_int n ^ " " ^ NotationPp.pp_term status t
   | NDiscriminator (_,_)
   | NInverter (_,_,_,_,_)
   | NUnivConstraint (_) -> "not supported"
   | NCoercion (_) -> "not supported"
-  | NObj (_,obj,index) -> 
-      (if not index then "-" else "") ^ 
+  | NObj (_,obj,index) ->
+      (if not index then "-" else "") ^
         NotationPp.pp_obj (NotationPp.pp_term status) obj
   | NQed (_,true) -> "qed"
   | NQed (_,false) -> "qed-"
-  | NCopy (_,name,uri,map) -> 
-      "copy " ^ name ^ " from " ^ NUri.string_of_uri uri ^ " with " ^ 
-        String.concat " and " 
-          (List.map 
-            (fun (a,b) -> NUri.string_of_uri a ^ " ↦ " ^ NUri.string_of_uri b) 
+  | NCopy (_,name,uri,map) ->
+      "copy " ^ name ^ " from " ^ NUri.string_of_uri uri ^ " with " ^
+        String.concat " and "
+          (List.map
+            (fun (a,b) -> NUri.string_of_uri a ^ " ↦ " ^ NUri.string_of_uri b)
             map)
   | Include (_,mode,path) -> (* not precise, since path is absolute *)
       if mode = WithPreferences then
@@ -192,14 +250,14 @@ let pp_ncommand status = function
   | Notation (_, dir_opt, l1_pattern, assoc, prec, l2_pattern) ->
       pp_notation status dir_opt l1_pattern assoc prec l2_pattern
 ;;
-    
+
 let pp_executable status ~map_unicode_to_tex =
   function
   | NMacro (_, macro) -> pp_nmacro status macro ^ "."
   | NTactic (_,tacl) ->
       String.concat " " (List.map (pp_ntactic status ~map_unicode_to_tex) tacl)
   | NCommand (_, cmd) -> pp_ncommand status cmd ^ "."
-                      
+
 let pp_comment status ~map_unicode_to_tex =
   function
   | Note (_,"") -> Printf.sprintf "\n"
@@ -209,5 +267,5 @@ let pp_comment status ~map_unicode_to_tex =
 
 let pp_statement status =
   function
-  | Executable (_, ex) -> pp_executable status ex 
+  | Executable (_, ex) -> pp_executable status ex
   | Comment (_, c) -> pp_comment status c