src/HOL/HOLCF/Tools/Domain/domain_constructors.ML
changeset 59582 0fbed69ff081
parent 59498 50b60f501b05
child 59621 291934bac95e
equal deleted inserted replaced
59580:cbc38731d42f 59582:0fbed69ff081
   133     | arglist t = ([], t)
   133     | arglist t = ([], t)
   134 in
   134 in
   135   fun beta_of_def thy def_thm =
   135   fun beta_of_def thy def_thm =
   136       let
   136       let
   137         val (con, lam) =
   137         val (con, lam) =
   138           Logic.dest_equals (Logic.unvarify_global (concl_of def_thm))
   138           Logic.dest_equals (Logic.unvarify_global (Thm.concl_of def_thm))
   139         val (args, rhs) = arglist lam
   139         val (args, rhs) = arglist lam
   140         val lhs = list_ccomb (con, args)
   140         val lhs = list_ccomb (con, args)
   141         val goal = mk_equals (lhs, rhs)
   141         val goal = mk_equals (lhs, rhs)
   142         val cs = ContProc.cont_thms lam
   142         val cs = ContProc.cont_thms lam
   143         val betas = map (fn c => mk_meta_eq (c RS @{thm beta_cfun})) cs
   143         val betas = map (fn c => mk_meta_eq (c RS @{thm beta_cfun})) cs
   209         | cons2typ n (con::cons) =
   209         | cons2typ n (con::cons) =
   210           let
   210           let
   211             val (n1, t1) = args2typ n (snd con)
   211             val (n1, t1) = args2typ n (snd con)
   212             val (n2, t2) = cons2typ n1 cons
   212             val (n2, t2) = cons2typ n1 cons
   213           in (n2, mk_ssumT (t1, t2)) end
   213           in (n2, mk_ssumT (t1, t2)) end
   214       val ct = ctyp_of thy (snd (cons2typ 1 spec'))
   214       val ct = Thm.ctyp_of thy (snd (cons2typ 1 spec'))
   215       val thm1 = instantiate' [SOME ct] [] @{thm exh_start}
   215       val thm1 = instantiate' [SOME ct] [] @{thm exh_start}
   216       val thm2 = rewrite_rule (Proof_Context.init_global thy)
   216       val thm2 = rewrite_rule (Proof_Context.init_global thy)
   217         (map mk_meta_eq @{thms ex_bottom_iffs}) thm1
   217         (map mk_meta_eq @{thms ex_bottom_iffs}) thm1
   218       val thm3 = rewrite_rule (Proof_Context.init_global thy)
   218       val thm3 = rewrite_rule (Proof_Context.init_global thy)
   219         [mk_meta_eq @{thm conj_assoc}] thm2
   219         [mk_meta_eq @{thm conj_assoc}] thm2