File:  [CSRG BSD Unix] / 43BSD / contrib / icon / src / lib / structs.icn
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs
Tue Apr 24 16:12:55 2018 UTC (8 years, 1 month ago) by root
Branches: MAIN, BSD
CVS tags: HEAD, BSD43
BSD 4.3

#	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


unix.superglobalmegacorp.com

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