| author | Fabian Huch <huch@in.tum.de> | 
| Thu, 16 Jan 2025 19:00:29 +0100 | |
| changeset 81880 | b1f6e80cfff9 | 
| 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: 
44270diff
changeset | 11 | val dest: exn -> exn list option | 
| 49061 
7449b804073b
central management of forked goals wrt. transaction id;
 wenzelm parents: 
47338diff
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: 
78681diff
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: 
78681diff
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: 
50911diff
changeset | 30 | let | 
| 
12e46440e391
more robust Par_Exn.make, especially relevant for SML/NJ trying to use Par_Exn.release_all;
 wenzelm parents: 
50911diff
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: 
44270diff
changeset | 35 | fun dest (Par_Exn exns) = SOME exns | 
| 78764 
a3dcae9a2ebe
distinguish proper interrupts from Poly/ML RTS breakdown;
 wenzelm parents: 
78681diff
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: 
47338diff
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: 
78681diff
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: 
47338diff
changeset | 44 | |
| 44266 
d9c7bf932eab
clarified Par_Exn.release_first: prefer plain exn, before falling back on full pack of parallel exceptions;
 wenzelm parents: 
44264diff
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: 
44264diff
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: 
44264diff
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: 
44264diff
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: 
44264diff
changeset | 51 | | plain_exn (Exn.Exn (Par_Exn _)) = NONE | 
| 78764 
a3dcae9a2ebe
distinguish proper interrupts from Poly/ML RTS breakdown;
 wenzelm parents: 
78681diff
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: 
44247diff
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: 
44264diff
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: 
44264diff
changeset | 56 | NONE => release_all results | 
| 62505 | 57 | | SOME exn => Exn.reraise exn); | 
| 44247 | 58 | |
| 59 | end; | |
| 60 |