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