home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROCS.ZIP / OBJECT.ICN < prev    next >
Encoding:
Text File  |  1992-09-28  |  6.4 KB  |  178 lines
  1. ############################################################################
  2. #
  3. #    File:     object.icn
  4. #
  5. #    Subject:  Procedures to encode and decode Icon values
  6. #
  7. #    Author:   Kurt A. Welgehausen
  8. #
  9. #    Date:     June 10, 1988
  10. #
  11. ###########################################################################
  12. #
  13. #     These procedures provide a way of storing Icon values as strings in
  14. #  files and reconstructing them.
  15. #
  16. #     putobj(obj, f) stores the Icon data object obj in the file f; it returns
  17. #  the object stored.  The returned value is usually not of interest, so a
  18. #  typical call is putobj(x, f).
  19. #  
  20. #     The file f must be open for writing; if f is null, it defaults to &output.
  21. #  
  22. #     Strings are stored as single lines in the file, with unprintable
  23. #  characters stored as the escape sequences produced by image().  
  24. #  
  25. #  Integers, reals, and csets are writen to the file as single lines of the
  26. #  form "%"type(obj)string(obj), for example 
  27. #  
  28. #      123 is stored as "%integer123"
  29. #      123.4 is stored as "%real123.4"
  30. #      '123' is stored as "%cset123"
  31. #  
  32. #     As in strings, unprintable characters in csets are stored as the escape 
  33. #  sequences produced by image().
  34. #  
  35. #     Procedures, functions,and record constructors are stored as strings of the
  36. #  form #  "%proc"procedure-name.  For example, the function write() is stored
  37. #  as "%procwrite".
  38. #  
  39. #     Files are stored as strings of the form "#file("file-name")".  For
  40. #  example, if f is a file variable connected to the disk file example.fil,
  41. #  then f is stored by putobj() as "#file(example.fil)".  
  42. #  
  43. #     Co-expressions are stored as the string "#co-expr".
  44. #  
  45. #     Null objects are stored as lines containing only "%".
  46. #  
  47. #     Structured objects are stored as single lines of the form
  48. #  "%"type(obj)"("n")", where n is the size of obj, followed by the n
  49. #  components of obj (tables are stored as their default assigned values
  50. #  followed by sorted lists of index and #  assigned values).  putobj() calls
  51. #  itself recursively to store the components.  For example,
  52. #
  53. #        ["aaa", ["bbb", 'edc'], 16rfff, open("somefile"), create write(1 to 3)]
  54. #
  55. #  is stored as 
  56. #  
  57. #          %list(5)
  58. #          aaa
  59. #          %list(2)
  60. #          bbb
  61. #          %csetcde
  62. #          %integer4095
  63. #          #file(somefile)
  64. #          #co-expr
  65. #  
  66. #  
  67. #     getobj(f) retrieves an Icon data object from the file f; it returns the 
  68. #  object.  A typical call is "x := getobj(f)".
  69. #  
  70. #     The file f must be open for reading; if f is null, it defaults to &input.
  71. #  
  72. #     The object to be retrieved must have been stored in the format used by
  73. #  putobj().
  74. #  
  75. #     No attempt is made to reconstruct file variables or co-expressions; only
  76. #  the descriptive string is returned.  It is up to the programmer to open the
  77. #  file or recreate the co-expression.  For all other types, the actual Icon
  78. #  object is returned.  
  79. #  
  80. ############################################################################
  81. #
  82. #  Warning:
  83. #
  84. #     putobj(x) calls itself to process structures in x.  If there is a
  85. #  loop in the structure, putobj(x) gets stack overflow due to excessive
  86. #  recursion.
  87. #
  88. #     Objects stored with putobj() and then retrieved with getobj() may
  89. #  not be identical to the original objects.  For example, if x is an Icon
  90. #  structure and y := [x, x], then y[1] and y[2] are identical; but 
  91. #  after storing and retrieving y, y[1] and y[2] will be copies of each 
  92. #  other but will not be the same object.
  93. #
  94. #     To  avoid these problems, use codeobj.icn instead of object.icn.
  95. #  
  96. ############################################################################
  97. #
  98. #  Links: escape
  99. #
  100. #  See also: codeobj.icn
  101. #
  102. ############################################################################
  103.  
  104. link  escape
  105.  
  106. global  HDRSYM, ESCSYM
  107.  
  108. procedure getobj(f)
  109.     local  line, buf, otype, size
  110.     initial  { /HDRSYM:= "%"; /ESCSYM:= "@" }   # these defs must be the same as
  111.                                                 # those in putobj()
  112.     /f:= &input
  113.     (line:= (read(f) | fail)) ? {
  114.         case move(1) | "" of {
  115.             ESCSYM: buf:= escape(tab(0))
  116.             HDRSYM: {
  117.              (otype:= tab(upto('(')), move(1), size:= integer(tab(upto(')')))) |
  118.                (buf:=
  119.                   (=("integer" | "real" | "cset" | "proc"))(escape(tab(0)))) |
  120.                  &null    # must succeed
  121.             }
  122.             "&": buf:= case tab(0) of {
  123.                     "input": &input ;  "output": &output ;  "errout": &errout
  124.                     "cset": &cset ;  "ascii": &ascii
  125.                     "lcase": &lcase ;  "ucase": &ucase
  126.                  }
  127.             default: buf:= escape(line)
  128.         }
  129.     }
  130.     \size & {       # not-null size means a structured type
  131.         ((otype == "table") & (buf:= getobj(f))) |
  132.             ((otype == "set") & (buf:= []))
  133.         buf:= otype(buf)
  134.         case otype of {
  135.             "list": every 1 to size do put(buf, getobj(f))
  136.             "table": every 1 to size do buf[getobj(f)]:= getobj(f)
  137.             "set": every 1 to size do insert(buf, getobj(f))
  138.             default: every buf[1 to size]:= getobj(f)
  139.         }
  140.     }
  141.     return  buf
  142. end
  143. # Put object <obj> on file <f>; <f> must be open for writing.
  144. # If <f> is not specified, output goes to &output.
  145.  
  146. global  HDRSYM, ESCSYM
  147.  
  148. procedure putobj(obj, f)
  149.     local  t, buf
  150.     initial  { /HDRSYM:= "%"; /ESCSYM:= "@" }  # these defs must be the same as
  151.                                                # those in getobj()
  152.     /f:= &output
  153.     case t:= type(obj) of {
  154.         "string": {
  155.             match(ESCSYM | HDRSYM | "&", obj) & (obj:= ESCSYM || obj)
  156.             write(f, image(obj)[2:-1])
  157.         }
  158.         "integer" | "real": write(f, HDRSYM, t, obj)
  159.         "cset": {
  160.             buf:= image(obj)
  161.             (match("&", buf) & write(f, buf)) | write(f, HDRSYM, t, buf[2:-1])
  162.         }
  163.         "null": write(f, HDRSYM)
  164.         "procedure": image(obj) ? {
  165.             =("procedure " | "function " | "record constructor ")
  166.             write(f, HDRSYM, "proc", tab(0))
  167.         }
  168.         "file" | "window": image(obj) ? write(f, (="&" | "#") || tab(0))
  169.         "co-expression": write(f, "#", t[1:8])
  170.         default: {
  171.             write(f, HDRSYM, t, "(", *obj, ")")
  172.             (t == "table", putobj(obj[[]], f), buf:= sort(obj, 3)) | (buf:= obj)
  173.             (*buf > 0) & every putobj(!buf, f)
  174.         }
  175.     }
  176.     return  obj
  177. end
  178.