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 |