home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / packs / tcll1 / xcode.icn < prev   
Text File  |  2000-07-29  |  12KB  |  422 lines
  1. ############################################################################
  2. #
  3. #    File:     xcode.icn
  4. #
  5. #    Subject:  Procedures to save and restore Icon data
  6. #
  7. #    Author:   Bob Alexander
  8. #
  9. #    Date:     January 1, 1996
  10. #
  11. ############################################################################
  12. #
  13. #    Contributor:  Ralph E. Griswold
  14. #
  15. ############################################################################
  16. #
  17. #  Description
  18. #  -----------
  19. #
  20. #     These procedures provide a way of storing Icon values in files
  21. #  and retrieving them.  The procedure xencode(x,f) stores x in file f
  22. #  such that it can be converted back to x by xdecode(f).  These
  23. #  procedures handle several kinds of values, including structures of
  24. #  arbitrary complexity and even loops.  The following sequence will
  25. #  output x and recreate it as y:
  26. #
  27. #    f := open("xstore","w")
  28. #    xencode(x,f)
  29. #    close(f)
  30. #    f := open("xstore")
  31. #    y := xdecode(f)
  32. #    close(f)
  33. #
  34. #  For "scalar" types -- null, integer, real, cset, and string, the
  35. #  above sequence will result in the relationship
  36. #
  37. #    x === y
  38. #
  39. #     For structured types -- list, set, table, and record types --
  40. #  y is, for course, not identical to x, but it has the same "shape" and
  41. #  its elements bear the same relation to the original as if they were
  42. #  encoded and decoded individually.
  43. #
  44. #     Files, co-expressions, and windows cannot generally be restored in any
  45. #  way that makes much sense.  These objects are restored as empty lists so
  46. #  that (1) they will be unique objects and (2) will likely generate
  47. #  run-time errors if they are (probably erroneously) used in
  48. #  computation.  However, the special files &input, &output, and &errout are
  49. #  restored.
  50. #
  51. #     Not much can be done with functions and procedures, except to preserve
  52. #  type and identification.
  53. #
  54. #     The encoding of strings and csets handles all characters in a way
  55. #  that it is safe to write the encoding to a file and read it back.
  56. #
  57. #     xdecode() fails if given a file that is not in xcode format or it
  58. #  the encoded file contains a record for which there is no declaration
  59. #  in the program in which the decoding is done.  Of course, if a record
  60. #  is declared differently in the encoding and decoding programs, the
  61. #  decoding may be bogus.
  62. #
  63. #     xencoden() and xdecoden() perform the same operations, except
  64. #  xencoden() and xdecoden() take the name of a file, not a file.
  65. #
  66. ############################################################################
  67. #
  68. #  Complete calling sequences
  69. #  --------------------------
  70. #
  71. #    xencode(x, f, p) # returns f
  72. #
  73. #    where
  74. #
  75. #        x is the object to encode
  76. #
  77. #        f is the file to write (default &output)
  78. #
  79. #        p is a procedure that writes a line on f using the
  80. #          same interface as write() (the first parameter is
  81. #          always a the value passed as "file") (default: write)
  82. #
  83. #
  84. #    xencode(f, p) # returns the restored object
  85. #
  86. #    where
  87. #
  88. #        f is the file to read (default &input)
  89. #
  90. #        p is a procedure that reads a line from f using the
  91. #          same interface as read() (the parameter is
  92. #          always a the value passed as "file") (default: read)
  93. #
  94. #
  95. #  The "p" parameter is not normally used for storage in text files, but
  96. #  it provides the flexibility to store the data in other ways, such as
  97. #  a string in memory.  If "p" is provided, then "f" can be any
  98. #  arbitrary data object -- it need not be a file.
  99. #
  100. #  For example, to "write" x to an Icon string:
  101. #
  102. #    record StringFile(s)
  103. #
  104. #    procedure main()
  105. #       ...
  106. #       encodeString := xencode(x,StringFile(""),WriteString).s
  107. #       ...
  108. #    end
  109. #
  110. #    procedure WriteString(f,s[])
  111. #      every f.s ||:= !s
  112. #      f.s ||:= "\n"
  113. #      return
  114. #    end
  115. #
  116. ############################################################################
  117. #
  118. #  Notes on the encoding
  119. #  ---------------------
  120. #
  121. #     Values are encoded as a sequence of one or more lines written to
  122. #  a plain text file.  The first or only line of a value begins with a
  123. #  single character that unambiguously indicates its type.  The
  124. #  remainder of the line, for some types, contains additional value
  125. #  information.  Then, for some types, additional lines follow
  126. #  consisting of additional object encodings that further specify the
  127. #  object.  The null value is a special case consisting of an empty
  128. #  line.
  129. #
  130. #     Each object other than &null is assigned an integer tag as it is
  131. #  encoded.  The tag is not, however, written to the output file.  On
  132. #  input, tags are assigned in the same order as objects are decoded, so
  133. #  each restored object is associated with the same integer tag as it
  134. #  was when being written.  In encoding, any recurrence of an object is
  135. #  represented by the original object's tag.  Tag references are
  136. #  represented as integers, and are easily recognized since no object's
  137. #  representation begins with a digit.
  138. #
  139. #     Where a structure contains elements, the encodings of the
  140. #  elements follow the structure's specification on following lines.
  141. #  Note that the form of the encoding contains the information needed to
  142. #  separate consecutive elements.
  143. #
  144. #     Here are some examples of values and their encodings:
  145. #
  146. #       x                     encode(x)
  147. #  -------------------------------------------------------
  148. #
  149. #       1                     N1
  150. #       2.0                   N2.0
  151. #       &null                 
  152. #       "\377"                "\377"
  153. #       '\376\377'            '\376\377'
  154. #       procedure main        p
  155. #                             "main"
  156. #       co-expression #1 (0)  C
  157. #       []                    L
  158. #                             N0
  159. #       set()                 "S"
  160. #                             N0
  161. #       table("a")            T
  162. #                             N0
  163. #                             "a"
  164. #       ["hi","there"]        L
  165. #                             N2
  166. #                             "hi"
  167. #                             "there"
  168. #
  169. #  A loop is illustrated by
  170. #
  171. #       L2 := []
  172. #       put(L2,L2)
  173. #
  174. #  for which
  175. #
  176. #       x                     encode(x)
  177. #  -------------------------------------------------------
  178. #
  179. #       L2                    L
  180. #                             N1
  181. #                             2
  182. #
  183. #  The "2" on the third line is a tag referring to the list L2.  The tag
  184. #  ordering specifies that an object is tagged *after* its describing
  185. #  objects, thus the list L2 has the tag 2 (the integer 1 has tag 1).
  186. #
  187. #     Of course, you don't have to know all this to use xencode and
  188. #  xdecode.
  189. #
  190. ############################################################################
  191. #
  192. #  Links:  escape
  193. #
  194. ############################################################################
  195. #
  196. #  See also:  object.icn, codeobj.icn
  197. #
  198. ############################################################################
  199.  
  200. invocable all
  201.  
  202. link escape
  203.  
  204. record xcode_rec(file,ioProc,done,nextTag)
  205.  
  206. procedure xencode(x,file,writeProc)    #: write structure to file
  207.  
  208.    /file := &output
  209.    return xencode_1(
  210.       xcode_rec(
  211.      file,
  212.      (\writeProc | write) \ 1,
  213.      table(),
  214.      0),
  215.       x)
  216. end
  217.  
  218. procedure xencode_1(data,x)
  219.    local tp,wr,f,im
  220.    wr := data.ioProc
  221.    f := data.file
  222.    #
  223.    #  Special case for &null.
  224.    #
  225.    if /x then {
  226.       wr(f)
  227.       return f
  228.       }
  229.    #
  230.    #  If this object has already been output, just write its tag.
  231.    #
  232.    if tp := \data.done[\x] then {
  233.       wr(f,tp)
  234.       return f
  235.       }
  236.    #
  237.    #  Check to see if it's a "distinguished" that is represented by
  238.    #  a keyword (special files and csets).  If so, just use the keyword
  239.    #  in the output.
  240.    #
  241.    im := image(x)
  242.    if match("integer(", im) then im := string(x)
  243.    else if match("&",im) then {
  244.       wr(f,im)
  245.       data.done[x] := data.nextTag +:= 1
  246.       return f
  247.       }
  248.    #
  249.    #  Determine the type and handle accordingly.
  250.    #
  251.    tp := case type(x) of {
  252.      "cset" | "string": ""
  253.      "file" | "window": "f"
  254.      "integer" | "real": "N"
  255.      "co-expression": "C"
  256.      "procedure": "p"
  257.      "external": "E"
  258.      "list": "L"
  259.      "set": "S"
  260.      "table": "T"
  261.      default: "R"
  262.    }
  263.    case tp of {
  264.       #
  265.       #  String, cset, or numeric outputs its string followed by its
  266.       #  image.
  267.       #
  268.       "" | "N": wr(f,tp,im)
  269.       #
  270.       #  Procedure writes "p" followed (on subsequent line) by its name
  271.       #  as a string object.
  272.       #
  273.       "p": {
  274.      wr(f,tp)
  275.      im ? {
  276.         while tab(find(" ") + 1)
  277.         xencode_1(data,tab(0))
  278.         }
  279.      }
  280.       #
  281.       #  Co-expression, file, or external just outputs its letter.
  282.       #
  283.       !"CEf": wr(f,tp)
  284.       #
  285.       #  Structured type outputs its letter followed (on subsequent
  286.       #  lines) by additional data.  A record writes its type as a
  287.       #  string object; other type writes its size as an integer object.
  288.       #  Structure elements follow on subsequent lines (alternating keys
  289.       #  and values for tables).
  290.       #
  291.       default: {
  292.      wr(f,tp)
  293.      case tp of {
  294.         !"LST": {
  295.            im ? {
  296.           tab(find("(") + 1)
  297.           xencode_1(data,integer(tab(-1)))
  298.           }
  299.            if tp == "T" then xencode_1(data,x[[]])
  300.            }
  301.         default: xencode_1(data,type(x))
  302.         }
  303.      #
  304.      #  Create the tag.  It's important that the tag is assigned
  305.      #  *after* other other objects that describe this object (e.g.
  306.      #  the length of a list) are output (and tagged), but *before*
  307.      #  the structure elements; otherwise decoding would be
  308.      #  difficult.
  309.      #
  310.      data.done[x] := data.nextTag +:= 1
  311.      #
  312.      #  Output the elements of the structure.
  313.      #
  314.      every xencode_1(data,
  315.            !case tp of {"S": sort(x); "T": sort(x,3); default: x})
  316.      }
  317.       }
  318.    #
  319.    #  Tag the object if it's not already tagged.
  320.    #
  321.    /data.done[x] := data.nextTag +:= 1
  322.    return f
  323. end
  324.  
  325. procedure xdecode(file,readProc)    #: read structure from file
  326.  
  327.    /file := &input
  328.  
  329.    return xdecode_1(
  330.       xcode_rec(
  331.      file,
  332.      (\readProc | read) \ 1,
  333.      []))
  334. end
  335.  
  336. #  This procedure fails if it encounters bad data
  337.  
  338. procedure xdecode_1(data)
  339.    local x,tp,sz, i
  340.    data.ioProc(data.file) ? {
  341.       if any(&digits) then {
  342.      #
  343.      #  It's a tag -- return its value from the object table.
  344.      #
  345.      return data.done[tab(0)]
  346.      }
  347.       if tp := move(1) then {
  348.      x := case tp of {
  349.         "N": numeric(tab(0))
  350.         "\"": escape(tab(-1))
  351.         "'": cset(escape(tab(-1)))
  352.         "p": proc(xdecode_1(data)) | fail
  353.         "L": list(xdecode_1(data)) | fail
  354.         "S": {sz := xdecode_1(data) | fail; set()}
  355.         "T": {sz := xdecode_1(data) | fail; table(xdecode_1(data)) | fail}
  356.         "R": proc(xdecode_1(data))() | fail
  357.         "&": case tab(0) of {
  358.            #
  359.            #  Special csets.
  360.            #
  361.            "cset":        &cset
  362.            "ascii":        &ascii
  363.            "digits":    &digits
  364.            "letters":    &letters
  365.            "lcase":        &lcase
  366.            "ucase":        &ucase
  367.            #
  368.            #  Special files.
  369.            #
  370.            "input":        &input
  371.            "output":    &output
  372.            "errout":    &errout
  373.            default:        [] # so it won't crash if new keywords arise
  374.            }
  375.             "f" | "C": []    # unique object for things that can't
  376.                 # be restored.
  377.         default: fail
  378.         }
  379.      put(data.done,x)
  380.      case tp of {
  381.         !"LR": every i := 1 to *x do
  382.               x[i] := xdecode_1(data) | fail
  383.         "T": every 1 to sz do
  384.                insert(x,xdecode_1(data),xdecode_1(data)) | fail
  385.         "S": every 1 to sz do
  386.                insert(x,xdecode_1(data)) | fail
  387.         }
  388.      return x
  389.      }
  390.       else return
  391.       }
  392.  
  393. end
  394.  
  395. procedure xencoden(x, name, opt)
  396.    local output
  397.  
  398.    /opt := "w"
  399.  
  400.    output := open(name, opt) | stop("*** xencoden(): cannot open ", name)
  401.    xencode(x, output)
  402.    close(output)
  403.  
  404.    return
  405.  
  406. end
  407.  
  408. procedure xdecoden(name)
  409.    local input, x
  410.  
  411.    input := open(name) | stop("*** xdecoden(): cannot open ", name)
  412.    if x := xdecode(input) then {
  413.       close(input)
  414.       return x
  415.       }
  416.    else {
  417.       close(input)
  418.       fail
  419.       }
  420.  
  421. end
  422.