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 |