848 disc_eqns |
848 disc_eqns |
849 else |
849 else |
850 let |
850 let |
851 val n = 0 upto length ctr_specs |
851 val n = 0 upto length ctr_specs |
852 |> the o find_first (fn idx => not (exists (curry (op =) idx o #ctr_no) disc_eqns)); |
852 |> the o find_first (fn idx => not (exists (curry (op =) idx o #ctr_no) disc_eqns)); |
|
853 val {ctr, disc, ...} = nth ctr_specs n; |
853 val fun_args = (try (#fun_args o hd) disc_eqns, try (#fun_args o hd) sel_eqns) |
854 val fun_args = (try (#fun_args o hd) disc_eqns, try (#fun_args o hd) sel_eqns) |
854 |> the_default (map (curry Free Name.uu) arg_Ts) o merge_options; |
855 |> the_default (map (curry Free Name.uu) arg_Ts) o merge_options; |
855 val sel_eqn_opt = |
856 val sel_eqn_opt = find_first (equal ctr o #ctr) sel_eqns; |
856 find_first (curry (op =) (Binding.name_of fun_binding) o #fun_name) sel_eqns; |
|
857 val extra_disc_eqn = { |
857 val extra_disc_eqn = { |
858 fun_name = Binding.name_of fun_binding, |
858 fun_name = Binding.name_of fun_binding, |
859 fun_T = arg_Ts ---> body_type (fastype_of (#ctr (hd ctr_specs))), |
859 fun_T = arg_Ts ---> body_type (fastype_of (#ctr (hd ctr_specs))), |
860 fun_args = fun_args, |
860 fun_args = fun_args, |
861 ctr = #ctr (nth ctr_specs n), |
861 ctr = ctr, |
862 ctr_no = n, |
862 ctr_no = n, |
863 disc = #disc (nth ctr_specs n), |
863 disc = disc, |
864 prems = maps (s_not_conj o #prems) disc_eqns, |
864 prems = maps (s_not_conj o #prems) disc_eqns, |
865 auto_gen = true, |
865 auto_gen = true, |
866 ctr_rhs_opt = Option.map #ctr_rhs_opt sel_eqn_opt |> the_default NONE, |
866 ctr_rhs_opt = Option.map #ctr_rhs_opt sel_eqn_opt |> the_default NONE, |
867 code_rhs_opt = Option.map #ctr_rhs_opt sel_eqn_opt |> the_default NONE, |
867 code_rhs_opt = Option.map #ctr_rhs_opt sel_eqn_opt |> the_default NONE, |
868 eqn_pos = Option.map (curry (op +) 1 o #eqn_pos) sel_eqn_opt |> the_default 1000 (*###*), |
868 eqn_pos = Option.map (curry (op +) 1 o #eqn_pos) sel_eqn_opt |> the_default 1000 (*###*), |