Quelle  LaTeXsugar.thy

(*  Title:      HOL/Library/LaTeXsugar.thy
    Author:     Gerwin Klein, Tobias Nipkow, Norbert Schirmer
    Copyright   2005 NICTA and TUM
*)

(*<*)
theory LaTeXsugar
imports Main
begin

(* Boxing *)

definition mbox :: "'a ==> 'a" where
"mbox x = x"

definition mbox0 :: "'a ==> 'a" where
"mbox0 x = x"

notation (latex) mbox (‹🍋‹\mbox{›_🍋‹}›› [999] 999)

notation (latex) mbox0 (‹🍋‹\mbox{›_🍋‹}›› [0] 999)

(* LOGIC *)
notation (latex output)
  If  (‹(🍋‹\textsf{›if🍋‹}› (_)/ 🍋‹\textsf{›then🍋‹}› (_)/ 🍋‹\textsf{›else🍋‹}› (_))› 10)

syntax (latex output)

  "_Let"        :: "[letbinds, 'a] => 'a"
  (‹(🍋‹\textsf{›let🍋‹}› (_)/ 🍋‹\textsf{›in🍋‹}› (_))› 10)

  "_case_syntax":: "['a, cases_syn] => 'b"
  (‹(🍋‹\textsf{›case🍋‹}› _ 🍋‹\textsf{›of🍋‹}›/ _)› 10)


(* SETS *)

(* empty set *)
notation (latex)
  "Set.empty" (‹∅›)

(* insert *)
translations 
  "{x} ∪ A" <= "CONST insert x A"
  "{x,y}" <= "{x} ∪ {y}"
  "{x,y} ∪ A" <= "{x} ∪ ({y} ∪ A)"
  "{x}" <= "{x} ∪ ∅"

(* set comprehension *)
syntax (latex output)
  "_Collect" :: "pttrn => bool => 'a set"              (‹(1{_ | _})›)
  "_CollectIn" :: "pttrn => 'a set => bool => 'a set"   (‹(1{_ ∈ _ | _})›)
translations
  "_Collect p P"      <= "{p. P}"
  "_Collect p P"      <= "{p|xs. P}"
  "_CollectIn p A P"  <= "{p : A. P}"

(* card *)
notation (latex output)
  card  (‹|_|›)

(* LISTS *)

(* Cons *)
notation (latex)
  Cons  (‹_ ⋅/ _› [66,65] 65)

(* length *)
notation (latex output)
  length  (‹|_|›)

(* nth *)
notation (latex output)
  nth  (‹_🍋‹\ensuremath{_{[\mathit{›_🍋‹}]}}›› [1000,0] 1000)

(* DUMMY *)
consts DUMMY :: 'a (‹🍋‹\_››)

(* THEOREMS *)
notation (Rule output)
  Pure.imp  (‹🍋‹\mbox{}\inferrule{\mbox{›_🍋‹}}›🍋‹{\mbox{›_🍋‹}}››)

syntax (Rule output)
  "_bigimpl" :: "asms ==> prop ==> prop"
  (‹🍋‹\mbox{}\inferrule{›_🍋‹}›🍋‹{\mbox{›_🍋‹}}››)

  "_asms" :: "prop ==> asms ==> asms" 
  (‹🍋‹\mbox{›_🍋‹}\\›/ _›)

  "_asm" :: "prop ==> asms" (‹🍋‹\mbox{›_🍋‹}››)

notation (Axiom output)
  "Trueprop"  (‹🍋‹\mbox{}\inferrule{\mbox{}}{\mbox{›_🍋‹}}››)

notation (IfThen output)
  Pure.imp  (‹🍋‹{\normalsize{}›If🍋‹\,}› _/ 🍋‹{\normalsize \,›then🍋‹\,}›/ _.›)
syntax (IfThen output)
  "_bigimpl" :: "asms ==> prop ==> prop"
  (‹🍋‹{\normalsize{}›If🍋‹\,}› _ /🍋‹{\normalsize \,›then🍋‹\,}›/ _.›)
  "_asms" :: "prop ==> asms ==> asms" (‹🍋‹\mbox{›_🍋‹}› /🍋‹{\normalsize \,›and🍋‹\,}›/ _›)
  "_asm" :: "prop ==> asms" (‹🍋‹\mbox{›_🍋‹}››)

notation (IfThenNoBox output)
  Pure.imp  (‹🍋‹{\normalsize{}›If🍋‹\,}› _/ 🍋‹{\normalsize \,›then🍋‹\,}›/ _.›)
syntax (IfThenNoBox output)
  "_bigimpl" :: "asms ==> prop ==> prop"
  (‹🍋‹{\normalsize{}›If🍋‹\,}› _ /🍋‹{\normalsize \,›then🍋‹\,}›/ _.›)
  "_asms" :: "prop ==> asms ==> asms" (‹_ /🍋‹{\normalsize \,›and🍋‹\,}›/ _›)
  "_asm" :: "prop ==> asms" (‹_›)

setup ‹
 Document_Output.antiquotation_pretty_source_embedded 🍋‹const_typ›
 (Scan.lift Parse.embedded_inner_syntax)
 (fn ctxt => fn c =>
 let val tc = Proof_Context.read_const {proper = false, strict = false} ctxt c in
 Pretty.block [Document_Output.pretty_term ctxt tc, Pretty.str " ::",
 Pretty.brk 1, Syntax.pretty_typ ctxt (fastype_of tc)]
 end)
 ›

setup‹
 
 fun dummy_pats (wrap $ (eq $ lhs $ rhs)) =
 let
 val rhs_vars = Term.add_vars rhs [];
 fun dummy (v as Var (ixn as (_, T))) =
 if member ((=) ) rhs_vars ixn then v else Const (🍋‹DUMMY›, T)
 | dummy (t $ u) = dummy t $ dummy u
 | dummy (Abs (n, T, b)) = Abs (n, T, dummy b)
 | dummy t = t;
 in wrap $ (eq $ dummy lhs $ rhs) end
 
 Term_Style.setup 🍋‹dummy_pats› (Scan.succeed (K dummy_pats))
 
 ›

setup ‹
 

  eta_expand Ts t xs = case t of
 Abs(x,T,t) =>
 let val (t', xs') = eta_expand (T::Ts) t xs
 in (Abs (x, T, t'), xs') end
 | _ =>
 let
        val (a,ts) = strip_comb t (* assume a atomic *)
        val (ts',xs') = fold_map (eta_expand Ts) ts xs
        val t' = list_comb (a, ts');
        val Bs = binder_types (fastype_of1 (Ts,t));
        val n = Int.min (length Bs, length xs');
        val bs = map Bound ((n - 1) downto 0);
        val xBs = ListPair.zip (xs',Bs);
        val xs'' = drop n xs';
        val t'' = fold_rev Term.abs xBs (list_comb(t', bs))
      in (t'', xs'') end

val style_eta_expand =
  (Scan.repeat Args.name) >> (fn xs => fn ctxt => fn t => fst (eta_expand [] t xs))

in Term_Style.setup 🍋‹eta_expand› style_eta_expand end
›

end
(*>*)