src/HOL/Tools/SMT/smt_builtin.ML
changeset 41072 9f9bc1bdacef
parent 41059 d2b1fc1b8e19
child 41073 07b454783ed8
--- a/src/HOL/Tools/SMT/smt_builtin.ML	Tue Dec 07 21:58:36 2010 +0100
+++ b/src/HOL/Tools/SMT/smt_builtin.ML	Wed Dec 08 08:33:02 2010 +0100
@@ -8,9 +8,10 @@
 sig
   (*built-in types*)
   val add_builtin_typ: SMT_Config.class ->
-    typ * (typ -> string option) * (typ -> int -> string option) -> theory ->
-    theory
-  val add_builtin_typ_ext: typ * (typ -> bool) -> theory -> theory
+    typ * (typ -> string option) * (typ -> int -> string option) ->
+    Context.generic -> Context.generic
+  val add_builtin_typ_ext: typ * (typ -> bool) -> Context.generic ->
+    Context.generic
   val builtin_typ: Proof.context -> typ -> string option
   val is_builtin_typ: Proof.context -> typ -> bool
   val is_builtin_typ_ext: Proof.context -> typ -> bool
@@ -23,11 +24,14 @@
   (*built-in functions*)
   type 'a bfun = Proof.context -> typ -> term list -> 'a
   val add_builtin_fun: SMT_Config.class ->
-    (string * typ) * (string * term list) option bfun -> theory -> theory
-  val add_builtin_fun': SMT_Config.class -> term * string -> theory -> theory
-  val add_builtin_fun_ext: (string * typ) * bool bfun -> theory -> theory
-  val add_builtin_fun_ext': string * typ -> theory -> theory
-  val add_builtin_fun_ext'': string -> theory -> theory
+    (string * typ) * (string * term list) option bfun -> Context.generic ->
+    Context.generic
+  val add_builtin_fun': SMT_Config.class -> term * string -> Context.generic ->
+    Context.generic
+  val add_builtin_fun_ext: (string * typ) * bool bfun -> Context.generic ->
+    Context.generic
+  val add_builtin_fun_ext': string * typ -> Context.generic -> Context.generic
+  val add_builtin_fun_ext'': string -> Context.generic -> Context.generic
   val builtin_fun: Proof.context -> string * typ -> term list ->
     (string * term list) option
   val is_builtin_fun: Proof.context -> string * typ -> term list -> bool
@@ -48,8 +52,6 @@
 
 type ('a, 'b) ttab = (C.class * (typ * ('a, 'b) kind) Ord_List.T) list 
 
-fun empty_ttab () = []
-
 fun typ_ord ((T, _), (U, _)) =
   let
     fun tord (TVar _, Type _) = GREATER
@@ -94,11 +96,11 @@
 
 (* built-in types *)
 
-structure Builtin_Types = Theory_Data
+structure Builtin_Types = Generic_Data
 (
   type T =
     (typ -> bool, (typ -> string option) * (typ -> int -> string option)) ttab
-  val empty = empty_ttab ()
+  val empty = []
   val extend = I
   val merge = merge_ttab
 )
@@ -110,7 +112,7 @@
   Builtin_Types.map (insert_ttab C.basicC T (Ext f))
 
 fun lookup_builtin_typ ctxt =
-  lookup_ttab ctxt (Builtin_Types.get (ProofContext.theory_of ctxt))
+  lookup_ttab ctxt (Builtin_Types.get (Context.Proof ctxt))
 
 fun builtin_typ ctxt T =
   (case lookup_builtin_typ ctxt T of
@@ -157,14 +159,16 @@
   @{const_name SMT.pat}, @{const_name SMT.nopat},
   @{const_name SMT.trigger}, @{const_name SMT.weight}]
 
-fun basic_builtin_funcs () =
+type builtin_funcs = (bool bfun, (string * term list) option bfun) btab
+
+fun basic_builtin_funcs () : builtin_funcs =
   empty_btab ()
   |> fold (raw_add_builtin_fun_ext @{theory} C.basicC) basic_builtin_fun_names
        (* FIXME: SMT_Normalize should check that they are properly used *)
 
-structure Builtin_Funcs = Theory_Data
+structure Builtin_Funcs = Generic_Data
 (
-  type T = (bool bfun, (string * term list) option bfun) btab
+  type T = builtin_funcs
   val empty = basic_builtin_funcs ()
   val extend = I
   val merge = merge_btab
@@ -181,11 +185,12 @@
 
 fun add_builtin_fun_ext' c = add_builtin_fun_ext (c, true3)
 
-fun add_builtin_fun_ext'' n thy =
-  add_builtin_fun_ext' (n, Sign.the_const_type thy n) thy
+fun add_builtin_fun_ext'' n context =
+  let val thy = Context.theory_of context
+  in add_builtin_fun_ext' (n, Sign.the_const_type thy n) context end
 
 fun lookup_builtin_fun ctxt =
-  lookup_btab ctxt (Builtin_Funcs.get (ProofContext.theory_of ctxt))
+  lookup_btab ctxt (Builtin_Funcs.get (Context.Proof ctxt))
 
 fun builtin_fun ctxt (c as (_, T)) ts =
   (case lookup_builtin_fun ctxt c of