175 term list -> term -> (serial * proof_body future) list -> proof_body -> pthm * proof |
175 term list -> term -> (serial * proof_body future) list -> proof_body -> pthm * proof |
176 val unconstrain_thm_proof: theory -> (class * class -> proof) -> |
176 val unconstrain_thm_proof: theory -> (class * class -> proof) -> |
177 (string * class list list * class -> proof) -> sort list -> term -> |
177 (string * class list list * class -> proof) -> sort list -> term -> |
178 (serial * proof_body future) list -> proof_body -> pthm * proof |
178 (serial * proof_body future) list -> proof_body -> pthm * proof |
179 val get_name: sort list -> term list -> term -> proof -> string |
179 val get_name: sort list -> term list -> term -> proof -> string |
|
180 val get_id: sort list -> term list -> term -> proof -> |
|
181 {serial: proof_serial, theory_name: string} option |
180 end |
182 end |
181 |
183 |
182 structure Proofterm : PROOFTERM = |
184 structure Proofterm : PROOFTERM = |
183 struct |
185 struct |
184 |
186 |
2181 in (i, fulfill_proof_future thy promises postproc body0) end; |
2183 in (i, fulfill_proof_future thy promises postproc body0) end; |
2182 |
2184 |
2183 val (i, body') = |
2185 val (i, body') = |
2184 (*non-deterministic, depends on unknown promises*) |
2186 (*non-deterministic, depends on unknown promises*) |
2185 (case strip_combt (fst (strip_combP prf)) of |
2187 (case strip_combt (fst (strip_combP prf)) of |
2186 (PThm ({serial = i, name = a, prop = prop', types = NONE, ...}, thm_body'), args') => |
2188 (PThm ({serial, name = a, prop = prop', types = NONE, ...}, thm_body'), args') => |
2187 if (a = "" orelse a = name) andalso prop' = prop1 andalso args' = args then |
2189 if (a = "" orelse a = name) andalso prop' = prop1 andalso args' = args then |
2188 let val Thm_Body {body = body', ...} = thm_body'; |
2190 let |
2189 in (i, body' |> (a = "" andalso named) ? Future.map (publish i)) end |
2191 val Thm_Body {body = body', ...} = thm_body'; |
|
2192 val i = if a = "" andalso named then proof_serial () else serial; |
|
2193 in (i, body' |> serial <> i ? Future.map (publish i)) end |
2190 else new_prf () |
2194 else new_prf () |
2191 | _ => new_prf ()); |
2195 | _ => new_prf ()); |
2192 |
2196 |
2193 val export_proof = |
2197 val export_proof = |
2194 if named orelse not (export_enabled ()) then no_export_proof |
2198 if named orelse not (export_enabled ()) then no_export_proof |
2219 end; |
2223 end; |
2220 |
2224 |
2221 |
2225 |
2222 (* approximative PThm name *) |
2226 (* approximative PThm name *) |
2223 |
2227 |
2224 fun get_name shyps hyps prop prf = |
2228 fun get_identity shyps hyps prop prf = |
2225 let val (_, prop) = Logic.unconstrainT shyps (Logic.list_implies (hyps, prop)) in |
2229 let val (_, prop) = Logic.unconstrainT shyps (Logic.list_implies (hyps, prop)) in |
2226 (case fst (strip_combt (fst (strip_combP prf))) of |
2230 (case fst (strip_combt (fst (strip_combP prf))) of |
2227 PThm ({name, prop = prop', ...}, _) => if prop = prop' then name else "" |
2231 PThm ({serial, theory_name, name, prop = prop', ...}, _) => |
2228 | _ => "") |
2232 if prop = prop' |
|
2233 then SOME {serial = serial, theory_name = theory_name, name = name} else NONE |
|
2234 | _ => NONE) |
2229 end; |
2235 end; |
|
2236 |
|
2237 fun get_name shyps hyps prop prf = |
|
2238 Option.map #name (get_identity shyps hyps prop prf) |> the_default ""; |
|
2239 |
|
2240 fun get_id shyps hyps prop prf = |
|
2241 (case get_identity shyps hyps prop prf of |
|
2242 NONE => NONE |
|
2243 | SOME {name = "", ...} => NONE |
|
2244 | SOME {serial, theory_name, ...} => SOME {serial = serial, theory_name = theory_name}); |
2230 |
2245 |
2231 end; |
2246 end; |
2232 |
2247 |
2233 structure Basic_Proofterm : BASIC_PROOFTERM = Proofterm; |
2248 structure Basic_Proofterm : BASIC_PROOFTERM = Proofterm; |
2234 open Basic_Proofterm; |
2249 open Basic_Proofterm; |