1implement Tsort; 2 3# 4# tsort -- topological sort 5# 6# convert a partial ordering into a linear ordering 7# 8# Copyright © 2004 Vita Nuova Holdings Limited 9# 10 11include "sys.m"; 12 sys: Sys; 13 14include "draw.m"; 15 16include "bufio.m"; 17 bufio: Bufio; 18 Iobuf: import bufio; 19 20Tsort: module 21{ 22 init: fn(nil: ref Draw->Context, nil: list of string); 23}; 24 25Item: adt { 26 name: string; 27 mark: int; 28 succ: cyclic list of ref Item; # node's successors 29 30 precede: fn(a: self ref Item, b: ref Item); 31}; 32 33Q: adt { 34 item: ref Item; 35 next: cyclic ref Q; 36}; 37 38items, itemt: ref Q; # use a Q not a list only to keep input order 39nitem := 0; 40bout: ref Iobuf; 41 42init(nil: ref Draw->Context, nil: list of string) 43{ 44 sys = load Sys Sys->PATH; 45 bufio = load Bufio Bufio->PATH; 46 47 bout = bufio->fopen(sys->fildes(1), Sys->OWRITE); 48 input(); 49 output(); 50 bout.flush(); 51} 52 53error(s: string) 54{ 55 sys->fprint(sys->fildes(2), "tsort: %s\n", s); 56 raise "fail:error"; 57} 58 59input() 60{ 61 b := bufio->fopen(sys->fildes(0), Sys->OREAD); 62 while((line := b.gets('\n')) != nil){ 63 (nil, fld) := sys->tokenize(line, " \t\n"); 64 if(fld != nil){ 65 a := finditem(hd fld); 66 while((fld = tl fld) != nil) 67 a.precede(finditem(hd fld)); 68 } 69 } 70} 71 72Item.precede(a: self ref Item, b: ref Item) 73{ 74 if(a != b){ 75 for(l := a.succ; l != nil; l = tl l) 76 if((hd l) == b) 77 return; 78 a.succ = b :: a.succ; 79 } 80} 81 82finditem(s: string): ref Item 83{ 84 # would use a hash table for large sets 85 for(il := items; il != nil; il = il.next) 86 if(il.item.name == s) 87 return il.item; 88 i := ref Item; 89 i.name = s; 90 i.mark = 0; 91 if(items != nil) 92 itemt = itemt.next = ref Q(i, nil); 93 else 94 itemt = items = ref Q(i, nil); 95 nitem++; 96 return i; 97} 98 99dep: list of ref Item; 100 101output() 102{ 103 for(k := items; k != nil; k = k.next) 104 if((q := k.item).mark == 0) 105 visit(q, nil); 106 for(; dep != nil; dep = tl dep) 107 bout.puts((hd dep).name+"\n"); 108} 109 110# visit q's successors depth first 111# parents is only used to print any cycles, and since it matches 112# the stack, the recursion could be eliminated 113visit(q: ref Item, parents: list of ref Item) 114{ 115 q.mark = 2; 116 parents = q :: parents; 117 for(sl := q.succ; sl != nil; sl = tl sl) 118 if((s := hd sl).mark == 0) 119 visit(s, parents); 120 else if(s.mark == 2){ 121 sys->fprint(sys->fildes(2), "tsort: cycle in input\n"); 122 rl: list of ref Item; 123 for(l := parents;; l = tl l){ # reverse to be closer to input order 124 rl = hd l :: rl; 125 if(hd l == s) 126 break; 127 } 128 for(l = rl; l != nil; l = tl l) 129 sys->fprint(sys->fildes(2), "tsort: %s\n", (hd l).name); 130 } 131 q.mark = 1; 132 dep = q :: dep; 133} 134