home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OL.LZH / PROCS.LZH / XIMAGE.ICN < prev   
Text File  |  1991-07-13  |  5KB  |  199 lines

  1. ############################################################################
  2. #
  3. #    Name:    ximage.icn
  4. #
  5. #    Title:    Produces string image of structured data
  6. #
  7. #    Author:    Robert J. Alexander
  8. #
  9. #    Date:    September 10, 1990
  10. #
  11. ############################################################################
  12. #
  13. #  ximage(x) : s
  14. #
  15. #  Produces a string image of x.  ximage() differs from image() in that
  16. #  it outputs all elements of structured data types.  The output
  17. #  resembles Icon code and is thus familiar to Icon programmers.
  18. #  Additionally, it indents successive structural levels in such a way
  19. #  that it is easy to visualize the data's structure.  Note that the
  20. #  additional arguments in the ximage procedure declaration are used for
  21. #  passing data among recursive levels.
  22. #
  23. #  xdump(x1,x2,...,xn) : xn
  24. #
  25. #  Using ximage(), successively writes the images of x1, x2, ..., xn to
  26. #  &errout.
  27. #
  28. #  Some Examples:
  29. #
  30. #  The following code:
  31. #    ...
  32. #    t := table() ; t["one"] := 1 ; t["two"] := 2
  33. #    xdump("A table",t)
  34. #    xdump("A list",[3,1,3,[2,4,6],3,4,3,5])
  35. #
  36. #  Writes the following output (note that ximage() infers the
  37. #  predominant list element value and avoids excessive output):
  38. #
  39. #    "A table"
  40. #    T18 := table(&null)
  41. #       T18["one"] := 1
  42. #       T18["two"] := 2
  43. #    "A list"
  44. #    L25 := list(8,3)
  45. #       L25[2] := 1
  46. #       L25[4] := L24 := list(3)
  47. #          L24[1] := 2
  48. #          L24[2] := 4
  49. #          L24[3] := 6
  50. #       L25[6] := 4
  51. #       L25[8] := 5
  52. #
  53.  
  54.  
  55. procedure ximage(x,indent,done)
  56.    local i,s,ss,state,t,xtag,tp,sn,sz
  57.    static tr
  58.    #
  59.    #  If this is the outer invocation, do some initialization.
  60.    #
  61.    if /(state := done) then {
  62.       tr := &trace ; &trace := 0    # postpone tracing while in here
  63.       indent := ""
  64.       done := table()
  65.       }
  66.    #
  67.    #  Determine the type and process accordingly.
  68.    #
  69.    indent := (if indent == "" then "\n" else "") || indent || "   "
  70.    ss := ""
  71.    tp := type(x)
  72.    s := if xtag := \done[x] then xtag else case tp of {
  73.       #
  74.       #  Unstructured types just return their image().
  75.       #
  76.       "null" | "string" | "integer" | "real" | "cset" |
  77.         "co-expression" | "file" | "procedure" | "external": image(x)
  78.       #
  79.       #  List.
  80.       #
  81.       "list": {
  82.      image(x) ? {
  83.         tab(6)
  84.         sn := tab(find("("))
  85.         sz := tab(0)
  86.         }
  87.      done[x] := xtag := "L" || sn
  88.      #
  89.      #  Figure out if there is a predominance of any object in the
  90.      #  list.  If so, make it the default object.
  91.      #
  92.      t := table(0)
  93.      every t[!x] +:= 1
  94.      s := [,0]
  95.      every t := !sort(t) do if s[2] < t[2] then s := t
  96.      if s[2] > *x / 3 & s[2] > 2 then {
  97.         s := s[1]
  98.         t := ximage(s,indent || "   ",done)
  99.         if t ? (not any('\'"') & ss := tab(find(" :="))) then
  100.           t := "{" || t || indent || "   " || ss || "}"
  101.         }
  102.      else t := &null
  103.      #
  104.      #  Output the non-defaulted elements of the list.
  105.      #
  106.      ss := ""
  107.      every i := 1 to *x do if x[i] ~=== s then {
  108.         ss ||:= indent || xtag || "[" || i || "] := " ||
  109.           ximage(x[i],indent,done)
  110.         }
  111.      s := tp || sz
  112.      s[-1:-1] := "," || \t
  113.      xtag || " := " || s || ss
  114.      }
  115.       #
  116.       #  Set.
  117.       #
  118.       "set": {
  119.      image(x) ? {
  120.         tab(5)
  121.         sn := tab(find("("))
  122.         }
  123.      done[x] := xtag := "S" || sn
  124.      every i := !sort(x) do {
  125.         ss ||:= indent || "insert(" || xtag || "," ||
  126.           ximage(i,indent,done,) || ")"
  127.         }
  128.      xtag || " := " || "set([])" || ss
  129.      }
  130.       #
  131.       #  Table.
  132.       #
  133.       "table": {
  134.      image(x) ? {
  135.         tab(7)
  136.         sn := tab(find("("))
  137.         }
  138.      done[x] := xtag := "T" || sn
  139.      #
  140.      #  Output the table elements.  This is a bit tricky, since
  141.      #  the subscripts might be structured, too.
  142.      #
  143.      every i := !sort(x) do {
  144.         t := ximage(i[1],indent || "   ",done)
  145.         if t ? (not any('\'"') & s := tab(find(" :="))) then
  146.           t := "{" || t || indent || "   " || s || "}"
  147.         ss ||:= indent || xtag || "[" ||
  148.           t || "] := " ||
  149.           ximage(i[2],indent,done)
  150.         }
  151.      #
  152.      #  Output the table, including its default value (which might
  153.      #  also be structured.
  154.      #
  155.      t := ximage(x[[]],indent || "   ",done)
  156.      if t ? (not any('\'"') & s := tab(find(" :="))) then
  157.            t := "{" || t || indent || "   " || s || "}"
  158.      xtag || " := " || "table(" || t || ")" || ss
  159.      }
  160.       #
  161.       #  Record.
  162.       #
  163.       default: {
  164.      image(x) ? {
  165.         move(7)
  166.         t := ""
  167.         while t ||:= tab(find("_")) || move(1)
  168.         t[-1] := ""
  169.         sn := tab(find("("))
  170.         }
  171.      done[x] := xtag := "R" || sn
  172.      every i := 1 to *x do {
  173.         ss ||:= indent || xtag || "[" || i || "] := " ||
  174.           ximage(\x[i],indent,done)
  175.         }
  176.      xtag || " := " || t || "()" || ss
  177.      }
  178.       }
  179.    #
  180.    #  If this is the outer invocation, clean up before returning.
  181.    #
  182.    if /state then {
  183.       &trace := tr                        # restore &trace
  184.       }
  185.    #
  186.    #  Return the result.
  187.    #
  188.    return s
  189. end
  190.  
  191.  
  192. #
  193. #  Write ximages of x1,x1,...,xn.
  194. #
  195. procedure xdump(x[])
  196.    every write(&errout,ximage(!x))
  197.    return x[-1]
  198. end
  199.