--- 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;
--- 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*)
--- 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*)