BSD 4_3 development

[unix-history] / usr / contrib / icon / src / lib / structs.icn

#       STRUCTS(2)
#
#       Structure operations
#
#       Ralph E. Griswold
#
#       Last modified 7/10/83
#

procedure eq(x,y)
  local i
  if x === y then return y
  if type(x) == type(y) == "list" then {
     if *x ~= *y then fail
     every i := 1 to *x do
        if not eq(x[i],y[i]) then fail
     return y
    }
end

procedure depth(ltree)
  local count
  count := 0
  every count <:= 1 + depth(ltree[2 to *ltree])
  return count
end

procedure ldag(stree,done)
  local a
  /done := table()
  if a := \done[stree] then return a
  stree ?
     if a := [tab(upto('('))] then {
        move(1)
        while put(a,ldag(tab(bal(',)')),done)) do
           move(1)
        }
     else a := [tab(0)]
  return done[stree] := a
end

procedure lgraph(sgraph)
  local nodes, ndescr, nlist, a, name, i
  nodes := table()
  sgraph ?
     while ndescr := tab(many(~';')) do {
        move(1)
        ndescr ? {
           a := []
           nodes[tab(upto(':'))] := a
           move(1)
           while put(a,tab(many(~','))) do
              move(1)
           }
        }
  every name := !nodes do
     every i := 2 to *name do
        name[i] := nodes[name[i]]
  return nodes
end

procedure ltree(stree)
  local a
  stree ?
     if a := [tab(upto('('))] then {
        move(1)
        while put(a,ltree(tab(bal(',)')))) do
           move(1)
        }
     else a := [tab(0)]
  return a
end

procedure stree(ltree)
  local s
  if *ltree = 1 then return ltree[1]
  s := ltree[1] || "("
  every s ||:= stree(ltree[2 to *ltree]) || ","
  return s[1:-1] || ")"
end

procedure tcopy(ltree)
  local a
  a := [ltree[1]]
  every put(a,tcopy(ltree[2 to *ltree]))
  return a
end

procedure teq(a1,a2)
  local i
  if *a1 ~= *a2 then fail
  if a1[1] ~== a2[1] then fail
  every i := 2 to *a1 do
     if not teq(a1[i],a2[i]) then fail
  return a2
end

procedure visit(ltree)
  suspend ltree | visit(ltree[2 to *ltree])
end