changing compilation to work only with contexts; adapting quickcheck
authorbulwahn
Wed, 19 May 2010 18:24:07 +0200
changeset 36996842a73dc6d0e
parent 36995 c62f743e37d4
child 36997 25fdef26b460
changing compilation to work only with contexts; adapting quickcheck
src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML
src/HOL/Tools/Predicate_Compile/predicate_compile_quickcheck.ML
     1.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML	Wed May 19 18:24:06 2010 +0200
     1.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML	Wed May 19 18:24:07 2010 +0200
     1.3 @@ -326,9 +326,9 @@
     1.4    (map (string_of_prem ctxt) prems)) ^ " --> " ^ pred ^ " "
     1.5     ^ (space_implode " " (map (Syntax.string_of_term ctxt) ts))
     1.6  
     1.7 -fun print_compiled_terms options thy =
     1.8 +fun print_compiled_terms options ctxt =
     1.9    if show_compilation options then
    1.10 -    print_pred_mode_table (fn _ => fn _ => Syntax.string_of_term_global thy) thy
    1.11 +    print_pred_mode_table (fn _ => fn _ => Syntax.string_of_term ctxt)
    1.12    else K ()
    1.13  
    1.14  fun print_stored_rules thy =
    1.15 @@ -1821,7 +1821,7 @@
    1.16  
    1.17  (** switch detection analysis **)
    1.18  
    1.19 -fun find_switch_test thy (i, is) (ts, prems) =
    1.20 +fun find_switch_test ctxt (i, is) (ts, prems) =
    1.21    let
    1.22      val t = nth_pair is (nth ts i)
    1.23      val T = fastype_of t
    1.24 @@ -1829,7 +1829,7 @@
    1.25      case T of
    1.26        TFree _ => NONE
    1.27      | Type (Tcon, _) =>
    1.28 -      (case Datatype_Data.get_constrs thy Tcon of
    1.29 +      (case Datatype_Data.get_constrs (ProofContext.theory_of ctxt) Tcon of
    1.30          NONE => NONE
    1.31        | SOME cs =>
    1.32          (case strip_comb t of
    1.33 @@ -1838,11 +1838,11 @@
    1.34          | (Const (c, T), _) => if AList.defined (op =) cs c then SOME (c, T) else NONE))
    1.35    end
    1.36  
    1.37 -fun partition_clause thy pos moded_clauses =
    1.38 +fun partition_clause ctxt pos moded_clauses =
    1.39    let
    1.40      fun insert_list eq (key, value) = AList.map_default eq (key, []) (cons value)
    1.41      fun find_switch_test' moded_clause (cases, left) =
    1.42 -      case find_switch_test thy pos moded_clause of
    1.43 +      case find_switch_test ctxt pos moded_clause of
    1.44          SOME (c, T) => (insert_list (op =) ((c, T), moded_clause) cases, left)
    1.45        | NONE => (cases, moded_clause :: left)
    1.46    in
    1.47 @@ -1852,12 +1852,12 @@
    1.48  datatype switch_tree =
    1.49    Atom of moded_clause list | Node of (position * ((string * typ) * switch_tree) list) * switch_tree
    1.50  
    1.51 -fun mk_switch_tree thy mode moded_clauses =
    1.52 +fun mk_switch_tree ctxt mode moded_clauses =
    1.53    let
    1.54      fun select_best_switch moded_clauses input_position best_switch =
    1.55        let
    1.56          val ord = option_ord (rev_order o int_ord o (pairself (length o snd o snd)))
    1.57 -        val partition = partition_clause thy input_position moded_clauses
    1.58 +        val partition = partition_clause ctxt input_position moded_clauses
    1.59          val switch = if (length (fst partition) > 1) then SOME (input_position, partition) else NONE
    1.60        in
    1.61          case ord (switch, best_switch) of LESS => best_switch
    1.62 @@ -1945,9 +1945,8 @@
    1.63  
    1.64  (* compilation of predicates *)
    1.65  
    1.66 -fun compile_pred options compilation_modifiers thy all_vs param_vs s T (pol, mode) moded_cls =
    1.67 +fun compile_pred options compilation_modifiers ctxt all_vs param_vs s T (pol, mode) moded_cls =
    1.68    let
    1.69 -    val ctxt = ProofContext.init_global thy
    1.70      val compilation_modifiers = if pol then compilation_modifiers else
    1.71        negative_comp_modifiers_of compilation_modifiers
    1.72      val additional_arguments = Comp_Mod.additional_arguments compilation_modifiers
    1.73 @@ -1975,7 +1974,7 @@
    1.74        if detect_switches options then
    1.75          the_default (mk_bot compfuns (HOLogic.mk_tupleT outTs))
    1.76            (compile_switch compilation_modifiers ctxt all_vs param_vs additional_arguments
    1.77 -            mode in_ts' outTs (mk_switch_tree thy mode moded_cls))
    1.78 +            mode in_ts' outTs (mk_switch_tree ctxt mode moded_cls))
    1.79        else
    1.80          let
    1.81            val cl_ts =
    1.82 @@ -2643,8 +2642,8 @@
    1.83    map (fn (pred, modes) =>
    1.84      (pred, map (fn (mode, value) => value) modes)) preds_modes_table
    1.85  
    1.86 -fun compile_preds options comp_modifiers thy all_vs param_vs preds moded_clauses =
    1.87 -  map_preds_modes (fn pred => compile_pred options comp_modifiers thy all_vs param_vs pred
    1.88 +fun compile_preds options comp_modifiers ctxt all_vs param_vs preds moded_clauses =
    1.89 +  map_preds_modes (fn pred => compile_pred options comp_modifiers ctxt all_vs param_vs pred
    1.90        (the (AList.lookup (op =) preds pred))) moded_clauses
    1.91  
    1.92  fun prove options thy clauses preds moded_clauses compiled_terms =
    1.93 @@ -2838,12 +2837,13 @@
    1.94        Output.cond_timeit (!Quickcheck.timing) "Defining executable functions..."
    1.95        (fn _ => fold (#define_functions (dest_steps steps) options preds) modes thy'
    1.96        |> Theory.checkpoint)
    1.97 +    val ctxt'' = ProofContext.init_global thy''
    1.98      val _ = print_step options "Compiling equations..."
    1.99      val compiled_terms =
   1.100        Output.cond_timeit (!Quickcheck.timing) "Compiling equations...." (fn _ =>
   1.101          compile_preds options
   1.102 -          (#comp_modifiers (dest_steps steps)) thy'' all_vs param_vs preds moded_clauses)
   1.103 -    val _ = print_compiled_terms options thy'' compiled_terms
   1.104 +          (#comp_modifiers (dest_steps steps)) ctxt'' all_vs param_vs preds moded_clauses)
   1.105 +    val _ = print_compiled_terms options ctxt'' compiled_terms
   1.106      val _ = print_step options "Proving equations..."
   1.107      val result_thms =
   1.108        Output.cond_timeit (!Quickcheck.timing) "Proving equations...." (fn _ =>
     2.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_quickcheck.ML	Wed May 19 18:24:06 2010 +0200
     2.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_quickcheck.ML	Wed May 19 18:24:07 2010 +0200
     2.3 @@ -216,12 +216,13 @@
     2.4      (*val _ = Predicate_Compile_Core.print_all_modes compilation thy4*)
     2.5      val _ = Output.tracing ("Preprocessing time: " ^ string_of_int (snd preproc_time))
     2.6      val _ = Output.tracing ("Core compilation time: " ^ string_of_int (snd core_comp_time))
     2.7 -    val modes = Predicate_Compile_Core.modes_of compilation thy4 full_constname
     2.8 +    val ctxt4 = ProofContext.init_global thy4
     2.9 +    val modes = Predicate_Compile_Core.modes_of compilation ctxt4 full_constname
    2.10      val output_mode = fold_rev (curry Fun) (map (K Output) (binder_types constT)) Bool
    2.11      val prog =
    2.12        if member eq_mode modes output_mode then
    2.13          let
    2.14 -          val name = Predicate_Compile_Core.function_name_of compilation thy4
    2.15 +          val name = Predicate_Compile_Core.function_name_of compilation ctxt4
    2.16              full_constname output_mode
    2.17            val T = 
    2.18              case compilation of