merged
authorhaftmann
Fri, 20 Feb 2009 21:29:34 +0100
changeset 2996700d04a562df1
parent 29965 f2421131a83c
parent 29966 d14d0b4bf5b4
child 29968 bd786c37af84
child 29986 05354c653d3a
merged
     1.1 --- a/src/Tools/code/code_wellsorted.ML	Fri Feb 20 20:51:06 2009 +0100
     1.2 +++ b/src/Tools/code/code_wellsorted.ML	Fri Feb 20 21:29:34 2009 +0100
     1.3 @@ -50,9 +50,9 @@
     1.4  fun complete_proper_sort thy =
     1.5    Sign.complete_sort thy #> filter (can (AxClass.get_info thy));
     1.6  
     1.7 -fun inst_params thy tyco class =
     1.8 +fun inst_params thy tyco =
     1.9    map (fn (c, _) => AxClass.param_of_inst thy (c, tyco))
    1.10 -    ((#params o AxClass.get_info thy) class);
    1.11 +    o maps (#params o AxClass.get_info thy);
    1.12  
    1.13  fun consts_of thy eqns = [] |> (fold o fold o fold_aterms)
    1.14    (fn Const (c, ty) => insert (op =) (c, Sign.const_typargs thy (c, Logic.unvarifyT ty)) | _ => I)
    1.15 @@ -100,12 +100,11 @@
    1.16    case AList.lookup (op =) arities inst
    1.17     of SOME classess => (classess, ([], []))
    1.18      | NONE => let
    1.19 +        val all_classes = complete_proper_sort thy [class];
    1.20 +        val superclasses = remove (op =) class all_classes
    1.21          val classess = map (complete_proper_sort thy)
    1.22            (Sign.arity_sorts thy tyco [class]);
    1.23 -        val superclasses = [class]
    1.24 -          |> complete_proper_sort thy
    1.25 -          |> remove (op =) class;
    1.26 -        val inst_params = inst_params thy tyco class;
    1.27 +        val inst_params = inst_params thy tyco all_classes;
    1.28        in (classess, (superclasses, inst_params)) end;
    1.29  
    1.30  fun add_classes thy arities eqngr c_k new_classes vardeps_data =
    1.31 @@ -225,7 +224,7 @@
    1.32    let
    1.33      fun class_relation (x, _) _ = x;
    1.34      fun type_constructor tyco xs class =
    1.35 -      inst_params thy tyco class @ (maps o maps) fst xs;
    1.36 +      inst_params thy tyco (Sorts.complete_sort algebra [class]) @ (maps o maps) fst xs;
    1.37      fun type_variable (TFree (_, sort)) = map (pair []) (proj_sort sort);
    1.38    in
    1.39      flat (Sorts.of_sort_derivation (Syntax.pp_global thy) algebra