diff options
Diffstat (limited to 'ipl/procs/xcode.icn')
| -rw-r--r-- | ipl/procs/xcode.icn | 444 |
1 files changed, 444 insertions, 0 deletions
diff --git a/ipl/procs/xcode.icn b/ipl/procs/xcode.icn new file mode 100644 index 0000000..0edfe99 --- /dev/null +++ b/ipl/procs/xcode.icn @@ -0,0 +1,444 @@ +############################################################################ +# +# File: xcode.icn +# +# Subject: Procedures to save and restore Icon data +# +# Author: Bob Alexander +# +# Date: November 19, 1997 +# +############################################################################ +# +# This file is in the public domain. +# +############################################################################ +# +# Contributor: Ralph E. Griswold +# +############################################################################ +# +# Description +# ----------- +# +# These procedures provide a way of storing Icon values in files +# and retrieving them. The procedure xencode(x,f) stores x in file f +# such that it can be converted back to x by xdecode(f). These +# procedures handle several kinds of values, including structures of +# arbitrary complexity and even loops. The following sequence will +# output x and recreate it as y: +# +# f := open("xstore","w") +# xencode(x,f) +# close(f) +# f := open("xstore") +# y := xdecode(f) +# close(f) +# +# For "scalar" types -- null, integer, real, cset, and string, the +# above sequence will result in the relationship +# +# x === y +# +# For structured types -- list, set, table, and record types -- +# y is, for course, not identical to x, but it has the same "shape" and +# its elements bear the same relation to the original as if they were +# encoded and decoded individually. +# +# Files, co-expressions, and windows cannot generally be restored in any +# way that makes much sense. These objects are restored as empty lists so +# that (1) they will be unique objects and (2) will likely generate +# run-time errors if they are (probably erroneously) used in +# computation. However, the special files &input, &output, and &errout are +# restored. +# +# Not much can be done with functions and procedures, except to preserve +# type and identification. +# +# The encoding of strings and csets handles all characters in a way +# that it is safe to write the encoding to a file and read it back. +# +# xdecode() fails if given a file that is not in xcode format or it +# the encoded file contains a record for which there is no declaration +# in the program in which the decoding is done. Of course, if a record +# is declared differently in the encoding and decoding programs, the +# decoding may be bogus. +# +# xencoden() and xdecoden() perform the same operations, except +# xencoden() and xdecoden() take the name of a file, not a file. +# +# xencodet() and xdecodet() are like xencode() and xdecode() +# except that the trailing argument is a type name. If the encoded +# decoded value is not of that type, they fail. xencodet() does +# not take an opt argument. +# +############################################################################ +# +# Complete calling sequences +# -------------------------- +# +# xencode(x, f, p) # returns f +# +# where +# +# x is the object to encode +# +# f is the file to write (default &output) +# +# p is a procedure that writes a line on f using the +# same interface as write() (the first parameter is +# always a the value passed as "file") (default: write) +# +# +# xencode(f, p) # returns the restored object +# +# where +# +# f is the file to read (default &input) +# +# p is a procedure that reads a line from f using the +# same interface as read() (the parameter is +# always a the value passed as "file") (default: read) +# +# +# The "p" parameter is not normally used for storage in text files, but +# it provides the flexibility to store the data in other ways, such as +# a string in memory. If "p" is provided, then "f" can be any +# arbitrary data object -- it need not be a file. +# +# For example, to "write" x to an Icon string: +# +# record StringFile(s) +# +# procedure main() +# ... +# encodeString := xencode(x,StringFile(""),WriteString).s +# ... +# end +# +# procedure WriteString(f,s[]) +# every f.s ||:= !s +# f.s ||:= "\n" +# return +# end +# +############################################################################ +# +# Notes on the encoding +# --------------------- +# +# Values are encoded as a sequence of one or more lines written to +# a plain text file. The first or only line of a value begins with a +# single character that unambiguously indicates its type. The +# remainder of the line, for some types, contains additional value +# information. Then, for some types, additional lines follow +# consisting of additional object encodings that further specify the +# object. The null value is a special case consisting of an empty +# line. +# +# Each object other than &null is assigned an integer tag as it is +# encoded. The tag is not, however, written to the output file. On +# input, tags are assigned in the same order as objects are decoded, so +# each restored object is associated with the same integer tag as it +# was when being written. In encoding, any recurrence of an object is +# represented by the original object's tag. Tag references are +# represented as integers, and are easily recognized since no object's +# representation begins with a digit. +# +# Where a structure contains elements, the encodings of the +# elements follow the structure's specification on following lines. +# Note that the form of the encoding contains the information needed to +# separate consecutive elements. +# +# Here are some examples of values and their encodings: +# +# x encode(x) +# ------------------------------------------------------- +# +# 1 N1 +# 2.0 N2.0 +# &null +# "\377" "\377" +# '\376\377' '\376\377' +# procedure main p +# "main" +# co-expression #1 (0) C +# [] L +# N0 +# set() "S" +# N0 +# table("a") T +# N0 +# "a" +# ["hi","there"] L +# N2 +# "hi" +# "there" +# +# A loop is illustrated by +# +# L2 := [] +# put(L2,L2) +# +# for which +# +# x encode(x) +# ------------------------------------------------------- +# +# L2 L +# N1 +# 2 +# +# The "2" on the third line is a tag referring to the list L2. The tag +# ordering specifies that an object is tagged *after* its describing +# objects, thus the list L2 has the tag 2 (the integer 1 has tag 1). +# +# Of course, you don't have to know all this to use xencode and +# xdecode. +# +############################################################################ +# +# Links: escape +# +############################################################################ +# +# See also: codeobj.icn +# +############################################################################ + +link escape + +record xcode_rec(file,ioProc,done,nextTag) + +procedure xencode(x,file,writeProc) #: write structure to file + + /file := &output + return xencode_1( + xcode_rec( + file, + (\writeProc | write) \ 1, + table(), + 0), + x) +end + +procedure xencode_1(data,x) + local tp,wr,f,im + wr := data.ioProc + f := data.file + # + # Special case for &null. + # + if /x then { + wr(f) + return f + } + # + # If this object has already been output, just write its tag. + # + if tp := \data.done[\x] then { + wr(f,tp) + return f + } + # + # Check to see if it's a "distinguished" that is represented by + # a keyword (special files and csets). If so, just use the keyword + # in the output. + # + im := image(x) + if match("integer(", im) then im := string(x) + else if match("&",im) then { + wr(f,im) + data.done[x] := data.nextTag +:= 1 + return f + } + # + # Determine the type and handle accordingly. + # + tp := case type(x) of { + "cset" | "string": "" + "file" | "window": "f" + "integer" | "real": "N" + "co-expression": "C" + "procedure": "p" + "list": "L" + "set": "S" + "table": "T" + default: "R" + } + case tp of { + # + # String, cset, or numeric outputs its string followed by its + # image. + # + "" | "N": wr(f,tp,im) + # + # Procedure writes "p" followed (on subsequent line) by its name + # as a string object. + # + "p": { + wr(f,tp) + im ? { + while tab(find(" ") + 1) + xencode_1(data,tab(0)) + } + } + # + # Co-expression, or file just outputs its letter. + # + !"CEf": wr(f,tp) + # + # Structured type outputs its letter followed (on subsequent + # lines) by additional data. A record writes its type as a + # string object; other type writes its size as an integer object. + # Structure elements follow on subsequent lines (alternating keys + # and values for tables). + # + default: { + wr(f,tp) + case tp of { + !"LST": { + im ? { + tab(find("(") + 1) + xencode_1(data,integer(tab(-1))) + } + if tp == "T" then xencode_1(data,x[[]]) + } + default: xencode_1(data,type(x)) + } + # + # Create the tag. It's important that the tag is assigned + # *after* other other objects that describe this object (e.g. + # the length of a list) are output (and tagged), but *before* + # the structure elements; otherwise decoding would be + # difficult. + # + data.done[x] := data.nextTag +:= 1 + # + # Output the elements of the structure. + # + every xencode_1(data, + !case tp of {"S": sort(x); "T": sort(x,3); default: x}) + } + } + # + # Tag the object if it's not already tagged. + # + /data.done[x] := data.nextTag +:= 1 + return f +end + +procedure xdecode(file,readProc) #: read structure from file + + /file := &input + + return xdecode_1( + xcode_rec( + file, + (\readProc | read) \ 1, + [])) +end + +# This procedure fails if it encounters bad data + +procedure xdecode_1(data) + local x,tp,sz, i + data.ioProc(data.file) ? { + if any(&digits) then { + # + # It's a tag -- return its value from the object table. + # + return data.done[tab(0)] + } + if tp := move(1) then { + x := case tp of { + "N": numeric(tab(0)) + "\"": escape(tab(-1)) + "'": cset(escape(tab(-1))) + "p": proc(xdecode_1(data)) | fail + "L": list(xdecode_1(data)) | fail + "S": {sz := xdecode_1(data) | fail; set()} + "T": {sz := xdecode_1(data) | fail; table(xdecode_1(data)) | fail} + "R": proc(xdecode_1(data))() | fail + "&": case tab(0) of { + # + # Special csets. + # + "cset": &cset + "ascii": &ascii + "digits": &digits + "letters": &letters + "lcase": &lcase + "ucase": &ucase + # + # Special files. + # + "input": &input + "output": &output + "errout": &errout + default: [] # so it won't crash if new keywords arise + } + "f" | "C": [] # unique object for things that can't + # be restored. + default: fail + } + put(data.done,x) + case tp of { + !"LR": every i := 1 to *x do + x[i] := xdecode_1(data) | fail + "T": every 1 to sz do + insert(x,xdecode_1(data),xdecode_1(data)) | fail + "S": every 1 to sz do + insert(x,xdecode_1(data)) | fail + } + return x + } + else return + } + +end + +procedure xencoden(x, name, opt) + local output + + /opt := "w" + + output := open(name, opt) | stop("*** xencoden(): cannot open ", name) + xencode(x, output) + close(output) + + return + +end + +procedure xencodet(x, file, typ) + + if type(x) === typ then return xencode(x, file) + else fail + +end + +procedure xdecodet(file, typ) + local x + + x := xdecode(file) + + if type(x) == typ then return x + else fail + +end + +procedure xdecoden(name) + local input, x + + input := open(name) | stop("*** xdecoden(): cannot open ", name) + if x := xdecode(input) then { + close(input) + return x + } + else { + close(input) + fail + } + +end |