+33 -1

Changes

reviewed

··· 1 1 Working version 2 2 ---------------- 3 3 + 3 4 ### Language features: 4 5 5 6 - #10437: Allow explicit binders for type variables. ··· 17 18 18 19 ### Code generation and optimizations: 19 20 21 21 + - #10578: Increase the number of integer registers used for 22 22 + parameter passing on PowerPC (16 registers) and on s390x (8 registers). 23 23 + (Xavier Leroy, review by Mark Shinwell) 24 24 + 20 25 ### Standard library: 21 26 22 27 * #7812, #10475: `Filename.chop_suffix name suff` now checks that `suff` ··· 31 36 - #10526: add Random.bits32, Random.bits64, Random.nativebits 32 37 (Xavier Leroy, review by Gabriel Scherer and François Bobot) 33 38 39 39 + * #10568: remove Obj.marshal and Obj.unmarshal 40 40 + (these functions have been deprecated for a while and are superseded 41 41 + by the functions from module Marshal) 42 42 + (François Pottier, review by Gabriel Scherer and Kate Deplaix) 43 43 + 44 44 + - #10545: Add In_channel and Out_channel modules. 45 45 + (Nicolás Ojeda Bär, review by Daniel Bünzli, Simon Cruanes, Gabriel Scherer, 46 46 + Guillaume Munch-Maccagnoni, Alain Frisch and Xavier Leroy) 47 47 + 34 48 ### Other libraries: 35 49 36 50 - #10192: Add support for Unix domain sockets on Windows and use them ··· 54 68 `OCAML_COLOR` is set, its setting takes precedence over `NO_COLOR`. 55 69 (Nicolás Ojeda Bär, report by Gabriel Scherer, review by Daniel Bünzli, 56 70 Gabriel Scherer and David Allsopp) 71 71 + 72 72 + - #10565: Toplevel value printing: truncate strings only after 8 bytes. 73 73 + (Wiktor Kuchta, review by Xavier Leroy) 74 74 + 75 75 + ### Debugging: 76 76 + 77 77 + - #10517, #10594: when running ocamldebug on a program linked with the 78 78 + threads library, don't fail immediately; instead, allow debugging 79 79 + until the program creates a thread for the first time, then fail cleanly. 80 80 + (Xavier Leroy, report by @anentropic, review by Gabriel Scherer) 57 81 58 82 ### Manual and documentation: 59 83 ··· 126 150 127 151 - #10539: Field kinds should be kept when copying types 128 152 Losing the sharing meant that one could desynchronize them between several 129 129 - occurences of self, allowing a method to be both public and hidden, 153 153 + occurrences of self, allowing a method to be both public and hidden, 130 154 which broke type soundness. 131 155 (Jacques Garrigue, review by Leo White) 132 156 ··· 582 606 "interval" patterns `c1..c2`. 583 607 (Guillaume Petiot, review by Gabriel Scherer and Nicolás Ojeda Bär) 584 608 609 609 + - #7449 #10458: Change the size heuristics of switch in flambda to avoid 610 610 + inlining too large jump tables. (Pierre Chambart, review by Gabriel Scherer, 611 611 + report by Mark Hayden) 612 612 + 585 613 ### Build system: 586 614 587 615 - #10289, #10406: Do not print option documentation in usage messages. ··· 744 772 745 773 - #10550, #10551: fix pretty-print of gadt-pattern-with-type-vars 746 774 (Chet Murthy, review by Gabriel Scherer) 775 775 + 776 776 + - #10584, #10856: Standard Library documentation build no longer fails if 777 777 + optional libraries have been disabled. 778 778 + (David Allsopp, report by Yuri Victorovich review by Florian Angeletti) 747 779 748 780 OCaml 4.12, maintenance version 749 781 -------------------------------

+14 -5

api_docgen/Makefile.docfiles

reviewed

··· 42 42 43 43 stdlib_UNPREFIXED=$(filter-out pervasives, $(STDLIB_MODULE_BASENAMES)) 44 44 45 45 - otherlibref= \ 46 46 - $(str_MLIS:%.mli=%) \ 47 47 - $(unix_MLIS:%.mli=%) \ 48 48 - $(dynlink_MLIS:%.mli=%) \ 49 49 - $(thread_MLIS:%.mli=%) 45 45 + otherlibref := $(dynlink_MLIS:%.mli=%) 46 46 + 47 47 + ifneq "$(filter str,$(OTHERLIBRARIES))" "" 48 48 + otherlibref += $(str_MLIS:%.mli=%) 49 49 + endif 50 50 + 51 51 + ifneq "$(filter %unix,$(OTHERLIBRARIES))" "" 52 52 + otherlibref += $(unix_MLIS:%.mli=%) 53 53 + endif 54 54 + 55 55 + ifneq "$(filter systhreads,$(OTHERLIBRARIES))" "" 56 56 + otherlibref += $(thread_MLIS:%.mli=%) 57 57 + endif 58 58 + 50 59 libref_EXTRA=stdlib__pervasives 51 60 libref_TEXT=Ocaml_operators Format_tutorial 52 61 libref_C=$(call capitalize,$(libref) $(libref_EXTRA))

+4 -4

asmcomp/power/proc.ml

reviewed

··· 155 155 let outgoing ofs = Outgoing ofs 156 156 let not_supported _ofs = fatal_error "Proc.loc_results: cannot call" 157 157 158 158 - let max_arguments_for_tailcalls = 8 158 158 + let max_arguments_for_tailcalls = 16 159 159 160 160 let loc_arguments arg = 161 161 - calling_conventions 0 7 100 112 outgoing arg 161 161 + calling_conventions 0 15 100 112 outgoing arg 162 162 163 163 let loc_parameters arg = 164 164 - let (loc, _ofs) = calling_conventions 0 7 100 112 incoming arg 164 164 + let (loc, _ofs) = calling_conventions 0 15 100 112 incoming arg 165 165 in loc 166 166 167 167 let loc_results res = 168 168 - let (loc, _ofs) = calling_conventions 0 7 100 112 not_supported res 168 168 + let (loc, _ofs) = calling_conventions 0 15 100 112 not_supported res 169 169 in loc 170 170 171 171 (* C calling conventions for ELF32:

+4 -4

asmcomp/s390x/proc.ml

reviewed

··· 128 128 let outgoing ofs = Outgoing ofs 129 129 let not_supported _ofs = fatal_error "Proc.loc_results: cannot call" 130 130 131 131 - let max_arguments_for_tailcalls = 5 131 131 + let max_arguments_for_tailcalls = 8 132 132 133 133 let loc_arguments arg = 134 134 - calling_conventions 0 4 100 103 outgoing 0 arg 134 134 + calling_conventions 0 7 100 103 outgoing 0 arg 135 135 let loc_parameters arg = 136 136 - let (loc, _ofs) = calling_conventions 0 4 100 103 incoming 0 arg in loc 136 136 + let (loc, _ofs) = calling_conventions 0 7 100 103 incoming 0 arg in loc 137 137 let loc_results res = 138 138 - let (loc, _ofs) = calling_conventions 0 4 100 103 not_supported 0 res in loc 138 138 + let (loc, _ofs) = calling_conventions 0 7 100 103 not_supported 0 res in loc 139 139 140 140 (* C calling conventions under SVR4: 141 141 use GPR 2-6 and FPR 0,2,4,6 just like ML calling conventions.

+4

manual/src/library/stdlib-blurb.etex

reviewed

··· 77 77 \end{tabular} 78 78 \subsubsection*{sss:stdlib-io}{input/output:} 79 79 \begin{tabular}{lll} 80 80 + "In_channel" & p.~\stdpageref{In-underscorechannel} & input channels \\ 81 81 + "Out_channel" & p.~\stdpageref{Out-underscorechannel} & output channels \\ 80 82 "Format" & p.~\stdpageref{Format} & pretty printing with automatic 81 83 indentation and line breaking \\ 82 84 "Marshal" & p.~\stdpageref{Marshal} & marshaling of data structures \\ ··· 130 132 \stddocitem{Gc}{memory management control and statistics; finalized values} 131 133 \stddocitem{Genlex}{a generic lexical analyzer} 132 134 \stddocitem{Hashtbl}{hash tables and hash functions} 135 135 + \stddocitem{In_channel}{input channels} 133 136 \stddocitem{Int}{integers} 134 137 \stddocitem{Int32}{32-bit integers} 135 138 \stddocitem{Int64}{64-bit integers} ··· 143 146 \stddocitem{Nativeint}{processor-native integers} 144 147 \stddocitem{Oo}{object-oriented extension} 145 148 \stddocitem{Option}{option values} 149 149 + \stddocitem{Out_channel}{output channels} 146 150 \stddocitem{Parsing}{the run-time library for parsers generated by \texttt{ocamlyacc}} 147 151 \stddocitem{Printexc}{facilities for printing exceptions} 148 152 \stddocitem{Printf}{formatting printing functions}

+2 -2

manual/src/tutorials/gadtexamples.etex

reviewed

··· 68 68 GADT type variable, this variable flows to the type of the recursive 69 69 function, and thus escapes its scope. In the above example, this happens 70 70 in the branch "App(f,x)" when "eval" is called with "f" as an argument. 71 71 - In this branch, the type of "f" is "($App_ 'b-> a)". The prefix "$" in 72 72 - "$App_ 'b" denotes an existential type named by the compiler 71 71 + In this branch, the type of "f" is "($App_'b -> a)". The prefix "$" in 72 72 + "$App_'b" denotes an existential type named by the compiler 73 73 (see~\ref{s:existential-names}). Since the type of "eval" is 74 74 "'a term -> 'a", the call "eval f" makes the existential type "$App_'b" 75 75 flow to the type variable "'a" and escape its scope. This triggers the

+1 -1

manual/tests/check-stdlib-modules

reviewed

··· 10 10 exitcode=0 11 11 for i in `cat $TMPDIR/stdlib-$$-modules`; do 12 12 case $i in 13 13 - Stdlib | Camlinternal* | *Labels | Obj | Pervasives) continue;; 13 13 + Stdlib | Camlinternal* | *Labels | Obj | Pervasives | In_channel | Out_channel) continue;; 14 14 esac 15 15 grep -q -e '"'$i'" & p\.~\\stdpageref{'$i'} &' $1/manual/src/library/stdlib-blurb.etex || { 16 16 echo "Module $i is missing from the module description in library/stdlib-blurb.etex." >&2

+6 -2

middle_end/flambda/inlining_cost.ml

reviewed

··· 89 89 List.iter (fun (_, lam) -> lambda_named_size lam) bindings; 90 90 lambda_size body 91 91 | Switch (_, sw) -> 92 92 - let aux = function _::_::_ -> size := !size + 5 | _ -> () in 93 93 - aux sw.consts; aux sw.blocks; 92 92 + let cost cases = 93 93 + let size = List.length cases in 94 94 + if size <= 1 then 0 95 95 + else 3 + size 96 96 + in 97 97 + size := !size + cost sw.consts + cost sw.blocks; 94 98 List.iter (fun (_, lam) -> lambda_size lam) sw.consts; 95 99 List.iter (fun (_, lam) -> lambda_size lam) sw.blocks; 96 100 Option.iter lambda_size sw.failaction

+1

ocaml-variants.opam

reviewed

··· 24 24 25 25 opam-version: "2.0" 26 26 version: "4.14.0+domains" 27 27 + license: "LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception" 27 28 synopsis: "OCaml 4.14.0, with support for multicore domains (dev branch)" 28 29 maintainer: "kc@kcsrk.info" 29 30 authors: "Xavier Leroy and many contributors"

+15 -9

otherlibs/systhreads/st_stubs.c

reviewed

··· 20 20 #include <stdio.h> 21 21 22 22 #include "caml/alloc.h" 23 23 - #include "caml/domain_state.h" 24 24 - #include "caml/platform.h" 23 23 + #include "caml/backtrace.h" 24 24 + #include "caml/callback.h" 25 25 #include "caml/custom.h" 26 26 - #include "caml/memory.h" 27 27 - #include "caml/io.h" 26 26 + #include "caml/debugger.h" 27 27 + #include "caml/domain.h" 28 28 + #include "caml/domain_state.h" 28 29 #include "caml/fail.h" 29 29 - #include "caml/startup.h" 30 30 #include "caml/fiber.h" 31 31 - #include "caml/callback.h" 32 32 - #include "caml/weak.h" 33 31 #include "caml/finalise.h" 34 34 - #include "caml/domain.h" 32 32 + #include "caml/io.h" 33 33 + #include "caml/platform.h" 35 34 #include "caml/printexc.h" 36 36 - #include "caml/backtrace.h" 35 35 + #include "caml/memory.h" 37 36 #include "caml/signals.h" 37 37 + #include "caml/startup.h" 38 38 + #include "caml/weak.h" 38 39 39 40 #include "caml/sync.h" 40 41 #include "st_posix.h" ··· 528 529 caml_thread_t th; 529 530 st_retcode err; 530 531 532 532 + #ifndef NATIVE_CODE 533 533 + if (caml_debugger_in_use) 534 534 + caml_fatal_error("ocamldebug does not support multithreaded programs"); 535 535 + #endif 536 536 + /* Create a thread info block */ 531 537 th = caml_thread_new_info(); 532 538 th->descr = caml_thread_new_descriptor(clos); 533 539

+3 -7

runtime/debugger.c

reviewed

··· 137 137 dbg_in = caml_open_descriptor_in(dbg_socket); 138 138 dbg_out = caml_open_descriptor_out(dbg_socket); 139 139 /* The code in this file does not bracket channel I/O operations with 140 140 - Lock and Unlock, so fail if those are not no-ops. */ 141 141 - /* TODO: multicore equivalent needed here: 142 142 - if (caml_channel_mutex_lock != NULL || 143 143 - caml_channel_mutex_unlock != NULL || 144 144 - caml_channel_mutex_unlock_exn != NULL) 145 145 - caml_fatal_error("debugger does not support channel locks"); 146 146 - */ 140 140 + Lock and Unlock, but this is safe because the debugger only works 141 141 + with single-threaded programs. The program being debugged 142 142 + will abort when it creates a thread. */ 147 143 if (!caml_debugger_in_use) caml_putword(dbg_out, -1); /* first connection */ 148 144 #ifdef _WIN32 149 145 caml_putword(dbg_out, _getpid());

+16 -2

stdlib/.depend

reviewed

··· 389 389 stdlib__Hashtbl.cmi 390 390 stdlib__Hashtbl.cmi : hashtbl.mli \ 391 391 stdlib__Seq.cmi 392 392 + stdlib__In_channel.cmo : in_channel.ml \ 393 393 + stdlib.cmi \ 394 394 + stdlib__In_channel.cmi 395 395 + stdlib__In_channel.cmx : in_channel.ml \ 396 396 + stdlib.cmx \ 397 397 + stdlib__In_channel.cmi 398 398 + stdlib__In_channel.cmi : in_channel.mli \ 399 399 + stdlib.cmi 392 400 stdlib__Int.cmo : int.ml \ 393 401 stdlib.cmi \ 394 402 stdlib__Int.cmi ··· 506 514 stdlib__Obj.cmo : obj.ml \ 507 515 stdlib__Sys.cmi \ 508 516 stdlib__Nativeint.cmi \ 509 509 - stdlib__Marshal.cmi \ 510 517 stdlib__Int32.cmi \ 511 518 stdlib__Obj.cmi 512 519 stdlib__Obj.cmx : obj.ml \ 513 520 stdlib__Sys.cmx \ 514 521 stdlib__Nativeint.cmx \ 515 515 - stdlib__Marshal.cmx \ 516 522 stdlib__Int32.cmx \ 517 523 stdlib__Obj.cmi 518 524 stdlib__Obj.cmi : obj.mli \ ··· 533 539 stdlib__Option.cmi 534 540 stdlib__Option.cmi : option.mli \ 535 541 stdlib__Seq.cmi 542 542 + stdlib__Out_channel.cmo : out_channel.ml \ 543 543 + stdlib.cmi \ 544 544 + stdlib__Out_channel.cmi 545 545 + stdlib__Out_channel.cmx : out_channel.ml \ 546 546 + stdlib.cmx \ 547 547 + stdlib__Out_channel.cmi 548 548 + stdlib__Out_channel.cmi : out_channel.mli \ 549 549 + stdlib.cmi 536 550 stdlib__Parsing.cmo : parsing.ml \ 537 551 stdlib__Obj.cmi \ 538 552 stdlib__Lexing.cmi \

+1 -1

stdlib/StdlibModules

reviewed

··· 43 43 printexc fun gc digest random hashtbl weak \ 44 44 format scanf callback camlinternalOO oo camlinternalMod genlex ephemeron \ 45 45 filename complex arrayLabels listLabels bytesLabels stringLabels moreLabels \ 46 46 - stdLabels bigarray 46 46 + stdLabels bigarray in_channel out_channel 47 47 48 48 STDLIB_PREFIXED_MODULES=\ 49 49 $(filter-out stdlib camlinternal%, $(STDLIB_MODULE_BASENAMES))

+66

stdlib/in_channel.ml

reviewed

··· 1 1 + (**************************************************************************) 2 2 + (* *) 3 3 + (* OCaml *) 4 4 + (* *) 5 5 + (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 6 + (* *) 7 7 + (* Copyright 2021 Institut National de Recherche en Informatique et *) 8 8 + (* en Automatique. *) 9 9 + (* *) 10 10 + (* All rights reserved. This file is distributed under the terms of *) 11 11 + (* the GNU Lesser General Public License version 2.1, with the *) 12 12 + (* special exception on linking described in the file LICENSE. *) 13 13 + (* *) 14 14 + (**************************************************************************) 15 15 + 16 16 + type t = in_channel 17 17 + 18 18 + type open_flag = Stdlib.open_flag = 19 19 + | Open_rdonly 20 20 + | Open_wronly 21 21 + | Open_append 22 22 + | Open_creat 23 23 + | Open_trunc 24 24 + | Open_excl 25 25 + | Open_binary 26 26 + | Open_text 27 27 + | Open_nonblock 28 28 + 29 29 + let stdin = Stdlib.stdin 30 30 + let open_bin = Stdlib.open_in_bin 31 31 + let open_text = Stdlib.open_in 32 32 + let open_gen = Stdlib.open_in_gen 33 33 + let seek = Stdlib.LargeFile.seek_in 34 34 + let pos = Stdlib.LargeFile.pos_in 35 35 + let length = Stdlib.LargeFile.in_channel_length 36 36 + let close = Stdlib.close_in 37 37 + let close_noerr = Stdlib.close_in_noerr 38 38 + 39 39 + let input_char ic = 40 40 + match Stdlib.input_char ic with 41 41 + | c -> Some c 42 42 + | exception End_of_file -> None 43 43 + 44 44 + let input_byte ic = 45 45 + match Stdlib.input_byte ic with 46 46 + | n -> Some n 47 47 + | exception End_of_file -> None 48 48 + 49 49 + let input_line ic = 50 50 + match Stdlib.input_line ic with 51 51 + | s -> Some s 52 52 + | exception End_of_file -> None 53 53 + 54 54 + let input = Stdlib.input 55 55 + 56 56 + let really_input ic buf pos len = 57 57 + match Stdlib.really_input ic buf pos len with 58 58 + | () -> Some () 59 59 + | exception End_of_file -> None 60 60 + 61 61 + let really_input_string ic len = 62 62 + match Stdlib.really_input_string ic len with 63 63 + | s -> Some s 64 64 + | exception End_of_file -> None 65 65 + 66 66 + let set_binary_mode = Stdlib.set_binary_mode_in

+136

stdlib/in_channel.mli

reviewed

··· 1 1 + (**************************************************************************) 2 2 + (* *) 3 3 + (* OCaml *) 4 4 + (* *) 5 5 + (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 6 + (* *) 7 7 + (* Copyright 2021 Institut National de Recherche en Informatique et *) 8 8 + (* en Automatique. *) 9 9 + (* *) 10 10 + (* All rights reserved. This file is distributed under the terms of *) 11 11 + (* the GNU Lesser General Public License version 2.1, with the *) 12 12 + (* special exception on linking described in the file LICENSE. *) 13 13 + (* *) 14 14 + (**************************************************************************) 15 15 + 16 16 + (** Input channels. 17 17 + 18 18 + @since 4.14.0 *) 19 19 + 20 20 + type t = in_channel 21 21 + (** The type of input channel. *) 22 22 + 23 23 + type open_flag = Stdlib.open_flag = 24 24 + | Open_rdonly (** open for reading. *) 25 25 + | Open_wronly (** open for writing. *) 26 26 + | Open_append (** open for appending: always write at end of file. *) 27 27 + | Open_creat (** create the file if it does not exist. *) 28 28 + | Open_trunc (** empty the file if it already exists. *) 29 29 + | Open_excl (** fail if Open_creat and the file already exists. *) 30 30 + | Open_binary (** open in binary mode (no conversion). *) 31 31 + | Open_text (** open in text mode (may perform conversions). *) 32 32 + | Open_nonblock (** open in non-blocking mode. *) 33 33 + (** Opening modes for {!open_gen}. *) 34 34 + 35 35 + val stdin : t 36 36 + (** The standard input for the process. *) 37 37 + 38 38 + val open_bin : string -> t 39 39 + (** Open the named file for reading, and return a new input channel on that 40 40 + file, positioned at the beginning of the file. *) 41 41 + 42 42 + val open_text : string -> t 43 43 + (** Same as {!open_bin}, but the file is opened in text mode, so that newline 44 44 + translation takes place during reads. On operating systems that do not 45 45 + distinguish between text mode and binary mode, this function behaves like 46 46 + {!open_bin}. *) 47 47 + 48 48 + val open_gen : open_flag list -> int -> string -> t 49 49 + (** [open_gen mode perm filename] opens the named file for reading, as described 50 50 + above. The extra arguments [mode] and [perm] specify the opening mode and 51 51 + file permissions. {!open_text} and {!open_bin} are special cases of this 52 52 + function. *) 53 53 + 54 54 + val seek : t -> int64 -> unit 55 55 + (** [seek chan pos] sets the current reading position to [pos] for channel 56 56 + [chan]. This works only for regular files. On files of other kinds, the 57 57 + behavior is unspecified. *) 58 58 + 59 59 + val pos : t -> int64 60 60 + (** Return the current reading position for the given channel. For files opened 61 61 + in text mode under Windows, the returned position is approximate (owing to 62 62 + end-of-line conversion); in particular, saving the current position with 63 63 + {!pos}, then going back to this position using {!seek} will not work. For 64 64 + this programming idiom to work reliably and portably, the file must be 65 65 + opened in binary mode. *) 66 66 + 67 67 + val length : t -> int64 68 68 + (** Return the size (number of characters) of the regular file on which the 69 69 + given channel is opened. If the channel is opened on a file that is not a 70 70 + regular file, the result is meaningless. The returned size does not take 71 71 + into account the end-of-line translations that can be performed when reading 72 72 + from a channel opened in text mode. *) 73 73 + 74 74 + val close : t -> unit 75 75 + (** Close the given channel. Input functions raise a [Sys_error] exception when 76 76 + they are applied to a closed input channel, except {!close}, which does 77 77 + nothing when applied to an already closed channel. *) 78 78 + 79 79 + val close_noerr : t -> unit 80 80 + (** Same as {!close}, but ignore all errors. *) 81 81 + 82 82 + val input_char : t -> char option 83 83 + (** Read one character from the given input channel. Returns [None] if there 84 84 + are no more characters to read. *) 85 85 + 86 86 + val input_byte : t -> int option 87 87 + (** Same as {!input_char}, but return the 8-bit integer representing the 88 88 + character. Returns [None] if the end of file was reached. *) 89 89 + 90 90 + val input_line : t -> string option 91 91 + (** [input_line ic] reads characters from [ic] until a newline or the end of 92 92 + file is reached. Returns the string of all characters read, without the 93 93 + newline (if any). Returns [None] if the end of the file has been reached. 94 94 + In particular, this will be the case if the last line of input is empty. 95 95 + 96 96 + A newline is the character [\n] unless the file is open in text mode and 97 97 + {!Sys.win32} is [true] in which case it is the sequence of characters 98 98 + [\r\n]. *) 99 99 + 100 100 + val input : t -> bytes -> int -> int -> int 101 101 + (** [input ic buf pos len] reads up to [len] characters from the given channel 102 102 + [ic], storing them in byte sequence [buf], starting at character number 103 103 + [pos]. It returns the actual number of characters read, between 0 and [len] 104 104 + (inclusive). A return value of 0 means that the end of file was reached. 105 105 + 106 106 + Use {!really_input} to read exactly [len] characters. 107 107 + 108 108 + @raise Invalid_argument if [pos] and [len] do not designate a valid range of 109 109 + [buf]. *) 110 110 + 111 111 + val really_input : t -> bytes -> int -> int -> unit option 112 112 + (** [really_input ic buf pos len] reads [len] characters from channel [ic], 113 113 + storing them in byte sequence [buf], starting at character number [pos]. 114 114 + 115 115 + Returns [None] if the end of file is reached before [len] characters have 116 116 + been read. 117 117 + 118 118 + @raise Invalid_argument if [pos] and [len] do not designate a valid range of 119 119 + [buf]. *) 120 120 + 121 121 + val really_input_string : t -> int -> string option 122 122 + (** [really_input_string ic len] reads [len] characters from channel [ic] and 123 123 + returns them in a new string. Returns [None] if the end of file is reached 124 124 + before [len] characters have been read. *) 125 125 + 126 126 + val set_binary_mode : t -> bool -> unit 127 127 + (** [set_binary_mode ic true] sets the channel [ic] to binary mode: no 128 128 + translations take place during input. 129 129 + 130 130 + [set_binary_mode ic false] sets the channel [ic] to text mode: depending 131 131 + on the operating system, some translations may take place during input. For 132 132 + instance, under Windows, end-of-lines will be translated from [\r\n] to 133 133 + [\n]. 134 134 + 135 135 + This function has no effect under operating systems that do not distinguish 136 136 + between text mode and binary mode. *)

-5

stdlib/obj.ml

reviewed

··· 49 49 external add_offset : t -> Int32.t -> t = "caml_obj_add_offset" 50 50 external with_tag : int -> t -> t = "caml_obj_with_tag" 51 51 52 52 - let marshal (obj : t) = 53 53 - Marshal.to_bytes obj [] 54 54 - let unmarshal str pos = 55 55 - (Marshal.from_bytes str pos, pos + Marshal.total_size str pos) 56 56 - 57 52 let first_non_constant_constructor_tag = 0 58 53 let last_non_constant_constructor_tag = 243 59 54

-8

stdlib/obj.mli

reviewed

··· 127 127 val [@inline always] extension_id : extension_constructor -> int 128 128 [@@ocaml.deprecated "use Obj.Extension_constructor.id"] 129 129 130 130 - (** The following two functions are deprecated. Use module {!Marshal} 131 131 - instead. *) 132 132 - 133 133 - val marshal : t -> bytes 134 134 - [@@ocaml.deprecated "Use Marshal.to_bytes instead."] 135 135 - val unmarshal : bytes -> int -> t * int 136 136 - [@@ocaml.deprecated "Use Marshal.from_bytes and Marshal.total_size instead."] 137 137 - 138 130 module Ephemeron: sig 139 131 (** Ephemeron with arbitrary arity and untyped *) 140 132

+47

stdlib/out_channel.ml

reviewed

··· 1 1 + (**************************************************************************) 2 2 + (* *) 3 3 + (* OCaml *) 4 4 + (* *) 5 5 + (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 6 + (* *) 7 7 + (* Copyright 2021 Institut National de Recherche en Informatique et *) 8 8 + (* en Automatique. *) 9 9 + (* *) 10 10 + (* All rights reserved. This file is distributed under the terms of *) 11 11 + (* the GNU Lesser General Public License version 2.1, with the *) 12 12 + (* special exception on linking described in the file LICENSE. *) 13 13 + (* *) 14 14 + (**************************************************************************) 15 15 + 16 16 + type t = out_channel 17 17 + 18 18 + type open_flag = Stdlib.open_flag = 19 19 + | Open_rdonly 20 20 + | Open_wronly 21 21 + | Open_append 22 22 + | Open_creat 23 23 + | Open_trunc 24 24 + | Open_excl 25 25 + | Open_binary 26 26 + | Open_text 27 27 + | Open_nonblock 28 28 + 29 29 + let stdout = Stdlib.stdout 30 30 + let stderr = Stdlib.stderr 31 31 + let open_bin = Stdlib.open_out_bin 32 32 + let open_text = Stdlib.open_out 33 33 + let open_gen = Stdlib.open_out_gen 34 34 + let seek = Stdlib.LargeFile.seek_out 35 35 + let pos = Stdlib.LargeFile.pos_out 36 36 + let length = Stdlib.LargeFile.out_channel_length 37 37 + let close = Stdlib.close_out 38 38 + let close_noerr = Stdlib.close_out_noerr 39 39 + let flush = Stdlib.flush 40 40 + let flush_all = Stdlib.flush_all 41 41 + let output_char = Stdlib.output_char 42 42 + let output_byte = Stdlib.output_byte 43 43 + let output_string = Stdlib.output_string 44 44 + let output_bytes = Stdlib.output_bytes 45 45 + let output = Stdlib.output 46 46 + let output_substring = Stdlib.output_substring 47 47 + let set_binary_mode = Stdlib.set_binary_mode_out

+131

stdlib/out_channel.mli

reviewed

··· 1 1 + (**************************************************************************) 2 2 + (* *) 3 3 + (* OCaml *) 4 4 + (* *) 5 5 + (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 6 + (* *) 7 7 + (* Copyright 2021 Institut National de Recherche en Informatique et *) 8 8 + (* en Automatique. *) 9 9 + (* *) 10 10 + (* All rights reserved. This file is distributed under the terms of *) 11 11 + (* the GNU Lesser General Public License version 2.1, with the *) 12 12 + (* special exception on linking described in the file LICENSE. *) 13 13 + (* *) 14 14 + (**************************************************************************) 15 15 + 16 16 + (** Output channels. 17 17 + 18 18 + @since 4.14.0 *) 19 19 + 20 20 + type t = out_channel 21 21 + (** The type of output channel. *) 22 22 + 23 23 + type open_flag = Stdlib.open_flag = 24 24 + | Open_rdonly (** open for reading. *) 25 25 + | Open_wronly (** open for writing. *) 26 26 + | Open_append (** open for appending: always write at end of file. *) 27 27 + | Open_creat (** create the file if it does not exist. *) 28 28 + | Open_trunc (** empty the file if it already exists. *) 29 29 + | Open_excl (** fail if Open_creat and the file already exists. *) 30 30 + | Open_binary (** open in binary mode (no conversion). *) 31 31 + | Open_text (** open in text mode (may perform conversions). *) 32 32 + | Open_nonblock (** open in non-blocking mode. *) 33 33 + (** Opening modes for {!open_gen}. *) 34 34 + 35 35 + val stdout : t 36 36 + (** The standard output for the process. *) 37 37 + 38 38 + val stderr : t 39 39 + (** The standard error output for the process. *) 40 40 + 41 41 + val open_bin : string -> t 42 42 + (** Open the named file for writing, and return a new output channel on that 43 43 + file, positioned at the beginning of the file. The file is truncated to zero 44 44 + length if it already exists. It is created if it does not already exists. *) 45 45 + 46 46 + val open_text : string -> t 47 47 + (** Same as {!open_bin}, but the file is opened in text mode, so that newline 48 48 + translation takes place during writes. On operating systems that do not 49 49 + distinguish between text mode and binary mode, this function behaves like 50 50 + {!open_bin}. *) 51 51 + 52 52 + val open_gen : open_flag list -> int -> string -> t 53 53 + (** [open_gen mode perm filename] opens the named file for writing, as described 54 54 + above. The extra argument [mode] specifies the opening mode. The extra 55 55 + argument [perm] specifies the file permissions, in case the file must be 56 56 + created. {!open_text} and {!open_bin} are special cases of this 57 57 + function. *) 58 58 + 59 59 + val seek : t -> int64 -> unit 60 60 + (** [seek chan pos] sets the current writing position to [pos] for channel 61 61 + [chan]. This works only for regular files. On files of other kinds (such as 62 62 + terminals, pipes and sockets), the behavior is unspecified. *) 63 63 + 64 64 + val pos : t -> int64 65 65 + (** Return the current writing position for the given channel. Does not work on 66 66 + channels opened with the [Open_append] flag (returns unspecified results). 67 67 + 68 68 + For files opened in text mode under Windows, the returned position is 69 69 + approximate (owing to end-of-line conversion); in particular, saving the 70 70 + current position with {!pos}, then going back to this position using {!seek} 71 71 + will not work. For this programming idiom to work reliably and portably, 72 72 + the file must be opened in binary mode. *) 73 73 + 74 74 + val length : t -> int64 75 75 + (** Return the size (number of characters) of the regular file on which the 76 76 + given channel is opened. If the channel is opened on a file that is not a 77 77 + regular file, the result is meaningless. *) 78 78 + 79 79 + val close : t -> unit 80 80 + (** Close the given channel, flushing all buffered write operations. Output 81 81 + functions raise a [Sys_error] exception when they are applied to a closed 82 82 + output channel, except {!close} and {!flush}, which do nothing when applied 83 83 + to an already closed channel. Note that {!close} may raise [Sys_error] if 84 84 + the operating system signals an error when flushing or closing. *) 85 85 + 86 86 + val close_noerr : t -> unit 87 87 + (** Same as {!close}, but ignore all errors. *) 88 88 + 89 89 + val flush : t -> unit 90 90 + (** Flush the buffer associated with the given output channel, performing all 91 91 + pending writes on that channel. Interactive programs must be careful about 92 92 + flushing standard output and standard error at the right time. *) 93 93 + 94 94 + val flush_all : unit -> unit 95 95 + (** Flush all open output channels; ignore errors. *) 96 96 + 97 97 + val output_char : t -> char -> unit 98 98 + (** Write the character on the given output channel. *) 99 99 + 100 100 + val output_byte : t -> int -> unit 101 101 + (** Write one 8-bit integer (as the single character with that code) on the 102 102 + given output channel. The given integer is taken modulo 256. *) 103 103 + 104 104 + val output_string : t -> string -> unit 105 105 + (** Write the string on the given output channel. *) 106 106 + 107 107 + val output_bytes : t -> bytes -> unit 108 108 + (** Write the byte sequence on the given output channel. *) 109 109 + 110 110 + val output : t -> bytes -> int -> int -> unit 111 111 + (** [output oc buf pos len] writes [len] characters from byte sequence [buf], 112 112 + starting at offset [pos], to the given output channel [oc]. 113 113 + 114 114 + @raise Invalid_argument if [pos] and [len] do not designate a valid range of 115 115 + [buf]. *) 116 116 + 117 117 + val output_substring : t -> string -> int -> int -> unit 118 118 + (** Same as {!output} but take a string as argument instead of a byte 119 119 + sequence. *) 120 120 + 121 121 + val set_binary_mode : t -> bool -> unit 122 122 + (** [set_binary_mode oc true] sets the channel [oc] to binary mode: no 123 123 + translations take place during output. 124 124 + 125 125 + [set_binary_mode oc false] sets the channel [oc] to text mode: depending on 126 126 + the operating system, some translations may take place during output. For 127 127 + instance, under Windows, end-of-lines will be translated from [\n] to 128 128 + [\r\n]. 129 129 + 130 130 + This function has no effect under operating systems that do not distinguish 131 131 + between text mode and binary mode. *)

+2

stdlib/stdlib.ml

reviewed

··· 605 605 module Gc = Gc 606 606 module Genlex = Genlex 607 607 module Hashtbl = Hashtbl 608 608 + module In_channel = In_channel 608 609 module Int = Int 609 610 module Int32 = Int32 610 611 module Int64 = Int64 ··· 620 621 module Obj = Obj 621 622 module Oo = Oo 622 623 module Option = Option 624 624 + module Out_channel = Out_channel 623 625 module Parsing = Parsing 624 626 module Pervasives = Pervasives 625 627 module Printexc = Printexc

+4 -2

stdlib/stdlib.mli

reviewed

··· 1128 1128 val input_byte : in_channel -> int 1129 1129 (** Same as {!Stdlib.input_char}, but return the 8-bit integer representing 1130 1130 the character. 1131 1131 - @raise End_of_file if an end of file was reached. *) 1131 1131 + @raise End_of_file if the end of file was reached. *) 1132 1132 1133 1133 val input_binary_int : in_channel -> int 1134 1134 (** Read an integer encoded in binary format (4 bytes, big-endian) 1135 1135 from the given input channel. See {!Stdlib.output_binary_int}. 1136 1136 - @raise End_of_file if an end of file was reached while reading the 1136 1136 + @raise End_of_file if the end of file was reached while reading the 1137 1137 integer. *) 1138 1138 1139 1139 val input_value : in_channel -> 'a ··· 1403 1403 module Genlex = Genlex 1404 1404 [@@deprecated "Use the camlp-streams library instead."] 1405 1405 module Hashtbl = Hashtbl 1406 1406 + module In_channel = In_channel 1406 1407 module Int = Int 1407 1408 module Int32 = Int32 1408 1409 module Int64 = Int64 ··· 1418 1419 module Obj = Obj 1419 1420 module Oo = Oo 1420 1421 module Option = Option 1422 1422 + module Out_channel = Out_channel 1421 1423 module Parsing = Parsing 1422 1424 module Pervasives = Pervasives 1423 1425 [@@deprecated "Use Stdlib instead.\n\

+1 -1

testsuite/tests/asmcomp/polling_insertion.ml

reviewed

··· 142 142 allocating_func_match minors_before 143 143 144 144 (* This function tests that polls are not added to the back edge of 145 145 - where loop bodies allocat unconditionally *) 145 145 + where loop bodies allocate unconditionally *) 146 146 let polls_not_added_to_allocating_loops () = 147 147 let current_minors = ref (minor_gcs ()) in 148 148 request_minor_gc ();

+109 -54

testsuite/tests/basic/patmatch_for_multiple.ml

reviewed

··· 1 1 (* TEST 2 2 - flags = "-drawlambda" 2 2 + flags = "-drawlambda -dlambda" 3 3 * expect 4 4 *) 5 5 6 6 - (* Successful flattening *) 6 6 + (* Note: the tests below contain *both* the -drawlambda and 7 7 + the -dlambda intermediate representations: 8 8 + -drawlambda is the Lambda code generated directly by the 9 9 + pattern-matching compiler; it contain "alias" bindings or static 10 10 + exits that are unused, and will be removed by simplification, or 11 11 + that are used only once, and will be inlined by simplification. 12 12 + -dlambda is the Lambda code resulting from simplification. 13 13 + 14 14 + The -drawlambda output more closely matches what the 15 15 + pattern-compiler produces, and the -dlambda output more closely 16 16 + matches the final generated code. 17 17 + 18 18 + In this test we decided to show both to notice that some allocations 19 19 + are "optimized away" during simplification (see "here flattening is 20 20 + an optimization" below). 21 21 + *) 7 22 8 23 match (3, 2, 1) with 9 24 | (_, 3, _) ··· 11 26 | _ -> false 12 27 ;; 13 28 [%%expect{| 14 14 - (let (*match*/92 = 3 *match*/93 = 2 *match*/94 = 1) 29 29 + (let (*match*/94 = 3 *match*/95 = 2 *match*/96 = 1) 15 30 (catch 16 31 (catch 17 17 - (catch (if (!= *match*/93 3) (exit 3) (exit 1)) with (3) 18 18 - (if (!= *match*/92 1) (exit 2) (exit 1))) 32 32 + (catch (if (!= *match*/95 3) (exit 3) (exit 1)) with (3) 33 33 + (if (!= *match*/94 1) (exit 2) (exit 1))) 19 34 with (2) 0) 20 35 with (1) 1)) 36 36 + (let (*match*/94 = 3 *match*/95 = 2 *match*/96 = 1) 37 37 + (catch (if (!= *match*/95 3) (if (!= *match*/94 1) 0 (exit 1)) (exit 1)) 38 38 + with (1) 1)) 21 39 - : bool = false 22 40 |}];; 23 41 24 24 - (* Failed flattening: we need to allocate the tuple to bind x. *) 25 25 - 42 42 + (* This tests needs to allocate the tuple to bind 'x', 43 43 + but this is only done in the branches that use it. *) 26 44 match (3, 2, 1) with 27 45 | ((_, 3, _) as x) 28 46 | ((1, _, _) as x) -> ignore x; true 29 47 | _ -> false 30 48 ;; 31 49 [%%expect{| 32 32 - (let (*match*/97 = 3 *match*/98 = 2 *match*/99 = 1) 50 50 + (let (*match*/99 = 3 *match*/100 = 2 *match*/101 = 1) 33 51 (catch 34 52 (catch 35 53 (catch 36 36 - (if (!= *match*/98 3) (exit 6) 37 37 - (let (x/101 =a (makeblock 0 *match*/97 *match*/98 *match*/99)) 38 38 - (exit 4 x/101))) 54 54 + (if (!= *match*/100 3) (exit 6) 55 55 + (let (x/103 =a (makeblock 0 *match*/99 *match*/100 *match*/101)) 56 56 + (exit 4 x/103))) 39 57 with (6) 40 40 - (if (!= *match*/97 1) (exit 5) 41 41 - (let (x/100 =a (makeblock 0 *match*/97 *match*/98 *match*/99)) 42 42 - (exit 4 x/100)))) 58 58 + (if (!= *match*/99 1) (exit 5) 59 59 + (let (x/102 =a (makeblock 0 *match*/99 *match*/100 *match*/101)) 60 60 + (exit 4 x/102)))) 43 61 with (5) 0) 44 44 - with (4 x/95) (seq (ignore x/95) 1))) 62 62 + with (4 x/97) (seq (ignore x/97) 1))) 63 63 + (let (*match*/99 = 3 *match*/100 = 2 *match*/101 = 1) 64 64 + (catch 65 65 + (if (!= *match*/100 3) 66 66 + (if (!= *match*/99 1) 0 67 67 + (exit 4 (makeblock 0 *match*/99 *match*/100 *match*/101))) 68 68 + (exit 4 (makeblock 0 *match*/99 *match*/100 *match*/101))) 69 69 + with (4 x/97) (seq (ignore x/97) 1))) 45 70 - : bool = false 46 71 |}];; 47 72 ··· 51 76 | ((true, _) as _g) 52 77 | ((false, _) as _g) -> () 53 78 [%%expect{| 54 54 - (function a/102[int] b/103 : int 0) 79 79 + (function a/104[int] b/105 : int 0) 80 80 + (function a/104[int] b/105 : int 0) 55 81 - : bool -> 'a -> unit = <fun> 56 82 |}];; 57 83 ··· 70 96 | (false, _) as p -> p 71 97 (* outside, trivial *) 72 98 [%%expect {| 73 73 - (function a/106[int] b/107 (let (p/108 =a (makeblock 0 a/106 b/107)) p/108)) 99 99 + (function a/108[int] b/109 (let (p/110 =a (makeblock 0 a/108 b/109)) p/110)) 100 100 + (function a/108[int] b/109 (makeblock 0 a/108 b/109)) 74 101 - : bool -> 'a -> bool * 'a = <fun> 75 102 |}] 76 103 ··· 79 106 | ((false, _) as p) -> p 80 107 (* inside, trivial *) 81 108 [%%expect{| 82 82 - (function a/110[int] b/111 (let (p/112 =a (makeblock 0 a/110 b/111)) p/112)) 109 109 + (function a/112[int] b/113 (let (p/114 =a (makeblock 0 a/112 b/113)) p/114)) 110 110 + (function a/112[int] b/113 (makeblock 0 a/112 b/113)) 83 111 - : bool -> 'a -> bool * 'a = <fun> 84 112 |}];; 85 113 ··· 88 116 | (false as x, _) as p -> x, p 89 117 (* outside, simple *) 90 118 [%%expect {| 91 91 - (function a/116[int] b/117 92 92 - (let (x/118 =a[int] a/116 p/119 =a (makeblock 0 a/116 b/117)) 93 93 - (makeblock 0 (int,*) x/118 p/119))) 119 119 + (function a/118[int] b/119 120 120 + (let (x/120 =a[int] a/118 p/121 =a (makeblock 0 a/118 b/119)) 121 121 + (makeblock 0 (int,*) x/120 p/121))) 122 122 + (function a/118[int] b/119 123 123 + (makeblock 0 (int,*) a/118 (makeblock 0 a/118 b/119))) 94 124 - : bool -> 'a -> bool * (bool * 'a) = <fun> 95 125 |}] 96 126 ··· 99 129 | ((false as x, _) as p) -> x, p 100 130 (* inside, simple *) 101 131 [%%expect {| 102 102 - (function a/122[int] b/123 103 103 - (let (x/124 =a[int] a/122 p/125 =a (makeblock 0 a/122 b/123)) 104 104 - (makeblock 0 (int,*) x/124 p/125))) 132 132 + (function a/124[int] b/125 133 133 + (let (x/126 =a[int] a/124 p/127 =a (makeblock 0 a/124 b/125)) 134 134 + (makeblock 0 (int,*) x/126 p/127))) 135 135 + (function a/124[int] b/125 136 136 + (makeblock 0 (int,*) a/124 (makeblock 0 a/124 b/125))) 105 137 - : bool -> 'a -> bool * (bool * 'a) = <fun> 106 138 |}] 107 139 ··· 110 142 | (false, x) as p -> x, p 111 143 (* outside, complex *) 112 144 [%%expect{| 113 113 - (function a/132[int] b/133[int] 114 114 - (if a/132 115 115 - (let (x/134 =a[int] a/132 p/135 =a (makeblock 0 a/132 b/133)) 116 116 - (makeblock 0 (int,*) x/134 p/135)) 117 117 - (let (x/136 =a b/133 p/137 =a (makeblock 0 a/132 b/133)) 118 118 - (makeblock 0 (int,*) x/136 p/137)))) 145 145 + (function a/134[int] b/135[int] 146 146 + (if a/134 147 147 + (let (x/136 =a[int] a/134 p/137 =a (makeblock 0 a/134 b/135)) 148 148 + (makeblock 0 (int,*) x/136 p/137)) 149 149 + (let (x/138 =a b/135 p/139 =a (makeblock 0 a/134 b/135)) 150 150 + (makeblock 0 (int,*) x/138 p/139)))) 151 151 + (function a/134[int] b/135[int] 152 152 + (if a/134 (makeblock 0 (int,*) a/134 (makeblock 0 a/134 b/135)) 153 153 + (makeblock 0 (int,*) b/135 (makeblock 0 a/134 b/135)))) 119 154 - : bool -> bool -> bool * (bool * bool) = <fun> 120 155 |}] 121 156 ··· 125 160 -> x, p 126 161 (* inside, complex *) 127 162 [%%expect{| 128 128 - (function a/138[int] b/139[int] 163 163 + (function a/140[int] b/141[int] 164 164 + (catch 165 165 + (if a/140 166 166 + (let (x/148 =a[int] a/140 p/149 =a (makeblock 0 a/140 b/141)) 167 167 + (exit 10 x/148 p/149)) 168 168 + (let (x/146 =a b/141 p/147 =a (makeblock 0 a/140 b/141)) 169 169 + (exit 10 x/146 p/147))) 170 170 + with (10 x/142[int] p/143) (makeblock 0 (int,*) x/142 p/143))) 171 171 + (function a/140[int] b/141[int] 129 172 (catch 130 130 - (if a/138 131 131 - (let (x/146 =a[int] a/138 p/147 =a (makeblock 0 a/138 b/139)) 132 132 - (exit 10 x/146 p/147)) 133 133 - (let (x/144 =a b/139 p/145 =a (makeblock 0 a/138 b/139)) 134 134 - (exit 10 x/144 p/145))) 135 135 - with (10 x/140[int] p/141) (makeblock 0 (int,*) x/140 p/141))) 173 173 + (if a/140 (exit 10 a/140 (makeblock 0 a/140 b/141)) 174 174 + (exit 10 b/141 (makeblock 0 a/140 b/141))) 175 175 + with (10 x/142[int] p/143) (makeblock 0 (int,*) x/142 p/143))) 136 176 - : bool -> bool -> bool * (bool * bool) = <fun> 137 177 |}] 138 178 ··· 145 185 | (false as x, _) as p -> x, p 146 186 (* outside, onecase *) 147 187 [%%expect {| 148 148 - (function a/148[int] b/149[int] 149 149 - (if a/148 150 150 - (let (x/150 =a[int] a/148 _p/151 =a (makeblock 0 a/148 b/149)) 151 151 - (makeblock 0 (int,*) x/150 [0: 1 1])) 152 152 - (let (x/152 =a[int] a/148 p/153 =a (makeblock 0 a/148 b/149)) 153 153 - (makeblock 0 (int,*) x/152 p/153)))) 188 188 + (function a/150[int] b/151[int] 189 189 + (if a/150 190 190 + (let (x/152 =a[int] a/150 _p/153 =a (makeblock 0 a/150 b/151)) 191 191 + (makeblock 0 (int,*) x/152 [0: 1 1])) 192 192 + (let (x/154 =a[int] a/150 p/155 =a (makeblock 0 a/150 b/151)) 193 193 + (makeblock 0 (int,*) x/154 p/155)))) 194 194 + (function a/150[int] b/151[int] 195 195 + (if a/150 (makeblock 0 (int,*) a/150 [0: 1 1]) 196 196 + (makeblock 0 (int,*) a/150 (makeblock 0 a/150 b/151)))) 154 197 - : bool -> bool -> bool * (bool * bool) = <fun> 155 198 |}] 156 199 ··· 159 202 | ((false as x, _) as p) -> x, p 160 203 (* inside, onecase *) 161 204 [%%expect{| 162 162 - (function a/154[int] b/155 163 163 - (let (x/156 =a[int] a/154 p/157 =a (makeblock 0 a/154 b/155)) 164 164 - (makeblock 0 (int,*) x/156 p/157))) 205 205 + (function a/156[int] b/157 206 206 + (let (x/158 =a[int] a/156 p/159 =a (makeblock 0 a/156 b/157)) 207 207 + (makeblock 0 (int,*) x/158 p/159))) 208 208 + (function a/156[int] b/157 209 209 + (makeblock 0 (int,*) a/156 (makeblock 0 a/156 b/157))) 165 210 - : bool -> 'a -> bool * (bool * 'a) = <fun> 166 211 |}] 167 212 168 213 type 'a tuplist = Nil | Cons of ('a * 'a tuplist) 169 214 [%%expect{| 215 215 + 0 170 216 0 171 217 type 'a tuplist = Nil | Cons of ('a * 'a tuplist) 172 218 |}] ··· 177 223 | (_, _) as p -> p 178 224 (* outside, tuplist *) 179 225 [%%expect {| 180 180 - (function a/167[int] b/168 226 226 + (function a/169[int] b/170 181 227 (catch 182 182 - (if a/167 (if b/168 (let (p/169 =a (field_imm 0 b/168)) p/169) (exit 12)) 228 228 + (if a/169 (if b/170 (let (p/171 =a (field_imm 0 b/170)) p/171) (exit 12)) 183 229 (exit 12)) 184 184 - with (12) (let (p/170 =a (makeblock 0 a/167 b/168)) p/170))) 230 230 + with (12) (let (p/172 =a (makeblock 0 a/169 b/170)) p/172))) 231 231 + (function a/169[int] b/170 232 232 + (catch (if a/169 (if b/170 (field_imm 0 b/170) (exit 12)) (exit 12)) 233 233 + with (12) (makeblock 0 a/169 b/170))) 185 234 - : bool -> bool tuplist -> bool * bool tuplist = <fun> 186 235 |}] 187 236 ··· 190 239 | ((_, _) as p) -> p 191 240 (* inside, tuplist *) 192 241 [%%expect{| 193 193 - (function a/171[int] b/172 242 242 + (function a/173[int] b/174 194 243 (catch 195 244 (catch 196 196 - (if a/171 197 197 - (if b/172 (let (p/176 =a (field_imm 0 b/172)) (exit 13 p/176)) 245 245 + (if a/173 246 246 + (if b/174 (let (p/178 =a (field_imm 0 b/174)) (exit 13 p/178)) 198 247 (exit 14)) 199 248 (exit 14)) 200 200 - with (14) (let (p/175 =a (makeblock 0 a/171 b/172)) (exit 13 p/175))) 201 201 - with (13 p/173) p/173)) 249 249 + with (14) (let (p/177 =a (makeblock 0 a/173 b/174)) (exit 13 p/177))) 250 250 + with (13 p/175) p/175)) 251 251 + (function a/173[int] b/174 252 252 + (catch 253 253 + (catch 254 254 + (if a/173 (if b/174 (exit 13 (field_imm 0 b/174)) (exit 14)) (exit 14)) 255 255 + with (14) (exit 13 (makeblock 0 a/173 b/174))) 256 256 + with (13 p/175) p/175)) 202 257 - : bool -> bool tuplist -> bool * bool tuplist = <fun> 203 258 |}]

+6 -6

testsuite/tests/generalized-open/gpr1506.ml

reviewed

··· 103 103 Line 1, characters 15-41: 104 104 1 | include struct open struct type t = T end let x = T end 105 105 ^^^^^^^^^^^^^^^^^^^^^^^^^^ 106 106 - Error: The type t/154 introduced by this open appears in the signature 106 106 + Error: The type t/156 introduced by this open appears in the signature 107 107 Line 1, characters 46-47: 108 108 - The value x has no valid type if t/154 is hidden 108 108 + The value x has no valid type if t/156 is hidden 109 109 |}];; 110 110 111 111 module A = struct ··· 123 123 4 | type t = T 124 124 5 | let x = T 125 125 6 | end 126 126 - Error: The type t/159 introduced by this open appears in the signature 126 126 + Error: The type t/161 introduced by this open appears in the signature 127 127 Line 7, characters 8-9: 128 128 - The value y has no valid type if t/159 is hidden 128 128 + The value y has no valid type if t/161 is hidden 129 129 |}];; 130 130 131 131 module A = struct ··· 142 142 3 | ....open struct 143 143 4 | type t = T 144 144 5 | end 145 145 - Error: The type t/164 introduced by this open appears in the signature 145 145 + Error: The type t/166 introduced by this open appears in the signature 146 146 Line 6, characters 8-9: 147 147 - The value y has no valid type if t/164 is hidden 147 147 + The value y has no valid type if t/166 is hidden 148 148 |}] 149 149 150 150 (* It was decided to not allow this anymore. *)

+3 -3

testsuite/tests/typing-sigsubst/sigsubst.ml

reviewed

··· 24 24 Line 3, characters 2-36: 25 25 3 | include Comparable with type t = t 26 26 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 27 27 - Error: Illegal shadowing of included type t/102 by t/106 27 27 + Error: Illegal shadowing of included type t/104 by t/108 28 28 Line 2, characters 2-19: 29 29 - Type t/102 came from this include 29 29 + Type t/104 came from this include 30 30 Line 3, characters 2-23: 31 31 - The value print has no valid type if t/102 is shadowed 31 31 + The value print has no valid type if t/104 is shadowed 32 32 |}] 33 33 34 34 module type Sunderscore = sig

+1 -1

typing/includecore.ml

reviewed

··· 105 105 | Tconstr(Pident _, _, _) -> 106 106 (* This function is checking for an abstract row on the side that is being 107 107 included into (usually numbered with "2" in this file). In this case, 108 108 - the abstract row variable has been subsituted for an object or variant 108 108 + the abstract row variable has been substituted for an object or variant 109 109 type. *) 110 110 begin match get_desc (Ctype.expand_head env ty) with 111 111 | Tobject _|Tvariant _ -> true

+1

typing/oprint.ml

reviewed

··· 188 188 | Oval_string (s, maxlen, kind) -> 189 189 begin try 190 190 let len = String.length s in 191 191 + let maxlen = max maxlen 8 in (* always show a little prefix *) 191 192 let s = if len > maxlen then String.sub s 0 maxlen else s in 192 193 begin match kind with 193 194 | Ostr_bytes -> fprintf ppf "Bytes.of_string %S" s

+2 -2

utils/diffing.mli

reviewed

··· 64 64 type left 65 65 type right 66 66 type eq 67 67 - (** Detailled equality trace *) 67 67 + (** Detailed equality trace *) 68 68 69 69 type diff 70 70 - (** Detailled difference trace *) 70 70 + (** Detailed difference trace *) 71 71 72 72 type state 73 73 (** environment of a partial patch *)