4.3BSD/usr/contrib/icon/src/lib/image.icn

#	IMAGE(2)
#
#	Generalized image of Icon object
#
#	Ralph E. Griswold
#
#	Last modified 5/11/83
#

procedure Image(x,done)
   /done := table()
   if match("record ",image(x)) then return rimage(x,done)
   else return case type(x) of {
      "list":  limage(x,done)
      "table": timage(x,done)
      default: image(x)
      }
end

#  list image
#
procedure limage(a,done)
   static i
   local s, tag
   initial i := 0
   if \done[a] then return done[a]
   done[a] := tag := "L" || (i +:= 1)
   if *a = 0 then s := tag || ":[]" else {
      s := tag || ":["
      every s ||:= Image(!a,done) || ","
      s[-1] := "]"
      }
   return s
end

#  record image
#
procedure rimage(x,done)
   static i
   local s, tag
   initial i := 0
   s := image(x)
					#  might be record constructor
   if match("record constructor ",s) then return s
   if \done[x] then return done[x]
   done[x] := tag := "R" || (i +:= 1)
   s ?:=  (="record " & (":" || (tab(upto('(') + 1))))
   if *x = 0 then s := tag || s || ")" else {
      s := tag || s
      every s ||:= Image(!x,done) || ","
      s[-1] := ")"
      }
   return s
end

#  table image
#
procedure timage(t,done)
   static i
   local s, tag, a, a1
   initial i := 0
   if \done[t] then return done[t]
   done[t] := tag := "T" || (i +:= 1)
   if *t = 0 then s := tag || ":[]" else {
      a := sort(t)
      s := tag || ":["
      every a1 := !a do
         s ||:= Image(a1[1],done) || "->" || Image(a1[2],done) || ","
      s[-1] := "]"
      }
   return s
end

global indent

procedure Imagex(x,done)
   initial indent := ""
   /done := table()
   if match("record ",image(x)) then return indent || rimagex(x,done)
   else return case type(x) of {
      "list":  indent || limagex(x,done)
      "table": indent || timagex(x,done)
      default: indent || image(x)
      }
end

#  list image
#
procedure limagex(a,done)
   static i
   local s, tag
   initial i := 0
   if \done[a] then return done[a]
   done[a] := tag := "L" || (i +:= 1)
   if *a = 0 then s := tag || ":[]" else {
      indent ||:= "   "
      s := tag || ":["
      every s ||:= "\n" || Image(!a,done)
      }
   s ||:= "\n" || indent || "]"
   indent := indent[1:-3]
   return s
end

#  record image
#
procedure rimagex(x,done)
   static i
   local s, tag
   initial i := 0
   s := image(x)
					#  might be record constructor
   if match("record constructor ",s) then return s
   if \done[x] then return done[x]
   done[x] := tag := "R" || (i +:= 1)
   s ?:=  (="record " & (":" || (tab(upto('(') + 1))))
   if *x = 0 then s := tag || s || ")" else {
      indent ||:= "   "
      s := tag || s
      every s ||:= "\n" || Image(!x,done)
      }
   s ||:= "\n" || indent || ")"
   indent := indent[1:-3]
   return s
end

#  table image
#
procedure timagex(t,done)
   static i
   local s, tag, a, a1
   initial i := 0
   if \done[t] then return done[t]
   done[t] := tag := "T" || (i +:= 1)
   if *t = 0 then s := tag || ":{}" else {
      indent ||:= "   "
      a := sort(t)
      s := tag || ":{"
      every a1 := !a do
         s ||:= "\n" || Image(a1[1],done) || "\n" || indent || "---" ||
            "\n" || Image(a1[2],done) || "\n" || indent || "------"
      }
   s ||:= "\n" || indent || "]"
   indent := indent[1:-3]
   return s
end