64 (* split theorems of case expressions *) |
64 (* split theorems of case expressions *) |
65 val prepare_split_thm : Proof.context -> thm -> thm |
65 val prepare_split_thm : Proof.context -> thm -> thm |
66 val find_split_thm : theory -> term -> thm option |
66 val find_split_thm : theory -> term -> thm option |
67 (* datastructures and setup for generic compilation *) |
67 (* datastructures and setup for generic compilation *) |
68 datatype compilation_funs = CompilationFuns of { |
68 datatype compilation_funs = CompilationFuns of { |
69 mk_predT : typ -> typ, |
69 mk_monadT : typ -> typ, |
70 dest_predT : typ -> typ, |
70 dest_monadT : typ -> typ, |
71 mk_bot : typ -> term, |
71 mk_empty : typ -> term, |
72 mk_single : term -> term, |
72 mk_single : term -> term, |
73 mk_bind : term * term -> term, |
73 mk_bind : term * term -> term, |
74 mk_sup : term * term -> term, |
74 mk_plus : term * term -> term, |
75 mk_if : term -> term, |
75 mk_if : term -> term, |
76 mk_iterate_upto : typ -> term * term * term -> term, |
76 mk_iterate_upto : typ -> term * term * term -> term, |
77 mk_not : term -> term, |
77 mk_not : term -> term, |
78 mk_map : typ -> typ -> term -> term -> term |
78 mk_map : typ -> typ -> term -> term -> term |
79 }; |
79 }; |
80 val mk_predT : compilation_funs -> typ -> typ |
80 val mk_monadT : compilation_funs -> typ -> typ |
81 val dest_predT : compilation_funs -> typ -> typ |
81 val dest_monadT : compilation_funs -> typ -> typ |
82 val mk_bot : compilation_funs -> typ -> term |
82 val mk_empty : compilation_funs -> typ -> term |
83 val mk_single : compilation_funs -> term -> term |
83 val mk_single : compilation_funs -> term -> term |
84 val mk_bind : compilation_funs -> term * term -> term |
84 val mk_bind : compilation_funs -> term * term -> term |
85 val mk_sup : compilation_funs -> term * term -> term |
85 val mk_plus : compilation_funs -> term * term -> term |
86 val mk_if : compilation_funs -> term -> term |
86 val mk_if : compilation_funs -> term -> term |
87 val mk_iterate_upto : compilation_funs -> typ -> term * term * term -> term |
87 val mk_iterate_upto : compilation_funs -> typ -> term * term * term -> term |
88 val mk_not : compilation_funs -> term -> term |
88 val mk_not : compilation_funs -> term -> term |
89 val mk_map : compilation_funs -> typ -> typ -> term -> term -> term |
89 val mk_map : compilation_funs -> typ -> typ -> term -> term -> term |
90 val funT_of : compilation_funs -> mode -> typ -> typ |
90 val funT_of : compilation_funs -> mode -> typ -> typ |
697 Pos_Random_DSeq, Neg_Random_DSeq, New_Pos_Random_DSeq, New_Neg_Random_DSeq, Pos_Generator_CPS] |
697 Pos_Random_DSeq, Neg_Random_DSeq, New_Pos_Random_DSeq, New_Neg_Random_DSeq, Pos_Generator_CPS] |
698 |
698 |
699 (* datastructures and setup for generic compilation *) |
699 (* datastructures and setup for generic compilation *) |
700 |
700 |
701 datatype compilation_funs = CompilationFuns of { |
701 datatype compilation_funs = CompilationFuns of { |
702 mk_predT : typ -> typ, |
702 mk_monadT : typ -> typ, |
703 dest_predT : typ -> typ, |
703 dest_monadT : typ -> typ, |
704 mk_bot : typ -> term, |
704 mk_empty : typ -> term, |
705 mk_single : term -> term, |
705 mk_single : term -> term, |
706 mk_bind : term * term -> term, |
706 mk_bind : term * term -> term, |
707 mk_sup : term * term -> term, |
707 mk_plus : term * term -> term, |
708 mk_if : term -> term, |
708 mk_if : term -> term, |
709 mk_iterate_upto : typ -> term * term * term -> term, |
709 mk_iterate_upto : typ -> term * term * term -> term, |
710 mk_not : term -> term, |
710 mk_not : term -> term, |
711 mk_map : typ -> typ -> term -> term -> term |
711 mk_map : typ -> typ -> term -> term -> term |
712 }; |
712 }; |
713 |
713 |
714 fun mk_predT (CompilationFuns funs) = #mk_predT funs |
714 fun mk_monadT (CompilationFuns funs) = #mk_monadT funs |
715 fun dest_predT (CompilationFuns funs) = #dest_predT funs |
715 fun dest_monadT (CompilationFuns funs) = #dest_monadT funs |
716 fun mk_bot (CompilationFuns funs) = #mk_bot funs |
716 fun mk_empty (CompilationFuns funs) = #mk_empty funs |
717 fun mk_single (CompilationFuns funs) = #mk_single funs |
717 fun mk_single (CompilationFuns funs) = #mk_single funs |
718 fun mk_bind (CompilationFuns funs) = #mk_bind funs |
718 fun mk_bind (CompilationFuns funs) = #mk_bind funs |
719 fun mk_sup (CompilationFuns funs) = #mk_sup funs |
719 fun mk_plus (CompilationFuns funs) = #mk_plus funs |
720 fun mk_if (CompilationFuns funs) = #mk_if funs |
720 fun mk_if (CompilationFuns funs) = #mk_if funs |
721 fun mk_iterate_upto (CompilationFuns funs) = #mk_iterate_upto funs |
721 fun mk_iterate_upto (CompilationFuns funs) = #mk_iterate_upto funs |
722 fun mk_not (CompilationFuns funs) = #mk_not funs |
722 fun mk_not (CompilationFuns funs) = #mk_not funs |
723 fun mk_map (CompilationFuns funs) = #mk_map funs |
723 fun mk_map (CompilationFuns funs) = #mk_map funs |
724 |
724 |
727 fun funT_of compfuns mode T = |
727 fun funT_of compfuns mode T = |
728 let |
728 let |
729 val Ts = binder_types T |
729 val Ts = binder_types T |
730 val (inTs, outTs) = split_map_modeT (fn m => fn T => (SOME (funT_of compfuns m T), NONE)) mode Ts |
730 val (inTs, outTs) = split_map_modeT (fn m => fn T => (SOME (funT_of compfuns m T), NONE)) mode Ts |
731 in |
731 in |
732 inTs ---> (mk_predT compfuns (HOLogic.mk_tupleT outTs)) |
732 inTs ---> (mk_monadT compfuns (HOLogic.mk_tupleT outTs)) |
733 end; |
733 end; |
734 |
734 |
735 (* Different options for compiler *) |
735 (* Different options for compiler *) |
736 |
736 |
737 datatype options = Options of { |
737 datatype options = Options of { |