--- 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 _ =>
--- 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;
--- 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;