Annotation of 43BSD/contrib/icon/src/lib/structs.icn, revision 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: 

unix.superglobalmegacorp.com

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