prefer Synchronized.var;
authorwenzelm
Wed Jul 06 20:46:06 2011 +0200 (2011-07-06 ago)
changeset 4368485388f5570c4
parent 43683 b5d1873449fb
child 43685 5c9160f420d5
prefer Synchronized.var;
src/Pure/General/markup.ML
src/Pure/General/output.ML
src/Pure/General/pretty.ML
src/Pure/Isar/code.ML
src/Pure/ROOT.ML
src/Pure/System/isabelle_process.ML
src/Pure/System/isar.ML
src/Pure/context.ML
     1.1 --- a/src/Pure/General/markup.ML	Wed Jul 06 20:14:13 2011 +0200
     1.2 +++ b/src/Pure/General/markup.ML	Wed Jul 06 20:46:06 2011 +0200
     1.3 @@ -378,12 +378,13 @@
     1.4  
     1.5  local
     1.6    val default = {output = default_output};
     1.7 -  val modes = Unsynchronized.ref (Symtab.make [("", default)]);
     1.8 +  val modes = Synchronized.var "Markup.modes" (Symtab.make [("", default)]);
     1.9  in
    1.10 -  fun add_mode name output = CRITICAL (fn () =>
    1.11 -    Unsynchronized.change modes (Symtab.update_new (name, {output = output})));
    1.12 +  fun add_mode name output =
    1.13 +    Synchronized.change modes (Symtab.update_new (name, {output = output}));
    1.14    fun get_mode () =
    1.15 -    the_default default (Library.get_first (Symtab.lookup (! modes)) (print_mode_value ()));
    1.16 +    the_default default
    1.17 +      (Library.get_first (Symtab.lookup (Synchronized.value modes)) (print_mode_value ()));
    1.18  end;
    1.19  
    1.20  fun output m = if is_empty m then no_output else #output (get_mode ()) m;
     2.1 --- a/src/Pure/General/output.ML	Wed Jul 06 20:14:13 2011 +0200
     2.2 +++ b/src/Pure/General/output.ML	Wed Jul 06 20:46:06 2011 +0200
     2.3 @@ -55,12 +55,13 @@
     2.4  
     2.5  local
     2.6    val default = {output = default_output, escape = default_escape};
     2.7 -  val modes = Unsynchronized.ref (Symtab.make [("", default)]);
     2.8 +  val modes = Synchronized.var "Output.modes" (Symtab.make [("", default)]);
     2.9  in
    2.10 -  fun add_mode name output escape = CRITICAL (fn () =>
    2.11 -    Unsynchronized.change modes (Symtab.update_new (name, {output = output, escape = escape})));
    2.12 +  fun add_mode name output escape =
    2.13 +    Synchronized.change modes (Symtab.update_new (name, {output = output, escape = escape}));
    2.14    fun get_mode () =
    2.15 -    the_default default (Library.get_first (Symtab.lookup (! modes)) (print_mode_value ()));
    2.16 +    the_default default
    2.17 +      (Library.get_first (Symtab.lookup (Synchronized.value modes)) (print_mode_value ()));
    2.18  end;
    2.19  
    2.20  fun output_width x = #output (get_mode ()) x;
     3.1 --- a/src/Pure/General/pretty.ML	Wed Jul 06 20:14:13 2011 +0200
     3.2 +++ b/src/Pure/General/pretty.ML	Wed Jul 06 20:46:06 2011 +0200
     3.3 @@ -75,12 +75,13 @@
     3.4  
     3.5  local
     3.6    val default = {indent = default_indent};
     3.7 -  val modes = Unsynchronized.ref (Symtab.make [("", default)]);
     3.8 +  val modes = Synchronized.var "Pretty.modes" (Symtab.make [("", default)]);
     3.9  in
    3.10 -  fun add_mode name indent = CRITICAL (fn () =>
    3.11 -    Unsynchronized.change modes (Symtab.update_new (name, {indent = indent})));
    3.12 +  fun add_mode name indent =
    3.13 +    Synchronized.change modes (Symtab.update_new (name, {indent = indent}));
    3.14    fun get_mode () =
    3.15 -    the_default default (Library.get_first (Symtab.lookup (! modes)) (print_mode_value ()));
    3.16 +    the_default default
    3.17 +      (Library.get_first (Symtab.lookup (Synchronized.value modes)) (print_mode_value ()));
    3.18  end;
    3.19  
    3.20  fun mode_indent x y = #indent (get_mode ()) x y;
     4.1 --- a/src/Pure/Isar/code.ML	Wed Jul 06 20:14:13 2011 +0200
     4.2 +++ b/src/Pure/Isar/code.ML	Wed Jul 06 20:46:06 2011 +0200
     4.3 @@ -247,11 +247,12 @@
     4.4  
     4.5  type kind = { empty: Object.T };
     4.6  
     4.7 -val kinds = Unsynchronized.ref (Datatab.empty: kind Datatab.table);
     4.8 +val kinds = Synchronized.var "Code_Data" (Datatab.empty: kind Datatab.table);
     4.9  
    4.10 -fun invoke f k = case Datatab.lookup (! kinds) k
    4.11 - of SOME kind => f kind
    4.12 -  | NONE => raise Fail "Invalid code data identifier";
    4.13 +fun invoke f k =
    4.14 +  (case Datatab.lookup (Synchronized.value kinds) k of
    4.15 +    SOME kind => f kind
    4.16 +  | NONE => raise Fail "Invalid code data identifier");
    4.17  
    4.18  in
    4.19  
    4.20 @@ -259,7 +260,7 @@
    4.21    let
    4.22      val k = serial ();
    4.23      val kind = { empty = empty };
    4.24 -    val _ = CRITICAL (fn () => Unsynchronized.change kinds (Datatab.update (k, kind)));
    4.25 +    val _ = Synchronized.change kinds (Datatab.update (k, kind));
    4.26    in k end;
    4.27  
    4.28  fun invoke_init k = invoke (fn kind => #empty kind) k;
     5.1 --- a/src/Pure/ROOT.ML	Wed Jul 06 20:14:13 2011 +0200
     5.2 +++ b/src/Pure/ROOT.ML	Wed Jul 06 20:46:06 2011 +0200
     5.3 @@ -20,6 +20,13 @@
     5.4  use "General/print_mode.ML";
     5.5  use "General/alist.ML";
     5.6  use "General/table.ML";
     5.7 +
     5.8 +use "Concurrent/simple_thread.ML";
     5.9 +
    5.10 +use "Concurrent/synchronized.ML";
    5.11 +if Multithreading.available then ()
    5.12 +else use "Concurrent/synchronized_sequential.ML";
    5.13 +
    5.14  use "General/output.ML";
    5.15  use "General/timing.ML";
    5.16  use "General/properties.ML";
    5.17 @@ -63,16 +70,10 @@
    5.18  
    5.19  (* concurrency within the ML runtime *)
    5.20  
    5.21 -use "Concurrent/simple_thread.ML";
    5.22 -
    5.23  use "Concurrent/single_assignment.ML";
    5.24  if Multithreading.available then ()
    5.25  else use "Concurrent/single_assignment_sequential.ML";
    5.26  
    5.27 -use "Concurrent/synchronized.ML";
    5.28 -if Multithreading.available then ()
    5.29 -else use "Concurrent/synchronized_sequential.ML";
    5.30 -
    5.31  if String.isPrefix "smlnj" ml_system then ()
    5.32  else use "Concurrent/time_limit.ML";
    5.33  
     6.1 --- a/src/Pure/System/isabelle_process.ML	Wed Jul 06 20:14:13 2011 +0200
     6.2 +++ b/src/Pure/System/isabelle_process.ML	Wed Jul 06 20:46:06 2011 +0200
     6.3 @@ -20,7 +20,7 @@
     6.4    val is_active: unit -> bool
     6.5    val add_command: string -> (string list -> unit) -> unit
     6.6    val command: string -> string list -> unit
     6.7 -  val crashes: exn list Unsynchronized.ref
     6.8 +  val crashes: exn list Synchronized.var
     6.9    val init: string -> string -> unit
    6.10  end;
    6.11  
    6.12 @@ -41,18 +41,19 @@
    6.13  
    6.14  local
    6.15  
    6.16 -val global_commands = Unsynchronized.ref (Symtab.empty: (string list -> unit) Symtab.table);
    6.17 +val commands =
    6.18 +  Synchronized.var "Isabelle_Process.commands" (Symtab.empty: (string list -> unit) Symtab.table);
    6.19  
    6.20  in
    6.21  
    6.22 -fun add_command name cmd = CRITICAL (fn () =>
    6.23 -  Unsynchronized.change global_commands (fn cmds =>
    6.24 +fun add_command name cmd =
    6.25 +  Synchronized.change commands (fn cmds =>
    6.26     (if not (Symtab.defined cmds name) then ()
    6.27      else warning ("Redefining Isabelle process command " ^ quote name);
    6.28 -    Symtab.update (name, cmd) cmds)));
    6.29 +    Symtab.update (name, cmd) cmds));
    6.30  
    6.31  fun command name args =
    6.32 -  (case Symtab.lookup (! global_commands) name of
    6.33 +  (case Symtab.lookup (Synchronized.value commands) name of
    6.34      NONE => error ("Undefined Isabelle process command " ^ quote name)
    6.35    | SOME cmd => cmd args);
    6.36  
    6.37 @@ -118,12 +119,12 @@
    6.38  
    6.39  (* protocol loop -- uninterruptible *)
    6.40  
    6.41 -val crashes = Unsynchronized.ref ([]: exn list);
    6.42 +val crashes = Synchronized.var "Isabelle_Process.crashes" ([]: exn list);
    6.43  
    6.44  local
    6.45  
    6.46  fun recover crash =
    6.47 -  (CRITICAL (fn () => Unsynchronized.change crashes (cons crash));
    6.48 +  (Synchronized.change crashes (cons crash);
    6.49      warning "Recovering from Isabelle process crash -- see also Isabelle_Process.crashes");
    6.50  
    6.51  fun read_chunk stream len =
     7.1 --- a/src/Pure/System/isar.ML	Wed Jul 06 20:14:13 2011 +0200
     7.2 +++ b/src/Pure/System/isar.ML	Wed Jul 06 20:46:06 2011 +0200
     7.3 @@ -17,7 +17,7 @@
     7.4    val undo: int -> unit
     7.5    val kill: unit -> unit
     7.6    val kill_proof: unit -> unit
     7.7 -  val crashes: exn list Unsynchronized.ref
     7.8 +  val crashes: exn list Synchronized.var
     7.9    val toplevel_loop: TextIO.instream ->
    7.10      {init: bool, welcome: bool, sync: bool, secure: bool} -> unit
    7.11    val loop: unit -> unit
    7.12 @@ -113,7 +113,7 @@
    7.13  
    7.14  (* toplevel loop -- uninterruptible *)
    7.15  
    7.16 -val crashes = Unsynchronized.ref ([]: exn list);
    7.17 +val crashes = Synchronized.var "Isar.crashes" ([]: exn list);
    7.18  
    7.19  local
    7.20  
    7.21 @@ -128,7 +128,7 @@
    7.22      handle exn =>
    7.23        (Output.error_msg (ML_Compiler.exn_message exn)
    7.24          handle crash =>
    7.25 -          (CRITICAL (fn () => Unsynchronized.change crashes (cons crash));
    7.26 +          (Synchronized.change crashes (cons crash);
    7.27              warning "Recovering from Isar toplevel crash -- see also Isar.crashes");
    7.28          raw_loop secure src)
    7.29    end;
     8.1 --- a/src/Pure/context.ML	Wed Jul 06 20:14:13 2011 +0200
     8.2 +++ b/src/Pure/context.ML	Wed Jul 06 20:46:06 2011 +0200
     8.3 @@ -128,10 +128,10 @@
     8.4    extend: Object.T -> Object.T,
     8.5    merge: pretty -> Object.T * Object.T -> Object.T};
     8.6  
     8.7 -val kinds = Unsynchronized.ref (Datatab.empty: kind Datatab.table);
     8.8 +val kinds = Synchronized.var "Theory_Data" (Datatab.empty: kind Datatab.table);
     8.9  
    8.10  fun invoke name f k x =
    8.11 -  (case Datatab.lookup (! kinds) k of
    8.12 +  (case Datatab.lookup (Synchronized.value kinds) k of
    8.13      SOME kind =>
    8.14        if ! timing andalso name <> "" then
    8.15          Timing.cond_timeit true ("Theory_Data." ^ name ^ Position.str_of (#pos kind))
    8.16 @@ -149,7 +149,7 @@
    8.17    let
    8.18      val k = serial ();
    8.19      val kind = {pos = pos, empty = empty, extend = extend, merge = merge};
    8.20 -    val _ = CRITICAL (fn () => Unsynchronized.change kinds (Datatab.update (k, kind)));
    8.21 +    val _ = Synchronized.change kinds (Datatab.update (k, kind));
    8.22    in k end;
    8.23  
    8.24  val extend_data = Datatab.map invoke_extend;
    8.25 @@ -475,15 +475,15 @@
    8.26  
    8.27  local
    8.28  
    8.29 -val kinds = Unsynchronized.ref (Datatab.empty: (theory -> Object.T) Datatab.table);
    8.30 +val kinds = Synchronized.var "Proof_Data" (Datatab.empty: (theory -> Object.T) Datatab.table);
    8.31  
    8.32  fun invoke_init k =
    8.33 -  (case Datatab.lookup (! kinds) k of
    8.34 +  (case Datatab.lookup (Synchronized.value kinds) k of
    8.35      SOME init => init
    8.36    | NONE => raise Fail "Invalid proof data identifier");
    8.37  
    8.38  fun init_data thy =
    8.39 -  Datatab.map (fn k => fn _ => invoke_init k thy) (! kinds);
    8.40 +  Datatab.map (fn k => fn _ => invoke_init k thy) (Synchronized.value kinds);
    8.41  
    8.42  fun init_new_data data thy =
    8.43    Datatab.merge (K true) (data, init_data thy);
    8.44 @@ -511,7 +511,7 @@
    8.45  fun declare init =
    8.46    let
    8.47      val k = serial ();
    8.48 -    val _ = CRITICAL (fn () => Unsynchronized.change kinds (Datatab.update (k, init)));
    8.49 +    val _ = Synchronized.change kinds (Datatab.update (k, init));
    8.50    in k end;
    8.51  
    8.52  fun get k dest prf =