# HG changeset patch
# User haftmann
# Date 1276594720 -7200
# Node ID c72a43a7d2c53316e79701390d064bfb75b7399d
# Parent  4906ab9703165ded6f7feeb1ce117b9a848b9ddc
drop function definitions of combinators

diff -r 4906ab970316 -r c72a43a7d2c5 src/Tools/Code/code_haskell.ML
--- a/src/Tools/Code/code_haskell.ML	Tue Jun 15 11:38:39 2010 +0200
+++ b/src/Tools/Code/code_haskell.ML	Tue Jun 15 11:38:40 2010 +0200
@@ -275,7 +275,8 @@
             val (base', nsp_typ') = mk_name_stmt (first_upper base) nsp_typ
           in (base', (nsp_fun, nsp_typ')) end;
         val add_name = case stmt
-         of Code_Thingol.Fun _ => add_fun false
+         of Code_Thingol.Fun (_, (_, SOME _)) => pair base
+          | Code_Thingol.Fun _ => add_fun false
           | Code_Thingol.Datatype _ => add_typ
           | Code_Thingol.Datatypecons _ => add_fun true
           | Code_Thingol.Class _ => add_typ
@@ -283,7 +284,9 @@
           | Code_Thingol.Classparam _ => add_fun false
           | Code_Thingol.Classinst _ => pair base;
         fun add_stmt' base' = case stmt
-         of Code_Thingol.Datatypecons _ =>
+         of Code_Thingol.Fun (_, (_, SOME _)) =>
+              I
+          | Code_Thingol.Datatypecons _ =>
               cons (name, (Long_Name.append module_name' base', NONE))
           | Code_Thingol.Classrel _ => I
           | Code_Thingol.Classparam _ =>
diff -r 4906ab970316 -r c72a43a7d2c5 src/Tools/Code/code_ml.ML
--- a/src/Tools/Code/code_ml.ML	Tue Jun 15 11:38:39 2010 +0200
+++ b/src/Tools/Code/code_ml.ML	Tue Jun 15 11:38:40 2010 +0200
@@ -758,6 +758,11 @@
         val base' = if upper then first_upper base else base;
         val ([base''], nsp') = Name.variants [base'] nsp;
       in (base'', nsp') end;
+    fun deps_of names =
+      []
+      |> fold (fold (insert (op =)) o Graph.imm_succs program) names
+      |> subtract (op =) names
+      |> filter_out (Code_Thingol.is_case o Graph.get_node program);
     fun ml_binding_of_stmt (name, Code_Thingol.Fun (_, ((tysm as (vs, ty), raw_eqs), _))) =
           let
             val eqs = filter (snd o snd) raw_eqs;
@@ -845,10 +850,7 @@
     fun add_stmts' stmts nsp_nodes =
       let
         val names as (name :: names') = map fst stmts;
-        val deps =
-          []
-          |> fold (fold (insert (op =)) o Graph.imm_succs program) names
-          |> subtract (op =) names;
+        val deps = deps_of names;
         val (module_names, _) = (split_list o map dest_name) names;
         val module_name = (the_single o distinct (op =) o map mk_name_module) module_names
           handle Empty =>
@@ -882,9 +884,9 @@
         |> apsnd (fold (fn name => fold (add_dep name) deps) names)
         |> apsnd (fold_product (curry (map_node module_name_path o Graph.add_edge)) names names)
       end;
-    val (_, nodes) = empty_module
-      |> fold add_stmts' (map (AList.make (Graph.get_node program))
-          (rev (Graph.strong_conn program)));
+    val stmts = map (AList.make (Graph.get_node program)) (rev (Graph.strong_conn program))
+      |> filter_out (fn [(_, stmt)] => Code_Thingol.is_case stmt | _ => false);
+    val (_, nodes) = fold add_stmts' stmts empty_module;
     fun deresolver prefix name = 
       let
         val module_name = (fst o dest_name) name;
diff -r 4906ab970316 -r c72a43a7d2c5 src/Tools/Code/code_scala.ML
--- a/src/Tools/Code/code_scala.ML	Tue Jun 15 11:38:39 2010 +0200
+++ b/src/Tools/Code/code_scala.ML	Tue Jun 15 11:38:40 2010 +0200
@@ -334,8 +334,9 @@
         |> add_name
         |-> (fn base' => rpair (add_stmt base' stmts))
       end;
-    val (_, sca_program) = fold prepare_stmt (AList.make (fn name => Graph.get_node program name)
-      (Graph.strong_conn program |> flat)) (((reserved, reserved), reserved), []);
+    val stmts = AList.make (Graph.get_node program) (Graph.strong_conn program |> flat)
+      |> filter_out (Code_Thingol.is_case o snd);
+    val (_, sca_program) = fold prepare_stmt stmts (((reserved, reserved), reserved), []);
     fun deresolver name = (fst o the o AList.lookup (op =) sca_program) name
       handle Option => error ("Unknown statement name: " ^ labelled_name name);
   in (deresolver, (the_module_name, sca_program)) end;