| author | wenzelm | 
| Tue, 01 Mar 2016 10:32:55 +0100 | |
| changeset 62480 | f2e8984adef7 | 
| parent 61656 | cfabbc083977 | 
| child 69605 | a96320074298 | 
| 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  | 
|
| 
 
d7f636331176
added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
 
wenzelm 
parents:  
diff
changeset
 | 
9  | 
ML_file "~~/src/Doc/antiquote_setup.ML"  | 
| 
 
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  |