src/HOL/Tools/Predicate_Compile/predicate_compile_aux.ML
changeset 45461 130c90bb80b4
parent 45450 dc2236b19a3d
child 45701 615da8b8d758
equal deleted inserted replaced
45452:414732ebf891 45461:130c90bb80b4
    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 {