[MLton] Factoring fun

[Wesley W. Terpstra]

--vkogqOf2sHV7VnPd
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline

In case anyone is interested in benchmarking MLton vs. other SML compilers
with a simple factoring algorithm, attached is factor.sml. This outputs
factored numbers in the same format as the coreutils factor present on every
Linux machine. Of course, that program only supports 64bit integers, the SML
program handles LargeInts.

./factor 85070591730234615865843651857942052865
./factor 98127489127489127498172489172489174987111 # takes some time

Just remember: the time needed is the squareroot of the 2nd largest factor.
So, don't expect it to break 512 bit RSA keys (where the 2nd largest factor
has ~256 bits -> 128 bits to search).

This program is intentionally unoptimized; I wanted to see how well MLton
managed with human-friendly code. Not bad. =)

-- 
Wesley W. Terpstra

--vkogqOf2sHV7VnPd
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="factor.sml"

open LargeInt

fun gcd (a, b) = if a = 0 then b else gcd (b mod a, a)

fun exp (x, 0, n) = 1
  | exp (x, 1, n) = x
  | exp (x, e, n) = exp (x*x mod n, e div 2, n) * exp (x, e mod 2, n) mod n

fun sort nil = nil
  | sort (p :: r) = 
    let val (s, b) = List.partition (fn x => x < p) r
    in sort s @ p :: sort b end

fun isPrime n = 
  let
    fun chomp (c, e) =
      if c mod 2 = 0 then chomp (c div 2, e+1) else (c, e)
    val (c, e) = chomp (n-1, 0)
    
    fun checkPow (w, e) =
      e > 0 andalso (w+1 = n orelse checkPow (w*w mod n, e-1))
    fun millerTest w = 
      let val v = exp (w, c, n)
      in v = 1 orelse checkPow (v, e) end
  in
    List.foldl (fn (w, a) => a andalso millerTest (1 + w mod (n-1))) true
      [ 2, 3, 5, 7, 11, 13, 17, 111, 123, 345 ]
  end

fun findafact n =
  let
    val start = Word.toLargeInt (MLton.Random.rand ()) mod n
    fun f x = (x*x + 2) mod n
    fun loop x y =
      let val g = gcd (n, n+x-y)
      in if g = 1 then loop (f x) (f (f y)) else g end
  in loop start (f start) end

fun factor n =
  let
    fun suck n l =
      if n = 1 then l else
      if isPrime n then n :: l else
      let val x = findafact n 
      in suck x (suck (n div x) l) end
  in sort (suck n []) end

val n = (valOf o fromString o hd o CommandLine.arguments) ()
val l = factor n

val () = print (toString n ^ ":")
val () = app (fn x => print (" " ^ toString x)) l
val () = print "\n"

--vkogqOf2sHV7VnPd--