# HG changeset patch # User haftmann # Date 1424016082 -3600 # Node ID 6e685f9c9aa5dc9c95016c5035d5411ccced2f55 # Parent d9304532c7ab25e84ab592db57087725310a2cdb more direct expression of syntactic function records diff -r d9304532c7ab -r 6e685f9c9aa5 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 **)