src/Pure/config.ML

--- a/src/Pure/config.ML	Fri Jul 27 16:04:26 2007 +0200
+++ b/src/Pure/config.ML	Fri Jul 27 16:31:14 2007 +0200
@@ -8,6 +8,7 @@
 
 signature CONFIG =
 sig
+  datatype value = Bool of bool | Int of int | String of string
   type 'a T
   val get: Proof.context -> 'a T -> 'a
   val get_thy: theory -> 'a T -> 'a
@@ -18,8 +19,8 @@
   val put: 'a T -> 'a -> Proof.context -> Proof.context
   val put_thy: 'a T -> 'a -> theory -> theory
   val put_generic: 'a T -> 'a -> Context.generic -> Context.generic
-  val put_generic_src: string -> string -> Context.generic -> Context.generic
   val print_configs: Proof.context -> unit
+  val the_config: string -> value T * value
   val bool: string -> bool -> bool T
   val int: string -> int -> int T
   val string: string -> string -> string T
@@ -28,6 +29,31 @@
 structure Config: CONFIG =
 struct
 
+(* mixed values *)
+
+datatype value =
+  Bool of bool |
+  Int of int |
+  String of string;
+
+fun print_value (Bool true) = "true"
+  | print_value (Bool false) = "false"
+  | print_value (Int i) = signed_string_of_int i
+  | print_value (String s) = quote s;
+
+fun print_type (Bool _) = "boolean"
+  | print_type (Int _) = "integer"
+  | print_type (String _) = "string";
+
+structure ConfigData = GenericDataFun
+(
+  type T = value Inttab.table;
+  val empty = Inttab.empty;
+  val extend = I;
+  fun merge _ = Inttab.merge (K true);
+);
+
+
 (* abstract configuration options *)
 
 datatype 'a T = Config of
@@ -47,48 +73,21 @@
 fun put_thy config value = map_thy config (K value);
 
 
-(* mixed values *)
-
-datatype value =
-  Bool of bool |
-  Int of int |
-  String of string;
-
-fun read_value (Bool _) "true" = SOME (Bool true)
-  | read_value (Bool _) "false" = SOME (Bool false)
-  | read_value (Int _) s = Option.map Int (Syntax.read_int s)
-  | read_value (String _) s = SOME (String s);
-
-fun print_value (Bool true) = "true"
-  | print_value (Bool false) = "false"
-  | print_value (Int i) = signed_string_of_int i
-  | print_value (String s) = quote s;
-
-fun print_type (Bool _) = "boolean"
-  | print_type (Int _) = "integer"
-  | print_type (String _) = "string";
-
-structure ConfigData = GenericDataFun
-(
-  type T = value Inttab.table;
-  val empty = Inttab.empty;
-  val extend = I;
-  fun merge _ = Inttab.merge (K true);
-);
-
-
 (* global declarations *)
 
 local val global_configs = ref (Symtab.empty: (value T * value) Symtab.table) in
 
-fun put_generic_src name src_value context =
-  (case Symtab.lookup (! global_configs) name of
-    NONE => error ("Unknown configuration option " ^ quote name)
-  | SOME (config, default) =>
-      (case read_value default src_value of
-        SOME value => put_generic config value context
-      | NONE => error ("Malformed " ^ print_type default ^
-          " value for configuration option " ^ quote name)));
+fun print_configs ctxt =
+  let
+    fun prt (name, (config, default)) =
+      Pretty.block [Pretty.str (name ^ ": " ^ print_type default ^ " ="), Pretty.brk 1,
+        Pretty.str (print_value (get_ctxt ctxt config))];
+    val configs = sort_wrt #1 (Symtab.dest (! global_configs));
+  in Pretty.writeln (Pretty.big_list "configuration options" (map prt configs)) end;
+
+fun the_config name =
+  (case Symtab.lookup (! global_configs) name of SOME cfg => cfg
+  | NONE => error ("Unknown configuration option " ^ quote name));
 
 fun declare make dest name default =
   let
@@ -107,14 +106,6 @@
 
   in Config {get_value = dest o get_value, map_value = fn f => map_value (make o f o dest)} end;
 
-fun print_configs ctxt =
-  let
-    fun prt (name, (config, default)) =
-      Pretty.block [Pretty.str (name ^ ": " ^ print_type default ^ " ="), Pretty.brk 1,
-        Pretty.str (print_value (get_ctxt ctxt config))];
-    val configs = sort_wrt #1 (Symtab.dest (! global_configs));
-  in Pretty.writeln (Pretty.big_list "configuration options" (map prt configs)) end;
-
 end;
 
 val bool = declare Bool (fn Bool b => b);