+34
-54
lines changedFilter options
+34
-54
lines changed Original file line number Diff line number Diff line change
@@ -107,11 +107,6 @@ stdlib__Callback.cmx : callback.ml \
107 107
stdlib__Obj.cmx \
108 108
stdlib__Callback.cmi
109 109
stdlib__Callback.cmi : callback.mli
110 -
camlinternalEffect.cmo : \
111 -
camlinternalEffect.cmi
112 -
camlinternalEffect.cmx : \
113 -
camlinternalEffect.cmi
114 -
camlinternalEffect.cmi :
115 110
camlinternalFormat.cmo : \
116 111
stdlib__Sys.cmi \
117 112
stdlib__String.cmi \
@@ -234,13 +229,15 @@ stdlib__Domain.cmx : domain.ml \
234 229
stdlib__Domain.cmi
235 230
stdlib__Domain.cmi : domain.mli
236 231
stdlib__Effect.cmo : effect.ml \
232 +
stdlib__Printf.cmi \
237 233
stdlib__Printexc.cmi \
238 -
camlinternalEffect.cmi \
234 +
stdlib__Obj.cmi \
239 235
stdlib__Callback.cmi \
240 236
stdlib__Effect.cmi
241 237
stdlib__Effect.cmx : effect.ml \
238 +
stdlib__Printf.cmx \
242 239
stdlib__Printexc.cmx \
243 -
camlinternalEffect.cmx \
240 +
stdlib__Obj.cmx \
244 241
stdlib__Callback.cmx \
245 242
stdlib__Effect.cmi
246 243
stdlib__Effect.cmi : effect.mli \
@@ -579,7 +576,6 @@ stdlib__Printexc.cmo : printexc.ml \
579 576
stdlib.cmi \
580 577
stdlib__Printf.cmi \
581 578
stdlib__Obj.cmi \
582 -
camlinternalEffect.cmi \
583 579
stdlib__Buffer.cmi \
584 580
stdlib__Atomic.cmi \
585 581
stdlib__Array.cmi \
@@ -588,12 +584,12 @@ stdlib__Printexc.cmx : printexc.ml \
588 584
stdlib.cmx \
589 585
stdlib__Printf.cmx \
590 586
stdlib__Obj.cmx \
591 -
camlinternalEffect.cmx \
592 587
stdlib__Buffer.cmx \
593 588
stdlib__Atomic.cmx \
594 589
stdlib__Array.cmx \
595 590
stdlib__Printexc.cmi
596 -
stdlib__Printexc.cmi : printexc.mli
591 +
stdlib__Printexc.cmi : printexc.mli \
592 +
stdlib__Obj.cmi
597 593
stdlib__Printf.cmo : printf.ml \
598 594
camlinternalFormatBasics.cmi \
599 595
camlinternalFormat.cmi \
@@ -40,7 +40,7 @@ STDLIB_MODULE_BASENAMES = \
40 40
list int bytes string unit marshal array float int32 int64 nativeint \
41 41
lexing parsing set map stack queue buffer \
42 42
mutex condition semaphore domain \
43 -
camlinternalFormat printf arg camlinternalEffect printexc \
43 +
camlinternalFormat printf arg printexc \
44 44
fun gc digest bigarray random hashtbl weak \
45 45
format scanf callback camlinternalOO oo camlinternalMod ephemeron \
46 46
filename complex arrayLabels listLabels bytesLabels stringLabels moreLabels \
@@ -12,12 +12,23 @@
12 12
(* *)
13 13
(**************************************************************************)
14 14 15 -
type 'a t = 'a CamlinternalEffect.t = ..
15 +
type 'a t = ..
16 16
external perform : 'a t -> 'a = "%perform"
17 17 18 -
exception Unhandled = CamlinternalEffect.Unhandled
18 +
type exn += Unhandled: 'a t -> exn
19 19
exception Continuation_already_taken
20 20 21 +
let () =
22 +
let printer = function
23 +
| Unhandled x ->
24 +
let msg = Printf.sprintf "Stdlib.Effect.Unhandled(%s)"
25 +
(Printexc.string_of_extension_constructor @@ Obj.repr x)
26 +
in
27 +
Some msg
28 +
| _ -> None
29 +
in
30 +
Printexc.register_printer printer
31 + 21 32
(* Register the exceptions so that the runtime can access it *)
22 33
type _ t += Should_not_see_this__ : unit t
23 34
let _ = Callback.register_exception "Effect.Unhandled"
@@ -52,15 +52,16 @@ let use_printers x =
52 52
| [] -> None in
53 53
conv (Atomic.get printers)
54 54 55 -
let walk_sum_type x =
55 +
let destruct_ext_constructor x =
56 56
if Obj.tag x <> 0 then
57 57
((Obj.magic (Obj.field x 0) : string), None)
58 58
else
59 59
let constructor =
60 60
(Obj.magic (Obj.field (Obj.field x 0) 0) : string) in
61 61
(constructor, Some (fields x))
62 62 63 -
let string_of_sum_type (constructor, fields_opt) =
63 +
let string_of_extension_constructor t =
64 +
let constructor, fields_opt = destruct_ext_constructor t in
64 65
match fields_opt with
65 66
| None -> constructor
66 67
| Some f -> constructor ^ f
@@ -74,13 +75,8 @@ let to_string_default = function
74 75
sprintf locfmt file line char (char+6) "Assertion failed"
75 76
| Undefined_recursive_module(file, line, char) ->
76 77
sprintf locfmt file line char (char+6) "Undefined recursive module"
77 -
| CamlinternalEffect.Unhandled e ->
78 -
sprintf "Stdlib.Effect.Unhandled(%s)"
79 -
(string_of_sum_type (walk_sum_type (Obj.repr e)))
80 78
| x ->
81 -
let x = Obj.repr x in
82 -
let (cname, fields) = walk_sum_type x in
83 -
string_of_sum_type (cname, fields)
79 +
string_of_extension_constructor (Obj.repr x)
84 80 85 81
let to_string e =
86 82
match use_printers e with
@@ -410,3 +410,12 @@ val exn_slot_name: exn -> string
410 410 411 411
@since 4.02.0
412 412
*)
413 + 414 +
(**/**)
415 + 416 +
(** {1 Obj printer}
417 +
Unsafe printer used in this module and exposed to the other standard library
418 +
module
419 +
*)
420 + 421 +
val string_of_extension_constructor: Obj.t -> string
Original file line number Diff line number Diff line change
@@ -2,5 +2,5 @@ Raised at Stdlib.failwith in file "stdlib.ml", line 29, characters 17-33
2 2
Called from Backtrace.foo in file "backtrace.ml", line 12, characters 11-27
3 3
Called from Backtrace.bar in file "backtrace.ml", line 20, characters 4-9
4 4
Called from Backtrace.task1 in file "backtrace.ml", line 29, characters 4-10
5 -
Re-raised at Stdlib__Effect.Deep.discontinue_with_backtrace.(fun) in file "effect.ml", line 51, characters 4-38
5 +
Re-raised at Stdlib__Effect.Deep.discontinue_with_backtrace.(fun) in file "effect.ml", line 62, characters 4-38
6 6
Called from Backtrace.task2 in file "backtrace.ml", line 36, characters 4-16
You can’t perform that action at this time.
RetroSearch is an open source project built by @garambo | Open a GitHub Issue
Search and Browse the WWW like it's 1997 | Search results from DuckDuckGo
HTML:
3.2
| Encoding:
UTF-8
| Version:
0.7.4