equal
deleted
inserted
replaced
962 val bad = fold (add_extra_frees ctxt [] []) corec_args []; |
962 val bad = fold (add_extra_frees ctxt [] []) corec_args []; |
963 val _ = null bad orelse |
963 val _ = null bad orelse |
964 (if exists has_call corec_args then nonprimitive_corec ctxt [] |
964 (if exists has_call corec_args then nonprimitive_corec ctxt [] |
965 else extra_variable ctxt [] (hd bad)); |
965 else extra_variable ctxt [] (hd bad)); |
966 |
966 |
967 fun currys [] t = t |
|
968 | currys Ts t = t $ mk_tuple1_balanced (List.rev Ts) (map Bound (length Ts - 1 downto 0)) |
|
969 |> fold_rev (Term.abs o pair Name.uu) Ts; |
|
970 |
|
971 val excludess' = |
967 val excludess' = |
972 disc_eqnss |
968 disc_eqnss |
973 |> map (map (fn x => (#fun_args x, #ctr_no x, #prems x, #auto_gen x)) |
969 |> map (map (fn x => (#fun_args x, #ctr_no x, #prems x, #auto_gen x)) |
974 #> fst o (fn xs => fold_map (fn x => fn ys => ((x, ys), ys @ [x])) xs []) |
970 #> fst o (fn xs => fold_map (fn x => fn ys => ((x, ys), ys @ [x])) xs []) |
975 #> maps (uncurry (map o pair) |
971 #> maps (uncurry (map o pair) |
978 ||> map_prod (map HOLogic.mk_Trueprop) HOLogic.mk_Trueprop |
974 ||> map_prod (map HOLogic.mk_Trueprop) HOLogic.mk_Trueprop |
979 ||> Logic.list_implies |
975 ||> Logic.list_implies |
980 ||> curry Logic.list_all (map dest_Free fun_args)))); |
976 ||> curry Logic.list_all (map dest_Free fun_args)))); |
981 in |
977 in |
982 map (Term.list_comb o rpair corec_args) corecs |
978 map (Term.list_comb o rpair corec_args) corecs |
983 |> map2 (fn Ts => fn t => if length Ts = 0 then t $ HOLogic.unit else t) arg_Tss |
979 |> map2 abs_curried_balanced arg_Tss |
984 |> map2 currys arg_Tss |
|
985 |> (fn ts => Syntax.check_terms ctxt ts |
980 |> (fn ts => Syntax.check_terms ctxt ts |
986 handle ERROR _ => nonprimitive_corec ctxt []) |
981 handle ERROR _ => nonprimitive_corec ctxt []) |
987 |> @{map 3} (fn b => fn mx => fn t => ((b, mx), ((Binding.concealed (Thm.def_binding b), []), t))) |
982 |> @{map 3} (fn b => fn mx => fn t => ((b, mx), ((Binding.concealed (Thm.def_binding b), []), t))) |
988 bs mxs |
983 bs mxs |
989 |> rpair excludess' |
984 |> rpair excludess' |