shift_left_nat nat ofs 1 tmp 0 4;
    set_digit_nat tmp 0 (Random.bits () land 15);

let random_big_int =
  let open Big_int in
  let open Nat in
  let random_limb = match length_of_digit with
  | 64 -> fun nat ofs tmp ->
    set_digit_nat nat ofs (Random.bits ());
    shift_left_nat nat ofs 1 tmp 0 30;
    set_digit_nat tmp 0 (Random.bits ());
    lor_digit_nat nat ofs tmp 0;
    shift_left_nat nat ofs 1 tmp 0 30;
    set_digit_nat tmp 0 (Random.bits () land 7);
    lor_digit_nat nat ofs tmp 0
  | 32 -> fun nat ofs tmp ->
    set_digit_nat nat ofs (Random.bits ());
    shift_left_nat nat ofs 1 tmp 0 30;
    set_digit_nat tmp 0 (Random.bits () land 3);
    lor_digit_nat nat ofs tmp 0
  | _  -> assert false
  in fun max ->
  let nat = nat_of_big_int max in
  let len = num_digits_nat nat 0 (length_nat nat) in
  let res = create_nat len
  and tmp = create_nat 1 in
  for i = 0 to len - 1 do random_limb res i tmp done;
  mod_big_int (big_int_of_nat res) max

(You can’t go much lower level than this.) Next, some utility functions on Big_ints:

let is_zero_big_int n = Big_int.sign_big_int n == 0

let is_even_big_int n = Big_int.( is_zero_big_int (and_big_int n unit_big_int) )

let modsquare_big_int x n = Big_int.( mod_big_int (square_big_int x) n)

let modexp_big_int x e n =
  let open Big_int in
  let rec go y z e =
    if is_zero_big_int e then y else
    let y = if is_even_big_int e
      then y
      else mod_big_int (mult_big_int y z) n
    in go y (modsquare_big_int z n) (shift_right_big_int e 1)
  in go unit_big_int x e

Finally, an imperative-style Rabin-Miller test:

let is_prime n =
  let open Big_int in
  if le_big_int n unit_big_int || is_even_big_int n
    then invalid_arg "is_prime" else
  let m = pred_big_int n in
  let r = ref 0
  and s = ref m in
  while is_even_big_int !s do
    incr r;
    s := shift_right_big_int !s 1
  done;
  try for i = 1 to 50 do
    let a = add_int_big_int 2 (random_big_int (add_int_big_int (-2) n)) in
    let x = ref (modexp_big_int a !s n)
    and j = ref !r in
    let any = ref (eq_big_int !x unit_big_int) in
    while !j != 0 && not !any do
      if eq_big_int !x m
        then any := true
        else x := modsquare_big_int !x n;
      decr j
    done;
    if not !any then raise Exit
  done;
  true
  with Exit -> false

Two optimizations were applied: first, the random a should be greater than 1; second, the successive powers of a in the inner loop are calculated inductively by (modular) squaring.

import Control.Arrow
import Data.Bits
import Data.List
import System.Random

isPrime :: Integer -> StdGen -> Bool
isPrime n g =
    let (s, d) = (length *** head) . span even $ iterate (flip div 2) (n - 1)
        xs = map (expm n d) . take 50 $ randomRs (2, n - 2) g
    in all (\x -> elem x [1, n - 1] ||
                  any (== n - 1) (take s $ iterate (expm n 2) x)) xs

expm :: Integer -> Integer -> Integer -> Integer
expm m e b = foldl' (\r (b', _) -> mod (r * b') m) 1 .
             filter (flip testBit 0 . snd) .
             zip (iterate (flip mod m . (^ 2)) b) $
             takeWhile (> 0) $ iterate (flip shiftR 1) e

main :: IO ()
main = print . isPrime (2 ^ 89 - 1) =<< getStdGen