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 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161
|
--- obrowser-1.1.1/Makefile.orig 2011-07-05 16:15:30.000000000 +0200
+++ obrowser-1.1.1/Makefile 2011-07-05 16:16:42.000000000 +0200
@@ -16,9 +16,9 @@
EXAMPLES = $(patsubst examples/%,%, $(wildcard examples/*))
EXAMPLES_TARGETS = $(patsubst examples/%,%.example, $(wildcard examples/*))
OCAMLFIND = ocamlfind
-.PHONY: tuto dist plugin lwt
+.PHONY: tuto dist plugin lwt AXO
-all: .check_version rt/caml/stdlib.cma vm.js tuto $(EXAMPLES_TARGETS) examples.html AXO lwt
+all: .check_version rt/caml/stdlib.cma vm.js tuto AXO $(EXAMPLES_TARGETS) examples.html lwt
.check_version:
@[ "$(shell ocamlc -vnum)" = "3.12.0" ] || \
--- obrowser-1.1.1.orig/Makefile 2011-04-20 18:26:44.000000000 +0200
+++ obrowser-1.1.1/Makefile 2012-03-12 16:55:44.000000000 +0100
@@ -21,10 +21,11 @@
all: .check_version rt/caml/stdlib.cma vm.js tuto $(EXAMPLES_TARGETS) examples.html AXO lwt
.check_version:
- @[ "$(shell ocamlc -vnum)" = "3.12.0" ] || \
- [ "$(shell ocamlc -vnum)" = "3.12.1" ] || \
- ( echo "You need ocaml version 3.12.0 or 3.12.1"; \
- exit 1 )
+ @case `ocaml -vnum` in \
+ 3.1[2-9].*);; \
+ 4.*);; \
+ *) echo "You need ocaml version 3.12.0 or later"; exit 1;; \
+ esac
touch $@
%.example:
--- obrowser-1.1.1.orig/rt/caml/pervasives.mli 2011-04-20 18:26:44.000000000 +0200
+++ obrowser-1.1.1/rt/caml/pervasives.mli 2012-01-12 01:07:49.000000000 +0100
@@ -1,6 +1,6 @@
(***********************************************************************)
(* *)
-(* Objective Caml *)
+(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
@@ -52,24 +52,24 @@
Equality between cyclic data structures may not terminate. *)
external ( <> ) : 'a -> 'a -> bool = "%notequal"
-(** Negation of {!Pervasives.(=)}. *)
+(** Negation of {!Pervasives.( = )}. *)
external ( < ) : 'a -> 'a -> bool = "%lessthan"
-(** See {!Pervasives.(>=)}. *)
+(** See {!Pervasives.( >= )}. *)
external ( > ) : 'a -> 'a -> bool = "%greaterthan"
-(** See {!Pervasives.(>=)}. *)
+(** See {!Pervasives.( >= )}. *)
external ( <= ) : 'a -> 'a -> bool = "%lessequal"
-(** See {!Pervasives.(>=)}. *)
+(** See {!Pervasives.( >= )}. *)
external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
(** Structural ordering functions. These functions coincide with
the usual orderings over integers, characters, strings
and floating-point numbers, and extend them to a
total ordering over all types.
- The ordering is compatible with [(=)]. As in the case
- of [(=)], mutable structures are compared by contents.
+ The ordering is compatible with [( = )]. As in the case
+ of [( = )], mutable structures are compared by contents.
Comparison between functional values raises [Invalid_argument].
Comparison between cyclic structures may not terminate. *)
@@ -108,12 +108,12 @@
mutable fields and objects with mutable instance variables,
[e1 == e2] is true if and only if physical modification of [e1]
also affects [e2].
- On non-mutable types, the behavior of [(==)] is
+ On non-mutable types, the behavior of [( == )] is
implementation-dependent; however, it is guaranteed that
[e1 == e2] implies [compare e1 e2 = 0]. *)
external ( != ) : 'a -> 'a -> bool = "%noteq"
-(** Negation of {!Pervasives.(==)}. *)
+(** Negation of {!Pervasives.( == )}. *)
(** {6 Boolean operations} *)
@@ -229,7 +229,7 @@
(** {6 Floating-point arithmetic}
- Caml's floating-point numbers follow the
+ OCaml's floating-point numbers follow the
IEEE 754 standard, using double precision (64 bits) numbers.
Floating-point operations never raise an exception on overflow,
underflow, division by zero, etc. Instead, special IEEE numbers
@@ -310,10 +310,18 @@
Result is in radians and is between [-pi/2] and [pi/2]. *)
external atan2 : float -> float -> float = "caml_atan2_float" "atan2" "float"
-(** [atan x y] returns the arc tangent of [y /. x]. The signs of [x]
+(** [atan2 y x] returns the arc tangent of [y /. x]. The signs of [x]
and [y] are used to determine the quadrant of the result.
Result is in radians and is between [-pi] and [pi]. *)
+external hypot : float -> float -> float
+ = "caml_hypot_float" "caml_hypot" "float"
+(** [hypot x y] returns [sqrt(x *. x + y *. y)], that is, the length
+ of the hypotenuse of a right-angled triangle with sides of length
+ [x] and [y], or, equivalently, the distance of the point [(x,y)]
+ to origin.
+ @since 3.13.0 *)
+
external cosh : float -> float = "caml_cosh_float" "cosh" "float"
(** Hyperbolic cosine. Argument is in radians. *)
@@ -337,6 +345,14 @@
external abs_float : float -> float = "%absfloat"
(** [abs_float f] returns the absolute value of [f]. *)
+external copysign : float -> float -> float
+ = "caml_copysign_float" "caml_copysign" "float"
+(** [copysign x y] returns a float whose absolute value is that of [x]
+ and whose sign is that of [y]. If [x] is [nan], returns [nan].
+ If [y] is [nan], returns either [x] or [-. x], but it is not
+ specified which.
+ @since 3.13.0 *)
+
external mod_float : float -> float -> float = "caml_fmod_float" "fmod" "float"
(** [mod_float a b] returns the remainder of [a] with respect to
[b]. The returned value is [a -. n *. b], where [n]
@@ -505,7 +521,7 @@
(** The standard output for the process. *)
val stderr : out_channel
-(** The standard error ouput for the process. *)
+(** The standard error output for the process. *)
(** {7 Output functions on standard output} *)
@@ -642,7 +658,7 @@
The given integer is taken modulo 2{^32}.
The only reliable way to read it back is through the
{!Pervasives.input_binary_int} function. The format is compatible across
- all machines for a given version of Objective Caml. *)
+ all machines for a given version of OCaml. *)
val output_value : out_channel -> 'a -> unit
(** Write the representation of a structured value of any type
@@ -855,12 +871,16 @@
(** Format strings have a general and highly polymorphic type
[('a, 'b, 'c, 'd, 'e, 'f) format6]. Type [format6] is built in.
The two simplified types, [format] and [format4] below are
- included for backward compatibility with earlier releases of Objective
- Caml.
+ included for backward compatibility with earlier releases of OCaml.
['a] is the type of the parameters of the format,
- ['c] is the result type for the "printf"-style function,
- and ['b] is the type of the first argument given to
- [%a] and [%t] printing functions. *)
+ ['b] is the type of the first argument given to
+ [%a] and [%t] printing functions,
+ ['c] is the type of the argument transmitted to the first argument of
+ "kprintf"-style functions,
+ ['d] is the result type for the "scanf"-style functions,
+ ['e] is the type of the receiver function for the "scanf"-style functions,
+ ['f] is the result type for the "printf"-style function.
+ *)
type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
@@ -888,7 +908,7 @@
(** Terminate the process, returning the given status code
to the operating system: usually 0 to indicate no errors,
and a small positive integer to indicate failure.
- All open output channels are flushed with flush_all.
+ All open output channels are flushed with [flush_all].
An implicit [exit 0] is performed each time a program
terminates normally. An implicit [exit 2] is performed if the program
terminates early because of an uncaught exception. *)
--- obrowser-1.1.1.orig/rt/caml/pervasives.ml 2011-04-20 18:26:44.000000000 +0200
+++ obrowser-1.1.1/rt/caml/pervasives.ml 2012-01-12 17:04:04.000000000 +0100
@@ -91,6 +91,8 @@
external asin : float -> float = "caml_asin_float" "asin" "float"
external atan : float -> float = "caml_atan_float" "atan" "float"
external atan2 : float -> float -> float = "caml_atan2_float" "atan2" "float"
+external hypot : float -> float -> float
+ = "caml_hypot_float" "caml_hypot" "float"
external cos : float -> float = "caml_cos_float" "cos" "float"
external cosh : float -> float = "caml_cosh_float" "cosh" "float"
external log : float -> float = "caml_log_float" "log" "float"
@@ -104,6 +106,8 @@
external ceil : float -> float = "caml_ceil_float" "ceil" "float"
external floor : float -> float = "caml_floor_float" "floor" "float"
external abs_float : float -> float = "%absfloat"
+external copysign : float -> float -> float
+ = "caml_copysign_float" "caml_copysign" "float"
external mod_float : float -> float -> float = "caml_fmod_float" "fmod" "float"
external frexp : float -> float * int = "caml_frexp_float"
external ldexp : float -> int -> float = "caml_ldexp_float"
--- obrowser-1.1.1.orig/rt/caml/list.ml 2011-04-20 18:26:44.000000000 +0200
+++ obrowser-1.1.1/rt/caml/list.ml 2012-01-12 17:30:31.000000000 +0100
@@ -1,6 +1,6 @@
(***********************************************************************)
(* *)
-(* Objective Caml *)
+(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
@@ -56,6 +56,12 @@
[] -> []
| a::l -> let r = f a in r :: map f l
+let rec mapi i f = function
+ [] -> []
+ | a::l -> let r = f i a in r :: mapi (i + 1) f l
+
+let mapi f l = mapi 0 f l
+
let rev_map f l =
let rec rmap_f accu = function
| [] -> accu
@@ -68,6 +74,12 @@
[] -> ()
| a::l -> f a; iter f l
+let rec iteri i f = function
+ [] -> ()
+ | a::l -> f i a; iteri (i + 1) f l
+
+let iteri f l = iteri 0 f l
+
let rec fold_left f accu l =
match l with
[] -> accu
--- obrowser-1.1.1.orig/rt/caml/list.mli 2011-04-20 18:26:44.000000000 +0200
+++ obrowser-1.1.1/rt/caml/list.mli 2012-01-12 17:30:31.000000000 +0100
@@ -1,6 +1,6 @@
(***********************************************************************)
(* *)
-(* Objective Caml *)
+(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
@@ -75,11 +75,25 @@
[a1; ...; an]. It is equivalent to
[begin f a1; f a2; ...; f an; () end]. *)
+val iteri : (int -> 'a -> unit) -> 'a list -> unit
+(** Same as {!List.iter}, but the function is applied to the index of
+ the element as first argument (counting from 0), and the element
+ itself as second argument.
+ @since 3.13.0
+*)
+
val map : ('a -> 'b) -> 'a list -> 'b list
(** [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an],
and builds the list [[f a1; ...; f an]]
with the results returned by [f]. Not tail-recursive. *)
+val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
+(** Same as {!List.map}, but the function is applied to the index of
+ the element as first argument (counting from 0), and the element
+ itself as second argument. Not tail-recursive.
+ @since 3.13.0
+*)
+
val rev_map : ('a -> 'b) -> 'a list -> 'b list
(** [List.rev_map f l] gives the same result as
{!List.rev}[ (]{!List.map}[ f l)], but is tail-recursive and
--- obrowser-1.1.1-old/rt/caml/pervasives.mli 2013-06-20 13:50:19.000000000 +0200
+++ obrowser-1.1.1/rt/caml/pervasives.mli 2013-06-20 13:50:59.000000000 +0200
@@ -11,8 +11,6 @@
(* *)
(***********************************************************************)
-(* $Id: pervasives.mli 10548 2010-06-09 10:26:19Z weis $ *)
-
(** The initially opened module.
This module provides the basic operations over the built-in types
@@ -122,7 +120,7 @@
(** The boolean negation. *)
external ( && ) : bool -> bool -> bool = "%sequand"
-(** The boolean ``and''. Evaluation is sequential, left-to-right:
+(** The boolean 'and'. Evaluation is sequential, left-to-right:
in [e1 && e2], [e1] is evaluated first, and if it returns [false],
[e2] is not evaluated at all. *)
@@ -130,7 +128,7 @@
(** @deprecated {!Pervasives.( && )} should be used instead. *)
external ( || ) : bool -> bool -> bool = "%sequor"
-(** The boolean ``or''. Evaluation is sequential, left-to-right:
+(** The boolean 'or'. Evaluation is sequential, left-to-right:
in [e1 || e2], [e1] is evaluated first, and if it returns [true],
[e2] is not evaluated at all. *)
@@ -138,6 +136,20 @@
(** @deprecated {!Pervasives.( || )} should be used instead.*)
+(** {6 Composition operators} *)
+
+external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+(** Reverse-application operator: [x |> f |> g] is exactly equivalent
+ to [g (f (x))].
+ @since 4.01
+*)
+
+external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
+(** Application operator: [g @@ f @@ x] is exactly equivalent to
+ [g (f (x))].
+ @since 4.01
+*)
+
(** {6 Integer arithmetic} *)
(** Integers are 31 bits wide (or 63 bits on 64-bit processors).
@@ -234,7 +246,7 @@
Floating-point operations never raise an exception on overflow,
underflow, division by zero, etc. Instead, special IEEE numbers
are returned as appropriate, such as [infinity] for [1.0 /. 0.0],
- [neg_infinity] for [-1.0 /. 0.0], and [nan] (``not a number'')
+ [neg_infinity] for [-1.0 /. 0.0], and [nan] ('not a number')
for [0.0 /. 0.0]. These special numbers then propagate through
floating-point computations as expected: for instance,
[1.0 /. infinity] is [0.0], and any arithmetic operation with [nan]
@@ -320,7 +332,7 @@
of the hypotenuse of a right-angled triangle with sides of length
[x] and [y], or, equivalently, the distance of the point [(x,y)]
to origin.
- @since 3.13.0 *)
+ @since 4.00.0 *)
external cosh : float -> float = "caml_cosh_float" "cosh" "float"
(** Hyperbolic cosine. Argument is in radians. *)
@@ -351,7 +363,7 @@
and whose sign is that of [y]. If [x] is [nan], returns [nan].
If [y] is [nan], returns either [x] or [-. x], but it is not
specified which.
- @since 3.13.0 *)
+ @since 4.00.0 *)
external mod_float : float -> float -> float = "caml_fmod_float" "fmod" "float"
(** [mod_float a b] returns the remainder of [a] with respect to
@@ -395,7 +407,7 @@
val nan : float
(** A special floating-point value denoting the result of an
undefined operation such as [0.0 /. 0.0]. Stands for
- ``not a number''. Any floating-point operation with [nan] as
+ 'not a number'. Any floating-point operation with [nan] as
argument returns [nan] as result. As for floating-point comparisons,
[=], [<], [<=], [>] and [>=] return [false] and [<>] returns [true]
if one or both of their arguments is [nan]. *)
@@ -461,7 +473,9 @@
(** {6 String conversion functions} *)
val string_of_bool : bool -> string
-(** Return the string representation of a boolean. *)
+(** Return the string representation of a boolean. As the returned values
+ may be shared, the user should not modify them directly.
+*)
val bool_of_string : string -> bool
(** Convert the given string to a boolean.
@@ -506,7 +520,9 @@
(** List concatenation. *)
-(** {6 Input/output} *)
+(** {6 Input/output}
+ Note: all input/output functions can raise [Sys_error] when the system
+ calls they invoke fail. *)
type in_channel
(** The type of input channel. *)
@@ -864,23 +880,73 @@
(** {6 Operations on format strings} *)
-(** Format strings are used to read and print data using formatted input
- functions in module {!Scanf} and formatted output in modules {!Printf} and
- {!Format}. *)
+(** Format strings are character strings with special lexical conventions
+ that defines the functionality of formatted input/output functions. Format
+ strings are used to read data with formatted input functions from module
+ {!Scanf} and to print data with formatted output functions from modules
+ {!Printf} and {!Format}.
+
+ Format strings are made of three kinds of entities:
+ - {e conversions specifications}, introduced by the special character ['%']
+ followed by one or more characters specifying what kind of argument to
+ read or print,
+ - {e formatting indications}, introduced by the special character ['@']
+ followed by one or more characters specifying how to read or print the
+ argument,
+ - {e plain characters} that are regular characters with usual lexical
+ conventions. Plain characters specify string literals to be read in the
+ input or printed in the output.
+
+ There is an additional lexical rule to escape the special characters ['%']
+ and ['@'] in format strings: if a special character follows a ['%']
+ character, it is treated as a plain character. In other words, ["%%"] is
+ considered as a plain ['%'] and ["%@"] as a plain ['@'].
+
+ For more information about conversion specifications and formatting
+ indications available, read the documentation of modules {!Scanf},
+ {!Printf} and {!Format}.
+*)
(** Format strings have a general and highly polymorphic type
[('a, 'b, 'c, 'd, 'e, 'f) format6]. Type [format6] is built in.
The two simplified types, [format] and [format4] below are
- included for backward compatibility with earlier releases of OCaml.
- ['a] is the type of the parameters of the format,
- ['b] is the type of the first argument given to
- [%a] and [%t] printing functions,
- ['c] is the type of the argument transmitted to the first argument of
- "kprintf"-style functions,
- ['d] is the result type for the "scanf"-style functions,
- ['e] is the type of the receiver function for the "scanf"-style functions,
- ['f] is the result type for the "printf"-style function.
- *)
+ included for backward compatibility with earlier releases of
+ OCaml.
+
+ The meaning of format string type parameters is as follows:
+
+ - ['a] is the type of the parameters of the format for formatted output
+ functions ([printf]-style functions);
+ ['a] is the type of the values read by the format for formatted input
+ functions ([scanf]-style functions).
+
+ - ['b] is the type of input source for formatted input functions and the
+ type of output target for formatted output functions.
+ For [printf]-style functions from module [Printf], ['b] is typically
+ [out_channel];
+ for [printf]-style functions from module [Format], ['b] is typically
+ [Format.formatter];
+ for [scanf]-style functions from module [Scanf], ['b] is typically
+ [Scanf.Scanning.in_channel].
+
+ Type argument ['b] is also the type of the first argument given to
+ user's defined printing functions for [%a] and [%t] conversions,
+ and user's defined reading functions for [%r] conversion.
+
+ - ['c] is the type of the result of the [%a] and [%t] printing
+ functions, and also the type of the argument transmitted to the
+ first argument of [kprintf]-style functions or to the
+ [kscanf]-style functions.
+
+ - ['d] is the type of parameters for the [scanf]-style functions.
+
+ - ['e] is the type of the receiver function for the [scanf]-style functions.
+
+ - ['f] is the final result type of a formatted input/output function
+ invocation: for the [printf]-style functions, it is typically [unit];
+ for the [scanf]-style functions, it is typically the result type of the
+ receiver function.
+*)
type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
@@ -892,14 +958,22 @@
('a, 'b, 'c, 'd, 'e, 'f) format6 ->
('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity"
(** [format_of_string s] returns a format string read from the string
- literal [s]. *)
+ literal [s].
+ Note: [format_of_string] can not convert a string argument that is not a
+ literal. If you need this functionality, use the more general
+ {!Scanf.format_from_string} function.
+*)
val ( ^^ ) :
('a, 'b, 'c, 'd, 'e, 'f) format6 ->
('f, 'b, 'c, 'e, 'g, 'h) format6 ->
('a, 'b, 'c, 'd, 'g, 'h) format6
-(** [f1 ^^ f2] catenates formats [f1] and [f2]. The result is a format
- that accepts arguments from [f1], then arguments from [f2]. *)
+(** [f1 ^^ f2] catenates format strings [f1] and [f2]. The result is a
+ format string that behaves as the concatenation of format strings [f1] and
+ [f2]: in case of formatted output, it accepts arguments from [f1], then
+ arguments from [f2]; in case of formatted input, it returns results from
+ [f1], then results from [f2].
+*)
(** {6 Program termination} *)
@@ -918,13 +992,12 @@
termination time. The functions registered with [at_exit]
will be called when the program executes {!Pervasives.exit},
or terminates, either normally or because of an uncaught exception.
- The functions are called in ``last in, first out'' order:
+ The functions are called in 'last in, first out' order:
the function most recently added with [at_exit] is called first. *)
(**/**)
-
-(** {6 For system use only, not for the casual user} *)
+(* The following is for system use only. Do not call directly. *)
val valid_float_lexem : string -> string
--- obrowser-1.1.1-old/rt/caml/pervasives.ml 2013-06-20 13:50:19.000000000 +0200
+++ obrowser-1.1.1/rt/caml/pervasives.ml 2013-06-20 13:51:53.000000000 +0200
@@ -1,6 +1,6 @@
(***********************************************************************)
(* *)
-(* Objective Caml *)
+(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
@@ -11,8 +11,6 @@
(* *)
(***********************************************************************)
-(* $Id: pervasives.ml 9412 2009-11-09 11:42:39Z weis $ *)
-
(* type 'a option = None | Some of 'a *)
(* Exceptions *)
@@ -24,66 +22,70 @@
exception Exit
+(* Composition operators *)
+
+external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
+
(* Comparisons *)
-external (=) : 'a -> 'a -> bool = "%equal"
-external (<>) : 'a -> 'a -> bool = "%notequal"
-external (<) : 'a -> 'a -> bool = "%lessthan"
-external (>) : 'a -> 'a -> bool = "%greaterthan"
-external (<=) : 'a -> 'a -> bool = "%lessequal"
-external (>=) : 'a -> 'a -> bool = "%greaterequal"
-external compare: 'a -> 'a -> int = "%compare"
+external ( = ) : 'a -> 'a -> bool = "%equal"
+external ( <> ) : 'a -> 'a -> bool = "%notequal"
+external ( < ) : 'a -> 'a -> bool = "%lessthan"
+external ( > ) : 'a -> 'a -> bool = "%greaterthan"
+external ( <= ) : 'a -> 'a -> bool = "%lessequal"
+external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
+external compare : 'a -> 'a -> int = "%compare"
let min x y = if x <= y then x else y
let max x y = if x >= y then x else y
-external (==) : 'a -> 'a -> bool = "%eq"
-external (!=) : 'a -> 'a -> bool = "%noteq"
+external ( == ) : 'a -> 'a -> bool = "%eq"
+external ( != ) : 'a -> 'a -> bool = "%noteq"
(* Boolean operations *)
external not : bool -> bool = "%boolnot"
-external (&) : bool -> bool -> bool = "%sequand"
-external (&&) : bool -> bool -> bool = "%sequand"
-external (or) : bool -> bool -> bool = "%sequor"
-external (||) : bool -> bool -> bool = "%sequor"
+external ( & ) : bool -> bool -> bool = "%sequand"
+external ( && ) : bool -> bool -> bool = "%sequand"
+external ( or ) : bool -> bool -> bool = "%sequor"
+external ( || ) : bool -> bool -> bool = "%sequor"
(* Integer operations *)
-external (~-) : int -> int = "%negint"
-external (~+) : int -> int = "%identity"
+external ( ~- ) : int -> int = "%negint"
+external ( ~+ ) : int -> int = "%identity"
external succ : int -> int = "%succint"
external pred : int -> int = "%predint"
-external (+) : int -> int -> int = "%addint"
-external (-) : int -> int -> int = "%subint"
-external ( * ) : int -> int -> int = "%mulint"
-external (/) : int -> int -> int = "%divint"
-external (mod) : int -> int -> int = "%modint"
+external ( + ) : int -> int -> int = "%addint"
+external ( - ) : int -> int -> int = "%subint"
+external ( * ) : int -> int -> int = "%mulint"
+external ( / ) : int -> int -> int = "%divint"
+external ( mod ) : int -> int -> int = "%modint"
let abs x = if x >= 0 then x else -x
-external (land) : int -> int -> int = "%andint"
-external (lor) : int -> int -> int = "%orint"
-external (lxor) : int -> int -> int = "%xorint"
+external ( land ) : int -> int -> int = "%andint"
+external ( lor ) : int -> int -> int = "%orint"
+external ( lxor ) : int -> int -> int = "%xorint"
let lnot x = x lxor (-1)
-external (lsl) : int -> int -> int = "%lslint"
-external (lsr) : int -> int -> int = "%lsrint"
-external (asr) : int -> int -> int = "%asrint"
+external ( lsl ) : int -> int -> int = "%lslint"
+external ( lsr ) : int -> int -> int = "%lsrint"
+external ( asr ) : int -> int -> int = "%asrint"
-let min_int = 1 lsl (if 1 lsl 32 = 1 then 31 else 63) (* obrowser mod: no tag bit*)
+let min_int = 1 lsl (if 1 lsl 31 = 0 then 30 else 62)
let max_int = min_int - 1
-
(* Floating-point operations *)
-external (~-.) : float -> float = "%negfloat"
-external (~+.) : float -> float = "%identity"
-external (+.) : float -> float -> float = "%addfloat"
-external (-.) : float -> float -> float = "%subfloat"
+external ( ~-. ) : float -> float = "%negfloat"
+external ( ~+. ) : float -> float = "%identity"
+external ( +. ) : float -> float -> float = "%addfloat"
+external ( -. ) : float -> float -> float = "%subfloat"
external ( *. ) : float -> float -> float = "%mulfloat"
-external (/.) : float -> float -> float = "%divfloat"
+external ( /. ) : float -> float -> float = "%divfloat"
external ( ** ) : float -> float -> float = "caml_power_float" "pow" "float"
external exp : float -> float = "caml_exp_float" "exp" "float"
external expm1 : float -> float = "caml_expm1_float" "caml_expm1" "float"
@@ -136,16 +138,16 @@
| FP_zero
| FP_infinite
| FP_nan
-external classify_float: float -> fpclass = "caml_classify_float"
+external classify_float : float -> fpclass = "caml_classify_float"
(* String operations -- more in module String *)
external string_length : string -> int = "%string_length"
-external string_create: int -> string = "caml_create_string"
+external string_create : int -> string = "caml_create_string"
external string_blit : string -> int -> string -> int -> int -> unit
= "caml_blit_string" "noalloc"
-let (^) s1 s2 =
+let ( ^ ) s1 s2 =
let l1 = string_length s1 and l2 = string_length s2 in
let s = string_create (l1 + l2) in
string_blit s1 0 s 0 l1;
@@ -170,8 +172,8 @@
(* String conversion functions *)
-external format_int: string -> int -> string = "caml_format_int"
-external format_float: string -> float -> string = "caml_format_float"
+external format_int : string -> int -> string = "caml_format_int"
+external format_float : string -> float -> string = "caml_format_float"
let string_of_bool b =
if b then "true" else "false"
@@ -187,7 +189,6 @@
module String = struct
external get : string -> int -> char = "%string_safe_get"
- external set : string -> int -> char -> unit = "%string_safe_set"
end
let valid_float_lexem s =
@@ -195,7 +196,7 @@
let rec loop i =
if i >= l then s ^ "." else
match s.[i] with
- | '0' .. '9' | '-' -> loop (i+1)
+ | '0' .. '9' | '-' -> loop (i + 1)
| _ -> s
in
loop 0
@@ -207,7 +208,7 @@
(* List operations -- more in module List *)
-let rec (@) l1 l2 =
+let rec ( @ ) l1 l2 =
match l1 with
[] -> l2
| hd :: tl -> hd :: (tl @ l2)
@@ -217,12 +218,13 @@
type in_channel
type out_channel
-let open_descriptor_out _ = failwith "not implemented in obrowser"
-let open_descriptor_in _ = failwith "not implemented in obrowser"
-
-let stdin = Obj.magic 0
-let stdout = Obj.magic 0
-let stderr = Obj.magic 0
+external open_descriptor_out : int -> out_channel
+ = "caml_ml_open_descriptor_out"
+external open_descriptor_in : int -> in_channel = "caml_ml_open_descriptor_in"
+
+let stdin = open_descriptor_in 0
+let stdout = open_descriptor_out 1
+let stderr = open_descriptor_out 2
(* General output functions *)
@@ -231,103 +233,184 @@
| Open_creat | Open_trunc | Open_excl
| Open_binary | Open_text | Open_nonblock
-let open_desc _ _ _ = failwith "not implemented in obrowser"
-let open_out_gen mode perm name = failwith "not implemented in obrowser"
-let open_out name = failwith "not implemented in obrowser"
-let open_out_bin name = failwith "not implemented in obrowser"
-let flush _ = failwith "not implemented in obrowser"
-let out_channels_list _ = failwith "not implemented in obrowser"
-let flush_all () = failwith "not implemented in obrowser"
-let unsafe_output _ _ _ _ = failwith "not implemented in obrowser"
-let output_char _ _ = failwith "not implemented in obrowser"
-let output_string oc s = failwith "not implemented in obrowser"
-let output oc s ofs len = failwith "not implemented in obrowser"
-let output_byte _ _ = failwith "not implemented in obrowser"
-let output_binary_int _ _ = failwith "not implemented in obrowser"
-let marshal_to_channel _ _ _ = failwith "not implemented in obrowser"
-let output_value _ _ = failwith "not implemented in obrowser"
-let seek_out _ _ = failwith "not implemented in obrowser"
-let pos_out _ = failwith "not implemented in obrowser"
-let out_channel_length _ = failwith "not implemented in obrowser"
-let close_out_channel _ = failwith "not implemented in obrowser"
-let close_out _ = failwith "not implemented in obrowser"
-let close_out_noerr _ = failwith "not implemented in obrowser"
-let set_binary_mode_out _ _ = failwith "not implemented in obrowser"
+external open_desc : string -> open_flag list -> int -> int = "caml_sys_open"
+
+let open_out_gen mode perm name =
+ open_descriptor_out(open_desc name mode perm)
+
+let open_out name =
+ open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_text] 0o666 name
+
+let open_out_bin name =
+ open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o666 name
+
+external flush : out_channel -> unit = "caml_ml_flush"
+
+external out_channels_list : unit -> out_channel list
+ = "caml_ml_out_channels_list"
+
+let flush_all () =
+ let rec iter = function
+ [] -> ()
+ | a :: l -> (try flush a with _ -> ()); iter l
+ in iter (out_channels_list ())
+
+external unsafe_output : out_channel -> string -> int -> int -> unit
+ = "caml_ml_output"
+
+external output_char : out_channel -> char -> unit = "caml_ml_output_char"
+
+let output_string oc s =
+ unsafe_output oc s 0 (string_length s)
+
+let output oc s ofs len =
+ if ofs < 0 || len < 0 || ofs > string_length s - len
+ then invalid_arg "output"
+ else unsafe_output oc s ofs len
+
+external output_byte : out_channel -> int -> unit = "caml_ml_output_char"
+external output_binary_int : out_channel -> int -> unit = "caml_ml_output_int"
+
+external marshal_to_channel : out_channel -> 'a -> unit list -> unit
+ = "caml_output_value"
+let output_value chan v = marshal_to_channel chan v []
+
+external seek_out : out_channel -> int -> unit = "caml_ml_seek_out"
+external pos_out : out_channel -> int = "caml_ml_pos_out"
+external out_channel_length : out_channel -> int = "caml_ml_channel_size"
+external close_out_channel : out_channel -> unit = "caml_ml_close_channel"
+let close_out oc = flush oc; close_out_channel oc
+let close_out_noerr oc =
+ (try flush oc with _ -> ());
+ (try close_out_channel oc with _ -> ())
+external set_binary_mode_out : out_channel -> bool -> unit
+ = "caml_ml_set_binary_mode"
(* General input functions *)
-let open_in_gen _ _ _ = failwith "not implemented in obrowser"
-let open_in _ = failwith "not implemented in obrowser"
-let open_in_bin _ = failwith "not implemented in obrowser"
-let input_char _ = failwith "not implemented in obrowser"
-let unsafe_input _ _ _ _ = failwith "not implemented in obrowser"
-let input _ _ _ _ = failwith "not implemented in obrowser"
-let rec unsafe_really_input _ _ _ _ = failwith "not implemented in obrowser"
-let really_input _ _ _ _ = failwith "not implemented in obrowser"
-let input_scan_line _ = failwith "not implemented in obrowser"
-let input_line _ = failwith "not implemented in obrowser"
-
-let input_byte _ = failwith "not implemented in obrowser"
-let input_binary_int _ = failwith "not implemented in obrowser"
-let input_value _ = failwith "not implemented in obrowser"
-let seek_in _ _ = failwith "not implemented in obrowser"
-let pos_in _ = failwith "not implemented in obrowser"
-let in_channel_length _ = failwith "not implemented in obrowser"
-let close_in _ = failwith "not implemented in obrowser"
-let close_in_noerr _ = failwith "not implemented in obrowser"
-let set_binary_mode_in _ _ = failwith "not implemented in obrowser"
+let open_in_gen mode perm name =
+ open_descriptor_in(open_desc name mode perm)
-(* Output functions on standard output *)
+let open_in name =
+ open_in_gen [Open_rdonly; Open_text] 0 name
+
+let open_in_bin name =
+ open_in_gen [Open_rdonly; Open_binary] 0 name
+
+external input_char : in_channel -> char = "caml_ml_input_char"
+
+external unsafe_input : in_channel -> string -> int -> int -> int
+ = "caml_ml_input"
+
+let input ic s ofs len =
+ if ofs < 0 || len < 0 || ofs > string_length s - len
+ then invalid_arg "input"
+ else unsafe_input ic s ofs len
+
+let rec unsafe_really_input ic s ofs len =
+ if len <= 0 then () else begin
+ let r = unsafe_input ic s ofs len in
+ if r = 0
+ then raise End_of_file
+ else unsafe_really_input ic s (ofs + r) (len - r)
+ end
-external basic_io_write : string -> unit = "caml_basic_io_write"
+let really_input ic s ofs len =
+ if ofs < 0 || len < 0 || ofs > string_length s - len
+ then invalid_arg "really_input"
+ else unsafe_really_input ic s ofs len
+
+external input_scan_line : in_channel -> int = "caml_ml_input_scan_line"
+
+let input_line chan =
+ let rec build_result buf pos = function
+ [] -> buf
+ | hd :: tl ->
+ let len = string_length hd in
+ string_blit hd 0 buf (pos - len) len;
+ build_result buf (pos - len) tl in
+ let rec scan accu len =
+ let n = input_scan_line chan in
+ if n = 0 then begin (* n = 0: we are at EOF *)
+ match accu with
+ [] -> raise End_of_file
+ | _ -> build_result (string_create len) len accu
+ end else if n > 0 then begin (* n > 0: newline found in buffer *)
+ let res = string_create (n - 1) in
+ ignore (unsafe_input chan res 0 (n - 1));
+ ignore (input_char chan); (* skip the newline *)
+ match accu with
+ [] -> res
+ | _ -> let len = len + n - 1 in
+ build_result (string_create len) len (res :: accu)
+ end else begin (* n < 0: newline not found *)
+ let beg = string_create (-n) in
+ ignore(unsafe_input chan beg 0 (-n));
+ scan (beg :: accu) (len - n)
+ end
+ in scan [] 0
+
+external input_byte : in_channel -> int = "caml_ml_input_char"
+external input_binary_int : in_channel -> int = "caml_ml_input_int"
+external input_value : in_channel -> 'a = "caml_input_value"
+external seek_in : in_channel -> int -> unit = "caml_ml_seek_in"
+external pos_in : in_channel -> int = "caml_ml_pos_in"
+external in_channel_length : in_channel -> int = "caml_ml_channel_size"
+external close_in : in_channel -> unit = "caml_ml_close_channel"
+let close_in_noerr ic = (try close_in ic with _ -> ());;
+external set_binary_mode_in : in_channel -> bool -> unit
+ = "caml_ml_set_binary_mode"
-let print_char c = basic_io_write (let s = string_create 1 in s.[0] <- c ; s)
-let print_string s = basic_io_write s
-let print_int i = basic_io_write (string_of_int i)
-let print_float f = basic_io_write (string_of_float f)
+(* Output functions on standard output *)
+
+let print_char c = output_char stdout c
+let print_string s = output_string stdout s
+let print_int i = output_string stdout (string_of_int i)
+let print_float f = output_string stdout (string_of_float f)
let print_endline s =
- print_string s; print_char '\n'
-let print_newline () = print_char '\n'
+ output_string stdout s; output_char stdout '\n'; flush stdout
+let print_newline () = output_char stdout '\n'; flush stdout
(* Output functions on standard error *)
-let prerr_char c = basic_io_write (let s = string_create 1 in s.[0] <- c ; s)
-let prerr_string s = basic_io_write s
-let prerr_int i = basic_io_write (string_of_int i)
-let prerr_float f = basic_io_write (string_of_float f)
+let prerr_char c = output_char stderr c
+let prerr_string s = output_string stderr s
+let prerr_int i = output_string stderr (string_of_int i)
+let prerr_float f = output_string stderr (string_of_float f)
let prerr_endline s =
- prerr_string s; prerr_char '\n'
-let prerr_newline () = prerr_char '\n'
+ output_string stderr s; output_char stderr '\n'; flush stderr
+let prerr_newline () = output_char stderr '\n'; flush stderr
(* Input functions on standard input *)
-let read_line () = failwith "not implemented in obrowser"
-let read_int () = failwith "not implemented in obrowser"
-let read_float () = failwith "not implemented in obrowser"
+let read_line () = flush stdout; input_line stdin
+let read_int () = int_of_string(read_line())
+let read_float () = float_of_string(read_line())
(* Operations on large files *)
module LargeFile =
struct
- let seek_out _ _ = failwith "not implemented in obrowser"
- let pos_out _ = failwith "not implemented in obrowser"
- let out_channel_length _ = failwith "not implemented in obrowser"
- let seek_in _ _ = failwith "not implemented in obrowser"
- let pos_in _ = failwith "not implemented in obrowser"
- let in_channel_length _ = failwith "not implemented in obrowser"
+ external seek_out : out_channel -> int64 -> unit = "caml_ml_seek_out_64"
+ external pos_out : out_channel -> int64 = "caml_ml_pos_out_64"
+ external out_channel_length : out_channel -> int64
+ = "caml_ml_channel_size_64"
+ external seek_in : in_channel -> int64 -> unit = "caml_ml_seek_in_64"
+ external pos_in : in_channel -> int64 = "caml_ml_pos_in_64"
+ external in_channel_length : in_channel -> int64 = "caml_ml_channel_size_64"
end
(* References *)
-type 'a ref = { mutable contents: 'a }
-external ref: 'a -> 'a ref = "%makemutable"
-external (!): 'a ref -> 'a = "%field0"
-external (:=): 'a ref -> 'a -> unit = "%setfield0"
-external incr: int ref -> unit = "%incr"
-external decr: int ref -> unit = "%decr"
+type 'a ref = { mutable contents : 'a }
+external ref : 'a -> 'a ref = "%makemutable"
+external ( ! ) : 'a ref -> 'a = "%field0"
+external ( := ) : 'a ref -> 'a -> unit = "%setfield0"
+external incr : int ref -> unit = "%incr"
+external decr : int ref -> unit = "%decr"
(* Formats *)
-type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
+type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
@@ -345,7 +428,8 @@
('f, 'b, 'c, 'e, 'g, 'h) format6 ->
('a, 'b, 'c, 'd, 'g, 'h) format6) =
fun fmt1 fmt2 ->
- string_to_format (format_to_string fmt1 ^ format_to_string fmt2);;
+ string_to_format (format_to_string fmt1 ^ "%," ^ format_to_string fmt2)
+;;
let string_of_format fmt =
let s = format_to_string fmt in
@@ -358,7 +442,7 @@
external sys_exit : int -> 'a = "caml_sys_exit"
-let exit_function = ref (fun () -> ())
+let exit_function = ref flush_all
let at_exit f =
let g = !exit_function in
--- obrowser-1.1.1.orig/rt/caml/printexc.ml 2011-04-20 18:26:44.000000000 +0200
+++ obrowser-1.1.1/rt/caml/printexc.ml 2013-08-13 15:54:35.000000000 +0200
@@ -1,6 +1,6 @@
(***********************************************************************)
(* *)
-(* Objective Caml *)
+(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
@@ -11,8 +11,6 @@
(* *)
(***********************************************************************)
-(* $Id: printexc.ml 10272 2010-04-19 12:25:46Z frisch $ *)
-
open Printf;;
let printers = ref []
@@ -56,9 +54,12 @@
sprintf locfmt file line char (char+5) "Pattern matching failed"
| Assert_failure(file, line, char) ->
sprintf locfmt file line char (char+6) "Assertion failed"
+ | Undefined_recursive_module(file, line, char) ->
+ sprintf locfmt file line char (char+6) "Undefined recursive module"
| _ ->
let x = Obj.repr x in
- let constructor = (Obj.magic(Obj.field (Obj.field x 0) 0) : string) in
+ let constructor =
+ (Obj.magic (Obj.field (Obj.field x 0) 0) : string) in
constructor ^ (fields x) in
conv !printers
@@ -78,6 +79,11 @@
eprintf "Uncaught exception: %s\n" (to_string x);
exit 2
+type raw_backtrace
+
+external get_raw_backtrace:
+ unit -> raw_backtrace = "caml_get_exception_raw_backtrace"
+
type loc_info =
| Known_location of bool (* is_raise *)
* string (* filename *)
@@ -86,8 +92,13 @@
* int (* end char *)
| Unknown_location of bool (*is_raise*)
-external get_exception_backtrace:
- unit -> loc_info array option = "caml_get_exception_backtrace"
+(* to avoid warning *)
+let _ = [Known_location (false, "", 0, 0, 0); Unknown_location false]
+
+type backtrace = loc_info array
+
+external convert_raw_backtrace:
+ raw_backtrace -> backtrace option = "caml_convert_raw_backtrace"
let format_loc_info pos li =
let is_raise =
@@ -108,8 +119,8 @@
sprintf "%s unknown location"
info
-let print_backtrace outchan =
- match get_exception_backtrace() with
+let print_exception_backtrace outchan backtrace =
+ match backtrace with
| None ->
fprintf outchan
"(Program not linked with -g, cannot print stack backtrace)\n"
@@ -119,8 +130,15 @@
fprintf outchan "%s\n" (format_loc_info i a.(i))
done
-let get_backtrace () =
- match get_exception_backtrace() with
+let print_raw_backtrace outchan raw_backtrace =
+ print_exception_backtrace outchan (convert_raw_backtrace raw_backtrace)
+
+(* confusingly named: prints the global current backtrace *)
+let print_backtrace outchan =
+ print_raw_backtrace outchan (get_raw_backtrace ())
+
+let backtrace_to_string backtrace =
+ match backtrace with
| None ->
"(Program not linked with -g, cannot print stack backtrace)\n"
| Some a ->
@@ -131,8 +149,22 @@
done;
Buffer.contents b
+let raw_backtrace_to_string raw_backtrace =
+ backtrace_to_string (convert_raw_backtrace raw_backtrace)
+
+(* confusingly named:
+ returns the *string* corresponding to the global current backtrace *)
+let get_backtrace () =
+ (* we could use the caml_get_exception_backtrace primitive here, but
+ we hope to deprecate it so it's better to just compose the
+ raw stuff *)
+ backtrace_to_string (convert_raw_backtrace (get_raw_backtrace ()))
+
external record_backtrace: bool -> unit = "caml_record_backtrace"
external backtrace_status: unit -> bool = "caml_backtrace_status"
let register_printer fn =
printers := fn :: !printers
+
+
+external get_callstack: int -> raw_backtrace = "caml_get_current_callstack"
--- obrowser-1.1.1.orig/rt/caml/printexc.mli 2011-04-20 18:26:44.000000000 +0200
+++ obrowser-1.1.1/rt/caml/printexc.mli 2013-08-13 15:54:40.000000000 +0200
@@ -1,6 +1,6 @@
(***********************************************************************)
(* *)
-(* Objective Caml *)
+(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
@@ -11,9 +11,7 @@
(* *)
(***********************************************************************)
-(* $Id: printexc.mli 10457 2010-05-21 18:30:12Z doligez $ *)
-
-(** Facilities for printing exceptions. *)
+(** Facilities for printing exceptions and inspecting current call stack. *)
val to_string: exn -> string
(** [Printexc.to_string e] returns a string representation of
@@ -77,5 +75,40 @@
in the reverse order of their registrations, until a printer returns
a [Some s] value (if no such printer exists, the runtime will use a
generic printer).
+
+ When using this mechanism, one should be aware that an exception backtrace
+ is attached to the thread that saw it raised, rather than to the exception
+ itself. Practically, it means that the code related to [fn] should not use
+ the backtrace if it has itself raised an exception before.
@since 3.11.2
*)
+
+(** {6 Raw backtraces} *)
+
+type raw_backtrace
+
+(** The abstract type [backtrace] stores exception backtraces in
+ a low-level format, instead of directly exposing them as string as
+ the [get_backtrace()] function does.
+
+ This allows to pay the performance overhead of representation
+ conversion and formatting only at printing time, which is useful
+ if you want to record more backtrace than you actually print.
+*)
+
+val get_raw_backtrace: unit -> raw_backtrace
+val print_raw_backtrace: out_channel -> raw_backtrace -> unit
+val raw_backtrace_to_string: raw_backtrace -> string
+
+
+(** {6 Current call stack} *)
+
+val get_callstack: int -> raw_backtrace
+
+(** [Printexc.get_callstack n] returns a description of the top of the
+ call stack on the current program point (for the current thread),
+ with at most [n] entries. (Note: this function is not related to
+ exceptions at all, despite being part of the [Printexc] module.)
+
+ @since 4.01.0
+*)
|