|
|
1.1 ! root 1: # STRUCTS(2) ! 2: # ! 3: # Structure operations ! 4: # ! 5: # Ralph E. Griswold ! 6: # ! 7: # Last modified 7/10/83 ! 8: # ! 9: ! 10: procedure eq(x,y) ! 11: local i ! 12: if x === y then return y ! 13: if type(x) == type(y) == "list" then { ! 14: if *x ~= *y then fail ! 15: every i := 1 to *x do ! 16: if not eq(x[i],y[i]) then fail ! 17: return y ! 18: } ! 19: end ! 20: ! 21: procedure depth(ltree) ! 22: local count ! 23: count := 0 ! 24: every count <:= 1 + depth(ltree[2 to *ltree]) ! 25: return count ! 26: end ! 27: ! 28: procedure ldag(stree,done) ! 29: local a ! 30: /done := table() ! 31: if a := \done[stree] then return a ! 32: stree ? ! 33: if a := [tab(upto('('))] then { ! 34: move(1) ! 35: while put(a,ldag(tab(bal(',)')),done)) do ! 36: move(1) ! 37: } ! 38: else a := [tab(0)] ! 39: return done[stree] := a ! 40: end ! 41: ! 42: procedure lgraph(sgraph) ! 43: local nodes, ndescr, nlist, a, name, i ! 44: nodes := table() ! 45: sgraph ? ! 46: while ndescr := tab(many(~';')) do { ! 47: move(1) ! 48: ndescr ? { ! 49: a := [] ! 50: nodes[tab(upto(':'))] := a ! 51: move(1) ! 52: while put(a,tab(many(~','))) do ! 53: move(1) ! 54: } ! 55: } ! 56: every name := !nodes do ! 57: every i := 2 to *name do ! 58: name[i] := nodes[name[i]] ! 59: return nodes ! 60: end ! 61: ! 62: procedure ltree(stree) ! 63: local a ! 64: stree ? ! 65: if a := [tab(upto('('))] then { ! 66: move(1) ! 67: while put(a,ltree(tab(bal(',)')))) do ! 68: move(1) ! 69: } ! 70: else a := [tab(0)] ! 71: return a ! 72: end ! 73: ! 74: procedure stree(ltree) ! 75: local s ! 76: if *ltree = 1 then return ltree[1] ! 77: s := ltree[1] || "(" ! 78: every s ||:= stree(ltree[2 to *ltree]) || "," ! 79: return s[1:-1] || ")" ! 80: end ! 81: ! 82: procedure tcopy(ltree) ! 83: local a ! 84: a := [ltree[1]] ! 85: every put(a,tcopy(ltree[2 to *ltree])) ! 86: return a ! 87: end ! 88: ! 89: procedure teq(a1,a2) ! 90: local i ! 91: if *a1 ~= *a2 then fail ! 92: if a1[1] ~== a2[1] then fail ! 93: every i := 2 to *a1 do ! 94: if not teq(a1[i],a2[i]) then fail ! 95: return a2 ! 96: end ! 97: ! 98: procedure visit(ltree) ! 99: suspend ltree | visit(ltree[2 to *ltree]) ! 100: end ! 101:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.