test/hamming.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*          Damien Doligez, projet Moscova, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 2002 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the Q Public License version 1.0.               *)
  10 (*                                                                     *)
  11 (***********************************************************************)
  12
  13 (* $Id$ *)
  14
  15 (* We cannot use bignums because we don't do custom runtimes, but
  16    int64 is a bit short, so we roll our own 37-digit numbers...
  17 *)
  18
  19 let n0 = Int64.of_int 0;;
  20 let n1 = Int64.of_int 1;;
  21 let n2 = Int64.of_int 2;;
  22 let n3 = Int64.of_int 3;;
  23 let n5 = Int64.of_int 5;;
  24
  25 let ( % ) = Int64.rem;;
  26 let ( * ) = Int64.mul;;
  27 let ( / ) = Int64.div;;
  28 let ( + ) = Int64.add;;
  29 let digit = Int64.of_string "1000000000000000000";;
  30
  31 let mul n (pl, ph) = ((n * pl) % digit, n * ph + (n * pl) / digit);;
  32 let cmp (nl, nh) (pl, ph) =
  33   if nh < ph then -1
  34   else if nh > ph then 1
  35   else if nl < pl then -1
  36   else if nl > pl then 1
  37   else 0
  38 ;;
  39
  40 let x2 = fun p -> mul n2 p;;
  41 let x3 = fun p -> mul n3 p;;
  42 let x5 = fun p -> mul n5 p;;
  43
  44 let nn1 = (n1, n0);;
  45
  46 let pr (nl, nh) =
  47   if compare nh n0 = 0
  48   then Printf.printf "%Ld\n" nl
  49   else Printf.printf "%Ld%018Ld\n" nh nl
  50 ;;
  51
  52 (*
  53   (* bignum version *)
  54 open Num;;
  55 let nn1 = num_of_int 1;;
  56 let x2 = fun p -> (num_of_int 2) */ p;;
  57 let x3 = fun p -> (num_of_int 3) */ p;;
  58 let x5 = fun p -> (num_of_int 5) */ p;;
  59 let cmp n p = sign_num (n -/ p);;
  60 let pr n = Printf.printf "%s\n" (string_of_num n);;
  61 *)
  62
  63
  64 (* This is where the interesting stuff begins. *)
  65
  66 open Lazy;;
  67
  68 type 'a lcons = Cons of 'a * 'a lcons Lazy.t;;
  69 type 'a llist = 'a lcons Lazy.t;;
  70
  71 let rec map f l =
  72   lazy (
  73     match force l with
  74     | Cons (x, ll) -> Cons (f x, map f ll)
  75   )
  76 ;;
  77
  78 let rec merge cmp l1 l2 =
  79   lazy (
  80     match force l1, force l2 with
  81     | Cons (x1, ll1), Cons (x2, ll2)
  82        -> let c = cmp x1 x2 in
  83           if c = 0
  84           then Cons (x1, merge cmp ll1 ll2)
  85           else if c < 0
  86           then Cons (x1, merge cmp ll1 l2)
  87           else Cons (x2, merge cmp l1 ll2)
  88   )
  89 ;;
  90
  91 let rec iter_interval f l (start, stop) =
  92   if stop = 0 then ()
  93   else match force l with
  94        | Cons (x, ll)
  95           -> if start <= 0 then f x;
  96              iter_interval f ll (start-1, stop-1)
  97 ;;
  98
  99 let rec hamming = lazy (Cons (nn1, merge cmp ham2 (merge cmp ham3 ham5)))
 100     and ham2 = lazy (force (map x2 hamming))
 101     and ham3 = lazy (force (map x3 hamming))
 102     and ham5 = lazy (force (map x5 hamming))
 103 ;;
 104
 105 iter_interval pr hamming (88000, 88100);;