353 in |
353 in |
354 issue_pgip (Metainforesponse {attrs=[("infotype", "isabelle_theorem_dependencies")], |
354 issue_pgip (Metainforesponse {attrs=[("infotype", "isabelle_theorem_dependencies")], |
355 content=[valuethms,valuedeps]}) |
355 content=[valuethms,valuedeps]}) |
356 end |
356 end |
357 |
357 |
358 (* FIXME: check this uses non-transitive closure function here *) |
|
359 fun tell_thm_deps ths = |
358 fun tell_thm_deps ths = |
360 if Output.has_mode thm_depsN then |
359 if Output.has_mode thm_depsN then |
361 let |
360 let |
362 val names = filter_out (equal "") (map PureThy.get_name_hint ths); (* da: HAS THIS NOW BECOME "??.unknown"? *) |
361 val names = filter_out (equal PureThy.unknown_name_hint) (map PureThy.get_name_hint ths) |
363 val deps = filter_out (equal "") |
362 val deps = (Symtab.keys (fold Proofterm.thms_of_proof' |
364 (Symtab.keys (fold Proofterm.thms_of_proof |
363 (map Thm.proof_of ths) Symtab.empty)) |
365 (map Thm.proof_of ths) Symtab.empty)); |
364 in |
366 in |
365 if null names orelse null deps then () |
367 if null names orelse null deps then () |
366 else thm_deps_message (spaces_quote names, spaces_quote deps) |
368 else thm_deps_message (spaces_quote names, spaces_quote deps) |
367 end |
369 end |
368 else () |
370 else (); |
|
371 |
369 |
372 in |
370 in |
373 |
371 |
374 fun setup_present_hook () = |
372 fun setup_present_hook () = |
375 Present.add_hook (fn _ => fn res => tell_thm_deps (maps #2 res)); |
373 Present.add_hook (fn _ => fn res => tell_thm_deps (maps #2 res)); |
575 val thyname = #thyname vs (* ask for identifiers within a theory *) |
573 val thyname = #thyname vs (* ask for identifiers within a theory *) |
576 val objtype = #objtype vs (* ask for identifiers of a particular type *) |
574 val objtype = #objtype vs (* ask for identifiers of a particular type *) |
577 |
575 |
578 fun idtable ty ctx ids = {objtype=ty,context=ctx,ids=ids} |
576 fun idtable ty ctx ids = {objtype=ty,context=ctx,ids=ids} |
579 |
577 |
580 fun setids t = issue_pgip (Setids {idtables = [t]}) |
578 fun setids t = issue_pgip (Setids {idtables = [t]}) |
581 |
579 |
582 val thms_of_thy = map fst o PureThy.thms_of o ThyInfo.get_theory |
580 (* fake one-level nested "subtheories" by picking apart names. *) |
583 in |
581 val thms_of_thy = |
584 (* case (url_attr,thyname,objtype) of |
582 map fst o NameSpace.extern_table o PureThy.theorems_of o ThyInfo.get_theory; |
585 (NONE,NONE,NONE) => |
583 val isnested_id = String.isSubstring NameSpace.separator |
586 *) (* top-level: return *) |
584 val immed_thms_of_thy = filter_out isnested_id o thms_of_thy |
587 |
585 fun thy_prefix s = case space_explode NameSpace.separator s of |
588 (* TODO: add askids for "file" here, which returns single theory with same name *) |
586 x::_::_ => SOME x (* String.find? *) |
589 (* FIXME: objtypes on both sides *) |
587 | _ => NONE |
|
588 fun subthys_of_thy s = |
|
589 foldl (fn (NONE,xs) => xs | (SOME x,xs) => insert op= x xs) [] |
|
590 (map thy_prefix (thms_of_thy s)) |
|
591 fun subthms_of_thy thy = |
|
592 (case thy_prefix thy of |
|
593 NONE => immed_thms_of_thy thy |
|
594 | SOME prf => filter (String.isPrefix (unprefix (prf ^ NameSpace.separator) thy)) |
|
595 (thms_of_thy prf)) |
|
596 val qualified_thms_of_thy = (* for global query with single response *) |
|
597 filter_out (equal PureThy.unknown_name_hint) o |
|
598 (map fst) o PureThy.thms_of o ThyInfo.get_theory; |
|
599 in |
590 case (thyname,objtype) of |
600 case (thyname,objtype) of |
591 (* only files known in top context *) |
601 (NONE, NONE) => |
592 (NONE, NONE) => setids (idtable ObjFile NONE (ThyInfo.names())) (*FIXME: uris?*) |
602 setids (idtable ObjFile NONE (ThyInfo.names())) (*FIXME: uris*) |
593 | (NONE, SOME ObjFile) => setids (idtable ObjFile NONE (ThyInfo.names())) (* ditto *) |
603 | (NONE, SOME ObjFile) => |
594 | (SOME fi, SOME ObjFile) => setids (idtable ObjTheory (SOME fi) [fi]) (* FIXME: lookup file *) |
604 setids (idtable ObjFile NONE (ThyInfo.names())) (*FIXME: uris*) |
595 | (NONE, SOME ObjTheory) => setids (idtable ObjTheory NONE (ThyInfo.names())) |
605 | (SOME fi, SOME ObjFile) => |
596 | (SOME thy, SOME ObjTheory) => setids (idtable ObjTheory (SOME thy) (ThyInfo.get_succs thy)) |
606 setids (idtable ObjTheory (SOME fi) [fi]) (* TODO: check exists *) |
597 | (SOME thy, SOME ObjTheorem) => setids (idtable ObjTheorem (SOME thy) (thms_of_thy thy)) |
607 | (NONE, SOME ObjTheory) => |
598 (* next case is both of above. FIXME: cleanup this *) |
608 setids (idtable ObjTheory NONE (ThyInfo.names())) |
599 | (SOME thy, NONE) => (setids (idtable ObjTheory (SOME thy) (ThyInfo.get_preds thy)); |
609 | (SOME thy, SOME ObjTheory) => |
600 setids (idtable ObjTheorem (SOME thy) (thms_of_thy thy))) |
610 setids (idtable ObjTheory (SOME thy) (subthys_of_thy thy)) |
601 | (_, SOME ot) => error ("No objects of type "^(PgipTypes.name_of_objtype ot)^" are available here.") |
611 | (SOME thy, SOME ObjTheorem) => |
|
612 setids (idtable ObjTheorem (SOME thy) (subthms_of_thy thy)) |
|
613 | (NONE, SOME ObjTheorem) => |
|
614 (* A large query, but not unreasonable. ~5000 results for HOL.*) |
|
615 (* Several setids should be allowed, but Eclipse code is currently broken: |
|
616 Library.seq (fn thy => setids (idtable ObjTheorem (SOME thy) (subthms_of_thy thy))) |
|
617 (ThyInfo.names()) *) |
|
618 setids (idtable ObjTheorem NONE (* this one gives ~7000 for HOL *) |
|
619 (flat (map qualified_thms_of_thy (ThyInfo.names())))) |
|
620 | _ => warning ("askids: ignored argument combination") |
602 end |
621 end |
603 |
622 |
604 fun askrefs (Askrefs vs) = |
623 fun askrefs (Askrefs vs) = |
605 let |
624 let |
606 val url = #url vs (* ask for references of a file (i.e. immediate pre-requisites) *) |
625 val url = #url vs (* ask for references of a file (i.e. immediate pre-requisites) *) |