1.1 --- a/src/Tools/Code/code_haskell.ML	Mon Aug 30 16:25:04 2010 +0200
     1.2 +++ b/src/Tools/Code/code_haskell.ML	Mon Aug 30 16:31:38 2010 +0200
     1.3 @@ -375,25 +375,24 @@
     1.4            | (_, (_, NONE)) => NONE) stmts);
     1.5      val serialize_module =
     1.6        if null presentation_stmt_names then serialize_module1 else pair "" o serialize_module2;
     1.7 -    fun check_destination destination =
     1.8 -      (File.check destination; destination);
     1.9 -    fun write_module width destination (modlname, content) =
    1.10 -      let
    1.11 -        val filename = case modlname
    1.12 -         of "" => Path.explode "Main.hs"
    1.13 -          | _ => (Path.ext "hs" o Path.explode o implode o separate "/"
    1.14 -                o Long_Name.explode) modlname;
    1.15 -        val pathname = Path.append destination filename;
    1.16 -        val _ = File.mkdir_leaf (Path.dir pathname);
    1.17 -      in File.write pathname
    1.18 -        ("{-# OPTIONS_GHC -fglasgow-exts #-}\n\n"
    1.19 -          ^ string_of_pretty width content)
    1.20 -      end
    1.21 +    fun write_module width (SOME destination) (modlname, content) =
    1.22 +          let
    1.23 +            val _ = File.check destination;
    1.24 +            val filename = case modlname
    1.25 +             of "" => Path.explode "Main.hs"
    1.26 +              | _ => (Path.ext "hs" o Path.explode o implode o separate "/"
    1.27 +                    o Long_Name.explode) modlname;
    1.28 +            val pathname = Path.append destination filename;
    1.29 +            val _ = File.mkdir_leaf (Path.dir pathname);
    1.30 +          in File.write pathname
    1.31 +            ("{-# OPTIONS_GHC -fglasgow-exts #-}\n\n"
    1.32 +              ^ string_of_pretty width content)
    1.33 +          end
    1.34 +      | write_module width NONE (_, content) = writeln_pretty width content;
    1.35    in
    1.36      Code_Target.mk_serialization
    1.37 -      (fn width => (fn NONE => K () o map (writeln_pretty width o snd)
    1.38 -        | SOME file => K () o map (write_module width (check_destination file))))
    1.39 -      (fn width => (rpair [] o cat_lines o map (string_of_pretty width o snd)))
    1.40 +      (fn width => fn destination => K () o map (write_module width destination))
    1.41 +      (fn width => rpair [] o cat_lines o map (string_of_pretty width o snd))
    1.42        (map (uncurry print_module) includes
    1.43          @ map serialize_module (Symtab.dest hs_program))
    1.44    end;