src/Pure/config.ML
changeset 36000 5560b2437789
parent 33519 e31a85f92ce9
child 36002 f4f343500249
equal deleted inserted replaced
35999:e031755609cf 36000:5560b2437789
    20   val map_thy: 'a T -> ('a -> 'a) -> theory -> theory
    20   val map_thy: 'a T -> ('a -> 'a) -> theory -> theory
    21   val put_thy: 'a T -> 'a -> theory -> theory
    21   val put_thy: 'a T -> 'a -> theory -> theory
    22   val get_generic: Context.generic -> 'a T -> 'a
    22   val get_generic: Context.generic -> 'a T -> 'a
    23   val map_generic: 'a T -> ('a -> 'a) -> Context.generic -> Context.generic
    23   val map_generic: 'a T -> ('a -> 'a) -> Context.generic -> Context.generic
    24   val put_generic: 'a T -> 'a -> Context.generic -> Context.generic
    24   val put_generic: 'a T -> 'a -> Context.generic -> Context.generic
    25   val declare: bool -> string -> value -> value T
    25   val declare: bool -> string -> (Proof.context -> value) -> value T
    26   val name_of: 'a T -> string
    26   val name_of: 'a T -> string
    27 end;
    27 end;
    28 
    28 
    29 structure Config: CONFIG =
    29 structure Config: CONFIG =
    30 struct
    30 struct
   100 
   100 
   101 fun declare global name default =
   101 fun declare global name default =
   102   let
   102   let
   103     val id = serial ();
   103     val id = serial ();
   104 
   104 
   105     fun get_value context = the_default default (Inttab.lookup (Value.get context) id);
   105     fun get_value context =
   106     fun modify_value f = Value.map (Inttab.map_default (id, default) (type_check name f));
   106       (case Inttab.lookup (Value.get context) id of
       
   107         SOME value => value
       
   108       | NONE => default (Context.proof_of context));
       
   109 
       
   110     fun update_value f context =
       
   111       Value.map (Inttab.update (id, type_check name f (get_value context))) context;
   107 
   112 
   108     fun map_value f (context as Context.Proof _) =
   113     fun map_value f (context as Context.Proof _) =
   109           let val context' = modify_value f context in
   114           let val context' = update_value f context in
   110             if global andalso
   115             if global andalso
   111               get_value (Context.Theory (Context.theory_of context')) <> get_value context'
   116               get_value (Context.Theory (Context.theory_of context')) <> get_value context'
   112             then (warning ("Ignoring local change of global option " ^ quote name); context)
   117             then (warning ("Ignoring local change of global option " ^ quote name); context)
   113             else context'
   118             else context'
   114           end
   119           end
   115       | map_value f context = modify_value f context;
   120       | map_value f context = update_value f context;
   116   in Config {name = name, get_value = get_value, map_value = map_value} end;
   121   in Config {name = name, get_value = get_value, map_value = map_value} end;
   117 
   122 
   118 fun name_of (Config {name, ...}) = name;
   123 fun name_of (Config {name, ...}) = name;
   119 
   124 
   120 
   125