# HG changeset patch
# User haftmann
# Date 1276767184 -7200
# Node ID ad3e04f289b67380f7c8fa3c2fb899ddd15efc98
# Parent  fc55011cfdfd786516399eb5fa65b2c6a6e1a345
transitive superclasses were also only a misunderstanding

diff -r fc55011cfdfd -r ad3e04f289b6 src/Tools/Code/code_haskell.ML
--- a/src/Tools/Code/code_haskell.ML	Thu Jun 17 10:57:00 2010 +0200
+++ b/src/Tools/Code/code_haskell.ML	Thu Jun 17 11:33:04 2010 +0200
@@ -194,7 +194,7 @@
               @ (if deriving_show name then [str "deriving (Read, Show)"] else [])
             )
           end
-      | print_stmt (name, Code_Thingol.Class (_, (v, ((super_classes, _), classparams)))) =
+      | print_stmt (name, Code_Thingol.Class (_, (v, (super_classes, classparams)))) =
           let
             val tyvars = intro_vars [v] reserved;
             fun print_classparam (classparam, ty) =
diff -r fc55011cfdfd -r ad3e04f289b6 src/Tools/Code/code_ml.ML
--- a/src/Tools/Code/code_ml.ML	Thu Jun 17 10:57:00 2010 +0200
+++ b/src/Tools/Code/code_ml.ML	Thu Jun 17 11:33:04 2010 +0200
@@ -40,7 +40,7 @@
   | ML_Val of ml_binding
   | ML_Funs of ml_binding list * string list
   | ML_Datas of (string * ((vname * sort) list * (string * itype list) list)) list
-  | ML_Class of string * (vname * (((class * string) list * (class * string) list) * (string * itype) list));
+  | ML_Class of string * (vname * ((class * string) list * (string * itype) list));
 
 fun stmt_name_of_binding (ML_Function (name, _)) = name
   | stmt_name_of_binding (ML_Instance (name, _)) = name;
@@ -301,7 +301,7 @@
             sig_ps
             (Pretty.chunks (ps @| semicolon [p]))
           end
-     | print_stmt (ML_Class (class, (v, ((super_classes, _), classparams)))) =
+     | print_stmt (ML_Class (class, (v, (super_classes, classparams)))) =
           let
             fun print_field s p = concat [str s, str ":", p];
             fun print_proj s p = semicolon
@@ -635,7 +635,7 @@
             sig_ps
             (Pretty.chunks (ps @| doublesemicolon [p]))
           end
-     | print_stmt (ML_Class (class, (v, ((super_classes, _), classparams)))) =
+     | print_stmt (ML_Class (class, (v, (super_classes, classparams)))) =
           let
             fun print_field s p = concat [str s, str ":", p];
             fun print_super_class_field (super_class, classrel) =
diff -r fc55011cfdfd -r ad3e04f289b6 src/Tools/Code/code_scala.ML
--- a/src/Tools/Code/code_scala.ML	Thu Jun 17 10:57:00 2010 +0200
+++ b/src/Tools/Code/code_scala.ML	Thu Jun 17 11:33:04 2010 +0200
@@ -212,7 +212,7 @@
               :: map print_co cos
             )
           end
-      | print_stmt (name, Code_Thingol.Class (_, (v, ((super_classes, all_super_classes), classparams)))) =
+      | print_stmt (name, Code_Thingol.Class (_, (v, (super_classes, classparams)))) =
           let
             val tyvars = intro_vars [v] reserved;
             val vs = [(v, [name])];
diff -r fc55011cfdfd -r ad3e04f289b6 src/Tools/Code/code_thingol.ML
--- a/src/Tools/Code/code_thingol.ML	Thu Jun 17 10:57:00 2010 +0200
+++ b/src/Tools/Code/code_thingol.ML	Thu Jun 17 11:33:04 2010 +0200
@@ -69,13 +69,10 @@
     | Fun of string * ((typscheme * ((iterm list * iterm) * (thm option * bool)) list) * thm option)
     | Datatype of string * ((vname * sort) list * (string * itype list) list)
     | Datatypecons of string * string
-    | Class of class * (vname
-        * (((class * string) list (*direct superclasses*)
-          * (class * string) list) (*indirect superclasses*)
-            * (string * itype) list (*class operations*)))
+    | Class of class * (vname * ((class * string) list * (string * itype) list))
     | Classrel of class * class
     | Classparam of string * class
-    | Classinst of (class * (string * (vname * sort) list) (*class and arity*))
+    | Classinst of (class * (string * (vname * sort) list) (*class and arity*) )
           * ((class * (string * (string * dict list list))) list (*super instances*)
         * ((string * const) * (thm * bool)) list (*class parameter instances*))
   type program = stmt Graph.T
@@ -403,17 +400,17 @@
 (** statements, abstract programs **)
 
 type typscheme = (vname * sort) list * itype;
-datatype stmt = (*see also signature*)
+datatype stmt =
     NoStmt
   | Fun of string * ((typscheme * ((iterm list * iterm) * (thm option * bool)) list) * thm option)
   | Datatype of string * ((vname * sort) list * (string * itype list) list)
   | Datatypecons of string * string
-  | Class of class * (vname * (((class * string) list * (class * string) list) * (string * itype) list))
+  | Class of class * (vname * ((class * string) list * (string * itype) list))
   | Classrel of class * class
   | Classparam of string * class
   | Classinst of (class * (string * (vname * sort) list))
         * ((class * (string * (string * dict list list))) list
-      * ((string * const) * (thm * bool)) list);
+      * ((string * const) * (thm * bool)) list) (*see also signature*);
 
 type program = stmt Graph.T;
 
@@ -596,7 +593,6 @@
     val stmt_class =
       fold_map (fn super_class => ensure_class thy algbr eqngr permissive super_class
         ##>> ensure_classrel thy algbr eqngr permissive (class, super_class)) super_classes
-      ##>> pair [] (*FIXME*)
       ##>> fold_map (fn (c, ty) => ensure_const thy algbr eqngr permissive c
         ##>> translate_typ thy algbr eqngr permissive ty) cs
       #>> (fn info => Class (class, (unprefix "'" Name.aT, info)))
diff -r fc55011cfdfd -r ad3e04f289b6 src/Tools/nbe.ML
--- a/src/Tools/nbe.ML	Thu Jun 17 10:57:00 2010 +0200
+++ b/src/Tools/nbe.ML	Thu Jun 17 11:33:04 2010 +0200
@@ -404,7 +404,7 @@
       []
   | eqns_of_stmt (_, Code_Thingol.Datatype _) =
       []
-  | eqns_of_stmt (class, Code_Thingol.Class (_, (v, ((super_classes, _), classparams)))) =
+  | eqns_of_stmt (class, Code_Thingol.Class (_, (v, (super_classes, classparams)))) =
       let
         val names = map snd super_classes @ map fst classparams;
         val params = Name.invent_list [] "d" (length names);