diff -r 9e40d815e002 -r 099877d83d2b src/HOL/Extraction/Higman.thy --- a/src/HOL/Extraction/Higman.thy Mon Oct 02 23:00:52 2006 +0200 +++ b/src/HOL/Extraction/Higman.thy Mon Oct 02 23:00:53 2006 +0200 @@ -294,9 +294,6 @@ contains test = good_prefix -declare barT.recs(2) [where ?fun = ?func, code func] -code_gen good_prefix (SML -) - ML {* local open Higman in @@ -340,4 +337,52 @@ end; *} +code_gen good_prefix (SML -) + +ML {* +local + open ROOT.Higman + open ROOT.IntDef +in + +val a = 16807.0; +val m = 2147483647.0; + +fun nextRand seed = + let val t = a*seed + in t - m * real (Real.floor(t/m)) end; + +fun mk_word seed l = + let + val r = nextRand seed; + val i = Real.round (r / m * 10.0); + in if i > 7 andalso l > 2 then (r, []) else + apsnd (cons (if i mod 2 = 0 then A else B)) (mk_word r (l+1)) + end; + +fun f s id_0 = mk_word s 0 + | f s (Succ_nat n) = f (fst (mk_word s 0)) n; + +val g1 = snd o (f 20000.0); + +val g2 = snd o (f 50000.0); + +fun f1 id_0 = [A,A] + | f1 (Succ_nat id_0) = [B] + | f1 (Succ_nat (Succ_nat id_0)) = [A,B] + | f1 _ = []; + +fun f2 id_0 = [A,A] + | f2 (Succ_nat id_0) = [B] + | f2 (Succ_nat (Succ_nat id_0)) = [B,A] + | f2 _ = []; + +val xs1 = good_prefix g1; +val xs2 = good_prefix g2; +val xs3 = good_prefix f1; +val xs4 = good_prefix f2; + +end; +*} + end