src/Doc/Eisbach/Base.thy
author wenzelm
Mon, 24 Oct 2016 11:42:39 +0200
changeset 64367 a424f2737646
parent 61656 cfabbc083977
child 69605 a96320074298
permissions -rw-r--r--
updated for release;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
61656
cfabbc083977 more uniform jEdit properties;
wenzelm
parents: 60791
diff changeset
     1
(*:maxLineLen=78:*)
cfabbc083977 more uniform jEdit properties;
wenzelm
parents: 60791
diff changeset
     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
e3f2262786ea updated to infer_instantiate;
wenzelm
parents: 60288
diff changeset
    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
e3f2262786ea updated to infer_instantiate;
wenzelm
parents: 60288
diff changeset
    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