Removal of structure Context and its replacement by a theorem list of
authorpaulson
Mon, 23 Jun 1997 11:33:59 +0200
changeset 3459 112cbb8301dc
parent 3458 5ff4bfab859c
child 3460 5d71eed16fbe
Removal of structure Context and its replacement by a theorem list of congruence rules for use in CONTEXT_REWRITE_RULE (where definitions are processed)
TFL/post.sml
TFL/tfl.sig
TFL/tfl.sml
--- a/TFL/post.sml	Mon Jun 23 11:30:35 1997 +0200
+++ b/TFL/post.sml	Mon Jun 23 11:33:59 1997 +0200
@@ -23,7 +23,8 @@
    val define   : theory -> string -> string -> string list 
                   -> theory * Prim.pattern list
 
-   val simplify_defn : simpset -> theory * (string * Prim.pattern list)
+   val simplify_defn : simpset * thm list 
+                        -> theory * (string * Prim.pattern list)
                         -> {rules:thm list, induct:thm, tcs:term list}
 
   (*-------------------------------------------------------------------------
@@ -31,8 +32,6 @@
        val lazyR_def: theory -> term -> {theory:theory, eqns : thm}
    *-------------------------------------------------------------------------*)
 
-   val tflcongs : theory -> thm list
-
   end;
 
 
@@ -77,7 +76,6 @@
 			  (!claset addSDs [not0_implies_Suc] addss ss) 1),
     simplifier = Rules.simpl_conv ss []};
 
-fun tflcongs thy = Prim.Context.read() @ (#case_congs(Thry.extract_info thy));
 
 
 val concl = #2 o Rules.dest_thm;
@@ -185,14 +183,25 @@
 
 val wf_rel_defs = [lex_prod_def, measure_def, inv_image_def];
 
-fun simplify_defn ss (thy,(id,pats)) =
+(*Convert conclusion from = to ==*)
+val eq_reflect_list = map (fn th => (th RS eq_reflection) handle _ => th);
+
+(*---------------------------------------------------------------------------
+ * Install the basic context notions. Others (for nat and list and prod) 
+ * have already been added in thry.sml
+ *---------------------------------------------------------------------------*)
+val defaultTflCongs = eq_reflect_list [Thms.LET_CONG, if_cong];
+
+fun simplify_defn (ss, tflCongs) (thy,(id,pats)) =
    let val dummy = deny (id  mem  map ! (stamps_of_thy thy))
                         ("Recursive definition " ^ id ^ 
                          " would clash with the theory of the same name!")
        val def =  freezeT(get_def thy id)   RS   meta_eq_to_obj_eq
        val ss' = ss addsimps ((less_Suc_eq RS iffD2) :: wf_rel_defs)
        val {theory,rules,TCs,full_pats_TCs,patterns} = 
-                Prim.post_definition ss' (thy,(def,pats))
+                Prim.post_definition
+		   (ss', defaultTflCongs @ eq_reflect_list tflCongs)
+		   (thy, (def,pats))
        val {lhs=f,rhs} = S.dest_eq(concl def)
        val (_,[R,_]) = S.strip_comb rhs
        val {induction, rules, tcs} = 
@@ -243,14 +252,4 @@
  *
  *
  *---------------------------------------------------------------------------*)
-
-
-
-
-(*---------------------------------------------------------------------------
- * Install the basic context notions. Others (for nat and list and prod) 
- * have already been added in thry.sml
- *---------------------------------------------------------------------------*)
-val () = Prim.Context.write[Thms.LET_CONG, Thms.COND_CONG];
-
 end;
--- a/TFL/tfl.sig	Mon Jun 23 11:30:35 1997 +0200
+++ b/TFL/tfl.sig	Mon Jun 23 11:33:59 1997 +0200
@@ -17,7 +17,7 @@
 
    val wfrec_definition0 : theory -> string -> term -> term -> theory
 
-   val post_definition : simpset -> theory * (thm * pattern list)
+   val post_definition : simpset * thm list -> theory * (thm * pattern list)
 				 -> {theory : theory,
 				     rules  : thm, 
 				       TCs  : term list list,
@@ -25,7 +25,7 @@
 				  patterns  : pattern list}
 
 (*CURRENTLY UNUSED
-   val wfrec_eqns : theory -> term list
+   val wfrec_eqns : simpset * thm list -> theory -> term list
                      -> {WFR : term, 
                          proto_def : term,
                          extracta :(thm * term list) list,
@@ -46,10 +46,4 @@
                      -> theory 
                       -> {rules:thm, induction:thm, TCs:term list list}
                        -> {rules:thm, induction:thm, nested_tcs:thm list}
-
-   structure Context
-     : sig
-         val read : unit -> thm list
-         val write : thm list -> unit
-       end
 end;
--- a/TFL/tfl.sml	Mon Jun 23 11:30:35 1997 +0200
+++ b/TFL/tfl.sml	Mon Jun 23 11:33:59 1997 +0200
@@ -355,16 +355,9 @@
  * This structure keeps track of congruence rules that aren't derived
  * from a datatype definition.
  *---------------------------------------------------------------------------*)
-structure Context =
-struct
-  val non_datatype_context = ref []: thm list ref
-  fun read() = !non_datatype_context
-  fun write L = (non_datatype_context := L)
-end;
-
 fun extraction_thms thy = 
  let val {case_rewrites,case_congs} = Thry.extract_info thy
- in (case_rewrites, case_congs@Context.read())
+ in (case_rewrites, case_congs)
  end;
 
 
@@ -393,7 +386,7 @@
   | givens (GIVEN(tm,_)::pats) = tm :: givens pats
   | givens (OMITTED _::pats)   = givens pats;
 
-fun post_definition ss (theory, (def, pats)) =
+fun post_definition (ss, tflCongs) (theory, (def, pats)) =
  let val tych = Thry.typecheck theory 
      val f = #lhs(S.dest_eq(concl def))
      val corollary = R.MATCH_MP Thms.WFREC_COROLLARY def
@@ -408,7 +401,7 @@
      val extract = R.CONTEXT_REWRITE_RULE 
 	             (ss, f, R,
 		      R.ISPECL (map tych [f,R]) Thms.CUT_LEMMA,
-		      context_congs)
+		      tflCongs@context_congs)
      val (rules, TCs) = ListPair.unzip (map extract corollaries')
      val rules0 = map (rewrite_rule [Thms.CUT_DEF]) rules
      val mk_cond_rule = R.FILTER_DISCH_ALL(not o curry (op aconv) WFR)
@@ -427,7 +420,7 @@
  * extraction commute for the non-nested case. For hol90 users, this 
  * function can be invoked without being in draft mode.
  * CURRENTLY UNUSED
-fun wfrec_eqns ss thy eqns =
+fun wfrec_eqns (ss, tflCongs) thy eqns =
  let val {functional,pats} = mk_functional thy eqns
      val given_pats = givens pats
      val {Bvar = f, Body} = S.dest_abs functional
@@ -448,7 +441,7 @@
      val extract = R.CONTEXT_REWRITE_RULE 
 	               (ss, f, R1, 
 		        R.ISPECL (map tych [f,R1]) Thms.CUT_LEMMA, 
-			context_congs)
+			tflCongs@context_congs)
  in {proto_def=proto_def, 
      WFR=WFR, 
      pats=pats,