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     ! 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.