src/Pure/PIDE/command.ML
changeset 52775 e0169f13bd37
parent 52774 627fb639a2d9
child 52784 4ba2e8b9972f
     1.1 --- a/src/Pure/PIDE/command.ML	Mon Jul 29 16:52:04 2013 +0200
     1.2 +++ b/src/Pure/PIDE/command.ML	Mon Jul 29 18:59:58 2013 +0200
     1.3 @@ -28,7 +28,7 @@
     1.4  structure Command: COMMAND =
     1.5  struct
     1.6  
     1.7 -(** memo results -- including physical interrupts **)
     1.8 +(** memo results **)
     1.9  
    1.10  datatype 'a expr =
    1.11    Expr of Document_ID.exec * (unit -> 'a) |
    1.12 @@ -48,24 +48,25 @@
    1.13  fun memo_finished (Memo v) =
    1.14    (case Synchronized.value v of
    1.15     Expr _ => false
    1.16 - | Result res => not (Exn.is_interrupt_exn res));
    1.17 + | Result _ => true);
    1.18  
    1.19  fun memo_exec execution_id (Memo v) =
    1.20    Synchronized.timed_access v (K (SOME Time.zeroTime))
    1.21      (fn expr =>
    1.22        (case expr of
    1.23 -        Expr (exec_id, e) =>
    1.24 +        Expr (exec_id, body) =>
    1.25            uninterruptible (fn restore_attributes => fn () =>
    1.26              if Execution.running execution_id exec_id then
    1.27                let
    1.28 -                val res = Exn.capture (restore_attributes e) ();
    1.29 -                val _ = Execution.finished exec_id;
    1.30 -              in SOME (Exn.is_interrupt_exn res, Result res) end
    1.31 -            else SOME (true, expr)) ()
    1.32 -      | Result _ => SOME (false, expr)))
    1.33 -  |> (fn SOME false => ()
    1.34 -       | SOME true => Exn.interrupt ()
    1.35 -       | NONE => error "Conflicting command execution");
    1.36 +                val res =
    1.37 +                  (body
    1.38 +                    |> restore_attributes
    1.39 +                    |> Future.worker_nest "Command.memo_exec"
    1.40 +                    |> Exn.interruptible_capture) ();
    1.41 +              in SOME ((), Result res) end
    1.42 +            else SOME ((), expr)) ()
    1.43 +      | Result _ => SOME ((), expr)))
    1.44 +  |> (fn NONE => error "Conflicting command execution" | _ => ());
    1.45  
    1.46  fun memo_fork params execution_id (Memo v) =
    1.47    (case Synchronized.value v of
    1.48 @@ -216,7 +217,7 @@
    1.49  
    1.50  fun print_eq (Print {exec_id, ...}, Print {exec_id = exec_id', ...}) = exec_id = exec_id';
    1.51  
    1.52 -fun print_finished (Print {exec_id, print_process, ...}) = memo_finished print_process;
    1.53 +fun print_finished (Print {print_process, ...}) = memo_finished print_process;
    1.54  
    1.55  fun print_persistent (Print {persistent, ...}) = persistent;
    1.56