author | wenzelm |
Sun, 15 Mar 2020 11:55:16 +0100 | |
changeset 71555 | 7eadccd4392c |
parent 69605 | a96320074298 |
child 80636 | 4041e7c8059d |
permissions | -rw-r--r-- |
61656 | 1 |
(*:maxLineLen=78:*) |
2 |
||
60288
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
3 |
section \<open>Basic setup that is not included in the document\<close> |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
4 |
|
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
5 |
theory Base |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
6 |
imports Main |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
7 |
begin |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
8 |
|
69605 | 9 |
ML_file \<open>~~/src/Doc/antiquote_setup.ML\<close> |
60288
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
10 |
|
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
11 |
ML\<open> |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
12 |
fun get_split_rule ctxt target = |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
13 |
let |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
14 |
val (head, args) = strip_comb (Envir.eta_contract target); |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
15 |
val (const_name, _) = dest_Const head; |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
16 |
val const_name_components = Long_Name.explode const_name; |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
17 |
|
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
18 |
val _ = |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
19 |
if String.isPrefix "case_" (List.last const_name_components) then () |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
20 |
else raise TERM ("Not a case statement", [target]); |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
21 |
|
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
22 |
val type_name = Long_Name.implode (rev (tl (rev const_name_components))); |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
23 |
val split = Proof_Context.get_thm ctxt (type_name ^ ".split"); |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
24 |
val vars = Term.add_vars (Thm.prop_of split) []; |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
25 |
|
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
26 |
val datatype_name = nth (rev const_name_components) 1; |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
27 |
|
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
28 |
fun is_datatype (Type (a, _)) = Long_Name.base_name a = Long_Name.base_name datatype_name |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
29 |
| is_datatype _ = false; |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
30 |
|
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
31 |
val datatype_var = |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
32 |
(case find_first (fn (_, T') => is_datatype T') vars of |
60791 | 33 |
SOME (xi, _) => xi |
60288
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
34 |
| NONE => error ("Couldn't find datatype in thm: " ^ datatype_name)); |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
35 |
in |
60791 | 36 |
SOME (infer_instantiate ctxt [(datatype_var, Thm.cterm_of ctxt (List.last args))] split) |
60288
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
37 |
end |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
38 |
handle TERM _ => NONE; |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
39 |
\<close> |
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
40 |
|
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff
changeset
|
41 |
end |