From 7bb80d434e596d2fd08b2bae823419fa850050ea Mon Sep 17 00:00:00 2001 From: John Whitington Date: Thu, 6 Aug 2020 14:18:18 +0100 Subject: [PATCH] "final" fixes --- otherlibs/unix/unix.mli | 85 ++++++++++++++++----------- otherlibs/unix/unixLabels.mli | 85 ++++++++++++++++----------- stdlib/bytes.mli | 11 ++-- stdlib/bytesLabels.mli | 11 ++-- stdlib/hashtbl.mli | 4 +- stdlib/moreLabels.mli | 4 +- stdlib/templates/hashtbl.template.mli | 4 +- 7 files changed, 122 insertions(+), 82 deletions(-) diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli index 9b7fcdaac..9433d9600 100644 --- a/otherlibs/unix/unix.mli +++ b/otherlibs/unix/unix.mli @@ -229,7 +229,7 @@ val wait : unit -> int * process_status (** Wait until one of the children processes die, and return its pid and termination status. - On Windows: Not implemented, use {!waitpid}. *) + On Windows: not implemented, use {!waitpid}. *) val waitpid : wait_flag list -> int -> int * process_status (** Same as {!wait}, but waits for the child process whose pid is given. @@ -241,8 +241,7 @@ val waitpid : wait_flag list -> int -> int * process_status immediately without waiting, and whether it should report stopped children. - On Windows, this function can only wait for a given PID, not any - child process. *) + On Windows: can only wait for a given PID, not any child process. *) val system : string -> process_status (** Execute the given command, wait until it terminates, and return @@ -260,7 +259,8 @@ val getpid : unit -> int val getppid : unit -> int (** Return the pid of the parent process. - On Windows: not implemented (because it is meaningless). *) + + On Windows: not implemented (because it is meaningless). *) val nice : int -> int (** Change the process priority. The integer argument is added to the @@ -366,7 +366,8 @@ val in_channel_of_descr : file_descr -> in_channel [set_binary_mode_in ic false] if text mode is desired. Text mode is supported only if the descriptor refers to a file or pipe, but is not supported if it refers to a socket. - On Windows, [set_binary_mode_in] always fails on channels created + + On Windows: [set_binary_mode_in] always fails on channels created with this function. Beware that channels are buffered so more characters may have been @@ -383,7 +384,8 @@ val out_channel_of_descr : file_descr -> out_channel [set_binary_mode_out oc false] if text mode is desired. Text mode is supported only if the descriptor refers to a file or pipe, but is not supported if it refers to a socket. - On Windows, [set_binary_mode_out] always fails on channels created + + On Windows: [set_binary_mode_out] always fails on channels created with this function. Beware that channels are buffered so you may have to [flush] them @@ -617,25 +619,29 @@ val chmod : string -> file_perm -> unit val fchmod : file_descr -> file_perm -> unit (** Change the permissions of an opened file. + On Windows: not implemented. *) val chown : string -> int -> int -> unit (** Change the owner uid and owner gid of the named file. + On Windows: not implemented. *) val fchown : file_descr -> int -> int -> unit (** Change the owner uid and owner gid of an opened file. + On Windows: not implemented. *) val umask : int -> int (** Set the process's file mode creation mask, and return the previous mask. + On Windows: not implemented. *) val access : string -> access_permission list -> unit (** Check that the process has the given permissions over the named file. - On Windows, execute permission [X_OK], cannot be tested, it just + On Windows: execute permission [X_OK] cannot be tested, just tests for read permission instead. @raise Unix_error otherwise. @@ -739,6 +745,7 @@ val getcwd : unit -> string val chroot : string -> unit (** Change the process root directory. + On Windows: not implemented. *) type dir_handle @@ -772,6 +779,7 @@ val pipe : ?cloexec: (* thwart tools/unlabel *) bool -> val mkfifo : string -> file_perm -> unit (** Create a named pipe with the given permissions (see {!umask}). + On Windows: not implemented. *) @@ -1042,8 +1050,9 @@ val lockf : file_descr -> lock_command -> int -> unit val kill : int -> int -> unit (** [kill pid signal] sends signal number [signal] to the process - with id [pid]. On Windows, only the {!Sys.sigkill} signal - is emulated. *) + with id [pid]. + + On Windows: only the {!Sys.sigkill} signal is emulated. *) type sigprocmask_command = SIG_SETMASK @@ -1153,7 +1162,8 @@ val sleepf : float -> unit val times : unit -> process_times (** Return the execution times of the process. - On Windows, it is partially implemented, will not report timings + + On Windows: partially implemented, will not report timings for child processes. *) val utimes : string -> float -> float -> unit @@ -1204,36 +1214,44 @@ val setitimer : val getuid : unit -> int (** Return the user id of the user executing the process. - On Windows, always return [1]. *) + + On Windows: always returns [1]. *) val geteuid : unit -> int (** Return the effective user id under which the process runs. - On Windows, always return [1]. *) + + On Windows: always return [1]. *) val setuid : int -> unit (** Set the real user id and effective user id for the process. + On Windows: not implemented. *) val getgid : unit -> int (** Return the group id of the user executing the process. - On Windows, always return [1]. *) + + On Windows: always returns [1]. *) val getegid : unit -> int (** Return the effective group id under which the process runs. - On Windows, always return [1]. *) + + On Windows: always returns [1]. *) val setgid : int -> unit (** Set the real group id and effective group id for the process. + On Windows: not implemented. *) val getgroups : unit -> int array (** Return the list of groups to which the user executing the process belongs. + On Windows, always return [[|1|]]. *) val setgroups : int array -> unit (** [setgroups groups] sets the supplementary group IDs for the calling process. Appropriate privileges are required. + On Windows: not implemented. *) val initgroups : string -> int -> unit @@ -1241,6 +1259,7 @@ val initgroups : string -> int -> unit reading the group database /etc/group and using all groups of which [user] is a member. The additional group [group] is also added to the list. + On Windows: not implemented. *) type passwd_entry = @@ -1267,27 +1286,22 @@ val getlogin : unit -> string val getpwnam : string -> passwd_entry (** Find an entry in [passwd] with the given name. - @raise Not_found if no such entry exist. - - On Windows, always raise [Not_found]. *) + @raise Not_found if no such entry exists, or always on Windows. *) val getgrnam : string -> group_entry (** Find an entry in [group] with the given name. - @raise Not_found if no such entry exist. - On Windows, always raise [Not_found]. *) + @raise Not_found if no such entry exists, or always on Windows. *) val getpwuid : int -> passwd_entry (** Find an entry in [passwd] with the given user id. - @raise Not_found if no such entry exist. - On Windows, always raise [Not_found]. *) + @raise Not_found if no such entry exists, or always on Windows. *) val getgrgid : int -> group_entry (** Find an entry in [group] with the given group id. - @raise Not_found if no such entry exist. - On Windows, always raise [Not_found]. *) + @raise Not_found if no such entry exists, or always on Windows. *) (** {1 Internet addresses} *) @@ -1335,8 +1349,9 @@ type socket_domain = | PF_INET (** Internet domain (IPv4) *) | PF_INET6 (** Internet domain (IPv6) *) (** The type of socket domains. Not all platforms support - IPv6 sockets (type [PF_INET6]). On Windows, [PF_UNIX] - is not implemented. *) + IPv6 sockets (type [PF_INET6]). + + On Windows: [PF_UNIX] not implemented. *) type socket_type = SOCK_STREAM (** Stream socket *) @@ -1373,7 +1388,9 @@ val socketpair : ?cloexec: (* thwart toosl/unlabel *) bool -> socket_domain -> socket_type -> int -> file_descr * file_descr -(** Create a pair of unnamed sockets, connected together. *) +(** Create a pair of unnamed sockets, connected together. + See {!set_close_on_exec} for documentation on the [cloexec] + optional argument. *) val accept : ?cloexec: (* thwart tools/unlabel *) bool -> file_descr -> file_descr * sockaddr @@ -1554,7 +1571,7 @@ val establish_server : is created for each connection. The function {!establish_server} never returns normally. - On Windows, it is not implemented. Use threads. *) + On Windows: not implemented (use threads). *) (** {1 Host and protocol databases} *) @@ -1732,7 +1749,7 @@ val tcgetattr : file_descr -> terminal_io (** Return the status of the terminal referred to by the given file descriptor. - On Windows, not implemented.*) + On Windows: not implemented. *) type setattr_when = TCSANOW @@ -1749,20 +1766,20 @@ val tcsetattr : file_descr -> setattr_when -> terminal_io -> unit the output parameters; [TCSAFLUSH], when changing the input parameters. - On Windows, not implemented. *) + On Windows: not implemented. *) val tcsendbreak : file_descr -> int -> unit (** Send a break condition on the given file descriptor. The second argument is the duration of the break, in 0.1s units; 0 means standard duration (0.25s). - On Windows, not implemented. *) + On Windows: not implemented. *) val tcdrain : file_descr -> unit (** Waits until all output written on the given file descriptor has been transmitted. - On Windows, not implemented. *) + On Windows: not implemented. *) type flush_queue = TCIFLUSH @@ -1776,7 +1793,7 @@ val tcflush : file_descr -> flush_queue -> unit [TCOFLUSH] flushes data written but not transmitted, and [TCIOFLUSH] flushes both. - On Windows, not implemented. *) + On Windows: not implemented. *) type flow_action = TCOOFF @@ -1791,10 +1808,10 @@ val tcflow : file_descr -> flow_action -> unit [TCIOFF] transmits a STOP character to suspend input, and [TCION] transmits a START character to restart input. - On Windows, not implemented. *) + On Windows: not implemented. *) val setsid : unit -> int (** Put the calling process in a new session and detach it from its controlling terminal. - On Windows, not implemented. *) + On Windows: not implemented. *) diff --git a/otherlibs/unix/unixLabels.mli b/otherlibs/unix/unixLabels.mli index 66e00de41..e7eeff9f1 100644 --- a/otherlibs/unix/unixLabels.mli +++ b/otherlibs/unix/unixLabels.mli @@ -229,7 +229,7 @@ val wait : unit -> int * process_status (** Wait until one of the children processes die, and return its pid and termination status. - On Windows: Not implemented, use {!waitpid}. *) + On Windows: not implemented, use {!waitpid}. *) val waitpid : mode:wait_flag list -> int -> int * process_status (** Same as {!wait}, but waits for the child process whose pid is given. @@ -241,8 +241,7 @@ val waitpid : mode:wait_flag list -> int -> int * process_status immediately without waiting, and whether it should report stopped children. - On Windows, this function can only wait for a given PID, not any - child process. *) + On Windows: can only wait for a given PID, not any child process. *) val system : string -> process_status (** Execute the given command, wait until it terminates, and return @@ -260,7 +259,8 @@ val getpid : unit -> int val getppid : unit -> int (** Return the pid of the parent process. - On Windows: not implemented (because it is meaningless). *) + + On Windows: not implemented (because it is meaningless). *) val nice : int -> int (** Change the process priority. The integer argument is added to the @@ -366,7 +366,8 @@ val in_channel_of_descr : file_descr -> in_channel [set_binary_mode_in ic false] if text mode is desired. Text mode is supported only if the descriptor refers to a file or pipe, but is not supported if it refers to a socket. - On Windows, [set_binary_mode_in] always fails on channels created + + On Windows: [set_binary_mode_in] always fails on channels created with this function. Beware that channels are buffered so more characters may have been @@ -383,7 +384,8 @@ val out_channel_of_descr : file_descr -> out_channel [set_binary_mode_out oc false] if text mode is desired. Text mode is supported only if the descriptor refers to a file or pipe, but is not supported if it refers to a socket. - On Windows, [set_binary_mode_out] always fails on channels created + + On Windows: [set_binary_mode_out] always fails on channels created with this function. Beware that channels are buffered so you may have to [flush] them @@ -617,25 +619,29 @@ val chmod : string -> perm:file_perm -> unit val fchmod : file_descr -> perm:file_perm -> unit (** Change the permissions of an opened file. + On Windows: not implemented. *) val chown : string -> uid:int -> gid:int -> unit (** Change the owner uid and owner gid of the named file. + On Windows: not implemented. *) val fchown : file_descr -> uid:int -> gid:int -> unit (** Change the owner uid and owner gid of an opened file. + On Windows: not implemented. *) val umask : int -> int (** Set the process's file mode creation mask, and return the previous mask. + On Windows: not implemented. *) val access : string -> perm:access_permission list -> unit (** Check that the process has the given permissions over the named file. - On Windows, execute permission [X_OK], cannot be tested, it just + On Windows: execute permission [X_OK] cannot be tested, just tests for read permission instead. @raise Unix_error otherwise. @@ -739,6 +745,7 @@ val getcwd : unit -> string val chroot : string -> unit (** Change the process root directory. + On Windows: not implemented. *) type dir_handle = Unix.dir_handle @@ -772,6 +779,7 @@ val pipe : ?cloexec: (* thwart tools/unlabel *) bool -> val mkfifo : string -> perm:file_perm -> unit (** Create a named pipe with the given permissions (see {!umask}). + On Windows: not implemented. *) @@ -1042,8 +1050,9 @@ val lockf : file_descr -> mode:lock_command -> len:int -> unit val kill : pid:int -> signal:int -> unit (** [kill ~pid ~signal] sends signal number [signal] to the process - with id [pid]. On Windows, only the {!Sys.sigkill} signal - is emulated. *) + with id [pid]. + + On Windows: only the {!Sys.sigkill} signal is emulated. *) type sigprocmask_command = Unix.sigprocmask_command = SIG_SETMASK @@ -1153,7 +1162,8 @@ val sleepf : float -> unit val times : unit -> process_times (** Return the execution times of the process. - On Windows, it is partially implemented, will not report timings + + On Windows: partially implemented, will not report timings for child processes. *) val utimes : string -> access:float -> modif:float -> unit @@ -1204,36 +1214,44 @@ val setitimer : val getuid : unit -> int (** Return the user id of the user executing the process. - On Windows, always return [1]. *) + + On Windows: always returns [1]. *) val geteuid : unit -> int (** Return the effective user id under which the process runs. - On Windows, always return [1]. *) + + On Windows: always return [1]. *) val setuid : int -> unit (** Set the real user id and effective user id for the process. + On Windows: not implemented. *) val getgid : unit -> int (** Return the group id of the user executing the process. - On Windows, always return [1]. *) + + On Windows: always returns [1]. *) val getegid : unit -> int (** Return the effective group id under which the process runs. - On Windows, always return [1]. *) + + On Windows: always returns [1]. *) val setgid : int -> unit (** Set the real group id and effective group id for the process. + On Windows: not implemented. *) val getgroups : unit -> int array (** Return the list of groups to which the user executing the process belongs. + On Windows, always return [[|1|]]. *) val setgroups : int array -> unit (** [setgroups groups] sets the supplementary group IDs for the calling process. Appropriate privileges are required. + On Windows: not implemented. *) val initgroups : string -> int -> unit @@ -1241,6 +1259,7 @@ val initgroups : string -> int -> unit reading the group database /etc/group and using all groups of which [user] is a member. The additional group [group] is also added to the list. + On Windows: not implemented. *) type passwd_entry = Unix.passwd_entry = @@ -1267,27 +1286,22 @@ val getlogin : unit -> string val getpwnam : string -> passwd_entry (** Find an entry in [passwd] with the given name. - @raise Not_found if no such entry exist. - - On Windows, always raise [Not_found]. *) + @raise Not_found if no such entry exists, or always on Windows. *) val getgrnam : string -> group_entry (** Find an entry in [group] with the given name. - @raise Not_found if no such entry exist. - On Windows, always raise [Not_found]. *) + @raise Not_found if no such entry exists, or always on Windows. *) val getpwuid : int -> passwd_entry (** Find an entry in [passwd] with the given user id. - @raise Not_found if no such entry exist. - On Windows, always raise [Not_found]. *) + @raise Not_found if no such entry exists, or always on Windows. *) val getgrgid : int -> group_entry (** Find an entry in [group] with the given group id. - @raise Not_found if no such entry exist. - On Windows, always raise [Not_found]. *) + @raise Not_found if no such entry exists, or always on Windows. *) (** {1 Internet addresses} *) @@ -1335,8 +1349,9 @@ type socket_domain = Unix.socket_domain = | PF_INET (** Internet domain (IPv4) *) | PF_INET6 (** Internet domain (IPv6) *) (** The type of socket domains. Not all platforms support - IPv6 sockets (type [PF_INET6]). On Windows, [PF_UNIX] - is not implemented. *) + IPv6 sockets (type [PF_INET6]). + + On Windows: [PF_UNIX] not implemented. *) type socket_type = Unix.socket_type = SOCK_STREAM (** Stream socket *) @@ -1373,7 +1388,9 @@ val socketpair : ?cloexec: (* thwart toosl/unlabel *) bool -> domain:socket_domain -> kind:socket_type -> protocol:int -> file_descr * file_descr -(** Create a pair of unnamed sockets, connected together. *) +(** Create a pair of unnamed sockets, connected together. + See {!set_close_on_exec} for documentation on the [cloexec] + optional argument. *) val accept : ?cloexec: (* thwart tools/unlabel *) bool -> file_descr -> file_descr * sockaddr @@ -1554,7 +1571,7 @@ val establish_server : is created for each connection. The function {!establish_server} never returns normally. - On Windows, it is not implemented. Use threads. *) + On Windows: not implemented (use threads). *) (** {1 Host and protocol databases} *) @@ -1732,7 +1749,7 @@ val tcgetattr : file_descr -> terminal_io (** Return the status of the terminal referred to by the given file descriptor. - On Windows, not implemented.*) + On Windows: not implemented. *) type setattr_when = Unix.setattr_when = TCSANOW @@ -1749,20 +1766,20 @@ val tcsetattr : file_descr -> mode:setattr_when -> terminal_io -> unit the output parameters; [TCSAFLUSH], when changing the input parameters. - On Windows, not implemented. *) + On Windows: not implemented. *) val tcsendbreak : file_descr -> duration:int -> unit (** Send a break condition on the given file descriptor. The second argument is the duration of the break, in 0.1s units; 0 means standard duration (0.25s). - On Windows, not implemented. *) + On Windows: not implemented. *) val tcdrain : file_descr -> unit (** Waits until all output written on the given file descriptor has been transmitted. - On Windows, not implemented. *) + On Windows: not implemented. *) type flush_queue = Unix.flush_queue = TCIFLUSH @@ -1776,7 +1793,7 @@ val tcflush : file_descr -> mode:flush_queue -> unit [TCOFLUSH] flushes data written but not transmitted, and [TCIOFLUSH] flushes both. - On Windows, not implemented. *) + On Windows: not implemented. *) type flow_action = Unix.flow_action = TCOOFF @@ -1791,10 +1808,10 @@ val tcflow : file_descr -> mode:flow_action -> unit [TCIOFF] transmits a STOP character to suspend input, and [TCION] transmits a START character to restart input. - On Windows, not implemented. *) + On Windows: not implemented. *) val setsid : unit -> int (** Put the calling process in a new session and detach it from its controlling terminal. - On Windows, not implemented. *) + On Windows: not implemented. *) diff --git a/stdlib/bytes.mli b/stdlib/bytes.mli index 34baca9ba..094bfd545 100644 --- a/stdlib/bytes.mli +++ b/stdlib/bytes.mli @@ -124,7 +124,7 @@ val extend : bytes -> int -> int -> bytes the corresponding side of [s]. @raise Invalid_argument if the result length is negative or longer than {!Sys.max_string_length} bytes. - @since 4.05.0 in labeled module *) + @since 4.05.0 in BytesLabels *) val fill : bytes -> int -> int -> char -> unit (** [fill s pos len c] modifies [s] in place, replacing [len] @@ -153,19 +153,22 @@ val blit_string : @raise Invalid_argument if [src_pos] and [len] do not designate a valid range of [src], or if [dst_pos] and [len] do not designate a valid range of [dst]. - @since 4.05.0 in labeled module *) + @since 4.05.0 in BytesLabels *) val concat : bytes -> bytes list -> bytes (** [concat sep sl] concatenates the list of byte sequences [sl], inserting the separator byte sequence [sep] between each, and - returns the result as a new byte sequence. *) + returns the result as a new byte sequence. + @raise Invalid_argument if the result is longer than + {!Sys.max_string_length} bytes. + *) val cat : bytes -> bytes -> bytes (** [cat s1 s2] concatenates [s1] and [s2] and returns the result as a new byte sequence. @raise Invalid_argument if the result is longer than {!Sys.max_string_length} bytes. - @since 4.05.0 in labeled module *) + @since 4.05.0 in BytesLabels *) val iter : (char -> unit) -> bytes -> unit (** [iter f s] applies function [f] in turn to all the bytes of [s]. diff --git a/stdlib/bytesLabels.mli b/stdlib/bytesLabels.mli index fb812ca7d..e2aebdcd4 100644 --- a/stdlib/bytesLabels.mli +++ b/stdlib/bytesLabels.mli @@ -124,7 +124,7 @@ val extend : bytes -> left:int -> right:int -> bytes the corresponding side of [s]. @raise Invalid_argument if the result length is negative or longer than {!Sys.max_string_length} bytes. - @since 4.05.0 in labeled module *) + @since 4.05.0 in BytesLabels *) val fill : bytes -> pos:int -> len:int -> char -> unit (** [fill s ~pos ~len c] modifies [s] in place, replacing [len] @@ -153,19 +153,22 @@ val blit_string : @raise Invalid_argument if [src_pos] and [len] do not designate a valid range of [src], or if [dst_pos] and [len] do not designate a valid range of [dst]. - @since 4.05.0 in labeled module *) + @since 4.05.0 in BytesLabels *) val concat : sep:bytes -> bytes list -> bytes (** [concat ~sep sl] concatenates the list of byte sequences [sl], inserting the separator byte sequence [sep] between each, and - returns the result as a new byte sequence. *) + returns the result as a new byte sequence. + @raise Invalid_argument if the result is longer than + {!Sys.max_string_length} bytes. + *) val cat : bytes -> bytes -> bytes (** [cat s1 s2] concatenates [s1] and [s2] and returns the result as a new byte sequence. @raise Invalid_argument if the result is longer than {!Sys.max_string_length} bytes. - @since 4.05.0 in labeled module *) + @since 4.05.0 in BytesLabels *) val iter : f:(char -> unit) -> bytes -> unit (** [iter ~f s] applies function [f] in turn to all the bytes of [s]. diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli index a2873b25e..67d084cb7 100644 --- a/stdlib/hashtbl.mli +++ b/stdlib/hashtbl.mli @@ -202,7 +202,7 @@ val is_randomized : unit -> bool val rebuild : ?random (* thwart tools/unlabel *) :bool -> ('a, 'b) t -> ('a, 'b) t (** Return a copy of the given hashtable. Unlike {!copy}, - [{!rebuild} h] re-hashes all the (key, value) entries of + {!rebuild}[ h] re-hashes all the (key, value) entries of the original table [h]. The returned hash table is randomized if [h] was randomized, or the optional [random] parameter is true, or if the default is to create randomized hash tables; see @@ -460,7 +460,7 @@ module MakeSeeded (H : SeededHashedType) : SeededS with type key = H.t interface, but use the seeded hashing and equality functions specified in the functor argument [H] instead of generic equality and hashing. The [create] operation of the - result structure supports the [random] optional parameter + result structure supports the [~][random] optional parameter and returns randomized hash tables if [~random:true] is passed or if randomization is globally on (see {!Hashtbl.randomize}). @since 4.00.0 *) diff --git a/stdlib/moreLabels.mli b/stdlib/moreLabels.mli index bfc70fb31..0757611f0 100644 --- a/stdlib/moreLabels.mli +++ b/stdlib/moreLabels.mli @@ -219,7 +219,7 @@ module Hashtbl : sig val rebuild : ?random (* thwart tools/unlabel *) :bool -> ('a, 'b) t -> ('a, 'b) t (** Return a copy of the given hashtable. Unlike {!copy}, - [{!rebuild} h] re-hashes all the (key, value) entries of + {!rebuild}[ h] re-hashes all the (key, value) entries of the original table [h]. The returned hash table is randomized if [h] was randomized, or the optional [random] parameter is true, or if the default is to create randomized hash tables; see @@ -481,7 +481,7 @@ module Hashtbl : sig interface, but use the seeded hashing and equality functions specified in the functor argument [H] instead of generic equality and hashing. The [create] operation of the - result structure supports the [~random] optional parameter + result structure supports the [~][random] optional parameter and returns randomized hash tables if [~random:true] is passed or if randomization is globally on (see {!Hashtbl.randomize}). @since 4.00.0 *) diff --git a/stdlib/templates/hashtbl.template.mli b/stdlib/templates/hashtbl.template.mli index 59c9dfc7f..f00a6b2cd 100644 --- a/stdlib/templates/hashtbl.template.mli +++ b/stdlib/templates/hashtbl.template.mli @@ -202,7 +202,7 @@ val is_randomized : unit -> bool val rebuild : ?random (* thwart tools/unlabel *) :bool -> ('a, 'b) t -> ('a, 'b) t (** Return a copy of the given hashtable. Unlike {!copy}, - [{!rebuild} h] re-hashes all the (key, value) entries of + {!rebuild}[ h] re-hashes all the (key, value) entries of the original table [h]. The returned hash table is randomized if [h] was randomized, or the optional [random] parameter is true, or if the default is to create randomized hash tables; see @@ -460,7 +460,7 @@ module MakeSeeded (H : SeededHashedType) : SeededS with type key = H.t interface, but use the seeded hashing and equality functions specified in the functor argument [H] instead of generic equality and hashing. The [create] operation of the - result structure supports the [~random] optional parameter + result structure supports the [~][random] optional parameter and returns randomized hash tables if [~random:true] is passed or if randomization is globally on (see {!Hashtbl.randomize}). @since 4.00.0 *)