src/Doc/Eisbach/Base.thy
author wenzelm
Wed, 04 Nov 2015 23:27:00 +0100
changeset 61578 6623c81cb15a
parent 60791 e3f2262786ea
child 61656 cfabbc083977
permissions -rw-r--r--
avoid ligatures;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
60288
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
     1
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
     2
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
     3
theory Base
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
     4
imports Main
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
     5
begin
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
     6
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
     7
ML_file "~~/src/Doc/antiquote_setup.ML"
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\<open>
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    10
fun get_split_rule ctxt target =
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    11
  let
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    12
    val (head, args) = strip_comb (Envir.eta_contract target);
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    13
    val (const_name, _) = dest_Const head;
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    14
    val const_name_components = Long_Name.explode const_name;
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    15
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    16
    val _ =
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    17
      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
    18
      else raise TERM ("Not a case statement", [target]);
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    19
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    20
    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
    21
    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
    22
    val vars = Term.add_vars (Thm.prop_of split) [];
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    23
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    24
    val datatype_name = nth (rev const_name_components) 1;
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
    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
    27
      | is_datatype _ = false;
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    28
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    29
    val datatype_var =
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    30
      (case find_first (fn (_, T') => is_datatype T') vars of
60791
e3f2262786ea updated to infer_instantiate;
wenzelm
parents: 60288
diff changeset
    31
        SOME (xi, _) => xi
60288
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    32
      | 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
    33
  in
60791
e3f2262786ea updated to infer_instantiate;
wenzelm
parents: 60288
diff changeset
    34
    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
    35
  end
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    36
  handle TERM _ => NONE;
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    37
\<close>
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    38
d7f636331176 added Eisbach manual, using version 8845c4cb28b6 of its Bitbucket repository;
wenzelm
parents:
diff changeset
    39
end