src/HOL/Library/Eval_Witness.thy
changeset 27103 d8549f4d900b
parent 26939 1035c89b4c02
child 27368 9f90ac19e32b
equal deleted inserted replaced
27102:a98cd7450204 27103:d8549f4d900b
    44 
    44 
    45 instance nat :: ml_equiv .. (* Attention: This conflicts with the "EfficientNat" theory *)
    45 instance nat :: ml_equiv .. (* Attention: This conflicts with the "EfficientNat" theory *)
    46 instance bool :: ml_equiv ..
    46 instance bool :: ml_equiv ..
    47 instance list :: (ml_equiv) ml_equiv ..
    47 instance list :: (ml_equiv) ml_equiv ..
    48 
    48 
       
    49 ML {*
       
    50 structure Eval_Witness_Method =
       
    51 struct
       
    52 
       
    53 val eval_ref : (unit -> bool) option ref = ref NONE;
       
    54 
       
    55 end;
       
    56 *}
       
    57 
    49 oracle eval_witness_oracle ("term * string list") = {* fn thy => fn (goal, ws) => 
    58 oracle eval_witness_oracle ("term * string list") = {* fn thy => fn (goal, ws) => 
    50 let
    59 let
    51   fun check_type T = 
    60   fun check_type T = 
    52     if Sorts.of_sort (Sign.classes_of thy) (T, ["Eval_Witness.ml_equiv"])
    61     if Sorts.of_sort (Sign.classes_of thy) (T, ["Eval_Witness.ml_equiv"])
    53     then T
    62     then T
    57     | dest_exs n (Const ("Ex", _) $ Abs (v,T,b)) = 
    66     | dest_exs n (Const ("Ex", _) $ Abs (v,T,b)) = 
    58       Abs (v, check_type T, dest_exs (n - 1) b)
    67       Abs (v, check_type T, dest_exs (n - 1) b)
    59     | dest_exs _ _ = sys_error "dest_exs";
    68     | dest_exs _ _ = sys_error "dest_exs";
    60   val t = dest_exs (length ws) (HOLogic.dest_Trueprop goal);
    69   val t = dest_exs (length ws) (HOLogic.dest_Trueprop goal);
    61 in
    70 in
    62   if CodePackage.satisfies thy t ws
    71   if CodeTarget.eval_term ("Eval_Witness_Method.eval_ref", Eval_Witness_Method.eval_ref) thy t ws
    63   then goal
    72   then goal
    64   else HOLogic.Trueprop $ HOLogic.true_const (*dummy*)
    73   else HOLogic.Trueprop $ HOLogic.true_const (*dummy*)
    65 end
    74 end
    66 *}
    75 *}
    67 
    76