tuned
authorhaftmann
Mon Aug 30 16:31:38 2010 +0200 (2010-08-30)
changeset 38915026526cba0e6
parent 38914 0a49a34e5d37
child 38916 c0b857a04758
tuned
src/Tools/Code/code_haskell.ML
src/Tools/Code/code_ml.ML
src/Tools/Code/code_scala.ML
     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;
     2.1 --- a/src/Tools/Code/code_ml.ML	Mon Aug 30 16:25:04 2010 +0200
     2.2 +++ b/src/Tools/Code/code_ml.ML	Mon Aug 30 16:31:38 2010 +0200
     2.3 @@ -934,10 +934,10 @@
     2.4      val stmt_names' = (map o try)
     2.5        (deresolver (if is_some module_name then the_list module_name else [])) stmt_names;
     2.6      val p = Pretty.chunks2 (map snd includes @ snd (print_nodes [] nodes));
     2.7 +    fun write width NONE = writeln_pretty width
     2.8 +      | write width (SOME p) = File.write p o string_of_pretty width;
     2.9    in
    2.10 -    Code_Target.mk_serialization
    2.11 -      (fn width => (fn NONE => writeln_pretty width | SOME file => File.write file o string_of_pretty width))
    2.12 -      (fn width => (rpair stmt_names' o string_of_pretty width)) p
    2.13 +    Code_Target.mk_serialization write (fn width => (rpair stmt_names' o string_of_pretty width)) p
    2.14    end;
    2.15  
    2.16  end; (*local*)
     3.1 --- a/src/Tools/Code/code_scala.ML	Mon Aug 30 16:25:04 2010 +0200
     3.2 +++ b/src/Tools/Code/code_scala.ML	Mon Aug 30 16:31:38 2010 +0200
     3.3 @@ -480,10 +480,10 @@
     3.4      val p_includes = if null presentation_stmt_names
     3.5        then map (fn (base, p) => print_module base [] p) includes else [];
     3.6      val p = Pretty.chunks2 (p_includes @ the_list (print_nodes [] sca_program));
     3.7 +    fun write width NONE = writeln_pretty width
     3.8 +      | write width (SOME p) = File.write p o string_of_pretty width;
     3.9    in
    3.10 -    Code_Target.mk_serialization
    3.11 -      (fn width => (fn NONE => writeln_pretty width | SOME file => File.write file o string_of_pretty width))
    3.12 -      (rpair [] oo string_of_pretty) p
    3.13 +    Code_Target.mk_serialization write (rpair [] oo string_of_pretty) p
    3.14    end;
    3.15  
    3.16  end; (*local*)