圏論勉強会#9 関数 fact の最小不動点を調べる例をSMLで実装 http://nineties.github.io/category-seminar/9.html#/45

fix_fact.sml

(**
 * 圏論勉強会#9
 *
 * 関数 fact の最小不動点を調べる 例をSMLで実装
 * http://nineties.github.io/category-seminar/9.html#/45
 *
 *)
structure Fact =
struct
  infixr 1 $
  fun f $ a = f a

  exception Fact

  fun factF f = fn n => if n=0 then 1 else n * f(n-1);
  val bottom = fn _=> raise Fact (* ⊥ *)
  val fact0 = bottom
  val fact1 = factF $ bottom
  val fact2 = factF o factF $ bottom
  val fact3 = factF o factF o factF $ bottom
  val fact4 = factF o factF o factF o factF $ bottom
  val fact5 = factF o factF o factF o factF o factF $ bottom

local
  open SMLUnit
  open Assert
  val (L,&,%) = (Test.TestLabel,Test.TestList,Test.TestCase)
in
val _ =
  let
    val assert = assertEqualInt
    val error  = assertEqualExceptionName Fact
    val test =
      L ("limit of fact" 
        , &[ L ("fact0", &[
                          (* % (fn()=> assert 1 (fact0 0)) *)
                          ])

           , L ("fact1", &[ % (fn()=> assert 1 (fact1 0))
                          (* , % (fn()=> assert 1 (fact1 1)) *)
                          ])

           , L ("fact2", &[ % (fn()=> assert 1 (fact2 0))
                          , % (fn()=> assert 1 (fact2 1))
                          (* , % (fn()=> assert 2 (fact2 2)) *)
                          ])

           , L ("fact3", &[ % (fn()=> assert 1 (fact3 0))
                          , % (fn()=> assert 1 (fact3 1))
                          , % (fn()=> assert 2 (fact3 2))
                          (* , % (fn()=> assert 6 (fact3 3)) *)
                          ])

           , L ("fact4", &[ % (fn()=> assert  1 (fact4 0))
                          , % (fn()=> assert  1 (fact4 1))
                          , % (fn()=> assert  2 (fact4 2))
                          , % (fn()=> assert  6 (fact4 3))
                          (* , % (fn()=> assert 24 (fact4 4)) *)
                          ])

           , L ("fact5", &[ % (fn()=> assert   1 (fact5 0))
                          , % (fn()=> assert   1 (fact5 1))
                          , % (fn()=> assert   2 (fact5 2))
                          , % (fn()=> assert   6 (fact5 3))
                          , % (fn()=> assert  24 (fact5 4))
                          (* , % (fn()=> assert 120 (fact5 5)) *)
                          ])
           ])
  in
    TextUITestRunner.runTest {output=TextIO.stdOut} test
  end
end
end

http://d.hatena.ne.jp/eldesh/20130713