author | wenzelm |
Wed, 22 Jan 2025 22:22:19 +0100 | |
changeset 81954 | 6f2bcdfa9a19 |
parent 78764 | a3dcae9a2ebe |
permissions | -rw-r--r-- |
44247 | 1 |
(* Title: Pure/Concurrent/par_exn.ML |
2 |
Author: Makarius |
|
3 |
||
4 |
Parallel exceptions as flattened results from acyclic graph of |
|
5 |
evaluations. Interrupt counts as neutral element. |
|
6 |
*) |
|
7 |
||
8 |
signature PAR_EXN = |
|
9 |
sig |
|
10 |
val make: exn list -> exn |
|
44271
89f40a5939b2
more precise treatment of exception nesting and serial numbers;
wenzelm
parents:
44270
diff
changeset
|
11 |
val dest: exn -> exn list option |
49061
7449b804073b
central management of forked goals wrt. transaction id;
wenzelm
parents:
47338
diff
changeset
|
12 |
val is_interrupted: 'a Exn.result list -> bool |
44247 | 13 |
val release_all: 'a Exn.result list -> 'a list |
14 |
val release_first: 'a Exn.result list -> 'a list |
|
15 |
end; |
|
16 |
||
47338 | 17 |
structure Par_Exn: PAR_EXN = |
44247 | 18 |
struct |
19 |
||
20 |
(* parallel exceptions *) |
|
21 |
||
44264 | 22 |
exception Par_Exn of exn list; |
78679 | 23 |
(*non-empty list with unique identified elements sorted by Exn_Properties.ord; |
78764
a3dcae9a2ebe
distinguish proper interrupts from Poly/ML RTS breakdown;
wenzelm
parents:
78681
diff
changeset
|
24 |
no occurrences of Par_Exn or Exn.is_interrupt_proper*) |
44247 | 25 |
|
44264 | 26 |
fun par_exns (Par_Exn exns) = exns |
78764
a3dcae9a2ebe
distinguish proper interrupts from Poly/ML RTS breakdown;
wenzelm
parents:
78681
diff
changeset
|
27 |
| par_exns exn = if Exn.is_interrupt_proper exn then [] else [Exn_Properties.identify [] exn]; |
44247 | 28 |
|
29 |
fun make exns = |
|
51428
12e46440e391
more robust Par_Exn.make, especially relevant for SML/NJ trying to use Par_Exn.release_all;
wenzelm
parents:
50911
diff
changeset
|
30 |
let |
12e46440e391
more robust Par_Exn.make, especially relevant for SML/NJ trying to use Par_Exn.release_all;
wenzelm
parents:
50911
diff
changeset
|
31 |
val exnss = map par_exns exns; |
78679 | 32 |
val exns' = Ord_List.unions Exn_Properties.ord exnss handle Option.Option => flat exnss; |
78681 | 33 |
in if null exns' then Isabelle_Thread.interrupt else Par_Exn exns' end; |
44247 | 34 |
|
44271
89f40a5939b2
more precise treatment of exception nesting and serial numbers;
wenzelm
parents:
44270
diff
changeset
|
35 |
fun dest (Par_Exn exns) = SOME exns |
78764
a3dcae9a2ebe
distinguish proper interrupts from Poly/ML RTS breakdown;
wenzelm
parents:
78681
diff
changeset
|
36 |
| dest exn = if Exn.is_interrupt_proper exn then SOME [] else NONE; |
44247 | 37 |
|
38 |
||
39 |
(* parallel results *) |
|
40 |
||
49061
7449b804073b
central management of forked goals wrt. transaction id;
wenzelm
parents:
47338
diff
changeset
|
41 |
fun is_interrupted results = |
78674 | 42 |
exists Exn.is_exn results andalso |
78764
a3dcae9a2ebe
distinguish proper interrupts from Poly/ML RTS breakdown;
wenzelm
parents:
78681
diff
changeset
|
43 |
Exn.is_interrupt_proper (make (map_filter Exn.get_exn results)); |
49061
7449b804073b
central management of forked goals wrt. transaction id;
wenzelm
parents:
47338
diff
changeset
|
44 |
|
44266
d9c7bf932eab
clarified Par_Exn.release_first: prefer plain exn, before falling back on full pack of parallel exceptions;
wenzelm
parents:
44264
diff
changeset
|
45 |
fun release_all results = |
78674 | 46 |
if forall Exn.is_res results |
44266
d9c7bf932eab
clarified Par_Exn.release_first: prefer plain exn, before falling back on full pack of parallel exceptions;
wenzelm
parents:
44264
diff
changeset
|
47 |
then map Exn.release results |
d9c7bf932eab
clarified Par_Exn.release_first: prefer plain exn, before falling back on full pack of parallel exceptions;
wenzelm
parents:
44264
diff
changeset
|
48 |
else raise make (map_filter Exn.get_exn results); |
44247 | 49 |
|
44266
d9c7bf932eab
clarified Par_Exn.release_first: prefer plain exn, before falling back on full pack of parallel exceptions;
wenzelm
parents:
44264
diff
changeset
|
50 |
fun plain_exn (Exn.Res _) = NONE |
d9c7bf932eab
clarified Par_Exn.release_first: prefer plain exn, before falling back on full pack of parallel exceptions;
wenzelm
parents:
44264
diff
changeset
|
51 |
| plain_exn (Exn.Exn (Par_Exn _)) = NONE |
78764
a3dcae9a2ebe
distinguish proper interrupts from Poly/ML RTS breakdown;
wenzelm
parents:
78681
diff
changeset
|
52 |
| plain_exn (Exn.Exn exn) = if Exn.is_interrupt_proper exn then NONE else SOME exn; |
44247 | 53 |
|
44248
6a3541412b23
clarified Par_Exn.release_first: traverse topmost list structure only, not arbitrary depths of nested Par_Exn;
wenzelm
parents:
44247
diff
changeset
|
54 |
fun release_first results = |
44266
d9c7bf932eab
clarified Par_Exn.release_first: prefer plain exn, before falling back on full pack of parallel exceptions;
wenzelm
parents:
44264
diff
changeset
|
55 |
(case get_first plain_exn results of |
d9c7bf932eab
clarified Par_Exn.release_first: prefer plain exn, before falling back on full pack of parallel exceptions;
wenzelm
parents:
44264
diff
changeset
|
56 |
NONE => release_all results |
62505 | 57 |
| SOME exn => Exn.reraise exn); |
44247 | 58 |
|
59 |
end; |
|
60 |