BSD 4_3 development

[unix-history] / 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