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 |