Up to index of Isabelle/HOL
theory Code_Setup(* Title: HOL/Code_Setup.thy ID: $Id: Code_Setup.thy,v 1.12 2008/05/23 14:42:43 berghofe Exp $ Author: Florian Haftmann *) header {* Setup of code generators and derived tools *} theory Code_Setup imports HOL uses "~~/src/HOL/Tools/recfun_codegen.ML" begin subsection {* SML code generator setup *} setup RecfunCodegen.setup types_code "bool" ("bool") attach (term_of) {* fun term_of_bool b = if b then HOLogic.true_const else HOLogic.false_const; *} attach (test) {* fun gen_bool i = let val b = one_of [false, true] in (b, fn () => term_of_bool b) end; *} "prop" ("bool") attach (term_of) {* fun term_of_prop b = HOLogic.mk_Trueprop (if b then HOLogic.true_const else HOLogic.false_const); *} consts_code "Trueprop" ("(_)") "True" ("true") "False" ("false") "Not" ("Bool.not") "op |" ("(_ orelse/ _)") "op &" ("(_ andalso/ _)") "If" ("(if _/ then _/ else _)") setup {* let fun eq_codegen thy defs gr dep thyname b t = (case strip_comb t of (Const ("op =", Type (_, [Type ("fun", _), _])), _) => NONE | (Const ("op =", _), [t, u]) => let val (gr', pt) = Codegen.invoke_codegen thy defs dep thyname false (gr, t); val (gr'', pu) = Codegen.invoke_codegen thy defs dep thyname false (gr', u); val (gr''', _) = Codegen.invoke_tycodegen thy defs dep thyname false (gr'', HOLogic.boolT) in SOME (gr''', Codegen.parens (Pretty.block [pt, Codegen.str " =", Pretty.brk 1, pu])) end | (t as Const ("op =", _), ts) => SOME (Codegen.invoke_codegen thy defs dep thyname b (gr, Codegen.eta_expand t ts 2)) | _ => NONE); in Codegen.add_codegen "eq_codegen" eq_codegen end *} quickcheck_params [size = 5, iterations = 50] text {* Evaluation *} method_setup evaluation = {* Method.no_args (Method.SIMPLE_METHOD' (CONVERSION Codegen.evaluation_conv THEN' rtac TrueI)) *} "solve goal by evaluation" subsection {* Generic code generator setup *} text {* using built-in Haskell equality *} code_class eq (Haskell "Eq" where "op =" ≡ "(==)") code_const "op =" (Haskell infixl 4 "==") text {* type bool *} lemmas [code func, code unfold, code post] = imp_conv_disj code_type bool (SML "bool") (OCaml "bool") (Haskell "Bool") code_const True and False and Not and "op &" and "op |" and If (SML "true" and "false" and "not" and infixl 1 "andalso" and infixl 0 "orelse" and "!(if (_)/ then (_)/ else (_))") (OCaml "true" and "false" and "not" and infixl 4 "&&" and infixl 2 "||" and "!(if (_)/ then (_)/ else (_))") (Haskell "True" and "False" and "not" and infixl 3 "&&" and infixl 2 "||" and "!(if (_)/ then (_)/ else (_))") code_reserved SML bool true false not code_reserved OCaml bool not text {* code generation for undefined as exception *} code_const undefined (SML "raise/ Fail/ \"undefined\"") (OCaml "failwith/ \"undefined\"") (Haskell "error/ \"undefined\"") text {* Let and If *} lemmas [code func] = Let_def if_True if_False subsection {* Evaluation oracle *} oracle eval_oracle ("term") = {* fn thy => fn t => if CodePackage.satisfies thy (HOLogic.dest_Trueprop t) [] then t else HOLogic.Trueprop $ HOLogic.true_const (*dummy*) *} method_setup eval = {* let fun eval_tac thy = SUBGOAL (fn (t, i) => rtac (eval_oracle thy t) i) in Method.ctxt_args (fn ctxt => Method.SIMPLE_METHOD' (eval_tac (ProofContext.theory_of ctxt))) end *} "solve goal by evaluation" subsection {* Normalization by evaluation *} method_setup normalization = {* Method.no_args (Method.SIMPLE_METHOD' (CONVERSION (ObjectLogic.judgment_conv Nbe.norm_conv) THEN' (fn k => TRY (rtac TrueI k)) )) *} "solve goal by normalization" end
lemma
(P --> Q) = (¬ P ∨ Q)
lemma
Let s f == f s
(if True then x else y) = x
(if False then x else y) = y