package eio
Effect-based direct-style IO API for OCaml
Install
Dune Dependency
Authors
Maintainers
Sources
eio-0.10.tbz
sha256=390f7814507b8133d6c25e3a67a742d731c7ca66252b287b1fb0e3ad4d10eecc
sha512=9c0c9088b178df9799aaae9deb803a802228f1329cbe452479c90e80a13985d9c364ea86ee14e4e759133940f9f6065c7e8ece509d176fb1e347c5320f00a494
doc/src/eio.core/exn.ml.html
Source file exn.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133
let show_backend_exceptions = ref true type with_bt = exn * Printexc.raw_backtrace type err = .. type context = { steps : string list; } exception Io of err * context exception Multiple of (exn * Printexc.raw_backtrace) list (* Note: the last exception in list is the first one reported *) type err += Multiple_io of (err * context * Printexc.raw_backtrace) list exception Cancelled of exn exception Cancel_hook_failed of exn list let create err = Io (err, { steps = [] }) let add_context ex fmt = fmt |> Fmt.kstr @@ fun msg -> match ex with | Io (code, t) -> Io (code, {steps = msg :: t.steps}) | ex -> ex let reraise_with_context ex bt fmt = fmt |> Fmt.kstr @@ fun msg -> match ex with | Io (code, t) -> let context = { steps = msg :: t.steps } in Printexc.raise_with_backtrace (Io (code, context)) bt | _ -> Printexc.raise_with_backtrace ex bt let err_printers : (Format.formatter -> err -> bool) list ref = ref [] let register_pp fn = err_printers := fn :: !err_printers let break f _ = Format.pp_print_custom_break f ~fits:(",", 1, "") ~breaks:(",", 2, "") let pp_err f x = let rec aux = function | [] -> Fmt.string f "?" | pp :: pps -> if not (pp f x) then aux pps in aux !err_printers let pp_with_context f (code, context) = Fmt.pf f "%a%a" pp_err code Fmt.(list ~sep:nop (break ++ string)) (List.rev context.steps) let pp_with_bt f (code, context, bt) = match String.trim (Printexc.raw_backtrace_to_string bt) with | "" -> Fmt.pf f "- @[<hov>%a@]" pp_with_context (code, context) | bt -> Fmt.pf f "- @[<v>%a@,%a@]" pp_with_context (code, context) Fmt.lines bt let pp f = function | Io (code, t) -> Fmt.pf f "Eio.Io %a%a" pp_err code Fmt.(list ~sep:nop (break ++ string)) (List.rev t.steps) | ex -> Fmt.string f (Printexc.to_string ex) let pp_multiple f exns = let pp_with_bt f (ex, bt) = match String.trim (Printexc.raw_backtrace_to_string bt) with | "" -> Fmt.pf f "- @[<v>%a@]" pp ex | bt -> Fmt.pf f "- @[<v>%a@,%a@]" pp ex Fmt.lines bt in Fmt.pf f "@[<v>Multiple exceptions:@,%a@]" (Fmt.(list ~sep:cut) pp_with_bt) (List.rev exns) let () = Printexc.register_printer @@ function | Io _ as ex -> Some (Fmt.str "@[<v>%a@]" pp ex) | Multiple exns -> Some (Fmt.str "%a" pp_multiple exns) | Cancel_hook_failed exns -> Some ("During cancellation:\n" ^ String.concat "\nand\n" (List.map Printexc.to_string exns)) | Cancelled ex -> Some ("Cancelled: " ^ Printexc.to_string ex) | _ -> None let combine e1 e2 = if fst e1 == fst e2 then e1 else match e1, e2 with | (Cancelled _, _), e | e, (Cancelled _, _) -> e (* Don't need to report a cancelled exception if we have something better *) | (Io (c1, t1), bt1), (Io (c2, t2), bt2) -> create (Multiple_io [(c1, t1, bt1); (c2, t2, bt2)]), Printexc.get_callstack 0 | (Multiple exs, bt1), e2 -> Multiple (e2 :: exs), bt1 | e1, e2 -> Multiple [e2; e1], Printexc.get_callstack 0 module Backend = struct type t = .. let show = ref true let printers : (Format.formatter -> t -> bool) list ref = ref [] let register_pp fn = printers := fn :: !printers let pp f x = if !show then ( let rec aux = function | [] -> Fmt.string f "?" | pp :: pps -> if not (pp f x) then aux pps in aux !printers ) else Fmt.string f "_" end type err += X of Backend.t let () = register_pp (fun f -> function | Multiple_io errs -> Fmt.pf f "Multiple_io@\n%a" (Fmt.(list ~sep:cut) pp_with_bt) errs; true | X ex -> Backend.pp f ex; true | _ -> false )
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>