src/Pure/Isar/overloading.ML
changeset 32343 605877054de7
parent 32035 8e77b6a250d5
child 32379 a97e9caebd60
equal deleted inserted replaced
32342:3fabf5b5fc83 32343:605877054de7
   130 
   130 
   131 fun operation lthy b = get_overloading lthy
   131 fun operation lthy b = get_overloading lthy
   132   |> get_first (fn ((c, _), (v, checked)) =>
   132   |> get_first (fn ((c, _), (v, checked)) =>
   133       if Binding.name_of b = v then SOME (c, checked) else NONE);
   133       if Binding.name_of b = v then SOME (c, checked) else NONE);
   134 
   134 
   135 fun confirm b = map_overloading (filter_out (fn (_, (c', _)) => c' = Binding.name_of b));
       
   136 
   135 
       
   136 (* target *)
   137 
   137 
   138 (* overloaded declarations and definitions *)
   138 fun synchronize_syntax ctxt =
       
   139   let
       
   140     val overloading = OverloadingData.get ctxt;
       
   141     fun subst (c, ty) = case AList.lookup (op =) overloading (c, ty)
       
   142      of SOME (v, _) => SOME (ty, Free (v, ty))
       
   143       | NONE => NONE;
       
   144     val unchecks =
       
   145       map (fn (c_ty as (_, ty), (v, _)) => (Free (v, ty), Const c_ty)) overloading;
       
   146   in 
       
   147     ctxt
       
   148     |> map_improvable_syntax (K ((([], []), (((K NONE, subst), false), unchecks)), false))
       
   149   end
       
   150 
       
   151 fun init raw_overloading thy =
       
   152   let
       
   153     val _ = if null raw_overloading then error "At least one parameter must be given" else ();
       
   154     val overloading = map (fn (v, c_ty, checked) => (c_ty, (v, checked))) raw_overloading;
       
   155   in
       
   156     thy
       
   157     |> ProofContext.init
       
   158     |> OverloadingData.put overloading
       
   159     |> fold (fn ((_, ty), (v, _)) => Variable.declare_names (Free (v, ty))) overloading
       
   160     |> add_improvable_syntax
       
   161     |> synchronize_syntax
       
   162   end;
   139 
   163 
   140 fun declare c_ty = pair (Const c_ty);
   164 fun declare c_ty = pair (Const c_ty);
   141 
   165 
   142 fun define checked b (c, t) = Thm.add_def (not checked) true
   166 fun define checked b (c, t) = Thm.add_def (not checked) true
   143   (b, Logic.mk_equals (Const (c, Term.fastype_of t), t));
   167   (b, Logic.mk_equals (Const (c, Term.fastype_of t), t));
   144 
   168 
   145 
   169 fun confirm b = map_overloading (filter_out (fn (_, (c', _)) => c' = Binding.name_of b))
   146 (* target *)
   170   #> LocalTheory.target synchronize_syntax
   147 
       
   148 fun init raw_overloading thy =
       
   149   let
       
   150     val _ = if null raw_overloading then error "At least one parameter must be given" else ();
       
   151     val overloading = map (fn (v, c_ty, checked) => (c_ty, (v, checked))) raw_overloading;
       
   152     fun subst (c, ty) = case AList.lookup (op =) overloading (c, ty)
       
   153      of SOME (v, _) => SOME (ty, Free (v, ty))
       
   154       | NONE => NONE;
       
   155     val unchecks =
       
   156       map (fn (c_ty as (_, ty), (v, _)) => (Free (v, ty), Const c_ty)) overloading;
       
   157   in
       
   158     thy
       
   159     |> ProofContext.init
       
   160     |> OverloadingData.put overloading
       
   161     |> fold (fn ((_, ty), (v, _)) => Variable.declare_names (Free (v, ty))) overloading
       
   162     |> map_improvable_syntax (K ((([], []), (((K NONE, subst), false), unchecks)), false))
       
   163     |> add_improvable_syntax
       
   164   end;
       
   165 
   171 
   166 fun conclude lthy =
   172 fun conclude lthy =
   167   let
   173   let
   168     val overloading = get_overloading lthy;
   174     val overloading = get_overloading lthy;
   169     val _ = if null overloading then () else
   175     val _ = if null overloading then () else