extra/benchmark/beust2/beust2.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: math math.ranges math.parser sequences kernel io locals ;
   4 IN: benchmark.beust2
   5
   6 :: (count-numbers) ( remaining first value used max listener -- ? )
   7     10 first - [| i |
   8         [let* | digit [ i first + ]
   9                 mask [ digit 2^ ]
  10                 value' [ i value + ] |
  11             used mask bitand zero? [
  12                 value max > [ t ] [
  13                     remaining 1 <= [
  14                         listener call f
  15                     ] [
  16                         remaining 1-
  17                         0
  18                         value' 10 *
  19                         used mask bitor
  20                         max
  21                         listener
  22                         (count-numbers)
  23                     ] if
  24                 ] if
  25             ] [ f ] if
  26         ]
  27     ] contains? ; inline
  28
  29 :: count-numbers ( max listener -- )
  30     10 [ 1+ 1 1 0 max listener (count-numbers) ] contains? drop ;
  31     inline
  32
  33 :: beust ( -- )
  34     [let | i! [ 0 ] |
  35         10000000000 [ i 1+ i! ] count-numbers
  36         i number>string " unique numbers." append print
  37     ] ;
  38
  39 MAIN: beust