src/HOL/Tools/Nitpick/nitpick_mono.ML
changeset 38190 b02e204b613a
parent 38179 7207321df8af
child 38199 8a9cace789d6
equal deleted inserted replaced
38189:a493dc2179a3 38190:b02e204b613a
   252       if T = alpha_T then
   252       if T = alpha_T then
   253         MAlpha
   253         MAlpha
   254       else case T of
   254       else case T of
   255         Type (@{type_name fun}, [T1, T2]) =>
   255         Type (@{type_name fun}, [T1, T2]) =>
   256         MFun (fresh_mfun_for_fun_type mdata false T1 T2)
   256         MFun (fresh_mfun_for_fun_type mdata false T1 T2)
   257       | Type (@{type_name Product_Type.prod}, [T1, T2]) => MPair (pairself do_type (T1, T2))
   257       | Type (@{type_name prod}, [T1, T2]) => MPair (pairself do_type (T1, T2))
   258       | Type (z as (s, _)) =>
   258       | Type (z as (s, _)) =>
   259         if could_exist_alpha_sub_mtype ctxt alpha_T T then
   259         if could_exist_alpha_sub_mtype ctxt alpha_T T then
   260           case AList.lookup (op =) (!datatype_mcache) z of
   260           case AList.lookup (op =) (!datatype_mcache) z of
   261             SOME M => M
   261             SOME M => M
   262           | NONE =>
   262           | NONE =>
  1041           case (M, T) of
  1041           case (M, T) of
  1042             (MAlpha, _) => T
  1042             (MAlpha, _) => T
  1043           | (MFun (M1, a, M2), Type (@{type_name fun}, Ts)) =>
  1043           | (MFun (M1, a, M2), Type (@{type_name fun}, Ts)) =>
  1044             Type (if should_finitize T a then @{type_name fin_fun}
  1044             Type (if should_finitize T a then @{type_name fin_fun}
  1045                   else @{type_name fun}, map2 type_from_mtype Ts [M1, M2])
  1045                   else @{type_name fun}, map2 type_from_mtype Ts [M1, M2])
  1046           | (MPair (M1, M2), Type (@{type_name Product_Type.prod}, Ts)) =>
  1046           | (MPair (M1, M2), Type (@{type_name prod}, Ts)) =>
  1047             Type (@{type_name Product_Type.prod}, map2 type_from_mtype Ts [M1, M2])
  1047             Type (@{type_name prod}, map2 type_from_mtype Ts [M1, M2])
  1048           | (MType _, _) => T
  1048           | (MType _, _) => T
  1049           | _ => raise MTYPE ("Nitpick_Mono.finitize_funs.type_from_mtype",
  1049           | _ => raise MTYPE ("Nitpick_Mono.finitize_funs.type_from_mtype",
  1050                               [M], [T])
  1050                               [M], [T])
  1051         fun finitize_constr (x as (s, T)) =
  1051         fun finitize_constr (x as (s, T)) =
  1052           (s, case AList.lookup (op =) constr_mtypes x of
  1052           (s, case AList.lookup (op =) constr_mtypes x of