src/HOL/Library/code_lazy.ML
changeset 80636 4041e7c8059d
parent 80634 a90ab1ea6458
child 82587 7415414bd9d8
--- a/src/HOL/Library/code_lazy.ML	Sun Aug 04 16:56:28 2024 +0200
+++ b/src/HOL/Library/code_lazy.ML	Sun Aug 04 17:39:47 2024 +0200
@@ -279,7 +279,7 @@
         val (caseT', lthy') = substitute_ctr (to_destr_eagerT caseT, eagerT) caseT lthy3
       in (Const (eager_case, caseT'), lthy') end
 
-    val ctr_names = map (Long_Name.base_name o fst o dest_Const) ctrs
+    val ctr_names = map (Long_Name.base_name o dest_Const_name) ctrs
     val ((((lazy_ctr_name, lazy_sel_name), lazy_ctrs_name), lazy_case_name), ctxt) = lthy4
       |> mk_name "Lazy_" "" short_type_name
       ||>> mk_name "unlazy_" "" short_type_name
@@ -320,7 +320,7 @@
 
     fun mk_lazy_ctr (name, eager_ctr) =
       let
-        val (_, ctrT) = dest_Const eager_ctr
+        val ctrT = dest_Const_type eager_ctr
         fun to_lazy_ctrT (Type (\<^type_name>\<open>fun\<close>, [T1, T2])) = T1 --> to_lazy_ctrT T2
           | to_lazy_ctrT T = if T = eagerT then lazy_type else raise Match
         val lazy_ctrT = to_lazy_ctrT ctrT
@@ -334,7 +334,7 @@
 
     val (lazy_case_def, lthy8) =
       let
-        val (_, caseT) = dest_Const case'
+        val caseT = dest_Const_type case'
         fun to_lazy_caseT (Type (\<^type_name>\<open>fun\<close>, [T1, T2])) =
             if T1 = eagerT then lazy_type --> T2 else T1 --> to_lazy_caseT T2
         val lazy_caseT = to_lazy_caseT caseT
@@ -385,7 +385,7 @@
 
     fun mk_lazy_ctr_eq (eager_ctr, lazy_ctr) =
       let
-        val (_, ctrT) = dest_Const eager_ctr
+        val ctrT = dest_Const_type eager_ctr
         val argsT = binder_types ctrT
         val args = length argsT
       in
@@ -401,7 +401,7 @@
 
     fun mk_ctrs_lazy_eq (eager_ctr, lazy_ctr) =
       let
-        val argsT = dest_Const eager_ctr |> snd |> binder_types
+        val argsT =  binder_types (dest_Const_type eager_ctr)
         val n = length argsT
         val lhs = apply_bounds 0 n eager_ctr
         val rhs = #const lazy_ctr_def $ 
@@ -423,7 +423,7 @@
 
     val case_lazy_eq = 
       let
-        val (_, caseT) = case' |> dest_Const
+        val caseT = dest_Const_type case'
         val argsT = binder_types caseT
         val n = length argsT
         val lhs = apply_bounds 0 n case'
@@ -447,10 +447,10 @@
     fun mk_case_ctrs_eq (i, lazy_ctr) =
       let
         val lazy_case = #const lazy_case_def
-        val (_, ctrT) = dest_Const lazy_ctr
+        val ctrT = dest_Const_type lazy_ctr
         val ctr_argsT = binder_types ctrT
         val ctr_args_n = length ctr_argsT
-        val (_, caseT) = dest_Const lazy_case
+        val caseT = dest_Const_type lazy_case
         val case_argsT = binder_types caseT
 
         fun n_bounds_from m n t =
@@ -537,7 +537,7 @@
           val table = Laziness_Data.get thy
         in fn (s1, s2) => case Symtab.lookup table s1 of
             NONE => false
-          | SOME x => #active x andalso s2 <> (#ctr x |> dest_Const |> fst)
+          | SOME x => #active x andalso s2 <> dest_Const_name (#ctr x)
         end
       val thy = Proof_Context.theory_of ctxt
       val table = Laziness_Data.get thy
@@ -577,7 +577,7 @@
     val ctxt = Proof_Context.init_global thy
     fun pretty_ctr ctr = 
       let
-        val argsT = dest_Const ctr |> snd |> binder_types
+        val argsT = binder_types (dest_Const_type ctr)
       in
         Pretty.block [
           Syntax.pretty_term ctxt ctr,