clarified modules (again);
authorwenzelm
Fri, 01 Nov 2019 15:23:23 +0100
changeset 70980 9dab828cbbc1
parent 70979 7abe5abb4c05
child 70981 a802d42c00bc
clarified modules (again);
src/Pure/Proof/proof_syntax.ML
src/Pure/proofterm.ML
--- a/src/Pure/Proof/proof_syntax.ML	Fri Nov 01 15:09:55 2019 +0100
+++ b/src/Pure/Proof/proof_syntax.ML	Fri Nov 01 15:23:23 2019 +0100
@@ -7,6 +7,7 @@
 signature PROOF_SYNTAX =
 sig
   val add_proof_syntax: theory -> theory
+  val term_of_proof: proof -> term
   val proof_of_term: theory -> bool -> term -> Proofterm.proof
   val read_term: theory -> bool -> typ -> string -> term
   val read_proof: theory -> bool -> bool -> string -> Proofterm.proof
@@ -22,7 +23,7 @@
 
 (**** add special syntax for embedding proof terms ****)
 
-val proofT = Proofterm.proofT;
+val proofT = Type ("Pure.proof", []);
 
 local
 
@@ -80,7 +81,60 @@
   |> Sign.add_consts (map (fn name => (Binding.qualified_name name, proofT, NoSyn)) names);
 
 
-(**** translation between proof terms and pure terms ****)
+
+(** proof terms as pure terms **)
+
+(* term_of_proof *)
+
+local
+
+val AbsPt = Const ("Pure.AbsP", propT --> (proofT --> proofT) --> proofT);
+val AppPt = Const ("Pure.AppP", proofT --> proofT --> proofT);
+val Hypt = Const ("Pure.Hyp", propT --> proofT);
+val Oraclet = Const ("Pure.Oracle", propT --> proofT);
+val MinProoft = Const ("Pure.MinProof", proofT);
+
+fun AppT T prf =
+  Const ("Pure.Appt", proofT --> Term.itselfT T --> proofT) $ prf $ Logic.mk_type T;
+
+fun OfClasst (T, c) =
+  let val U = Term.itselfT T --> propT
+  in Const ("Pure.OfClass", U --> proofT) $ Const (Logic.const_of_class c, U) end;
+
+fun term_of _ (PThm ({serial = i, name, types = Ts, ...}, _)) =
+      fold AppT (these Ts)
+        (Const (Long_Name.append "thm" (if name = "" then string_of_int i else name), proofT))
+  | term_of _ (PAxm (name, _, Ts)) =
+      fold AppT (these Ts) (Const (Long_Name.append "axm" name, proofT))
+  | term_of _ (OfClass (T, c)) = AppT T (OfClasst (T, c))
+  | term_of _ (PBound i) = Bound i
+  | term_of Ts (Abst (s, opT, prf)) =
+      let val T = the_default dummyT opT in
+        Const ("Pure.Abst", (T --> proofT) --> proofT) $
+          Abs (s, T, term_of (T::Ts) (Proofterm.incr_pboundvars 1 0 prf))
+      end
+  | term_of Ts (AbsP (s, t, prf)) =
+      AbsPt $ the_default Term.dummy_prop t $
+        Abs (s, proofT, term_of (proofT::Ts) (Proofterm.incr_pboundvars 0 1 prf))
+  | term_of Ts (prf1 %% prf2) =
+      AppPt $ term_of Ts prf1 $ term_of Ts prf2
+  | term_of Ts (prf % opt) =
+      let
+        val t = the_default Term.dummy opt;
+        val T = fastype_of1 (Ts, t) handle TERM _ => dummyT;
+      in Const ("Pure.Appt", proofT --> T --> proofT) $ term_of Ts prf $ t end
+  | term_of _ (Hyp t) = Hypt $ t
+  | term_of _ (Oracle (_, t, _)) = Oraclet $ t
+  | term_of _ MinProof = MinProoft;
+
+in
+
+val term_of_proof = term_of [];
+
+end;
+
+
+(* proof_of_term *)
 
 fun proof_of_term thy ty =
   let
@@ -194,7 +248,7 @@
 fun pretty_proof ctxt prf =
   Proof_Context.pretty_term_abbrev
     (Proof_Context.transfer (proof_syntax prf (Proof_Context.theory_of ctxt)) ctxt)
-    (Proofterm.term_of_proof prf);
+    (term_of_proof prf);
 
 fun pretty_standard_proof_of ctxt full thm =
   pretty_proof ctxt (Thm.standard_proof_of {full = full, expand_name = Thm.expand_name thm} thm);
--- a/src/Pure/proofterm.ML	Fri Nov 01 15:09:55 2019 +0100
+++ b/src/Pure/proofterm.ML	Fri Nov 01 15:23:23 2019 +0100
@@ -103,8 +103,6 @@
   val prf_subst_bounds: term list -> proof -> proof
   val prf_subst_pbounds: proof list -> proof -> proof
   val freeze_thaw_prf: proof -> proof * (proof -> proof)
-  val proofT: typ
-  val term_of_proof: proof -> term
 
   (*proof terms for specific inference rules*)
   val trivial_proof: proof
@@ -835,59 +833,6 @@
 
 
 
-(** proof terms as pure terms **)
-
-val proofT = Type ("Pure.proof", []);
-
-local
-
-val AbsPt = Const ("Pure.AbsP", propT --> (proofT --> proofT) --> proofT);
-val AppPt = Const ("Pure.AppP", proofT --> proofT --> proofT);
-val Hypt = Const ("Pure.Hyp", propT --> proofT);
-val Oraclet = Const ("Pure.Oracle", propT --> proofT);
-val MinProoft = Const ("Pure.MinProof", proofT);
-
-fun AppT T prf =
-  Const ("Pure.Appt", proofT --> Term.itselfT T --> proofT) $ prf $ Logic.mk_type T;
-
-fun OfClasst (T, c) =
-  let val U = Term.itselfT T --> propT
-  in Const ("Pure.OfClass", U --> proofT) $ Const (Logic.const_of_class c, U) end;
-
-fun term_of _ (PThm ({serial = i, name, types = Ts, ...}, _)) =
-      fold AppT (these Ts)
-        (Const (Long_Name.append "thm" (if name = "" then string_of_int i else name), proofT))
-  | term_of _ (PAxm (name, _, Ts)) =
-      fold AppT (these Ts) (Const (Long_Name.append "axm" name, proofT))
-  | term_of _ (OfClass (T, c)) = AppT T (OfClasst (T, c))
-  | term_of _ (PBound i) = Bound i
-  | term_of Ts (Abst (s, opT, prf)) =
-      let val T = the_default dummyT opT in
-        Const ("Pure.Abst", (T --> proofT) --> proofT) $
-          Abs (s, T, term_of (T::Ts) (incr_pboundvars 1 0 prf))
-      end
-  | term_of Ts (AbsP (s, t, prf)) =
-      AbsPt $ the_default Term.dummy_prop t $
-        Abs (s, proofT, term_of (proofT::Ts) (incr_pboundvars 0 1 prf))
-  | term_of Ts (prf1 %% prf2) =
-      AppPt $ term_of Ts prf1 $ term_of Ts prf2
-  | term_of Ts (prf % opt) =
-      let
-        val t = the_default Term.dummy opt;
-        val T = fastype_of1 (Ts, t) handle TERM _ => dummyT;
-      in Const ("Pure.Appt", proofT --> T --> proofT) $ term_of Ts prf $ t end
-  | term_of _ (Hyp t) = Hypt $ t
-  | term_of _ (Oracle (_, t, _)) = Oraclet $ t
-  | term_of _ MinProof = MinProoft;
-
-in
-
-val term_of_proof = term_of [];
-
-end;
-
-
-
 (** inference rules **)
 
 (* trivial implication *)