home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
OL.LZH
/
PROCS.LZH
/
XIMAGE.ICN
< prev
Wrap
Text File
|
1991-07-13
|
5KB
|
199 lines
############################################################################
#
# Name: ximage.icn
#
# Title: Produces string image of structured data
#
# Author: Robert J. Alexander
#
# Date: September 10, 1990
#
############################################################################
#
# ximage(x) : s
#
# Produces a string image of x. ximage() differs from image() in that
# it outputs all elements of structured data types. The output
# resembles Icon code and is thus familiar to Icon programmers.
# Additionally, it indents successive structural levels in such a way
# that it is easy to visualize the data's structure. Note that the
# additional arguments in the ximage procedure declaration are used for
# passing data among recursive levels.
#
# xdump(x1,x2,...,xn) : xn
#
# Using ximage(), successively writes the images of x1, x2, ..., xn to
# &errout.
#
# Some Examples:
#
# The following code:
# ...
# t := table() ; t["one"] := 1 ; t["two"] := 2
# xdump("A table",t)
# xdump("A list",[3,1,3,[2,4,6],3,4,3,5])
#
# Writes the following output (note that ximage() infers the
# predominant list element value and avoids excessive output):
#
# "A table"
# T18 := table(&null)
# T18["one"] := 1
# T18["two"] := 2
# "A list"
# L25 := list(8,3)
# L25[2] := 1
# L25[4] := L24 := list(3)
# L24[1] := 2
# L24[2] := 4
# L24[3] := 6
# L25[6] := 4
# L25[8] := 5
#
procedure ximage(x,indent,done)
local i,s,ss,state,t,xtag,tp,sn,sz
static tr
#
# If this is the outer invocation, do some initialization.
#
if /(state := done) then {
tr := &trace ; &trace := 0 # postpone tracing while in here
indent := ""
done := table()
}
#
# Determine the type and process accordingly.
#
indent := (if indent == "" then "\n" else "") || indent || " "
ss := ""
tp := type(x)
s := if xtag := \done[x] then xtag else case tp of {
#
# Unstructured types just return their image().
#
"null" | "string" | "integer" | "real" | "cset" |
"co-expression" | "file" | "procedure" | "external": image(x)
#
# List.
#
"list": {
image(x) ? {
tab(6)
sn := tab(find("("))
sz := tab(0)
}
done[x] := xtag := "L" || sn
#
# Figure out if there is a predominance of any object in the
# list. If so, make it the default object.
#
t := table(0)
every t[!x] +:= 1
s := [,0]
every t := !sort(t) do if s[2] < t[2] then s := t
if s[2] > *x / 3 & s[2] > 2 then {
s := s[1]
t := ximage(s,indent || " ",done)
if t ? (not any('\'"') & ss := tab(find(" :="))) then
t := "{" || t || indent || " " || ss || "}"
}
else t := &null
#
# Output the non-defaulted elements of the list.
#
ss := ""
every i := 1 to *x do if x[i] ~=== s then {
ss ||:= indent || xtag || "[" || i || "] := " ||
ximage(x[i],indent,done)
}
s := tp || sz
s[-1:-1] := "," || \t
xtag || " := " || s || ss
}
#
# Set.
#
"set": {
image(x) ? {
tab(5)
sn := tab(find("("))
}
done[x] := xtag := "S" || sn
every i := !sort(x) do {
ss ||:= indent || "insert(" || xtag || "," ||
ximage(i,indent,done,) || ")"
}
xtag || " := " || "set([])" || ss
}
#
# Table.
#
"table": {
image(x) ? {
tab(7)
sn := tab(find("("))
}
done[x] := xtag := "T" || sn
#
# Output the table elements. This is a bit tricky, since
# the subscripts might be structured, too.
#
every i := !sort(x) do {
t := ximage(i[1],indent || " ",done)
if t ? (not any('\'"') & s := tab(find(" :="))) then
t := "{" || t || indent || " " || s || "}"
ss ||:= indent || xtag || "[" ||
t || "] := " ||
ximage(i[2],indent,done)
}
#
# Output the table, including its default value (which might
# also be structured.
#
t := ximage(x[[]],indent || " ",done)
if t ? (not any('\'"') & s := tab(find(" :="))) then
t := "{" || t || indent || " " || s || "}"
xtag || " := " || "table(" || t || ")" || ss
}
#
# Record.
#
default: {
image(x) ? {
move(7)
t := ""
while t ||:= tab(find("_")) || move(1)
t[-1] := ""
sn := tab(find("("))
}
done[x] := xtag := "R" || sn
every i := 1 to *x do {
ss ||:= indent || xtag || "[" || i || "] := " ||
ximage(\x[i],indent,done)
}
xtag || " := " || t || "()" || ss
}
}
#
# If this is the outer invocation, clean up before returning.
#
if /state then {
&trace := tr # restore &trace
}
#
# Return the result.
#
return s
end
#
# Write ximages of x1,x1,...,xn.
#
procedure xdump(x[])
every write(&errout,ximage(!x))
return x[-1]
end