diff -r 303b63be1a9d -r 0c3d19af759d src/Tools/Code/code_haskell.ML
--- a/src/Tools/Code/code_haskell.ML	Tue Sep 07 16:26:14 2010 +0200
+++ b/src/Tools/Code/code_haskell.ML	Tue Sep 07 16:37:23 2010 +0200
@@ -27,7 +27,6 @@
 fun print_haskell_stmt labelled_name class_syntax tyco_syntax const_syntax
     reserved deresolve contr_classparam_typs deriving_show =
   let
-    val deresolve_base = Long_Name.base_name o deresolve;
     fun class_name class = case class_syntax class
      of NONE => deresolve class
       | SOME class => class;
@@ -121,7 +120,7 @@
             val tyvars = intro_vars (map fst vs) reserved;
             fun print_err n =
               semicolon (
-                (str o deresolve_base) name
+                (str o deresolve) name
                 :: map str (replicate n "_")
                 @ str "="
                 :: str "error"
@@ -138,7 +137,7 @@
                       (insert (op =)) ts []);
               in
                 semicolon (
-                  (str o deresolve_base) name
+                  (str o deresolve) name
                   :: map (print_term tyvars some_thm vars BR) ts
                   @ str "="
                   @@ print_term tyvars some_thm vars NOBR t
@@ -147,7 +146,7 @@
           in
             Pretty.chunks (
               semicolon [
-                (str o suffix " ::" o deresolve_base) name,
+                (str o suffix " ::" o deresolve) name,
                 print_typscheme tyvars (vs, ty)
               ]
               :: (case filter (snd o snd) raw_eqs
@@ -161,7 +160,7 @@
           in
             semicolon [
               str "data",
-              print_typdecl tyvars (vs, (deresolve_base name, map (ITyVar o fst) vs))
+              print_typdecl tyvars (vs, (deresolve name, map (ITyVar o fst) vs))
             ]
           end
       | print_stmt (name, Code_Thingol.Datatype (_, (vs, [((co, _), [ty])]))) =
@@ -170,9 +169,9 @@
           in
             semicolon (
               str "newtype"
-              :: print_typdecl tyvars (vs, (deresolve_base name, map (ITyVar o fst) vs))
+              :: print_typdecl tyvars (vs, (deresolve name, map (ITyVar o fst) vs))
               :: str "="
-              :: (str o deresolve_base) co
+              :: (str o deresolve) co
               :: print_typ tyvars BR ty
               :: (if deriving_show name then [str "deriving (Read, Show)"] else [])
             )
@@ -182,13 +181,13 @@
             val tyvars = intro_vars (map fst vs) reserved;
             fun print_co ((co, _), tys) =
               concat (
-                (str o deresolve_base) co
+                (str o deresolve) co
                 :: map (print_typ tyvars BR) tys
               )
           in
             semicolon (
               str "data"
-              :: print_typdecl tyvars (vs, (deresolve_base name, map (ITyVar o fst) vs))
+              :: print_typdecl tyvars (vs, (deresolve name, map (ITyVar o fst) vs))
               :: str "="
               :: print_co co
               :: map ((fn p => Pretty.block [str "| ", p]) o print_co) cos
@@ -200,7 +199,7 @@
             val tyvars = intro_vars [v] reserved;
             fun print_classparam (classparam, ty) =
               semicolon [
-                (str o deresolve_base) classparam,
+                (str o deresolve) classparam,
                 str "::",
                 print_typ tyvars NOBR ty
               ]
@@ -209,7 +208,7 @@
               Pretty.block [
                 str "class ",
                 Pretty.block (print_typcontext tyvars [(v, map fst super_classes)]),
-                str (deresolve_base name ^ " " ^ lookup_var tyvars v),
+                str (deresolve name ^ " " ^ lookup_var tyvars v),
                 str " where {"
               ],
               str "};"
@@ -219,17 +218,17 @@
           let
             val tyvars = intro_vars (map fst vs) reserved;
             fun requires_args classparam = case const_syntax classparam
-             of NONE => 0
-              | SOME (Code_Printer.Plain_const_syntax _) => 0
-              | SOME (Code_Printer.Complex_const_syntax (k,_ )) => k;
+             of NONE => NONE
+              | SOME (Code_Printer.Plain_const_syntax _) => SOME 0
+              | SOME (Code_Printer.Complex_const_syntax (k,_ )) => SOME k;
             fun print_classparam_instance ((classparam, const), (thm, _)) =
               case requires_args classparam
-               of 0 => semicolon [
-                      (str o deresolve_base) classparam,
+               of NONE => semicolon [
+                      (str o Long_Name.base_name o deresolve) classparam,
                       str "=",
                       print_app tyvars (SOME thm) reserved NOBR (const, [])
                     ]
-                | k =>
+                | SOME k =>
                     let
                       val (c, (_, tys)) = const;
                       val (vs, rhs) = (apfst o map) fst