--- a/src/HOL/IsaMakefile Wed Mar 12 19:38:13 2008 +0100
+++ b/src/HOL/IsaMakefile Wed Mar 12 19:38:14 2008 +0100
@@ -674,7 +674,7 @@
ex/Abstract_NAT.thy ex/Antiquote.thy ex/Arith_Examples.thy \
ex/BT.thy ex/BinEx.thy ex/CTL.thy \
ex/Chinese.thy ex/Classical.thy ex/Dense_Linear_Order_Ex.thy \
- ex/Eval_Examples.thy ex/Groebner_Examples.thy ex/Random.thy \
+ ex/Eval_Examples.thy ex/Groebner_Examples.thy ex/Random.thy ex/Quickcheck.thy \
ex/Codegenerator.thy ex/Codegenerator_Pretty.thy \
ex/Commutative_RingEx.thy ex/Efficient_Nat_examples.thy ex/Hex_Bin_Examples.thy \
ex/Commutative_Ring_Complete.thy ex/ExecutableContent.thy \
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/ex/Quickcheck.thy Wed Mar 12 19:38:14 2008 +0100
@@ -0,0 +1,383 @@
+(* ID: $Id$
+ Author: Florian Haftmann, TU Muenchen
+*)
+
+header {* A simple counterexample generator *}
+
+theory Quickcheck
+imports Random Eval
+begin
+
+subsection {* The @{text random} class *}
+
+class random = type +
+ fixes random :: "index \<Rightarrow> seed \<Rightarrow> 'a \<times> seed"
+
+print_classes
+
+instantiation itself :: (type) random
+begin
+
+definition
+ "random _ = return TYPE('a)"
+
+instance ..
+
+end
+
+lemma random_aux_if:
+ fixes random' :: "index \<Rightarrow> index \<Rightarrow> seed \<Rightarrow> 'a \<times> seed"
+ assumes "random' 0 j = undefined"
+ and "\<And>i. random' (Suc_index i) j = rhs2 i"
+ shows "random' i j s = (if i = 0 then undefined else rhs2 (i - 1) s)"
+ by (cases i rule: index.exhaust) (insert assms, simp_all add: undefined_fun)
+
+setup {*
+let
+ exception REC;
+ fun random_inst tyco thy =
+ let
+ val { descr, index, ... } = DatatypePackage.the_datatype thy tyco;
+ val _ = if length descr > 1 then raise REC else ();
+ val (raw_vs, _) = DatatypePackage.the_datatype_spec thy tyco;
+ val vs = (map o apsnd)
+ (curry (Sorts.inter_sort (Sign.classes_of thy)) @{sort random}) raw_vs;
+ val ty = Type (tyco, map TFree vs);
+ val typ_of = DatatypeAux.typ_of_dtyp descr vs;
+ val SOME (_, _, constrs) = AList.lookup (op =) descr index;
+ val randomN = NameSpace.base @{const_name random};
+ val random_aux_name = randomN ^ "_" ^ Class.type_name tyco ^ "'";
+ fun lift_ty ty = StateMonad.liftT ty @{typ seed};
+ val ty_aux = @{typ index} --> @{typ index} --> lift_ty ty;
+ fun random ty =
+ Const (@{const_name random}, @{typ index} --> lift_ty ty);
+ val random_aux = Free (random_aux_name, ty_aux);
+ fun add_cons_arg dty (is_rec, t) =
+ let
+ val ty' = typ_of dty;
+ val rec_call = case try DatatypeAux.dest_DtRec dty
+ of SOME index' => index = index'
+ | NONE => false
+ val random' = if rec_call
+ then random_aux $ @{term "i\<Colon>index"} $ @{term "j\<Colon>index"}
+ else random ty' $ @{term "j\<Colon>index"}
+ val is_rec' = is_rec orelse DatatypeAux.is_rec_type dty;
+ val t' = StateMonad.mbind ty' ty @{typ seed} random' (Abs ("", ty', t))
+ in (is_rec', t') end;
+ fun mk_cons_t (c, dtys) =
+ let
+ val ty' = map typ_of dtys ---> ty;
+ val t = StateMonad.return ty @{typ seed} (list_comb (Const (c, ty'),
+ map Bound (length dtys - 1 downto 0)));
+ val (is_rec, t') = fold_rev add_cons_arg dtys (false, t);
+ in (is_rec, StateMonad.run ty @{typ seed} t') end;
+ fun check_empty [] = NONE
+ | check_empty xs = SOME xs;
+ fun bundle_cons_ts cons_ts =
+ let
+ val ts = map snd cons_ts;
+ val t = HOLogic.mk_list (lift_ty ty) ts;
+ val t' = Const (@{const_name select}, HOLogic.listT (lift_ty ty) --> lift_ty (lift_ty ty)) $ t;
+ val t'' = Const (@{const_name collapse}, lift_ty (lift_ty ty) --> lift_ty ty) $ t';
+ in t'' end;
+ fun bundle_conss (some_rec_t, nonrec_t) =
+ let
+ val t = case some_rec_t
+ of SOME rec_t => Const (@{const_name collapse}, lift_ty (lift_ty ty) --> lift_ty ty)
+ $ (Const (@{const_name select_default},
+ @{typ index} --> lift_ty ty --> lift_ty ty --> lift_ty (lift_ty ty))
+ $ @{term "i\<Colon>index"} $ rec_t $ nonrec_t)
+ | NONE => nonrec_t
+ in t end;
+ val random_rhs = constrs
+ |> map mk_cons_t
+ |> List.partition fst
+ |> apfst (Option.map bundle_cons_ts o check_empty)
+ |> apsnd bundle_cons_ts
+ |> bundle_conss;
+ val random_aux_undef = (HOLogic.mk_Trueprop o HOLogic.mk_eq)
+ (random_aux $ @{term "0\<Colon>index"} $ @{term "j\<Colon>index"}, Const (@{const_name undefined}, lift_ty ty))
+ val random_aux_eq = (HOLogic.mk_Trueprop o HOLogic.mk_eq)
+ (random_aux $ @{term "Suc_index i"} $ @{term "j\<Colon>index"}, random_rhs);
+ val random_eq = (HOLogic.mk_Trueprop o HOLogic.mk_eq) (Const (@{const_name random},
+ @{typ index} --> lift_ty ty) $ @{term "i\<Colon>index"},
+ random_aux $ @{term "i\<Colon>index"} $ @{term "i\<Colon>index"});
+ val del_func = Attrib.internal (fn _ => Thm.declaration_attribute
+ (fn thm => Context.mapping (Code.del_func thm) I));
+ fun add_code simps lthy =
+ let
+ val thy = ProofContext.theory_of lthy;
+ val thm = @{thm random_aux_if}
+ |> Drule.instantiate' [SOME (Thm.ctyp_of thy ty)] [SOME (Thm.cterm_of thy random_aux)]
+ |> (fn thm => thm OF simps)
+ |> singleton (ProofContext.export lthy (ProofContext.init thy))
+ in
+ lthy
+ |> LocalTheory.theory (PureThy.note Thm.internalK (random_aux_name ^ "_code", thm)
+ #-> Code.add_func)
+ end;
+ in
+ thy
+ |> TheoryTarget.instantiation ([tyco], vs, @{sort random})
+ |> PrimrecPackage.add_primrec [(random_aux_name, SOME ty_aux, NoSyn)]
+ [(("", [del_func]), random_aux_undef), (("", [del_func]), random_aux_eq)]
+ |-> add_code
+ |> `(fn lthy => Syntax.check_term lthy random_eq)
+ |-> (fn eq => Specification.definition (NONE, (("", []), eq)))
+ |> snd
+ |> Class.prove_instantiation_instance (K (Class.intro_classes_tac []))
+ |> LocalTheory.exit
+ |> ProofContext.theory_of
+ end;
+ fun add_random_inst [tyco] = (fn thy => random_inst tyco thy handle REC =>
+ (warning ("Will not generated random elements for mutual recursive type " ^ quote tyco); thy))
+ | add_random_inst tycos = tap (fn _ => warning
+ ("Will not generated random elements for mutual recursive type(s) " ^ commas (map quote tycos)));
+in DatatypePackage.interpretation add_random_inst end
+*}
+
+instantiation int :: random
+begin
+
+definition
+ "random n = (do
+ (b, m) \<leftarrow> random n;
+ return (if b then int m else - int m)
+ done)"
+
+instance ..
+
+end
+
+instantiation set :: (random) random
+begin
+
+primrec random_set' :: "index \<Rightarrow> index \<Rightarrow> seed \<Rightarrow> 'a set \<times> seed" where
+ "random_set' 0 j = undefined"
+ | "random_set' (Suc_index i) j = collapse (select_default i
+ (do x \<leftarrow> random i; xs \<leftarrow> random_set' i j; return (insert x xs) done)
+ (return {}))"
+
+lemma random_set'_code [code func]:
+ "random_set' i j s = (if i = 0 then undefined else collapse (select_default (i - 1)
+ (do x \<leftarrow> random (i - 1); xs \<leftarrow> random_set' (i - 1) j; return (insert x xs) done)
+ (return {})) s)"
+ by (rule random_aux_if random_set'.simps)+
+
+definition
+ "random i = random_set' i i"
+
+instance ..
+
+end
+
+code_reserved SML Quickcheck
+
+
+subsection {* Quickcheck generator *}
+
+ML {*
+structure Quickcheck =
+struct
+
+val eval_ref : (unit -> int -> int * int -> term list option * (int * int)) option ref = ref NONE;
+
+fun mk_generator_expr prop tys =
+ let
+ val bounds = map_index (fn (i, ty) => (i, ty)) tys;
+ val result = list_comb (prop, map (fn (i, _) => Bound (length tys - i - 1)) bounds);
+ val terms = map (fn (i, ty) => Const (@{const_name Eval.term_of}, ty --> @{typ term}) $ Bound (length tys - i - 1)) bounds;
+ val check = @{term "If \<Colon> bool \<Rightarrow> term list option \<Rightarrow> term list option \<Rightarrow> term list option"}
+ $ result $ @{term "None \<Colon> term list option"} $ (@{term "Some \<Colon> term list \<Rightarrow> term list option "} $ HOLogic.mk_list @{typ term} terms);
+ val return = @{term "Pair \<Colon> term list option \<Rightarrow> seed \<Rightarrow> term list option \<times> seed"};
+ fun mk_bindtyp ty = @{typ seed} --> HOLogic.mk_prodT (ty, @{typ seed});
+ fun mk_bindclause (i, ty) t = Const (@{const_name mbind}, mk_bindtyp ty
+ --> (ty --> mk_bindtyp @{typ "term list option"}) --> mk_bindtyp @{typ "term list option"})
+ $ (Const (@{const_name random}, @{typ index} --> mk_bindtyp ty)
+ $ Bound i) $ Abs ("a", ty, t);
+ val t = fold_rev mk_bindclause bounds (return $ check);
+ in Abs ("n", @{typ index}, t) end;
+
+fun compile_generator_expr thy prop tys =
+ let
+ val f = CodePackage.eval_term ("Quickcheck.eval_ref", eval_ref) thy
+ (mk_generator_expr prop tys) [];
+ in f #> Random_Engine.run #> (Option.map o map) (Code.postprocess_term thy) end;
+
+fun VALUE prop tys thy =
+ let
+ val t = mk_generator_expr prop tys;
+ val eq = Logic.mk_equals (Free ("VALUE", fastype_of t), t)
+ in
+ thy
+ |> TheoryTarget.init NONE
+ |> Specification.definition (NONE, (("", []), eq))
+ |> snd
+ |> LocalTheory.exit
+ |> ProofContext.theory_of
+ end;
+
+end
+*}
+
+(*setup {* Quickcheck.VALUE @{term "\<lambda>(n::nat) (m::nat) (q::nat). n = m + q + 1"} [@{typ nat}, @{typ nat}, @{typ nat}] *}
+export_code VALUE in SML module_name QuickcheckExample file "~~/../../gen_code/quickcheck.ML"
+use "~~/../../gen_code/quickcheck.ML"
+ML {* Random_Engine.run (QuickcheckExample.range 1) *}*)
+
+ML {* val f = Quickcheck.compile_generator_expr @{theory}
+ @{term "\<lambda>(n::nat) (m::nat) (q::nat). n = m + q + 1"} [@{typ nat}, @{typ nat}, @{typ nat}] *}
+
+ML {* f 5 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 5 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 25 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 1 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 1 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 2 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 2 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+
+ML {* val f = Quickcheck.compile_generator_expr @{theory}
+ @{term "\<lambda>(n::int) (m::int) (q::int). n = m + q + 1"} [@{typ int}, @{typ int}, @{typ int}] *}
+
+(*definition "FOO = (True, Suc 0)"
+
+code_module (test) QuickcheckExample
+ file "~~/../../gen_code/quickcheck'.ML"
+ contains FOO*)
+
+ML {* f 5 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 5 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 25 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 1 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 1 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 2 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 2 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 3 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 4 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 4 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+
+ML {* val f = Quickcheck.compile_generator_expr @{theory}
+ @{term "\<lambda>(xs\<Colon>int list) ys. rev (xs @ ys) = rev xs @ rev ys"}
+ [@{typ "int list"}, @{typ "int list"}] *}
+
+ML {* f 15 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 5 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 25 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 1 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 1 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 2 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 2 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 4 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 4 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 5 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 8 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 8 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 8 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 88 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+
+subsection {* Incremental function generator *}
+
+ML {*
+structure Quickcheck =
+struct
+
+open Quickcheck;
+
+fun random_fun (eq : 'a -> 'a -> bool)
+ (random : Random_Engine.seed -> 'b * Random_Engine.seed)
+ (random_split : Random_Engine.seed -> Random_Engine.seed * Random_Engine.seed)
+ (seed : Random_Engine.seed) =
+ let
+ val (seed', seed'') = random_split seed;
+ val state = ref (seed', []);
+ fun random_fun' x =
+ let
+ val (seed, fun_map) = ! state;
+ in case AList.lookup (uncurry eq) fun_map x
+ of SOME y => y
+ | NONE => let
+ val (y, seed') = random seed;
+ val _ = state := (seed', (x, y) :: fun_map);
+ in y end
+ end;
+ in (random_fun', seed'') end;
+
+end
+*}
+
+axiomatization
+ random_fun_aux :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> (seed \<Rightarrow> 'b \<times> seed)
+ \<Rightarrow> (seed \<Rightarrow> seed \<times> seed) \<Rightarrow> seed \<Rightarrow> ('a \<Rightarrow> 'b) \<times> seed"
+
+code_const random_fun_aux (SML "Quickcheck.random'_fun")
+
+instantiation "fun" :: (term_of, term_of) term_of
+begin
+
+instance ..
+
+end
+
+code_const "Eval.term_of :: ('a\<Colon>term_of \<Rightarrow> 'b\<Colon>term_of) \<Rightarrow> _"
+ (SML "(fn '_ => Const (\"arbitrary\", dummyT))")
+
+instantiation "fun" :: (eq, "{type, random}") random
+begin
+
+definition
+ "random n = random_fun_aux (op =) (random n) split_seed"
+
+instance ..
+
+end
+
+ML {* val f = Quickcheck.compile_generator_expr @{theory}
+ @{term "\<lambda>f k. int (f k) = k"} [@{typ "int \<Rightarrow> nat"}, @{typ int}] *}
+
+ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+
+ML {* val f = Quickcheck.compile_generator_expr @{theory}
+ @{term "\<lambda>(A \<Colon> nat set) B. card (A \<union> B) = card A + card B"} [@{typ "nat set"}, @{typ "nat set"}] *}
+
+ML {* f 1 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 2 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 3 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 4 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 5 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 6 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 10 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 10 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+
+ML {* val f = Quickcheck.compile_generator_expr @{theory}
+ @{term "\<lambda>(s \<Colon> string). s \<noteq> rev s"} [@{typ string}] *}
+
+ML {* f 4 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 4 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 4 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 4 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 10 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 10 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 10 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 10 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 10 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 8 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+ML {* f 8 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
+
+end
--- a/src/HOL/ex/ROOT.ML Wed Mar 12 19:38:13 2008 +0100
+++ b/src/HOL/ex/ROOT.ML Wed Mar 12 19:38:14 2008 +0100
@@ -14,7 +14,7 @@
"FuncSet",
"Word",
"Eval_Examples",
- "Random"
+ "Quickcheck"
];
no_document use_thy "Codegenerator";
--- a/src/HOL/ex/Random.thy Wed Mar 12 19:38:13 2008 +0100
+++ b/src/HOL/ex/Random.thy Wed Mar 12 19:38:14 2008 +0100
@@ -2,30 +2,75 @@
Author: Florian Haftmann, TU Muenchen
*)
-header {* A simple term generator *}
+header {* A HOL random engine *}
theory Random
-imports State_Monad Code_Index List Eval
+imports State_Monad Code_Index
begin
-subsection {* The random engine *}
+subsection {* Auxiliary functions *}
+
+definition
+ inc_shift :: "index \<Rightarrow> index \<Rightarrow> index"
+where
+ "inc_shift v k = (if v = k then 1 else k + 1)"
+
+definition
+ minus_shift :: "index \<Rightarrow> index \<Rightarrow> index \<Rightarrow> index"
+where
+ "minus_shift r k l = (if k < l then r + k - l else k - l)"
+
+function
+ log :: "index \<Rightarrow> index \<Rightarrow> index"
+where
+ "log b i = (if b \<le> 1 \<or> i < b then 1 else 1 + log b (i div b))"
+by pat_completeness auto
+termination
+ by (relation "measure (nat_of_index o snd)")
+ (auto simp add: index)
+
+
+subsection {* Random seeds *}
types seed = "index \<times> index"
-definition
+primrec
"next" :: "seed \<Rightarrow> index \<times> seed"
where
- "next s = (let
- (v, w) = s;
- k = v div 53668;
- v' = 40014 * (v - k * 53668) - k * 12211;
- v'' = (if v' < 0 then v' + 2147483563 else v');
- l = w div 52774;
- w' = 40692 * (w - l * 52774) - l * 3791;
- w'' = (if w' < 0 then w' + 2147483399 else w');
- z = v'' - w'';
- z' = (if z < 1 then z + 2147483562 else z)
- in (z', (v'', w'')))"
+ "next (v, w) = (let
+ k = v div 53668;
+ v' = minus_shift 2147483563 (40014 * (v mod 53668)) (k * 12211);
+ l = w div 52774;
+ w' = minus_shift 2147483399 (40692 * (w mod 52774)) (l * 3791);
+ z = minus_shift 2147483562 v' (w' + 1) + 1
+ in (z, (v', w')))"
+
+lemma next_not_0:
+ "fst (next s) \<noteq> 0"
+apply (cases s)
+apply (auto simp add: minus_shift_def Let_def)
+done
+
+primrec
+ seed_invariant :: "seed \<Rightarrow> bool"
+where
+ "seed_invariant (v, w) \<longleftrightarrow> 0 < v \<and> v < 9438322952 \<and> 0 < w \<and> True"
+
+lemma if_same:
+ "(if b then f x else f y) = f (if b then x else y)"
+ by (cases b) simp_all
+
+(*lemma seed_invariant:
+ assumes "seed_invariant (index_of_nat v, index_of_nat w)"
+ and "(index_of_nat z, (index_of_nat v', index_of_nat w')) = next (index_of_nat v, index_of_nat w)"
+ shows "seed_invariant (index_of_nat v', index_of_nat w')"
+using assms
+apply (auto simp add: seed_invariant_def)
+apply (auto simp add: minus_shift_def Let_def)
+apply (simp_all add: if_same cong del: if_cong)
+apply safe
+unfolding not_less
+oops*)
definition
split_seed :: "seed \<Rightarrow> seed \<times> seed"
@@ -33,27 +78,14 @@
"split_seed s = (let
(v, w) = s;
(v', w') = snd (next s);
- v'' = (if v = 2147483562 then 1 else v + 1);
+ v'' = inc_shift 2147483562 v;
s'' = (v'', w');
- w'' = (if w = 2147483398 then 1 else w + 1);
+ w'' = inc_shift 2147483398 w;
s''' = (v', w'')
in (s'', s'''))"
-text {* Base selectors *}
-primrec
- pick :: "(index \<times> 'a) list \<Rightarrow> index \<Rightarrow> 'a"
-where
- "pick (x#xs) n = (if n < fst x then snd x else pick xs (n - fst x))"
-
-function
- iLogBase :: "index \<Rightarrow> index \<Rightarrow> index"
-where
- "iLogBase b i = (if b \<le> 1 \<or> i < b then 1 else 1 + iLogBase b (i div b))"
-by pat_completeness auto
-termination
- by (relation "measure (nat_of_index o snd)")
- (auto simp add: index)
+subsection {* Base selectors *}
function
range_aux :: "index \<Rightarrow> index \<Rightarrow> seed \<Rightarrow> index \<times> seed"
@@ -69,122 +101,94 @@
definition
range :: "index \<Rightarrow> seed \<Rightarrow> index \<times> seed"
where
- "range k s = (let
- b = 2147483561;
- n = iLogBase b k;
- (v, s') = range_aux n 1 s
- in (v mod k, s'))"
+ "range k = (do
+ v \<leftarrow> range_aux (log 2147483561 k) 1;
+ return (v mod k)
+ done)"
+
+lemma range:
+ assumes "k > 0"
+ shows "fst (range k s) < k"
+proof -
+ obtain v w where range_aux:
+ "range_aux (log 2147483561 k) 1 s = (v, w)"
+ by (cases "range_aux (log 2147483561 k) 1 s")
+ with assms show ?thesis
+ by (simp add: range_def run_def mbind_def split_def del: range_aux.simps log.simps)
+qed
definition
select :: "'a list \<Rightarrow> seed \<Rightarrow> 'a \<times> seed"
where
- [simp]: "select xs s = (let
- (k, s') = range (index_of_nat (length xs)) s
- in (nth xs (nat_of_index k), s'))"
+ "select xs = (do
+ k \<leftarrow> range (index_of_nat (length xs));
+ return (nth xs (nat_of_index k))
+ done)"
+
+lemma select:
+ assumes "xs \<noteq> []"
+ shows "fst (select xs s) \<in> set xs"
+proof -
+ from assms have "index_of_nat (length xs) > 0" by simp
+ with range have
+ "fst (range (index_of_nat (length xs)) s) < index_of_nat (length xs)" by best
+ then have
+ "nat_of_index (fst (range (index_of_nat (length xs)) s)) < length xs" by simp
+ then show ?thesis
+ by (auto simp add: select_def run_def mbind_def split_def)
+qed
definition
- select_weight :: "(index \<times> 'a) list \<Rightarrow> seed \<Rightarrow> 'a \<times> seed"
+ select_default :: "index \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> seed \<Rightarrow> 'a \<times> seed"
where
- [simp]: "select_weight xs s = (let
- (k, s') = range (foldr (op + \<circ> fst) xs 0) s
- in (pick xs k, s'))"
+ [code func del]: "select_default k x y = (do
+ l \<leftarrow> range k;
+ return (if l + 1 < k then x else y)
+ done)"
+
+lemma select_default_zero:
+ "fst (select_default 0 x y s) = y"
+ by (simp add: run_def mbind_def split_def select_default_def)
-(*lemma
- "select (x#xs) s = select_weight (map (Pair 1) (x#xs)) s"
-proof (induct xs)
- case Nil show ?case apply (auto simp add: Let_def split_def)
+lemma select_default_code [code]:
+ "select_default k x y = (if k = 0 then do
+ _ \<leftarrow> range 1;
+ return y
+ done else do
+ l \<leftarrow> range k;
+ return (if l + 1 < k then x else y)
+ done)"
+proof (cases "k = 0")
+ case False then show ?thesis by (simp add: select_default_def)
next
- have map_fst_Pair: "!!xs y. map fst (map (Pair y) xs) = replicate (length xs) y"
- proof -
- fix xs
- fix y
- show "map fst (map (Pair y) xs) = replicate (length xs) y"
- by (induct xs) simp_all
- qed
- have pick_nth: "!!xs n. n < length xs \<Longrightarrow> pick (map (Pair 1) xs) n = nth xs n"
- proof -
- fix xs
- fix n
- assume "n < length xs"
- then show "pick (map (Pair 1) xs) n = nth xs n"
- proof (induct xs arbitrary: n)
- case Nil then show ?case by simp
- next
- case (Cons x xs) show ?case
- proof (cases n)
- case 0 then show ?thesis by simp
- next
- case (Suc _)
- from Cons have "n < length (x # xs)" by auto
- then have "n < Suc (length xs)" by simp
- with Suc have "n - 1 < Suc (length xs) - 1" by auto
- with Cons have "pick (map (Pair (1\<Colon>nat)) xs) (n - 1) = xs ! (n - 1)" by auto
- with Suc show ?thesis by auto
- qed
- qed
- qed
- have sum_length: "!!xs. foldl (op +) 0 (map fst (map (Pair 1) xs)) = length xs"
- proof -
- have replicate_append:
- "!!x xs y. replicate (length (x # xs)) y = replicate (length xs) y @ [y]"
- by (simp add: replicate_app_Cons_same)
- fix xs
- show "foldl (op +) 0 (map fst (map (Pair 1) xs)) = length xs"
- unfolding map_fst_Pair proof (induct xs)
- case Nil show ?case by simp
- next
- case (Cons x xs) then show ?case unfolding replicate_append by simp
- qed
- qed
- have pick_nth_random:
- "!!x xs s. pick (map (Pair 1) (x#xs)) (fst (random (length (x#xs)) s)) = nth (x#xs) (fst (random (length (x#xs)) s))"
- proof -
- fix s
- fix x
- fix xs
- have bound: "fst (random (length (x#xs)) s) < length (x#xs)" by (rule random_bound) simp
- from pick_nth [OF bound] show
- "pick (map (Pair 1) (x#xs)) (fst (random (length (x#xs)) s)) = nth (x#xs) (fst (random (length (x#xs)) s))" .
- qed
- have pick_nth_random_do:
- "!!x xs s. (do n \<leftarrow> random (length (x#xs)); return (pick (map (Pair 1) (x#xs)) n) done) s =
- (do n \<leftarrow> random (length (x#xs)); return (nth (x#xs) n) done) s"
- unfolding monad_collapse split_def unfolding pick_nth_random ..
- case (Cons x xs) then show ?case
- unfolding select_weight_def sum_length pick_nth_random_do
- by simp
-qed*)
+ case True then show ?thesis
+ by (simp add: run_def mbind_def split_def select_default_def expand_fun_eq range_def)
+qed
-text {* The @{text ML} interface *}
+
+subsection {* @{text ML} interface *}
ML {*
-structure Quickcheck =
+structure Random_Engine =
struct
type seed = int * int;
local
-val seed = ref (0, 0);
-
-fun init () =
- let
- val now = Time.toNanoseconds (Time.now ());
+val seed = ref
+ (let
+ val now = Time.toMilliseconds (Time.now ());
val (q, s1) = IntInf.divMod (now, 2147483562);
val s2 = q mod 2147483398;
- in seed := (s1 + 1, s2 + 1) end;
-
+ in (s1 + 1, s2 + 1) end);
+
in
-val seed = seed; (* FIXME *)
-
fun run f =
let
- val (x, seed') = f (!seed);
+ val (x, seed') = f (! seed);
val _ = seed := seed'
- val _ = if fst (! seed) = 0 orelse snd (! seed) = 0 then
- (warning "broken random seed"; init ())
- else ()
in x end;
end;
@@ -192,325 +196,4 @@
end;
*}
-
-subsection {* The @{text random} class *}
-
-class random =
- fixes random :: "index \<Rightarrow> seed \<Rightarrow> 'a\<Colon>{} \<times> seed"
-
-instantiation itself :: (type) random
-begin
-
-definition
- "random _ = return TYPE('a)"
-
-instance ..
-
end
-
-lemma random_aux_if:
- fixes random' :: "index \<Rightarrow> index \<Rightarrow> seed \<Rightarrow> 'a \<times> seed"
- assumes "random' 0 j = undefined"
- and "\<And>i. random' (Suc_index i) j = rhs2 i"
- shows "random' i j s = (if i = 0 then undefined else rhs2 (i - 1) s)"
- by (cases i rule: index.exhaust) (insert assms, simp_all add: undefined_fun)
-
-setup {*
-let
- fun random_inst tyco thy =
- let
- val { descr, index, ... } = DatatypePackage.the_datatype thy tyco;
- val (raw_vs, _) = DatatypePackage.the_datatype_spec thy tyco;
- val vs = (map o apsnd)
- (curry (Sorts.inter_sort (Sign.classes_of thy)) @{sort random}) raw_vs;
- val ty = Type (tyco, map TFree vs);
- val typ_of = DatatypeAux.typ_of_dtyp descr vs;
- val SOME (_, _, constrs) = AList.lookup (op =) descr index;
- val randomN = NameSpace.base @{const_name random};
- val random_aux_name = randomN ^ "_" ^ Class.type_name tyco ^ "'";
- fun lift_ty ty = StateMonad.liftT ty @{typ seed};
- val ty_aux = @{typ index} --> @{typ index} --> lift_ty ty;
- fun random ty =
- Const (@{const_name random}, @{typ index} --> lift_ty ty);
- val random_aux = Free (random_aux_name, ty_aux);
- fun add_cons_arg dty (is_rec, t) =
- let
- val ty' = typ_of dty;
- val random' = if can DatatypeAux.dest_DtRec dty
- then random_aux $ @{term "i\<Colon>index"} $ @{term "j\<Colon>index"}
- else random ty' $ @{term "j\<Colon>index"}
- val is_rec' = is_rec orelse DatatypeAux.is_rec_type dty;
- val t' = StateMonad.mbind ty' ty @{typ seed} random' (Abs ("", ty', t))
- in (is_rec', t') end;
- fun mk_cons_t (c, dtys) =
- let
- val ty' = map typ_of dtys ---> ty;
- val t = StateMonad.return ty @{typ seed} (list_comb (Const (c, ty'),
- map Bound (length dtys - 1 downto 0)));
- val (is_rec, t') = fold_rev add_cons_arg dtys (false, t);
- in (is_rec, StateMonad.run ty @{typ seed} t') end;
- fun check_empty [] = NONE
- | check_empty xs = SOME xs;
- fun bundle_cons_ts cons_ts =
- let
- val ts = map snd cons_ts;
- val t = HOLogic.mk_list (lift_ty ty) ts;
- val t' = Const (@{const_name select}, HOLogic.listT (lift_ty ty) --> lift_ty (lift_ty ty)) $ t;
- val t'' = Const (@{const_name collapse}, lift_ty (lift_ty ty) --> lift_ty ty) $ t';
- in t'' end;
- fun bundle_conss (some_rec_t, nonrec_t) =
- let
- val rec' = case some_rec_t
- of SOME rec_t => SOME (HOLogic.mk_prod (@{term "i\<Colon>index"}, rec_t))
- | NONE => NONE;
- val nonrec' = HOLogic.mk_prod (@{term "1\<Colon>index"}, nonrec_t);
- val i_ty = HOLogic.mk_prodT (@{typ index}, lift_ty ty);
- val t = HOLogic.mk_list i_ty (the_list rec' @ single nonrec');
- val t' = Const (@{const_name select_weight}, HOLogic.listT i_ty --> lift_ty (lift_ty ty)) $ t;
- val t'' = Const (@{const_name collapse}, lift_ty (lift_ty ty) --> lift_ty ty) $ t';
- in t'' end;
- val random_rhs = constrs
- |> map mk_cons_t
- |> List.partition fst
- |> apfst (Option.map bundle_cons_ts o check_empty)
- |> apsnd bundle_cons_ts
- |> bundle_conss;
- val random_aux_undef = (HOLogic.mk_Trueprop o HOLogic.mk_eq)
- (random_aux $ @{term "0\<Colon>index"} $ @{term "j\<Colon>index"}, Const (@{const_name undefined}, lift_ty ty))
- val random_aux_eq = (HOLogic.mk_Trueprop o HOLogic.mk_eq)
- (random_aux $ @{term "Suc_index i"} $ @{term "j\<Colon>index"}, random_rhs);
- val random_eq = (HOLogic.mk_Trueprop o HOLogic.mk_eq) (Const (@{const_name random},
- @{typ index} --> lift_ty ty) $ @{term "i\<Colon>index"},
- random_aux $ @{term "i\<Colon>index"} $ @{term "i\<Colon>index"});
- val del_func = Attrib.internal (fn _ => Thm.declaration_attribute
- (fn thm => Context.mapping (Code.del_func thm) I));
- fun add_code simps lthy =
- let
- val thy = ProofContext.theory_of lthy;
- val thm = @{thm random_aux_if}
- |> Drule.instantiate' [SOME (Thm.ctyp_of thy ty)] [SOME (Thm.cterm_of thy random_aux)]
- |> (fn thm => thm OF simps)
- |> singleton (ProofContext.export lthy (ProofContext.init thy))
- in
- lthy
- |> LocalTheory.theory (PureThy.note Thm.internalK (random_aux_name ^ "_code", thm)
- #-> Code.add_func)
- end;
- in
- thy
- |> TheoryTarget.instantiation ([tyco], vs, @{sort random})
- |> PrimrecPackage.add_primrec [(random_aux_name, SOME ty_aux, NoSyn)]
- [(("", [del_func]), random_aux_undef), (("", [del_func]), random_aux_eq)]
- |-> add_code
- |> `(fn lthy => Syntax.check_term lthy random_eq)
- |-> (fn eq => Specification.definition (NONE, (("", []), eq)))
- |> snd
- |> Class.prove_instantiation_instance (K (Class.intro_classes_tac []))
- |> LocalTheory.exit
- |> ProofContext.theory_of
- end;
- fun add_random_inst [tyco] = (fn thy => case try (random_inst tyco) thy
- of SOME thy => thy
- | NONE => (warning ("Failed to generate random elements for type" ^ tyco); thy))
- | add_random_inst tycos = tap (fn _ => warning
- ("Will not generated random elements for mutual recursive types " ^ commas (map quote tycos)));
-in DatatypePackage.interpretation add_random_inst end
-*}
-
-instantiation int :: random
-begin
-
-definition
- "random n = (do
- (b, m) \<leftarrow> random n;
- return (if b then int m else - int m)
- done)"
-
-instance ..
-
-end
-
-code_reserved SML Quickcheck
-
-
-subsection {* Quickcheck generator *}
-
-ML {*
-structure Quickcheck =
-struct
-
-open Quickcheck;
-
-val eval_ref : (unit -> int -> int * int -> term list option * (int * int)) option ref = ref NONE;
-
-fun mk_generator_expr prop tys =
- let
- val bounds = map_index (fn (i, ty) => (i, ty)) tys;
- val result = list_comb (prop, map (fn (i, _) => Bound (length tys - i - 1)) bounds);
- val terms = map (fn (i, ty) => Const (@{const_name Eval.term_of}, ty --> @{typ term}) $ Bound (length tys - i - 1)) bounds;
- val check = @{term "If \<Colon> bool \<Rightarrow> term list option \<Rightarrow> term list option \<Rightarrow> term list option"}
- $ result $ @{term "None \<Colon> term list option"} $ (@{term "Some \<Colon> term list \<Rightarrow> term list option "} $ HOLogic.mk_list @{typ term} terms);
- val return = @{term "Pair \<Colon> term list option \<Rightarrow> seed \<Rightarrow> term list option \<times> seed"};
- fun mk_bindtyp ty = @{typ seed} --> HOLogic.mk_prodT (ty, @{typ seed});
- fun mk_bindclause (i, ty) t = Const (@{const_name mbind}, mk_bindtyp ty
- --> (ty --> mk_bindtyp @{typ "term list option"}) --> mk_bindtyp @{typ "term list option"})
- $ (Const (@{const_name random}, @{typ index} --> mk_bindtyp ty)
- $ Bound i) $ Abs ("a", ty, t);
- val t = fold_rev mk_bindclause bounds (return $ check);
- in Abs ("n", @{typ index}, t) end;
-
-fun compile_generator_expr thy prop tys =
- let
- val f = CodePackage.eval_term ("Quickcheck.eval_ref", eval_ref) thy
- (mk_generator_expr prop tys) [];
- in f #> run #> (Option.map o map) (Code.postprocess_term thy) end;
-
-fun VALUE prop tys thy =
- let
- val t = mk_generator_expr prop tys;
- val eq = Logic.mk_equals (Free ("VALUE", fastype_of t), t)
- in
- thy
- |> TheoryTarget.init NONE
- |> Specification.definition (NONE, (("", []), eq))
- |> snd
- |> LocalTheory.exit
- |> ProofContext.theory_of
- end;
-
-end
-*}
-
-ML {* val f = Quickcheck.compile_generator_expr @{theory}
- @{term "\<lambda>(n::nat) (m::nat) (q::nat). n = m + q + 1"} [@{typ nat}, @{typ nat}, @{typ nat}] *}
-
-ML {* f 5 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 5 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 25 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 1 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 1 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 2 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 2 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-
-ML {* val f = Quickcheck.compile_generator_expr @{theory}
- @{term "\<lambda>(n::int) (m::int) (q::int). n = m + q + 1"} [@{typ int}, @{typ int}, @{typ int}] *}
-
-(*setup {* Quickcheck.VALUE @{term "\<lambda>(n::int) (m::int) (q::int). n = m + q + 1"} [@{typ int}, @{typ int}, @{typ int}] *}
-
-export_code VALUE in SML module_name QuickcheckExample file "~~/../../gen_code/quickcheck.ML"
-
-definition "FOO = (True, Suc 0)"
-
-code_module (test) QuickcheckExample
- file "~~/../../gen_code/quickcheck'.ML"
- contains FOO*)
-
-ML {* f 5 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 5 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 25 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 1 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 1 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 2 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 2 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 3 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 4 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 4 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-
-ML {* val f = Quickcheck.compile_generator_expr @{theory}
- @{term "\<lambda>(xs\<Colon>nat list) ys. rev (xs @ ys) = rev xs @ rev ys"}
- [@{typ "nat list"}, @{typ "nat list"}] *}
-
-ML {* f 15 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 5 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 25 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 1 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 1 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 2 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 2 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 4 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 4 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 5 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 8 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 8 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 8 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 88 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-
-subsection {* Incremental function generator *}
-
-ML {*
-structure Quickcheck =
-struct
-
-open Quickcheck;
-
-fun random_fun (eq : 'a -> 'a -> bool)
- (random : seed -> 'b * seed)
- (random_split : seed -> seed * seed)
- (seed : seed) =
- let
- val (seed', seed'') = random_split seed;
- val state = ref (seed', []);
- fun random_fun' x =
- let
- val (seed, fun_map) = ! state;
- in case AList.lookup (uncurry eq) fun_map x
- of SOME y => y
- | NONE => let
- val (y, seed') = random seed;
- val _ = state := (seed', (x, y) :: fun_map);
- in y end
- end;
- in (random_fun', seed'') end;
-
-end
-*}
-
-axiomatization
- random_fun_aux :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> (seed \<Rightarrow> 'b \<times> seed)
- \<Rightarrow> (seed \<Rightarrow> seed \<times> seed) \<Rightarrow> seed \<Rightarrow> ('a \<Rightarrow> 'b) \<times> seed"
-
-code_const random_fun_aux (SML "Quickcheck.random'_fun")
-
-instantiation "fun" :: (term_of, term_of) term_of
-begin
-
-instance ..
-
-end
-
-code_const "Eval.term_of :: ('a\<Colon>term_of \<Rightarrow> 'b\<Colon>term_of) \<Rightarrow> _"
- (SML "(fn '_ => Const (\"arbitrary\", dummyT))")
-
-instantiation "fun" :: (eq, "{type, random}") random
-begin
-
-definition
- "random n = random_fun_aux (op =) (random n) split_seed"
-
-instance ..
-
-end
-
-ML {* val f = Quickcheck.compile_generator_expr @{theory}
- @{term "\<lambda>f k. int (f k) = k"} [@{typ "int \<Rightarrow> nat"}, @{typ int}] *}
-
-ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-ML {* f 20 |> (Option.map o map) (Sign.string_of_term @{theory}) *}
-
-end