--- a/src/HOL/Tools/Predicate_Compile/predicate_compile_compilations.ML Fri Nov 11 10:40:36 2011 +0100
+++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_compilations.ML Fri Nov 11 12:10:49 2011 +0100
@@ -7,16 +7,16 @@
structure Predicate_Comp_Funs =
struct
-fun mk_predT T = Type (@{type_name Predicate.pred}, [T])
+fun mk_monadT T = Type (@{type_name Predicate.pred}, [T])
-fun dest_predT (Type (@{type_name Predicate.pred}, [T])) = T
- | dest_predT T = raise TYPE ("dest_predT", [T], []);
+fun dest_monadT (Type (@{type_name Predicate.pred}, [T])) = T
+ | dest_monadT T = raise TYPE ("dest_monadT", [T], []);
-fun mk_bot T = Const (@{const_name Orderings.bot}, mk_predT T);
+fun mk_empty T = Const (@{const_name Orderings.bot}, mk_monadT T);
fun mk_single t =
let val T = fastype_of t
- in Const(@{const_name Predicate.single}, T --> mk_predT T) $ t end;
+ in Const(@{const_name Predicate.single}, T --> mk_monadT T) $ t end;
fun mk_bind (x, f) =
let val T as Type ("fun", [_, U]) = fastype_of f
@@ -24,42 +24,42 @@
Const (@{const_name Predicate.bind}, fastype_of x --> T --> U) $ x $ f
end;
-val mk_sup = HOLogic.mk_binop @{const_name sup};
+val mk_plus = HOLogic.mk_binop @{const_name sup};
fun mk_if cond = Const (@{const_name Predicate.if_pred},
- HOLogic.boolT --> mk_predT HOLogic.unitT) $ cond;
+ HOLogic.boolT --> mk_monadT HOLogic.unitT) $ cond;
fun mk_iterate_upto T (f, from, to) =
list_comb (Const (@{const_name Code_Numeral.iterate_upto},
- [@{typ code_numeral} --> T, @{typ code_numeral}, @{typ code_numeral}] ---> mk_predT T),
+ [@{typ code_numeral} --> T, @{typ code_numeral}, @{typ code_numeral}] ---> mk_monadT T),
[f, from, to])
fun mk_not t =
let
- val T = mk_predT HOLogic.unitT
+ val T = mk_monadT HOLogic.unitT
in Const (@{const_name Predicate.not_pred}, T --> T) $ t end
fun mk_Enum f =
let val T as Type ("fun", [T', _]) = fastype_of f
in
- Const (@{const_name Predicate.Pred}, T --> mk_predT T') $ f
+ Const (@{const_name Predicate.Pred}, T --> mk_monadT T') $ f
end;
fun mk_Eval (f, x) =
let
- val T = dest_predT (fastype_of f)
+ val T = dest_monadT (fastype_of f)
in
- Const (@{const_name Predicate.eval}, mk_predT T --> T --> HOLogic.boolT) $ f $ x
+ Const (@{const_name Predicate.eval}, mk_monadT T --> T --> HOLogic.boolT) $ f $ x
end;
fun dest_Eval (Const (@{const_name Predicate.eval}, _) $ f $ x) = (f, x)
fun mk_map T1 T2 tf tp = Const (@{const_name Predicate.map},
- (T1 --> T2) --> mk_predT T1 --> mk_predT T2) $ tf $ tp;
+ (T1 --> T2) --> mk_monadT T1 --> mk_monadT T2) $ tf $ tp;
val compfuns = Predicate_Compile_Aux.CompilationFuns
- {mk_predT = mk_predT, dest_predT = dest_predT, mk_bot = mk_bot,
- mk_single = mk_single, mk_bind = mk_bind, mk_sup = mk_sup, mk_if = mk_if,
+ {mk_monadT = mk_monadT, dest_monadT = dest_monadT, mk_empty = mk_empty,
+ mk_single = mk_single, mk_bind = mk_bind, mk_plus = mk_plus, mk_if = mk_if,
mk_iterate_upto = mk_iterate_upto, mk_not = mk_not, mk_map = mk_map};
end;
@@ -67,16 +67,16 @@
structure CPS_Comp_Funs =
struct
-fun mk_predT T = (T --> @{typ "Code_Evaluation.term list option"}) --> @{typ "Code_Evaluation.term list option"}
+fun mk_monadT T = (T --> @{typ "Code_Evaluation.term list option"}) --> @{typ "Code_Evaluation.term list option"}
-fun dest_predT (Type ("fun", [Type ("fun", [T, @{typ "term list option"}]), @{typ "term list option"}])) = T
- | dest_predT T = raise TYPE ("dest_predT", [T], []);
+fun dest_monadT (Type ("fun", [Type ("fun", [T, @{typ "term list option"}]), @{typ "term list option"}])) = T
+ | dest_monadT T = raise TYPE ("dest_monadT", [T], []);
-fun mk_bot T = Const (@{const_name Quickcheck_Exhaustive.cps_empty}, mk_predT T);
+fun mk_empty T = Const (@{const_name Quickcheck_Exhaustive.cps_empty}, mk_monadT T);
fun mk_single t =
let val T = fastype_of t
- in Const(@{const_name Quickcheck_Exhaustive.cps_single}, T --> mk_predT T) $ t end;
+ in Const(@{const_name Quickcheck_Exhaustive.cps_single}, T --> mk_monadT T) $ t end;
fun mk_bind (x, f) =
let val T as Type ("fun", [_, U]) = fastype_of f
@@ -84,16 +84,16 @@
Const (@{const_name Quickcheck_Exhaustive.cps_bind}, fastype_of x --> T --> U) $ x $ f
end;
-val mk_sup = HOLogic.mk_binop @{const_name Quickcheck_Exhaustive.cps_plus};
+val mk_plus = HOLogic.mk_binop @{const_name Quickcheck_Exhaustive.cps_plus};
fun mk_if cond = Const (@{const_name Quickcheck_Exhaustive.cps_if},
- HOLogic.boolT --> mk_predT HOLogic.unitT) $ cond;
+ HOLogic.boolT --> mk_monadT HOLogic.unitT) $ cond;
fun mk_iterate_upto T (f, from, to) = error "not implemented yet"
fun mk_not t =
let
- val T = mk_predT HOLogic.unitT
+ val T = mk_monadT HOLogic.unitT
in Const (@{const_name Quickcheck_Exhaustive.cps_not}, T --> T) $ t end
fun mk_Enum f = error "not implemented"
@@ -105,8 +105,8 @@
fun mk_map T1 T2 tf tp = error "not implemented"
val compfuns = Predicate_Compile_Aux.CompilationFuns
- {mk_predT = mk_predT, dest_predT = dest_predT, mk_bot = mk_bot,
- mk_single = mk_single, mk_bind = mk_bind, mk_sup = mk_sup, mk_if = mk_if,
+ {mk_monadT = mk_monadT, dest_monadT = dest_monadT, mk_empty = mk_empty,
+ mk_single = mk_single, mk_bind = mk_bind, mk_plus = mk_plus, mk_if = mk_if,
mk_iterate_upto = mk_iterate_upto, mk_not = mk_not, mk_map = mk_map};
end;
@@ -114,16 +114,16 @@
structure Pos_Bounded_CPS_Comp_Funs =
struct
-fun mk_predT T = (T --> @{typ "Code_Evaluation.term list option"}) --> @{typ "code_numeral => Code_Evaluation.term list option"}
+fun mk_monadT T = (T --> @{typ "Code_Evaluation.term list option"}) --> @{typ "code_numeral => Code_Evaluation.term list option"}
-fun dest_predT (Type ("fun", [Type ("fun", [T, @{typ "term list option"}]), @{typ "code_numeral => term list option"}])) = T
- | dest_predT T = raise TYPE ("dest_predT", [T], []);
+fun dest_monadT (Type ("fun", [Type ("fun", [T, @{typ "term list option"}]), @{typ "code_numeral => term list option"}])) = T
+ | dest_monadT T = raise TYPE ("dest_monadT", [T], []);
-fun mk_bot T = Const (@{const_name Quickcheck_Exhaustive.pos_bound_cps_empty}, mk_predT T);
+fun mk_empty T = Const (@{const_name Quickcheck_Exhaustive.pos_bound_cps_empty}, mk_monadT T);
fun mk_single t =
let val T = fastype_of t
- in Const(@{const_name Quickcheck_Exhaustive.pos_bound_cps_single}, T --> mk_predT T) $ t end;
+ in Const(@{const_name Quickcheck_Exhaustive.pos_bound_cps_single}, T --> mk_monadT T) $ t end;
fun mk_bind (x, f) =
let val T as Type ("fun", [_, U]) = fastype_of f
@@ -131,10 +131,10 @@
Const (@{const_name Quickcheck_Exhaustive.pos_bound_cps_bind}, fastype_of x --> T --> U) $ x $ f
end;
-val mk_sup = HOLogic.mk_binop @{const_name Quickcheck_Exhaustive.pos_bound_cps_plus};
+val mk_plus = HOLogic.mk_binop @{const_name Quickcheck_Exhaustive.pos_bound_cps_plus};
fun mk_if cond = Const (@{const_name Quickcheck_Exhaustive.pos_bound_cps_if},
- HOLogic.boolT --> mk_predT HOLogic.unitT) $ cond;
+ HOLogic.boolT --> mk_monadT HOLogic.unitT) $ cond;
fun mk_iterate_upto T (f, from, to) = error "not implemented yet"
@@ -143,7 +143,7 @@
val nT = @{typ "(unit Quickcheck_Exhaustive.unknown =>
Code_Evaluation.term list Quickcheck_Exhaustive.three_valued) => code_numeral =>
Code_Evaluation.term list Quickcheck_Exhaustive.three_valued"}
- val T = mk_predT HOLogic.unitT
+ val T = mk_monadT HOLogic.unitT
in Const (@{const_name Quickcheck_Exhaustive.pos_bound_cps_not}, nT --> T) $ t end
fun mk_Enum f = error "not implemented"
@@ -155,8 +155,8 @@
fun mk_map T1 T2 tf tp = error "not implemented"
val compfuns = Predicate_Compile_Aux.CompilationFuns
- {mk_predT = mk_predT, dest_predT = dest_predT, mk_bot = mk_bot,
- mk_single = mk_single, mk_bind = mk_bind, mk_sup = mk_sup, mk_if = mk_if,
+ {mk_monadT = mk_monadT, dest_monadT = dest_monadT, mk_empty = mk_empty,
+ mk_single = mk_single, mk_bind = mk_bind, mk_plus = mk_plus, mk_if = mk_if,
mk_iterate_upto = mk_iterate_upto, mk_not = mk_not, mk_map = mk_map};
end;
@@ -164,21 +164,21 @@
structure Neg_Bounded_CPS_Comp_Funs =
struct
-fun mk_predT T =
+fun mk_monadT T =
(Type (@{type_name "Quickcheck_Exhaustive.unknown"}, [T])
--> @{typ "Code_Evaluation.term list Quickcheck_Exhaustive.three_valued"})
--> @{typ "code_numeral => Code_Evaluation.term list Quickcheck_Exhaustive.three_valued"}
-fun dest_predT (Type ("fun", [Type ("fun", [Type (@{type_name "Quickcheck_Exhaustive.unknown"}, [T]),
+fun dest_monadT (Type ("fun", [Type ("fun", [Type (@{type_name "Quickcheck_Exhaustive.unknown"}, [T]),
@{typ "term list Quickcheck_Exhaustive.three_valued"}]),
@{typ "code_numeral => term list Quickcheck_Exhaustive.three_valued"}])) = T
- | dest_predT T = raise TYPE ("dest_predT", [T], []);
+ | dest_monadT T = raise TYPE ("dest_monadT", [T], []);
-fun mk_bot T = Const (@{const_name Quickcheck_Exhaustive.neg_bound_cps_empty}, mk_predT T);
+fun mk_empty T = Const (@{const_name Quickcheck_Exhaustive.neg_bound_cps_empty}, mk_monadT T);
fun mk_single t =
let val T = fastype_of t
- in Const(@{const_name Quickcheck_Exhaustive.neg_bound_cps_single}, T --> mk_predT T) $ t end;
+ in Const(@{const_name Quickcheck_Exhaustive.neg_bound_cps_single}, T --> mk_monadT T) $ t end;
fun mk_bind (x, f) =
let val T as Type ("fun", [_, U]) = fastype_of f
@@ -186,16 +186,16 @@
Const (@{const_name Quickcheck_Exhaustive.neg_bound_cps_bind}, fastype_of x --> T --> U) $ x $ f
end;
-val mk_sup = HOLogic.mk_binop @{const_name Quickcheck_Exhaustive.neg_bound_cps_plus};
+val mk_plus = HOLogic.mk_binop @{const_name Quickcheck_Exhaustive.neg_bound_cps_plus};
fun mk_if cond = Const (@{const_name Quickcheck_Exhaustive.neg_bound_cps_if},
- HOLogic.boolT --> mk_predT HOLogic.unitT) $ cond;
+ HOLogic.boolT --> mk_monadT HOLogic.unitT) $ cond;
fun mk_iterate_upto T (f, from, to) = error "not implemented"
fun mk_not t =
let
- val T = mk_predT HOLogic.unitT
+ val T = mk_monadT HOLogic.unitT
val pT = @{typ "(unit => Code_Evaluation.term list option) => code_numeral => Code_Evaluation.term list option"}
in Const (@{const_name Quickcheck_Exhaustive.neg_bound_cps_not}, pT --> T) $ t end
@@ -208,8 +208,8 @@
fun mk_map T1 T2 tf tp = error "not implemented"
val compfuns = Predicate_Compile_Aux.CompilationFuns
- {mk_predT = mk_predT, dest_predT = dest_predT, mk_bot = mk_bot,
- mk_single = mk_single, mk_bind = mk_bind, mk_sup = mk_sup, mk_if = mk_if,
+ {mk_monadT = mk_monadT, dest_monadT = dest_monadT, mk_empty = mk_empty,
+ mk_single = mk_single, mk_bind = mk_bind, mk_plus = mk_plus, mk_if = mk_if,
mk_iterate_upto = mk_iterate_upto, mk_not = mk_not, mk_map = mk_map};
end;
@@ -219,13 +219,13 @@
struct
fun mk_randompredT T =
- @{typ Random.seed} --> HOLogic.mk_prodT (Predicate_Comp_Funs.mk_predT T, @{typ Random.seed})
+ @{typ Random.seed} --> HOLogic.mk_prodT (Predicate_Comp_Funs.mk_monadT T, @{typ Random.seed})
fun dest_randompredT (Type ("fun", [@{typ Random.seed}, Type (@{type_name Product_Type.prod},
[Type (@{type_name "Predicate.pred"}, [T]), @{typ Random.seed}])])) = T
| dest_randompredT T = raise TYPE ("dest_randompredT", [T], []);
-fun mk_bot T = Const(@{const_name Quickcheck.empty}, mk_randompredT T)
+fun mk_empty T = Const(@{const_name Quickcheck.empty}, mk_randompredT T)
fun mk_single t =
let
@@ -241,7 +241,7 @@
Const (@{const_name Quickcheck.bind}, fastype_of x --> T --> U) $ x $ f
end
-val mk_sup = HOLogic.mk_binop @{const_name Quickcheck.union}
+val mk_plus = HOLogic.mk_binop @{const_name Quickcheck.union}
fun mk_if cond = Const (@{const_name Quickcheck.if_randompred},
HOLogic.boolT --> mk_randompredT HOLogic.unitT) $ cond;
@@ -260,8 +260,8 @@
(T1 --> T2) --> mk_randompredT T1 --> mk_randompredT T2) $ tf $ tp
val compfuns = Predicate_Compile_Aux.CompilationFuns
- {mk_predT = mk_randompredT, dest_predT = dest_randompredT,
- mk_bot = mk_bot, mk_single = mk_single, mk_bind = mk_bind, mk_sup = mk_sup, mk_if = mk_if,
+ {mk_monadT = mk_randompredT, dest_monadT = dest_randompredT,
+ mk_empty = mk_empty, mk_single = mk_single, mk_bind = mk_bind, mk_plus = mk_plus, mk_if = mk_if,
mk_iterate_upto = mk_iterate_upto, mk_not = mk_not, mk_map = mk_map};
end;
@@ -276,7 +276,7 @@
Type (@{type_name Option.option}, [Type (@{type_name Lazy_Sequence.lazy_sequence}, [T])])])])) = T
| dest_dseqT T = raise TYPE ("dest_dseqT", [T], []);
-fun mk_bot T = Const (@{const_name DSequence.empty}, mk_dseqT T);
+fun mk_empty T = Const (@{const_name DSequence.empty}, mk_dseqT T);
fun mk_single t =
let val T = fastype_of t
@@ -288,7 +288,7 @@
Const (@{const_name DSequence.bind}, fastype_of x --> T --> U) $ x $ f
end;
-val mk_sup = HOLogic.mk_binop @{const_name DSequence.union};
+val mk_plus = HOLogic.mk_binop @{const_name DSequence.union};
fun mk_if cond = Const (@{const_name DSequence.if_seq},
HOLogic.boolT --> mk_dseqT HOLogic.unitT) $ cond;
@@ -302,8 +302,8 @@
(T1 --> T2) --> mk_dseqT T1 --> mk_dseqT T2) $ tf $ tp
val compfuns = Predicate_Compile_Aux.CompilationFuns
- {mk_predT = mk_dseqT, dest_predT = dest_dseqT,
- mk_bot = mk_bot, mk_single = mk_single, mk_bind = mk_bind, mk_sup = mk_sup, mk_if = mk_if,
+ {mk_monadT = mk_dseqT, dest_monadT = dest_dseqT,
+ mk_empty = mk_empty, mk_single = mk_single, mk_bind = mk_bind, mk_plus = mk_plus, mk_if = mk_if,
mk_iterate_upto = mk_iterate_upto, mk_not = mk_not, mk_map = mk_map}
end;
@@ -318,7 +318,7 @@
Type (@{type_name Lazy_Sequence.lazy_sequence}, [T])])) = T
| dest_pos_dseqT T = raise TYPE ("dest_pos_dseqT", [T], []);
-fun mk_bot T = Const (@{const_name New_DSequence.pos_empty}, mk_pos_dseqT T);
+fun mk_empty T = Const (@{const_name New_DSequence.pos_empty}, mk_pos_dseqT T);
fun mk_single t =
let
@@ -339,7 +339,7 @@
Const (@{const_name New_DSequence.pos_decr_bind}, fastype_of x --> T --> U) $ x $ f
end;
-val mk_sup = HOLogic.mk_binop @{const_name New_DSequence.pos_union};
+val mk_plus = HOLogic.mk_binop @{const_name New_DSequence.pos_union};
fun mk_if cond = Const (@{const_name New_DSequence.pos_if_seq},
HOLogic.boolT --> mk_pos_dseqT HOLogic.unitT) $ cond;
@@ -358,13 +358,13 @@
(T1 --> T2) --> mk_pos_dseqT T1 --> mk_pos_dseqT T2) $ tf $ tp
val depth_limited_compfuns = Predicate_Compile_Aux.CompilationFuns
- {mk_predT = mk_pos_dseqT, dest_predT = dest_pos_dseqT,
- mk_bot = mk_bot, mk_single = mk_single, mk_bind = mk_decr_bind, mk_sup = mk_sup, mk_if = mk_if,
+ {mk_monadT = mk_pos_dseqT, dest_monadT = dest_pos_dseqT,
+ mk_empty = mk_empty, mk_single = mk_single, mk_bind = mk_decr_bind, mk_plus = mk_plus, mk_if = mk_if,
mk_iterate_upto = mk_iterate_upto, mk_not = mk_not, mk_map = mk_map}
val depth_unlimited_compfuns = Predicate_Compile_Aux.CompilationFuns
- {mk_predT = mk_pos_dseqT, dest_predT = dest_pos_dseqT,
- mk_bot = mk_bot, mk_single = mk_single, mk_bind = mk_bind, mk_sup = mk_sup, mk_if = mk_if,
+ {mk_monadT = mk_pos_dseqT, dest_monadT = dest_pos_dseqT,
+ mk_empty = mk_empty, mk_single = mk_single, mk_bind = mk_bind, mk_plus = mk_plus, mk_if = mk_if,
mk_iterate_upto = mk_iterate_upto, mk_not = mk_not, mk_map = mk_map}
end;
@@ -379,7 +379,7 @@
Type (@{type_name Lazy_Sequence.lazy_sequence}, [Type (@{type_name Option.option}, [T])])])) = T
| dest_neg_dseqT T = raise TYPE ("dest_neg_dseqT", [T], []);
-fun mk_bot T = Const (@{const_name New_DSequence.neg_empty}, mk_neg_dseqT T);
+fun mk_empty T = Const (@{const_name New_DSequence.neg_empty}, mk_neg_dseqT T);
fun mk_single t =
let
@@ -400,7 +400,7 @@
Const (@{const_name New_DSequence.neg_decr_bind}, fastype_of x --> T --> U) $ x $ f
end;
-val mk_sup = HOLogic.mk_binop @{const_name New_DSequence.neg_union};
+val mk_plus = HOLogic.mk_binop @{const_name New_DSequence.neg_union};
fun mk_if cond = Const (@{const_name New_DSequence.neg_if_seq},
HOLogic.boolT --> mk_neg_dseqT HOLogic.unitT) $ cond;
@@ -419,13 +419,13 @@
(T1 --> T2) --> mk_neg_dseqT T1 --> mk_neg_dseqT T2) $ tf $ tp
val depth_limited_compfuns = Predicate_Compile_Aux.CompilationFuns
- {mk_predT = mk_neg_dseqT, dest_predT = dest_neg_dseqT,
- mk_bot = mk_bot, mk_single = mk_single, mk_bind = mk_decr_bind, mk_sup = mk_sup, mk_if = mk_if,
+ {mk_monadT = mk_neg_dseqT, dest_monadT = dest_neg_dseqT,
+ mk_empty = mk_empty, mk_single = mk_single, mk_bind = mk_decr_bind, mk_plus = mk_plus, mk_if = mk_if,
mk_iterate_upto = mk_iterate_upto, mk_not = mk_not, mk_map = mk_map}
val depth_unlimited_compfuns = Predicate_Compile_Aux.CompilationFuns
- {mk_predT = mk_neg_dseqT, dest_predT = dest_neg_dseqT,
- mk_bot = mk_bot, mk_single = mk_single, mk_bind = mk_bind, mk_sup = mk_sup, mk_if = mk_if,
+ {mk_monadT = mk_neg_dseqT, dest_monadT = dest_neg_dseqT,
+ mk_empty = mk_empty, mk_single = mk_single, mk_bind = mk_bind, mk_plus = mk_plus, mk_if = mk_if,
mk_iterate_upto = mk_iterate_upto, mk_not = mk_not, mk_map = mk_map}
end;
@@ -442,7 +442,7 @@
Type (@{type_name Lazy_Sequence.lazy_sequence}, [T])])])])])) = T
| dest_pos_random_dseqT T = raise TYPE ("dest_random_dseqT", [T], []);
-fun mk_bot T = Const (@{const_name New_Random_Sequence.pos_empty}, mk_pos_random_dseqT T);
+fun mk_empty T = Const (@{const_name New_Random_Sequence.pos_empty}, mk_pos_random_dseqT T);
fun mk_single t =
let
@@ -463,7 +463,7 @@
Const (@{const_name New_Random_Sequence.pos_decr_bind}, fastype_of x --> T --> U) $ x $ f
end;
-val mk_sup = HOLogic.mk_binop @{const_name New_Random_Sequence.pos_union};
+val mk_plus = HOLogic.mk_binop @{const_name New_Random_Sequence.pos_union};
fun mk_if cond = Const (@{const_name New_Random_Sequence.pos_if_random_dseq},
HOLogic.boolT --> mk_pos_random_dseqT HOLogic.unitT) $ cond;
@@ -487,13 +487,13 @@
(T1 --> T2) --> mk_pos_random_dseqT T1 --> mk_pos_random_dseqT T2) $ tf $ tp
val depth_limited_compfuns = Predicate_Compile_Aux.CompilationFuns
- {mk_predT = mk_pos_random_dseqT, dest_predT = dest_pos_random_dseqT,
- mk_bot = mk_bot, mk_single = mk_single, mk_bind = mk_decr_bind, mk_sup = mk_sup, mk_if = mk_if,
+ {mk_monadT = mk_pos_random_dseqT, dest_monadT = dest_pos_random_dseqT,
+ mk_empty = mk_empty, mk_single = mk_single, mk_bind = mk_decr_bind, mk_plus = mk_plus, mk_if = mk_if,
mk_iterate_upto = mk_iterate_upto, mk_not = mk_not, mk_map = mk_map}
val depth_unlimited_compfuns = Predicate_Compile_Aux.CompilationFuns
- {mk_predT = mk_pos_random_dseqT, dest_predT = dest_pos_random_dseqT,
- mk_bot = mk_bot, mk_single = mk_single, mk_bind = mk_bind, mk_sup = mk_sup, mk_if = mk_if,
+ {mk_monadT = mk_pos_random_dseqT, dest_monadT = dest_pos_random_dseqT,
+ mk_empty = mk_empty, mk_single = mk_single, mk_bind = mk_bind, mk_plus = mk_plus, mk_if = mk_if,
mk_iterate_upto = mk_iterate_upto, mk_not = mk_not, mk_map = mk_map}
end;
@@ -511,7 +511,7 @@
[Type (@{type_name Option.option}, [T])])])])])])) = T
| dest_neg_random_dseqT T = raise TYPE ("dest_random_dseqT", [T], []);
-fun mk_bot T = Const (@{const_name New_Random_Sequence.neg_empty}, mk_neg_random_dseqT T);
+fun mk_empty T = Const (@{const_name New_Random_Sequence.neg_empty}, mk_neg_random_dseqT T);
fun mk_single t =
let
@@ -532,7 +532,7 @@
Const (@{const_name New_Random_Sequence.neg_decr_bind}, fastype_of x --> T --> U) $ x $ f
end;
-val mk_sup = HOLogic.mk_binop @{const_name New_Random_Sequence.neg_union};
+val mk_plus = HOLogic.mk_binop @{const_name New_Random_Sequence.neg_union};
fun mk_if cond = Const (@{const_name New_Random_Sequence.neg_if_random_dseq},
HOLogic.boolT --> mk_neg_random_dseqT HOLogic.unitT) $ cond;
@@ -554,13 +554,13 @@
(T1 --> T2) --> mk_neg_random_dseqT T1 --> mk_neg_random_dseqT T2) $ tf $ tp
val depth_limited_compfuns = Predicate_Compile_Aux.CompilationFuns
- {mk_predT = mk_neg_random_dseqT, dest_predT = dest_neg_random_dseqT,
- mk_bot = mk_bot, mk_single = mk_single, mk_bind = mk_decr_bind, mk_sup = mk_sup, mk_if = mk_if,
+ {mk_monadT = mk_neg_random_dseqT, dest_monadT = dest_neg_random_dseqT,
+ mk_empty = mk_empty, mk_single = mk_single, mk_bind = mk_decr_bind, mk_plus = mk_plus, mk_if = mk_if,
mk_iterate_upto = mk_iterate_upto, mk_not = mk_not, mk_map = mk_map}
val depth_unlimited_compfuns = Predicate_Compile_Aux.CompilationFuns
- {mk_predT = mk_neg_random_dseqT, dest_predT = dest_neg_random_dseqT,
- mk_bot = mk_bot, mk_single = mk_single, mk_bind = mk_bind, mk_sup = mk_sup, mk_if = mk_if,
+ {mk_monadT = mk_neg_random_dseqT, dest_monadT = dest_neg_random_dseqT,
+ mk_empty = mk_empty, mk_single = mk_single, mk_bind = mk_bind, mk_plus = mk_plus, mk_if = mk_if,
mk_iterate_upto = mk_iterate_upto, mk_not = mk_not, mk_map = mk_map}
end;
@@ -577,7 +577,7 @@
Type (@{type_name Product_Type.prod}, [T, @{typ Random.seed}])])])])) = DSequence_CompFuns.dest_dseqT T
| dest_random_dseqT T = raise TYPE ("dest_random_dseqT", [T], []);
-fun mk_bot T = Const (@{const_name Random_Sequence.empty}, mk_random_dseqT T);
+fun mk_empty T = Const (@{const_name Random_Sequence.empty}, mk_random_dseqT T);
fun mk_single t =
let
@@ -591,7 +591,7 @@
Const (@{const_name Random_Sequence.bind}, fastype_of x --> T --> U) $ x $ f
end;
-val mk_sup = HOLogic.mk_binop @{const_name Random_Sequence.union};
+val mk_plus = HOLogic.mk_binop @{const_name Random_Sequence.union};
fun mk_if cond = Const (@{const_name Random_Sequence.if_random_dseq},
HOLogic.boolT --> mk_random_dseqT HOLogic.unitT) $ cond;
@@ -607,8 +607,8 @@
(T1 --> T2) --> mk_random_dseqT T1 --> mk_random_dseqT T2) $ tf $ tp
val compfuns = Predicate_Compile_Aux.CompilationFuns
- {mk_predT = mk_random_dseqT, dest_predT = dest_random_dseqT,
- mk_bot = mk_bot, mk_single = mk_single, mk_bind = mk_bind, mk_sup = mk_sup, mk_if = mk_if,
+ {mk_monadT = mk_random_dseqT, dest_monadT = dest_random_dseqT,
+ mk_empty = mk_empty, mk_single = mk_single, mk_bind = mk_bind, mk_plus = mk_plus, mk_if = mk_if,
mk_iterate_upto = mk_iterate_upto, mk_not = mk_not, mk_map = mk_map}
end;
--- a/src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML Fri Nov 11 10:40:36 2011 +0100
+++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML Fri Nov 11 12:10:49 2011 +0100
@@ -312,11 +312,11 @@
let
val [depth] = additional_arguments
val (_, Ts) = split_modeT mode (binder_types T)
- val T' = mk_predT compfuns (HOLogic.mk_tupleT Ts)
+ val T' = mk_monadT compfuns (HOLogic.mk_tupleT Ts)
val if_const = Const (@{const_name "If"}, @{typ bool} --> T' --> T' --> T')
in
if_const $ HOLogic.mk_eq (depth, @{term "0 :: code_numeral"})
- $ mk_bot compfuns (dest_predT compfuns T')
+ $ mk_empty compfuns (dest_monadT compfuns T')
$ compilation
end,
transform_additional_arguments =
@@ -337,7 +337,7 @@
mk_random = (fn T => fn additional_arguments =>
list_comb (Const(@{const_name Quickcheck.iter},
[@{typ code_numeral}, @{typ code_numeral}, @{typ Random.seed}] --->
- Predicate_Comp_Funs.mk_predT T), additional_arguments)),
+ Predicate_Comp_Funs.mk_monadT T), additional_arguments)),
modify_funT = (fn T =>
let
val (Ts, U) = strip_type T
@@ -363,7 +363,7 @@
mk_random = (fn T => fn additional_arguments =>
list_comb (Const(@{const_name Quickcheck.iter},
[@{typ code_numeral}, @{typ code_numeral}, @{typ Random.seed}] --->
- Predicate_Comp_Funs.mk_predT T), tl additional_arguments)),
+ Predicate_Comp_Funs.mk_monadT T), tl additional_arguments)),
modify_funT = (fn T =>
let
val (Ts, U) = strip_type T
@@ -383,11 +383,11 @@
val depth = hd (additional_arguments)
val (_, Ts) = split_map_modeT (fn m => fn T => (SOME (funT_of compfuns m T), NONE))
mode (binder_types T)
- val T' = mk_predT compfuns (HOLogic.mk_tupleT Ts)
+ val T' = mk_monadT compfuns (HOLogic.mk_tupleT Ts)
val if_const = Const (@{const_name "If"}, @{typ bool} --> T' --> T' --> T')
in
if_const $ HOLogic.mk_eq (depth, @{term "0 :: code_numeral"})
- $ mk_bot compfuns (dest_predT compfuns T')
+ $ mk_empty compfuns (dest_monadT compfuns T')
$ compilation
end,
transform_additional_arguments =
@@ -658,7 +658,7 @@
val name' = singleton (Name.variant_list (name :: names)) "y";
val T = HOLogic.mk_tupleT (map fastype_of out_ts);
val U = fastype_of success_t;
- val U' = dest_predT compfuns U;
+ val U' = dest_monadT compfuns U;
val v = Free (name, T);
val v' = Free (name', T);
in
@@ -667,8 +667,8 @@
if null eqs'' then success_t
else Const (@{const_name HOL.If}, HOLogic.boolT --> U --> U --> U) $
foldr1 HOLogic.mk_conj eqs'' $ success_t $
- mk_bot compfuns U'),
- (v', mk_bot compfuns U')])
+ mk_empty compfuns U'),
+ (v', mk_empty compfuns U')])
end;
fun string_of_tderiv ctxt (t, deriv) =
@@ -928,7 +928,7 @@
compile_clause compilation_modifiers ctxt all_vs param_modes additional_arguments
inp (in_ts', out_ts') moded_ps'
end
- in SOME (foldr1 (mk_sup compfuns) (map compile_clause' moded_clauses)) end
+ in SOME (foldr1 (mk_plus compfuns) (map compile_clause' moded_clauses)) end
| compile_switch_tree all_vs ctxt_eqs (Node ((position, switched_clauses), left_clauses)) =
let
val (i, is) = argument_position_of mode position
@@ -943,18 +943,18 @@
val args = map2 (curry Free) argnames Ts
val pattern = list_comb (Const (c, T), args)
val ctxt_eqs' = (inp_var, pattern) :: ctxt_eqs
- val compilation = the_default (mk_bot compfuns (HOLogic.mk_tupleT outTs))
+ val compilation = the_default (mk_empty compfuns (HOLogic.mk_tupleT outTs))
(compile_switch_tree (argnames @ x :: all_vs) ctxt_eqs' switched)
in
(pattern, compilation)
end
val switch = Datatype.make_case ctxt Datatype_Case.Quiet [] inp_var
((map compile_single_case switched_clauses) @
- [(xt, mk_bot compfuns (HOLogic.mk_tupleT outTs))])
+ [(xt, mk_empty compfuns (HOLogic.mk_tupleT outTs))])
in
case compile_switch_tree all_vs ctxt_eqs left_clauses of
NONE => SOME switch
- | SOME left_comp => SOME (mk_sup compfuns (switch, left_comp))
+ | SOME left_comp => SOME (mk_plus compfuns (switch, left_comp))
end
in
compile_switch_tree all_vs [] switch_tree
@@ -978,11 +978,11 @@
(all_vs @ param_vs)
val compfuns = Comp_Mod.compfuns compilation_modifiers
fun is_param_type (T as Type ("fun",[_ , T'])) =
- is_some (try (dest_predT compfuns) T) orelse is_param_type T'
- | is_param_type T = is_some (try (dest_predT compfuns) T)
+ is_some (try (dest_monadT compfuns) T) orelse is_param_type T'
+ | is_param_type T = is_some (try (dest_monadT compfuns) T)
val (inpTs, outTs) = split_map_modeT (fn m => fn T => (SOME (funT_of compfuns m T), NONE)) mode
(binder_types T)
- val predT = mk_predT compfuns (HOLogic.mk_tupleT outTs)
+ val predT = mk_monadT compfuns (HOLogic.mk_tupleT outTs)
val funT = Comp_Mod.funT_of compilation_modifiers mode T
val (in_ts, _) = fold_map (fold_map_aterms_prodT (curry HOLogic.mk_prod)
(fn T => fn (param_vs, names) =>
@@ -998,7 +998,7 @@
val param_modes = param_vs ~~ ho_arg_modes_of mode
val compilation =
if detect_switches options then
- the_default (mk_bot compfuns (HOLogic.mk_tupleT outTs))
+ the_default (mk_empty compfuns (HOLogic.mk_tupleT outTs))
(compile_switch compilation_modifiers ctxt all_vs param_modes additional_arguments mode
in_ts' outTs (mk_switch_tree ctxt mode moded_cls))
else
@@ -1010,9 +1010,9 @@
in
Comp_Mod.wrap_compilation compilation_modifiers compfuns s T mode additional_arguments
(if null cl_ts then
- mk_bot compfuns (HOLogic.mk_tupleT outTs)
+ mk_empty compfuns (HOLogic.mk_tupleT outTs)
else
- foldr1 (mk_sup compfuns) cl_ts)
+ foldr1 (mk_plus compfuns) cl_ts)
end
val fun_const =
Const (function_name_of (Comp_Mod.compilation compilation_modifiers)
@@ -1341,7 +1341,7 @@
(map (fn i => "x" ^ string_of_int i) (1 upto length Ts))
val args = map2 (curry Free) arg_names Ts
val predfun = Const (function_name_of Pred ctxt predname full_mode,
- Ts ---> Predicate_Comp_Funs.mk_predT @{typ unit})
+ Ts ---> Predicate_Comp_Funs.mk_monadT @{typ unit})
val rhs = @{term Predicate.holds} $ (list_comb (predfun, args))
val eq_term = HOLogic.mk_Trueprop
(HOLogic.mk_eq (list_comb (Const (predname, T), args), rhs))
@@ -1833,7 +1833,7 @@
val (_, outargs) = split_mode (head_mode_of deriv) all_args
val t_pred = compile_expr comp_modifiers ctxt
(body, deriv) [] additional_arguments;
- val T_pred = dest_predT compfuns (fastype_of t_pred)
+ val T_pred = dest_monadT compfuns (fastype_of t_pred)
val arrange = HOLogic.tupled_lambda (HOLogic.mk_tuple outargs) output
in
if null outargs then t_pred else mk_map compfuns T_pred T_compr arrange t_pred
@@ -1876,7 +1876,7 @@
| New_Pos_Random_DSeq => []
| Pos_Generator_DSeq => []
val t = analyze_compr ctxt (comp_modifiers, additional_arguments) param_user_modes options t_compr;
- val T = dest_predT compfuns (fastype_of t);
+ val T = dest_monadT compfuns (fastype_of t);
val t' =
if stats andalso compilation = New_Pos_Random_DSeq then
mk_map compfuns T (HOLogic.mk_prodT (HOLogic.termT, @{typ code_numeral}))