src/HOL/Tools/ATP/atp_problem_generate.ML
changeset 51921 bbbacaef19a6
parent 51920 16f3b9d4e515
child 51998 f732a674db1b
equal deleted inserted replaced
51920:16f3b9d4e515 51921:bbbacaef19a6
  1175     case unprefix_and_unascii const_prefix s of
  1175     case unprefix_and_unascii const_prefix s of
  1176       NONE =>
  1176       NONE =>
  1177       if level_of_type_enc type_enc = No_Types orelse s = tptp_choice then []
  1177       if level_of_type_enc type_enc = No_Types orelse s = tptp_choice then []
  1178       else T_args
  1178       else T_args
  1179     | SOME s'' =>
  1179     | SOME s'' =>
  1180       filter_type_args thy constrs type_enc (unmangled_invert_const s'') ary T_args
  1180       filter_type_args thy constrs type_enc (unmangled_invert_const s'') ary
       
  1181                        T_args
  1181 fun filter_type_args_in_iterm thy constrs type_enc =
  1182 fun filter_type_args_in_iterm thy constrs type_enc =
  1182   let
  1183   let
  1183     fun filt ary (IApp (tm1, tm2)) = IApp (filt (ary + 1) tm1, filt 0 tm2)
  1184     fun filt ary (IApp (tm1, tm2)) = IApp (filt (ary + 1) tm1, filt 0 tm2)
  1184       | filt ary (IConst (name as (s, _), T, T_args)) =
  1185       | filt ary (IConst (name as (s, _), T, T_args)) =
  1185         filter_type_args_in_const thy constrs type_enc ary s T_args
  1186         filter_type_args_in_const thy constrs type_enc ary s T_args
  1642 
  1643 
  1643 fun firstorderize_fact thy constrs type_enc sym_tab uncurried_aliases
  1644 fun firstorderize_fact thy constrs type_enc sym_tab uncurried_aliases
  1644                        completish =
  1645                        completish =
  1645   let
  1646   let
  1646     fun do_app arg head = mk_app_op type_enc head arg
  1647     fun do_app arg head = mk_app_op type_enc head arg
  1647     fun list_app_ops head args = fold do_app args head
  1648     fun list_app_ops (head, args) = fold do_app args head
  1648     fun introduce_app_ops tm =
  1649     fun introduce_app_ops tm =
  1649       let val (head, args) = tm |> strip_iterm_comb ||> map introduce_app_ops in
  1650       let val (head, args) = tm |> strip_iterm_comb ||> map introduce_app_ops in
  1650         case head of
  1651         case head of
  1651           IConst (name as (s, _), T, T_args) =>
  1652           IConst (name as (s, _), T, T_args) =>
  1652           if uncurried_aliases andalso String.isPrefix const_prefix s then
  1653           let
  1653             let
  1654             val min_ary = min_ary_of sym_tab s
  1654               val ary = length args
  1655             val ary =
  1655               val name =
  1656               if uncurried_aliases andalso String.isPrefix const_prefix s then
  1656                 name |> ary > min_ary_of sym_tab s ? aliased_uncurried ary
  1657                 let
  1657             in list_app (IConst (name, T, T_args)) args end
  1658                   val ary = length args
  1658           else
  1659                   (* In polymorphic native type encodings, it is impossible to
  1659             args |> chop (min_ary_of sym_tab s)
  1660                      declare a fully polymorphic symbol that takes more arguments
  1660                  |>> list_app head |-> list_app_ops
  1661                      than its signature (even though such concrete instances, where
  1661         | _ => list_app_ops head args
  1662                      a type variable is instantiated by a function type, are
       
  1663                      possible.) *)
       
  1664                   val official_ary =
       
  1665                     if is_type_enc_polymorphic type_enc then
       
  1666                       case unprefix_and_unascii const_prefix s of
       
  1667                         SOME s' =>
       
  1668                         (case try (robust_const_ary thy) (invert_const s') of
       
  1669                            SOME ary => ary
       
  1670                          | NONE => min_ary)
       
  1671                       | NONE => min_ary
       
  1672                     else
       
  1673                       1000000000 (* irrealistically big arity *)
       
  1674                 in Int.min (ary, official_ary) end
       
  1675               else
       
  1676                 min_ary
       
  1677             val head =
       
  1678               if ary = min_ary then head
       
  1679               else IConst (aliased_uncurried ary name, T, T_args)
       
  1680           in
       
  1681             args |> chop ary |>> list_app head |> list_app_ops
       
  1682           end
       
  1683         | _ => list_app_ops (head, args)
  1662       end
  1684       end
  1663     fun introduce_predicators tm =
  1685     fun introduce_predicators tm =
  1664       case strip_iterm_comb tm of
  1686       case strip_iterm_comb tm of
  1665         (IConst ((s, _), _, _), _) =>
  1687         (IConst ((s, _), _, _), _) =>
  1666         if is_pred_sym sym_tab s then tm else predicatify completish tm
  1688         if is_pred_sym sym_tab s then tm else predicatify completish tm