equal
deleted
inserted
replaced
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 |