src/Pure/proofterm.ML
changeset 70551 9e87e978be5e
parent 70541 f3fbc7f3559d
child 70554 10d41bf28b92
equal deleted inserted replaced
70550:8bc7e54bead9 70551:9e87e978be5e
   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;