Return to structs.icn CVS log

Up to [Research Unix] / researchv10dc / cmd / icon / ipl / source

Annotation of researchv10dc/cmd/icon/ipl/source/structs.icn, revision 1.1.1.1

1.1       root        1: #      STRUCTS
                      2: #
                      3: #      Structure operations
                      4: #
                      5: #      Ralph E. Griswold
                      6: #
                      7: #      Last modified 2/1/86
                      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 ltree(stree)
                     43:    local a
                     44:    stree ?
                     45:       if a := [tab(upto('('))] then {
                     46:          move(1)
                     47:          while put(a,ltree(tab(bal(',)')))) do
                     48:             move(1)
                     49:          }
                     50:       else a := [tab(0)]
                     51:    return a
                     52: end
                     53: 
                     54: procedure stree(ltree)
                     55:    local s
                     56:    if *ltree = 1 then return ltree[1]
                     57:    s := ltree[1] || "("
                     58:    every s ||:= stree(ltree[2 to *ltree]) || ","
                     59:    return s[1:-1] || ")"
                     60: end
                     61: 
                     62: procedure tcopy(ltree)
                     63:    local a
                     64:    a := [ltree[1]]
                     65:    every put(a,tcopy(ltree[2 to *ltree]))
                     66:    return a
                     67: end
                     68: 
                     69: procedure teq(a1,a2)
                     70:    local i
                     71:    if *a1 ~= *a2 then fail
                     72:    if a1[1] ~== a2[1] then fail
                     73:    every i := 2 to *a1 do
                     74:       if not teq(a1[i],a2[i]) then fail
                     75:    return a2
                     76: end
                     77: 
                     78: procedure visit(ltree)
                     79:    suspend ltree | visit(ltree[2 to *ltree])
                     80: end
                     81: 

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.