home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
OL.LZH
/
PROCS.LZH
/
OBJECT.ICN
< prev
next >
Wrap
Text File
|
1991-07-13
|
7KB
|
178 lines
############################################################################
#
# Name: object.icn
#
# Title: Encode and decode Icon values
#
# Author: Kurt A. Welgehausen
#
# Date: June 10, 1988
#
############################################################################
#
# These procedures provide a way of storing Icon values as strings in
# files and reconstructing them.
#
# putobj(obj, f) stores the Icon data object obj in the file f; it returns
# the object stored. The returned value is usually not of interest, so a
# typical call is putobj(x, f).
#
# The file f must be open for writing; if f is null, it defaults to &output.
#
# Strings are stored as single lines in the file, with unprintable
# characters stored as the escape sequences produced by image().
#
# Integers, reals, and csets are writen to the file as single lines of the
# form "%"type(obj)string(obj), for example
#
# 123 is stored as "%integer123"
# 123.4 is stored as "%real123.4"
# '123' is stored as "%cset123"
#
# As in strings, unprintable characters in csets are stored as the escape
# sequences produced by image().
#
# Procedures, functions,and record constructors are stored as strings of the
# form # "%proc"procedure-name. For example, the function write() is stored
# as "%procwrite".
#
# Files are stored as strings of the form "#file("file-name")". For
# example, if f is a file variable connected to the disk file example.fil,
# then f is stored by putobj() as "#file(example.fil)".
#
# Co-expressions are stored as the string "#co-expr".
#
# Null objects are stored as lines containing only "%".
#
# Structured objects are stored as single lines of the form
# "%"type(obj)"("n")", where n is the size of obj, followed by the n
# components of obj (tables are stored as their default assigned values
# followed by sorted lists of index and # assigned values). putobj() calls
# itself recursively to store the components. For example,
#
# ["aaa", ["bbb", 'edc'], 16rfff, open("somefile"), create write(1 to 3)]
#
# is stored as
#
# %list(5)
# aaa
# %list(2)
# bbb
# %csetcde
# %integer4095
# #file(somefile)
# #co-expr
#
#
# getobj(f) retrieves an Icon data object from the file f; it returns the
# object. A typical call is "x := getobj(f)".
#
# The file f must be open for reading; if f is null, it defaults to &input.
#
# The object to be retrieved must have been stored in the format used by
# putobj().
#
# No attempt is made to reconstruct file variables or co-expressions; only
# the descriptive string is returned. It is up to the programmer to open the
# file or recreate the co-expression. For all other types, the actual Icon
# object is returned.
#
############################################################################
#
# Warning:
#
# putobj(x) calls itself to process structures in x. If there is a
# loop in the structure, putobj(x) gets stack overflow due to excessive
# recursion.
#
# Objects stored with putobj() and then retrieved with getobj() may
# not be identical to the original objects. For example, if x is an Icon
# structure and y := [x, x], then y[1] and y[2] are identical; but
# after storing and retrieving y, y[1] and y[2] will be copies of each
# other but will not be the same object.
#
# To avoid these problems, use codeobj.icn instead of object.icn.
#
############################################################################
#
# Links: escape
#
# See also: codeobj.icn
#
############################################################################
link escape
global HDRSYM, ESCSYM
procedure getobj(f)
local line, buf, otype, size
initial { /HDRSYM:= "%"; /ESCSYM:= "@" } # these defs must be the same as
# those in putobj()
/f:= &input
(line:= (read(f) | fail)) ? {
case move(1) | "" of {
ESCSYM: buf:= escape(tab(0))
HDRSYM: {
(otype:= tab(upto('(')), move(1), size:= integer(tab(upto(')')))) |
(buf:=
(=("integer" | "real" | "cset" | "proc"))(escape(tab(0)))) |
&null # must succeed
}
"&": buf:= case tab(0) of {
"input": &input ; "output": &output ; "errout": &errout
"cset": &cset ; "ascii": &ascii
"lcase": &lcase ; "ucase": &ucase
}
default: buf:= escape(line)
}
}
\size & { # not-null size means a structured type
((otype == "table") & (buf:= getobj(f))) |
((otype == "set") & (buf:= []))
buf:= otype(buf)
case otype of {
"list": every 1 to size do put(buf, getobj(f))
"table": every 1 to size do buf[getobj(f)]:= getobj(f)
"set": every 1 to size do insert(buf, getobj(f))
default: every buf[1 to size]:= getobj(f)
}
}
return buf
end
# Put object <obj> on file <f>; <f> must be open for writing.
# If <f> is not specified, output goes to &output.
global HDRSYM, ESCSYM
procedure putobj(obj, f)
local t, buf
initial { /HDRSYM:= "%"; /ESCSYM:= "@" } # these defs must be the same as
# those in getobj()
/f:= &output
case t:= type(obj) of {
"string": {
match(ESCSYM | HDRSYM | "&", obj) & (obj:= ESCSYM || obj)
write(f, image(obj)[2:-1])
}
"integer" | "real": write(f, HDRSYM, t, obj)
"cset": {
buf:= image(obj)
(match("&", buf) & write(f, buf)) | write(f, HDRSYM, t, buf[2:-1])
}
"null": write(f, HDRSYM)
"procedure": image(obj) ? {
=("procedure " | "function " | "record constructor ")
write(f, HDRSYM, "proc", tab(0))
}
"file": image(obj) ? write(f, (="&" | "#") || tab(0))
"co-expression": write(f, "#", t[1:8])
default: {
write(f, HDRSYM, t, "(", *obj, ")")
(t == "table", putobj(obj[[]], f), buf:= sort(obj, 3)) | (buf:= obj)
(*buf > 0) & every putobj(!buf, f)
}
}
return obj
end