Some RNGs for the standard library, plus typeclass interfaces.

extras/README

@@ -80,6 +80,9 @@ old_term_parser	A library containing versions of the the standard library's
 posix		A Mercury interface to some of the POSIX
 		(Portable Operating System Interface) APIs.
 
+random		Some additional instances of the random typeclasses from
+		the standard library.
+
 references	A library package containing modules for manipulating
 		ML-style references (mutable state).
 

extras/random/binfile.m

@@ -0,0 +1,126 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2019 The Mercury team.
+% This file is distributed under the terms specified in COPYING.LIB.
+%---------------------------------------------------------------------------%
+%
+% File: binfile.m
+% Main author: Mark Brown
+%
+% "Random" number generator that reads numbers from a binary file.
+%
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- module binfile.
+:- interface.
+
+:- import_module io.
+:- import_module random.
+
+%---------------------------------------------------------------------------%
+
+:- type binfile.
+:- instance urandom(binfile, io).
+
+    % Open a binfile generator from a filename. This should be closed
+    % when no longer needed.
+    %
+:- pred open(string, io.res(binfile), io, io).
+:- mode open(in, out, di, uo) is det.
+
+    % Close a binfile generator.
+    %
+:- pred close(binfile, io, io).
+:- mode close(in, di, uo) is det.
+
+%---------------------------------------------------------------------------%
+
+    % Generate an unsigned integer of 8, 16, 32 or 64 bits, reespectively.
+    % This reads the required number of bytes from the file and interprets
+    % them as an unsigned, big-endian integer.
+    %
+    % Throws an exception if the end-of-file is reached.
+    %
+:- pred generate_uint8(binfile::in, uint8::out, io::di, io::uo) is det.
+:- pred generate_uint16(binfile::in, uint16::out, io::di, io::uo) is det.
+:- pred generate_uint32(binfile::in, uint32::out, io::di, io::uo) is det.
+:- pred generate_uint64(binfile::in, uint64::out, io::di, io::uo) is det.
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module require.
+:- import_module uint64.
+
+%---------------------------------------------------------------------------%
+
+:- type binfile
+    --->    binfile(binary_input_stream).
+
+:- instance urandom(binfile, io) where [
+    pred(generate_uint8/4) is binfile.generate_uint8,
+    pred(generate_uint16/4) is binfile.generate_uint16,
+    pred(generate_uint32/4) is binfile.generate_uint32,
+    pred(generate_uint64/4) is binfile.generate_uint64
+].
+
+%---------------------------------------------------------------------------%
+
+open(Filename, Res, !IO) :-
+    io.open_binary_input(Filename, Res0, !IO),
+    (
+        Res0 = ok(Stream),
+        Res = ok(binfile(Stream))
+    ;
+        Res0 = error(E),
+        Res = error(E)
+    ).
+
+close(binfile(Stream), !IO) :-
+    io.close_binary_input(Stream, !IO).
+
+%---------------------------------------------------------------------------%
+
+generate_uint8(binfile(Stream), N, !IO) :-
+    io.read_binary_uint8(Stream, Res, !IO),
+    (
+        Res = ok(N)
+    ;
+        Res = eof,
+        unexpected($pred, "end of file")
+    ;
+        Res = error(E),
+        unexpected($pred, io.error_message(E))
+    ).
+
+generate_uint16(binfile(Stream), N, !IO) :-
+    io.read_binary_uint16_be(Stream, Res, !IO),
+    handle_res(Res, N).
+
+generate_uint32(binfile(Stream), N, !IO) :-
+    io.read_binary_uint32_be(Stream, Res, !IO),
+    handle_res(Res, N).
+
+generate_uint64(binfile(Stream), N, !IO) :-
+    io.read_binary_uint64_be(Stream, Res, !IO),
+    handle_res(Res, N).
+
+:- pred handle_res(maybe_incomplete_result(T)::in, T::out) is det.
+
+handle_res(Res, N) :-
+    (
+        Res = ok(N)
+    ;
+        ( Res = eof
+        ; Res = incomplete(_)
+        ),
+        unexpected($pred, "end of file")
+    ;
+        Res = error(E),
+        unexpected($pred, io.error_message(E))
+    ).
+
+%---------------------------------------------------------------------------%

extras/random/marsaglia.m

@@ -0,0 +1,122 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2019 The Mercury team.
+% This file is distributed under the terms specified in COPYING.LIB.
+%---------------------------------------------------------------------------%
+%
+% File: marsaglia.m
+% Main author: Mark Brown
+%
+% Very fast concatenation of two 16-bit MWC generators.
+%
+% http://gcrhoads.byethost4.com/Code/Random/marsaglia.c
+%
+% "Algorithm recommended by Marsaglia."
+%
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- module marsaglia.
+:- interface.
+
+:- import_module random.
+
+%---------------------------------------------------------------------------%
+
+:- type random.
+
+:- instance random(random).
+
+    % Initialise a marsaglia generator with the default seed.
+    %
+:- func init = random.
+
+    % Initialise a marsaglia generator with the given seed.
+    %
+:- func seed(uint32, uint32) = random.
+
+    % Generate a uniformly distributed pseudo-random unsigned integer
+    % of 8, 16, 32 or 64 bytes, respectively.
+    %
+:- pred generate_uint8(uint8::out, random::in, random::out) is det.
+:- pred generate_uint16(uint16::out, random::in, random::out) is det.
+:- pred generate_uint32(uint32::out, random::in, random::out) is det.
+:- pred generate_uint64(uint64::out, random::in, random::out) is det.
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module uint8.
+:- import_module uint16.
+:- import_module uint32.
+:- import_module uint64.
+
+%---------------------------------------------------------------------------%
+
+:- type random
+    --->    random(uint64).
+
+:- instance random(random) where [
+    pred(generate_uint8/3) is marsaglia.generate_uint8,
+    pred(generate_uint16/3) is marsaglia.generate_uint16,
+    pred(generate_uint32/3) is marsaglia.generate_uint32,
+    pred(generate_uint64/3) is marsaglia.generate_uint64
+].
+
+init = seed(0u32, 0u32).
+
+seed(SX0, SY0) = R :-
+    SX = ( if SX0 = 0u32 then 521288629u32 else SX0 ),
+    SY = ( if SY0 = 0u32 then 362436069u32 else SY0 ),
+    R = random(pack_uint64(SX, SY)).
+
+%---------------------------------------------------------------------------%
+
+generate_uint8(N, !R) :-
+    marsaglia.generate_uint32(N0, !R),
+    N1 = uint32.cast_to_int(N0 >> 24),
+    N = uint8.cast_from_int(N1).
+
+generate_uint16(N, !R) :-
+    marsaglia.generate_uint32(N0, !R),
+    N1 = uint32.cast_to_int(N0 >> 16),
+    N = uint16.cast_from_int(N1).
+
+generate_uint64(N, !R) :-
+    marsaglia.generate_uint32(A0, !R),
+    marsaglia.generate_uint32(B0, !R),
+    A = uint32.cast_to_uint64(A0),
+    B = uint32.cast_to_uint64(B0),
+    N = A + (B << 32).
+
+%---------------------------------------------------------------------------%
+
+generate_uint32(N, R0, R) :-
+    R0 = random(S0),
+    unpack_uint64(S0, SX0, SY0),
+    A = 18000u32,
+    B = 30903u32,
+    M = 0xffffu32,
+    SX = A * (SX0 /\ M) + (SX0 >> 16),
+    SY = B * (SY0 /\ M) + (SY0 >> 16),
+    N = (SX << 16) + (SY /\ M),
+    S = pack_uint64(SX, SY),
+    R = random(S).
+
+%---------------------------------------------------------------------------%
+
+:- func pack_uint64(uint32, uint32) = uint64.
+
+pack_uint64(Hi, Lo) =
+    (uint32.cast_to_uint64(Hi) << 32) + uint32.cast_to_uint64(Lo).
+
+:- pred unpack_uint64(uint64, uint32, uint32).
+:- mode unpack_uint64(in, out, out) is det.
+
+unpack_uint64(S, Hi, Lo) :-
+    Hi = uint32.cast_from_uint64(S >> 32),
+    Lo = uint32.cast_from_uint64(S /\ 0xffffffffu64).
+
+%---------------------------------------------------------------------------%