src/Pure/Isar/class_declaration.ML
changeset 38493 95a41e6ef5a8
parent 38435 1e1ef69ec0de
child 38756 d07959fabde6
equal deleted inserted replaced
38463:0e4565062017 38493:95a41e6ef5a8
   127                   ^ Syntax.string_of_sort_global thy inferred_sort
   127                   ^ Syntax.string_of_sort_global thy inferred_sort
   128                   ^ " of type parameter " ^ Name.aT ^ " of sort "
   128                   ^ " of type parameter " ^ Name.aT ^ " of sort "
   129                   ^ Syntax.string_of_sort_global thy a_sort ^ ".")
   129                   ^ Syntax.string_of_sort_global thy a_sort ^ ".")
   130             | _ => error "Multiple type variables in class specification.";
   130             | _ => error "Multiple type variables in class specification.";
   131       in (map o map_atyps) (K (TFree (Name.aT, fixate_sort))) Ts end;
   131       in (map o map_atyps) (K (TFree (Name.aT, fixate_sort))) Ts end;
       
   132     val after_infer_fixate = (map o map_atyps)
       
   133       (fn T as TFree _ => T | T as TVar (vi, sort) =>
       
   134         if Type_Infer.is_param vi then Type_Infer.param 0 (Name.aT, sort) else T);
   132     fun add_typ_check level name f = Context.proof_map
   135     fun add_typ_check level name f = Context.proof_map
   133       (Syntax.add_typ_check level name (fn Ts => fn ctxt =>
   136       (Syntax.add_typ_check level name (fn Ts => fn ctxt =>
   134         let val Ts' = f Ts in if eq_list (op =) (Ts, Ts') then NONE else SOME (Ts', ctxt) end));
   137         let val Ts' = f Ts in if eq_list (op =) (Ts, Ts') then NONE else SOME (Ts', ctxt) end));
   135 
   138 
   136     (* preprocessing elements, retrieving base sort from type-checked elements *)
   139     (* preprocessing elements, retrieving base sort from type-checked elements *)
       
   140     val raw_supexpr = (map (fn sup => (sup, (("", false),
       
   141       Expression.Positional []))) sups, []);
   137     val init_class_body = fold (ProofContext.add_const_constraint o apsnd SOME) base_constraints
   142     val init_class_body = fold (ProofContext.add_const_constraint o apsnd SOME) base_constraints
   138       #> Class.redeclare_operations thy sups
   143       #> Class.redeclare_operations thy sups
   139       #> add_typ_check 10 "reject_bcd_etc" reject_bcd_etc
   144       #> add_typ_check 10 "reject_bcd_etc" reject_bcd_etc
   140       #> add_typ_check ~10 "singleton_fixate" singleton_fixate;
   145       #> add_typ_check ~10 "singleton_fixate" singleton_fixate;
   141     val raw_supexpr = (map (fn sup => (sup, (("", false),
       
   142       Expression.Positional []))) sups, []);
       
   143     val ((raw_supparams, _, raw_inferred_elems), _) = ProofContext.init_global thy
   146     val ((raw_supparams, _, raw_inferred_elems), _) = ProofContext.init_global thy
       
   147       |> add_typ_check 5 "after_infer_fixate" after_infer_fixate
   144       |> prep_decl raw_supexpr init_class_body raw_elems;
   148       |> prep_decl raw_supexpr init_class_body raw_elems;
   145     fun filter_element (Element.Fixes []) = NONE
   149     fun filter_element (Element.Fixes []) = NONE
   146       | filter_element (e as Element.Fixes _) = SOME e
   150       | filter_element (e as Element.Fixes _) = SOME e
   147       | filter_element (Element.Constrains []) = NONE
   151       | filter_element (Element.Constrains []) = NONE
   148       | filter_element (e as Element.Constrains _) = SOME e
   152       | filter_element (e as Element.Constrains _) = SOME e