tuned
authorhaftmann
Sun, 15 Feb 2015 08:17:46 +0100
changeset 59544 792691e4b311
parent 59543 d3f4ddeaacc3
child 59545 12a6088ed195
tuned
src/Tools/Code/code_thingol.ML
--- a/src/Tools/Code/code_thingol.ML	Sun Feb 15 08:17:44 2015 +0100
+++ b/src/Tools/Code/code_thingol.ML	Sun Feb 15 08:17:46 2015 +0100
@@ -672,41 +672,41 @@
     val constrs =
       if null case_pats then []
       else map_filter I (map2 mk_constr case_pats (nth_drop t_pos ts));
+    fun disjunctive_varnames ts =
+      let
+        val vs = (fold o fold_varnames) (insert (op =)) ts [];
+      in fn pat => null (inter (op =) vs (fold_varnames (insert (op =)) pat [])) end;
+    fun purge_unused_vars_in t =
+      let
+        val vs = fold_varnames (insert (op =)) t [];
+      in
+        map_terms_bottom_up (fn IVar (SOME v) =>
+          IVar (if member (op =) vs v then SOME v else NONE) | t => t)
+      end;
+    fun collapse_clause vs_map ts body =
+      case body
+       of IConst { sym = Constant c, ... } => if member (op =) undefineds c
+            then []
+            else [(ts, body)]
+        | ICase { term = IVar (SOME v), clauses = clauses, ... } =>
+            if forall (fn (pat', body') => exists_var pat' v
+              orelse not (exists_var body' v)) clauses
+              andalso forall (disjunctive_varnames ts o fst) clauses
+            then case AList.lookup (op =) vs_map v
+             of SOME i => maps (fn (pat', body') =>
+                  collapse_clause (AList.delete (op =) v vs_map)
+                    (nth_map i (K pat') ts |> map (purge_unused_vars_in body')) body') clauses
+              | NONE => [(ts, body)]
+            else [(ts, body)]
+        | _ => [(ts, body)];
+    fun mk_clause mk tys t =
+      let
+        val (vs, body) = unfold_abs_eta tys t;
+        val vs_map = fold_index (fn (i, (SOME v, _)) => cons (v, i) | _ => I) vs [];
+        val ts = map (IVar o fst) vs;
+      in map mk (collapse_clause vs_map ts body) end;
     fun casify constrs ty t_app ts =
       let
-        fun disjunctive_varnames ts =
-          let
-            val vs = (fold o fold_varnames) (insert (op =)) ts [];
-          in fn pat => null (inter (op =) vs (fold_varnames (insert (op =)) pat [])) end;
-        fun purge_unused_vars_in t =
-          let
-            val vs = fold_varnames (insert (op =)) t [];
-          in
-            map_terms_bottom_up (fn IVar (SOME v) =>
-              IVar (if member (op =) vs v then SOME v else NONE) | t => t)
-          end;
-        fun collapse_clause vs_map ts body =
-          case body
-           of IConst { sym = Constant c, ... } => if member (op =) undefineds c
-                then []
-                else [(ts, body)]
-            | ICase { term = IVar (SOME v), clauses = clauses, ... } =>
-                if forall (fn (pat', body') => exists_var pat' v
-                  orelse not (exists_var body' v)) clauses
-                  andalso forall (disjunctive_varnames ts o fst) clauses
-                then case AList.lookup (op =) vs_map v
-                 of SOME i => maps (fn (pat', body') =>
-                      collapse_clause (AList.delete (op =) v vs_map)
-                        (nth_map i (K pat') ts |> map (purge_unused_vars_in body')) body') clauses
-                  | NONE => [(ts, body)]
-                else [(ts, body)]
-            | _ => [(ts, body)];
-        fun mk_clause mk tys t =
-          let
-            val (vs, body) = unfold_abs_eta tys t;
-            val vs_map = fold_index (fn (i, (SOME v, _)) => cons (v, i) | _ => I) vs [];
-            val ts = map (IVar o fst) vs;
-          in map mk (collapse_clause vs_map ts body) end;
         val t = nth ts t_pos;
         val ts_clause = nth_drop t_pos ts;
         val clauses = if null case_pats