src/Pure/Tools/codegen_serializer.ML

--- a/src/Pure/Tools/codegen_serializer.ML	Wed Dec 21 15:18:57 2005 +0100
+++ b/src/Pure/Tools/codegen_serializer.ML	Wed Dec 21 15:19:16 2005 +0100
@@ -409,7 +409,6 @@
                 in mk_app_p br (pr (map (ml_from_expr BR) es1) (ml_from_expr BR)) es2 end;
     fun ml_from_funs (ds as d::ds_tl) =
       let
-        val _ = debug 15 (fn _ => "(1) FUN") ();
         fun mk_definer [] = "val"
           | mk_definer _ = "fun"
         fun check_args (_, Fun ((pats, _)::_, _)) NONE =
@@ -420,12 +419,9 @@
               else error ("mixing simultaneous vals and funs not implemented")
           | check_args _ _ =
               error ("function definition block containing other definitions than functions")
-        val _ = debug 15 (fn _ => "(2) FUN") ();
         val definer = the (fold check_args ds NONE);
-        val _ = debug 15 (fn _ => "(3) FUN") ();
         fun mk_eq definer f ty (pats, expr) =
           let
-            val _ = debug 15 (fn _ => "(5) FUN") ();
             fun mk_pat_arg p =
               case itype_of_ipat p
                of ty as IType (tyco, _) =>
@@ -439,20 +435,16 @@
                       ]
                     else ml_from_pat BR p
                 | _ => ml_from_pat BR p;
-            val _ = debug 15 (fn _ => "(6) FUN") ();
             val lhs = [Pretty.str (definer ^ " " ^ f)]
                        @ (if null pats
                           then [Pretty.str ":", ml_from_type NOBR ty]
                           else map mk_pat_arg pats)
-            val _ = debug 15 (fn _ => "(7) FUN") ();
             val rhs = [Pretty.str "=", ml_from_expr NOBR expr]
-            val _ = debug 15 (fn _ => "(8) FUN") ();
           in
             Pretty.block (separate (Pretty.brk 1) (lhs @ rhs))
           end
         fun mk_fun definer (f, Fun (eqs as eq::eq_tl, (_, ty))) =
           let
-            val _ = debug 15 (fn _ => "(4) FUN") ();
             val (pats_hd::pats_tl) = (fst o split_list) eqs;
             val shift = if null eq_tl then I else map (Pretty.block o single);
           in (Pretty.block o Pretty.fbreaks o shift) (
@@ -520,12 +512,11 @@
           NONE
       | ml_from_def (name, Classinst _) =
           error ("can't serialize instance declaration " ^ quote name ^ " to ML")
-  in (debug 10 (fn _ => "*** defs " ^ commas (map (fn (n, d) => n ^ " = " ^ (Pretty.output o pretty_def) d) ds)) ();
-  case ds
+  in case ds
    of (_, Fun _)::_ => ml_from_funs ds
     | (_, Datatypecons _)::_ => ml_from_datatypes ds
     | (_, Datatype _)::_ => ml_from_datatypes ds
-    | [d] => ml_from_def d)
+    | [d] => ml_from_def d
   end;
 
 in
@@ -561,7 +552,7 @@
         Pretty.str ("end; (* struct " ^ name ^ " *)")
       ]);
     fun is_dicttype tyco =
-      case get_def module tyco
+      NameSpace.is_qualified tyco andalso case get_def module tyco
        of Typesyn (_, IDictT _) => true
         | _ => false;
     fun eta_expander "Pair" = 2
@@ -588,7 +579,6 @@
           else 0;
   in
     module
-    |> debug 12 (Pretty.output o pretty_module)
     |> debug 3 (fn _ => "selecting submodule...")
     |> (if is_some select then (partof o the) select else I)
     |> debug 3 (fn _ => "eta-expanding...")
@@ -599,7 +589,6 @@
     |> tupelize_cons
     |> debug 3 (fn _ => "eliminating classes...")
     |> eliminate_classes
-    |> debug 12 (Pretty.output o pretty_module)
     |> debug 3 (fn _ => "serializing...")
     |> serialize (ml_from_defs tyco_syntax const_syntax is_dicttype) ml_from_module ml_validator nspgrp name_root
     |> (fn p => Pretty.chunks [setmp print_mode [] (Pretty.str o mk_prims) prims, p])
@@ -894,9 +883,7 @@
           else error ("empty statement during serialization: " ^ quote name)
       | haskell_from_def (name, Fun (eqs, (_, ty))) =
           let
-            val _ = print "(1) FUN";
             fun from_eq name (args, rhs) =
-              (print args; print rhs;
               Pretty.block [
                 Pretty.str (lower_first name),
                 Pretty.block (map (fn p => Pretty.block [Pretty.brk 1, haskell_from_pat BR p]) args),
@@ -904,8 +891,7 @@
                 Pretty.str ("="),
                 Pretty.brk 1,
                 haskell_from_expr NOBR rhs
-              ])
-            val _ = print "(2) FUN";
+              ]
           in
             Pretty.chunks [
               Pretty.block [
@@ -991,7 +977,7 @@
             ) instmems)
           ] |> SOME
   in
-    case List.mapPartial (fn (name, def) => (print ("serializing " ^ name); haskell_from_def (name, def))) defs
+    case List.mapPartial (fn (name, def) => haskell_from_def (name, def)) defs
      of [] => NONE
       | l => (SOME o Pretty.block) l
   end;
@@ -1047,7 +1033,6 @@
         | _ => false;
   in
     module
-    |> debug 12 (Pretty.output o pretty_module)
     |> debug 3 (fn _ => "selecting submodule...")
     |> (if is_some select then (partof o the) select else I)
     |> debug 3 (fn _ => "eta-expanding...")