src/Tools/code/code_wellsorted.ML
changeset 30769 756088c52d10
parent 30202 2775062fd3a9
child 30876 613c2eb8aef6
equal deleted inserted replaced
30767:16c689643a7a 30769:756088c52d10
   351 fun code_thms thy = Pretty.writeln o pretty thy o code_depgr thy;
   351 fun code_thms thy = Pretty.writeln o pretty thy o code_depgr thy;
   352 
   352 
   353 fun code_deps thy consts =
   353 fun code_deps thy consts =
   354   let
   354   let
   355     val eqngr = code_depgr thy consts;
   355     val eqngr = code_depgr thy consts;
   356     fun mk_entry (const, (_, (_, parents))) =
   356     val constss = Graph.strong_conn eqngr;
   357       let
   357     val mapping = Symtab.empty |> fold (fn consts => fold (fn const =>
   358         val name = Code_Unit.string_of_const thy const;
   358       Symtab.update (const, consts)) consts) constss;
   359         val nameparents = map (Code_Unit.string_of_const thy) parents;
   359     fun succs consts = consts
   360       in { name = name, ID = name, dir = "", unfold = true,
   360       |> maps (Graph.imm_succs eqngr)
   361         path = "", parents = nameparents }
   361       |> subtract (op =) consts
   362       end;
   362       |> map (the o Symtab.lookup mapping)
   363     val prgr = Graph.fold ((fn x => fn xs => xs @ [x]) o mk_entry) eqngr [];
   363       |> distinct (op =);
       
   364     val conn = [] |> fold (fn consts => cons (consts, succs consts)) constss;
       
   365     fun namify consts = map (Code_Unit.string_of_const thy) consts
       
   366       |> commas;
       
   367     val prgr = map (fn (consts, constss) =>
       
   368       { name = namify consts, ID = namify consts, dir = "", unfold = true,
       
   369         path = "", parents = map namify constss }) conn;
   364   in Present.display_graph prgr end;
   370   in Present.display_graph prgr end;
   365 
   371 
   366 local
   372 local
   367 
   373 
   368 structure P = OuterParse
   374 structure P = OuterParse