extracted selector function, restoring code generation for let expressions
authorhaftmann
Thu, 24 Mar 2022 16:34:40 +0000
changeset 75322 b7a74a04ae4e
parent 75321 d06547c72775
child 75323 a82f7f8a3c7b
extracted selector function, restoring code generation for let expressions
src/Tools/Code/code_thingol.ML
--- a/src/Tools/Code/code_thingol.ML	Thu Mar 24 16:34:39 2022 +0000
+++ b/src/Tools/Code/code_thingol.ML	Thu Mar 24 16:34:40 2022 +0000
@@ -677,14 +677,19 @@
   let
     val thy = Proof_Context.theory_of ctxt;
     val ty = nth (binder_types (snd c_ty)) t_pos;
+    val is_let = null case_pats;
     fun mk_constr NONE _ = NONE
       | mk_constr (SOME c) t =
           let
             val n = Code.args_number thy c;
           in SOME ((c, (take n o binder_types o fastype_of o untag_term) t ---> ty), n) end;
     val constrs =
-      if null case_pats then []
+      if is_let then []
       else map_filter I (map2 mk_constr case_pats (nth_drop t_pos ts));
+    val split_clauses =
+      if is_let then (fn ts => (nth ts t_pos, nth_drop t_pos ts))
+        else (fn ts => (nth ts t_pos, ts |> nth_drop t_pos |> curry (op ~~) case_pats
+          |> map_filter (fn (NONE, _) => NONE | (SOME _, t) => SOME t)));
     fun disjunctive_varnames ts =
       let
         val vs = (fold o fold_varnames) (insert (op =)) ts [];
@@ -720,9 +725,7 @@
       in collapse_clause vs_map ts body end;
     fun casify constrs ty t_app ts =
       let
-        val t = nth ts t_pos;
-        val ts_clause = ts |> nth_drop t_pos |> curry (op ~~) case_pats
-          |> map_filter (fn (NONE, _) => NONE | (SOME _, t) => SOME t);
+        val (t, ts_clause) = split_clauses ts;
         val clauses = if null case_pats
           then map (fn ([t], body) => (t, body)) (mk_clause [ty] (the_single ts_clause))
           else maps (fn ((constr as IConst { dom = tys, ... }, n), t) =>