# HG changeset patch
# User haftmann
# Date 1283178698 -7200
# Node ID 026526cba0e668ef7b5f4aa0ab1641badc655af7
# Parent  0a49a34e5d37d3055c5e85e0b69646199d946c26
tuned

diff -r 0a49a34e5d37 -r 026526cba0e6 src/Tools/Code/code_haskell.ML
--- a/src/Tools/Code/code_haskell.ML	Mon Aug 30 16:25:04 2010 +0200
+++ b/src/Tools/Code/code_haskell.ML	Mon Aug 30 16:31:38 2010 +0200
@@ -375,25 +375,24 @@
           | (_, (_, NONE)) => NONE) stmts);
     val serialize_module =
       if null presentation_stmt_names then serialize_module1 else pair "" o serialize_module2;
-    fun check_destination destination =
-      (File.check destination; destination);
-    fun write_module width destination (modlname, content) =
-      let
-        val filename = case modlname
-         of "" => Path.explode "Main.hs"
-          | _ => (Path.ext "hs" o Path.explode o implode o separate "/"
-                o Long_Name.explode) modlname;
-        val pathname = Path.append destination filename;
-        val _ = File.mkdir_leaf (Path.dir pathname);
-      in File.write pathname
-        ("{-# OPTIONS_GHC -fglasgow-exts #-}\n\n"
-          ^ string_of_pretty width content)
-      end
+    fun write_module width (SOME destination) (modlname, content) =
+          let
+            val _ = File.check destination;
+            val filename = case modlname
+             of "" => Path.explode "Main.hs"
+              | _ => (Path.ext "hs" o Path.explode o implode o separate "/"
+                    o Long_Name.explode) modlname;
+            val pathname = Path.append destination filename;
+            val _ = File.mkdir_leaf (Path.dir pathname);
+          in File.write pathname
+            ("{-# OPTIONS_GHC -fglasgow-exts #-}\n\n"
+              ^ string_of_pretty width content)
+          end
+      | write_module width NONE (_, content) = writeln_pretty width content;
   in
     Code_Target.mk_serialization
-      (fn width => (fn NONE => K () o map (writeln_pretty width o snd)
-        | SOME file => K () o map (write_module width (check_destination file))))
-      (fn width => (rpair [] o cat_lines o map (string_of_pretty width o snd)))
+      (fn width => fn destination => K () o map (write_module width destination))
+      (fn width => rpair [] o cat_lines o map (string_of_pretty width o snd))
       (map (uncurry print_module) includes
         @ map serialize_module (Symtab.dest hs_program))
   end;
diff -r 0a49a34e5d37 -r 026526cba0e6 src/Tools/Code/code_ml.ML
--- a/src/Tools/Code/code_ml.ML	Mon Aug 30 16:25:04 2010 +0200
+++ b/src/Tools/Code/code_ml.ML	Mon Aug 30 16:31:38 2010 +0200
@@ -934,10 +934,10 @@
     val stmt_names' = (map o try)
       (deresolver (if is_some module_name then the_list module_name else [])) stmt_names;
     val p = Pretty.chunks2 (map snd includes @ snd (print_nodes [] nodes));
+    fun write width NONE = writeln_pretty width
+      | write width (SOME p) = File.write p o string_of_pretty width;
   in
-    Code_Target.mk_serialization
-      (fn width => (fn NONE => writeln_pretty width | SOME file => File.write file o string_of_pretty width))
-      (fn width => (rpair stmt_names' o string_of_pretty width)) p
+    Code_Target.mk_serialization write (fn width => (rpair stmt_names' o string_of_pretty width)) p
   end;
 
 end; (*local*)
diff -r 0a49a34e5d37 -r 026526cba0e6 src/Tools/Code/code_scala.ML
--- a/src/Tools/Code/code_scala.ML	Mon Aug 30 16:25:04 2010 +0200
+++ b/src/Tools/Code/code_scala.ML	Mon Aug 30 16:31:38 2010 +0200
@@ -480,10 +480,10 @@
     val p_includes = if null presentation_stmt_names
       then map (fn (base, p) => print_module base [] p) includes else [];
     val p = Pretty.chunks2 (p_includes @ the_list (print_nodes [] sca_program));
+    fun write width NONE = writeln_pretty width
+      | write width (SOME p) = File.write p o string_of_pretty width;
   in
-    Code_Target.mk_serialization
-      (fn width => (fn NONE => writeln_pretty width | SOME file => File.write file o string_of_pretty width))
-      (rpair [] oo string_of_pretty) p
+    Code_Target.mk_serialization write (rpair [] oo string_of_pretty) p
   end;
 
 end; (*local*)