Return to structs.icn CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / icon / src / lib

Annotation of 43BSD/contrib/icon/src/lib/structs.icn, revision 1.1.1.1

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.