more direct expression of syntactic function records
authorhaftmann
Sun, 15 Feb 2015 17:01:22 +0100
changeset 59549 6e685f9c9aa5
parent 59548 d9304532c7ab
child 59550 ded0ff754037
more direct expression of syntactic function records
src/HOL/Tools/semiring_normalizer.ML
--- a/src/HOL/Tools/semiring_normalizer.ML	Sun Feb 15 17:01:22 2015 +0100
+++ b/src/HOL/Tools/semiring_normalizer.ML	Sun Feb 15 17:01:22 2015 +0100
@@ -7,7 +7,6 @@
 signature SEMIRING_NORMALIZER = 
 sig
   type entry
-  val get: Proof.context -> (thm * entry) list
   val match: Proof.context -> cterm -> entry option
   val del: attribute
   val add: {semiring: cterm list * thm list, ring: cterm list * thm list,
@@ -62,8 +61,6 @@
   fun merge data = AList.merge Thm.eq_thm (K true) data;
 );
 
-val get = Data.get o Context.Proof;
-
 fun match ctxt tm =
   let
     fun match_inst
@@ -94,24 +91,15 @@
     fun match_struct (_,
         entry as ({semiring = (sr_ops, _), ring = (r_ops, _), field = (f_ops, _), ...}, _): entry) =
       get_first (match_inst entry) (sr_ops @ r_ops @ f_ops);
-  in get_first match_struct (get ctxt) end;
+  in get_first match_struct (Data.get (Context.Proof ctxt)) end;
 
   
   (* extra-logical functions *)
 
-fun funs key {is_const, dest_const, mk_const, conv} = 
- Data.map (fn data =>
-  let
-    val _ = AList.defined Thm.eq_thm data key orelse
-      raise THM ("No data entry for structure key", 0, [key]);
-    val fns = {is_const = is_const, dest_const = dest_const,
-      mk_const = mk_const, conv = conv};
-  in AList.map_entry Thm.eq_thm key (apsnd (K fns)) data end);
-
 val semiring_norm_ss =
   simpset_of (put_simpset HOL_basic_ss @{context} addsimps @{thms semiring_norm});
 
-fun semiring_funs key = funs key
+val semiring_funs =
    {is_const = can HOLogic.dest_number o Thm.term_of,
     dest_const = (fn ct =>
       Rat.rat_of_int (snd
@@ -123,7 +111,7 @@
       Simplifier.rewrite (put_simpset semiring_norm_ss ctxt)
       then_conv Simplifier.rewrite (put_simpset HOL_basic_ss ctxt addsimps @{thms numeral_1_eq_1}))};
 
-fun field_funs key =
+val field_funs =
   let
     fun numeral_is_const ct =
       case term_of ct of
@@ -146,7 +134,7 @@
                          (Numeral.mk_cnumber cT a))
              (Numeral.mk_cnumber cT b)
       end
-  in funs key
+  in
      {is_const = numeral_is_const,
       dest_const = dest_const,
       mk_const = mk_const,
@@ -207,13 +195,12 @@
       val ring = (r_ops, r_rules');
       val field = (f_ops, f_rules');
       val ideal' = map (Thm.symmetric o mk_meta) ideal
+      
     in
       AList.update Thm.eq_thm (key,
         ({vars = vars, semiring = semiring, ring = ring, field = field, idom = idom, ideal = ideal'},
-          {is_const = undefined, dest_const = undefined, mk_const = undefined,
-          conv = undefined}))
-    end
-    |> (if null f_ops then semiring_funs else field_funs) key)
+          (if null f_ops then semiring_funs else field_funs)))
+    end)
 
 
 (** auxiliary **)