home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OL.LZH / PROCS.LZH / CODEOBJ.ICN < prev    next >
Text File  |  1991-07-13  |  8KB  |  250 lines
  1. ############################################################################
  2. #
  3. #    Name:    codeobj.icn
  4. #
  5. #    Title:    Procedures to encode and decode Icon data
  6. #
  7. #    Author:    Ralph E. Griswold
  8. #
  9. #    Date:    September 7, 1990
  10. #
  11. ############################################################################
  12. #
  13. #     These procedures provide a way of storing Icon values as strings and
  14. #  retrieving them.  The procedure encode(x) converts x to a string s that
  15. #  can be converted back to x by decode(s). These procedures handle all
  16. #  kinds of values, including structures of arbitrary complexity and even
  17. #  loops.  For "scalar" types -- null, integer, real, cset, and string --
  18. #
  19. #    decode(encode(x)) === x
  20. #
  21. #     For structures types -- list, set, table, and record types --
  22. #  decode(encode(x)) is, for course, not identical to x, but it has the
  23. #  same "shape" and its elements bear the same relation to the original
  24. #  as if they were encoded and decode individually.
  25. #
  26. #     No much can be done with files, functions and procedures, and
  27. #  co-expressions except to preserve type and identification.
  28. #
  29. #     The encoding of strings and csets handles all characters in a way
  30. #  that it is safe to write the encoding to a file and read it back.
  31. #
  32. #     No particular effort was made to use an encoding of value that
  33. #  minimizes the length of the resulting string. Note, however, that
  34. #  as of Version 7 of Icon, there are no limits on the length of strings
  35. #  that can be written out or read in.
  36. #
  37. ############################################################################
  38. #
  39. #     The encoding of a value consists of four parts:  a tag, a length,
  40. #  a type code, and a string of the specified length that encodes the value
  41. #  itself.
  42. #
  43. #     The tag is omitted for scalar values that are self-defining.
  44. #  For other values, the tag serves as a unique identification. If such a
  45. #  value appears more than once, only its tag appears after the first encoding.
  46. #  There is, therefore, a type code that distinguishes a label for a previously
  47. #  encoded value from other encodings. Tags are strings of lowercase
  48. #  letters. Since the tag is followed by a digit that starts the length, the
  49. #  two can be distinguished.
  50. #
  51. #     The length is simply the length of the encoded value that follows.
  52. #
  53. #     The type codes consist of single letters taken from the first character
  54. #  of the type name, with lower- and uppercase used to avoid ambiguities.
  55. #
  56. #     Where a structure contains several elements, the encodings of the
  57. #  elements are concatenated. Note that the form of the encoding contains
  58. #  the information needed to separate consecutive elements.
  59. #
  60. #     Here are some examples of values and their encodings:
  61. #
  62. #    x                     encode(x)
  63. #  -------------------------------------------------------
  64. #
  65. #    1                     "1i1"
  66. #    2.0                   "3r2.0"
  67. #    &null                 "0n"
  68. #    "\377"                "4s\\377"
  69. #    '\376\377'            "8c\\376\\377"
  70. #    procedure main        "a4pmain"
  71. #    co-expression #1 (0)  "b0C"
  72. #    []                    "c0L"
  73. #    set()                 "d0S"
  74. #    table("a")            "e3T1sa"
  75. #    L1 := ["hi","there"]  "f11L2shi5sthere"
  76. #
  77. #  A loop is illsutrated by
  78. #
  79. #    L2 := []
  80. #    put(L2,L2)
  81. #
  82. #  for which
  83. #
  84. #    x                     encode(x)
  85. #  -------------------------------------------------------
  86. #
  87. #    L2                    "g3L1lg"
  88. #
  89. #     Of course, you don't have to know all this to use encode and decode.
  90. #
  91. ############################################################################
  92. #
  93. #  Links: escape, gener, typecode
  94. #
  95. #  Requires:  co-expressions
  96. #
  97. #  See also: object.icn
  98. #
  99. ############################################################################
  100.  
  101. link escape, gener, typecode
  102.  
  103. global outlab, inlab
  104.  
  105. record triple(type,value,tag)
  106.  
  107. #  Encode an arbitary value as a string.
  108. #
  109. procedure encode(x,level)
  110.    local str, tag, Type
  111.    static label
  112.    initial label := create "l" || star(string(&lcase))
  113.    if /level then outlab := table()    # table is global, but reset at
  114.                     # each root call.
  115.    tag := ""
  116.    Type := typecode(x)
  117.    if Type == !"ri" then str := string(x)    # first the scalars
  118.    else if Type == !"cs" then str := image(string(x))[2:-1]    # remove quotes
  119.    else if Type == "n" then str := ""
  120.    else if Type == !"LSRTfpC" then    # next the structures and other types
  121.       if str := \outlab[x] then        # if the object has been processed,
  122.          Type := "l"            # use its label and type it as label.
  123.       else {
  124.          tag := outlab[x] := @label    # else make a label for it.
  125.          str := ""
  126.          if Type == !"LSRT" then {    # structures
  127.             every str ||:= encode(    # generate, recurse, and concatenate
  128.                case Type of {
  129.                   !"LS":   !x        # elements
  130.                   "T":    x[[]] | !sort(x,3)    # default, then elements
  131.                   "R":    type(x) | !x        # type then elements
  132.                   }
  133.                ,1)            # indicate internal call
  134.             }
  135.             else str ||:= case Type of {    # other things
  136.                "f":   image(x)
  137.                "C":   ""
  138.                "p":   image(x) ? {    # watch out for record constructors
  139.                   tab(find("record constructor ") + *"record constructor ") |
  140.                   tab(upto(' ') + 1)
  141.                   tab(0)
  142.                   }
  143.                }
  144.          }
  145.    else stop("unsupported type in encode: ",image(x))
  146.    return tag || *str || Type || str
  147. end
  148.  
  149. #  Generate decoded results.  At the top level, there is only one,
  150. #  but for structures, it is called recursively and generates the
  151. #  the decoded elements. 
  152. #
  153. procedure decode(s,level)
  154.    local p
  155.    if /level then inlab := table()    # global but reset
  156.    every p := separ(s) do {
  157.       suspend case p.type of {
  158.          "l":  inlab[p.value]        # label for an object
  159.          "i":  integer(p.value)
  160.          "s":  escape(p.value)
  161.          "c":  cset(escape(p.value))
  162.          "r":  real(p.value)
  163.          "n":  &null
  164.          "L":  delist(p.value,p.tag)
  165.          "R":  derecord(p.value,p.tag)
  166.          "S":  deset(p.value,p.tag)
  167.          "T":  detable(p.value,p.tag)
  168.          "f":  defile(p.value)
  169.          "C":  create &fail    # can't hurt much to fail
  170.          "p":  (proc(p.value) | stop("encoded procedure not found")) \ 1
  171.          default:  stop("unexpected type in decode: ",p.type)
  172.          }
  173.       }
  174. end
  175.  
  176. #  Generate triples for the encoded values in concatenation.
  177. #
  178. procedure separ(s)
  179.    local p, size
  180.  
  181.    while *s ~= 0 do {
  182.       p := triple()
  183.       s ?:= {
  184.          p.tag := tab(many(&lcase))
  185.          size := tab(many(&digits)) | break
  186.          p.type := move(1)
  187.          p.value := move(size)
  188.          tab(0)
  189.          }
  190.       suspend p
  191.       }
  192. end
  193.  
  194. #  Decode a list. The newly constructed list is added to the table that
  195. #  relates tags to structure values.
  196. #
  197. procedure delist(s,tag)
  198.    local a
  199.    inlab[tag] := a := []    # insert object for label
  200.    every put(a,decode(s,1))
  201.    return a
  202. end
  203.  
  204. #  Decode a set. Compare to delist above.
  205. #
  206. procedure deset(s,tag)
  207.    local S
  208.    inlab[tag] := S := set()
  209.    every insert(S,decode(s,1))
  210.    return S
  211. end
  212.  
  213. #  Decode a record.
  214. #
  215. procedure derecord(s,tag)
  216.    local R, e
  217.    e := create decode(s,1)    # note use of co-expressions to control
  218.                 # generation, since record must be constructed
  219.                 # before fields are produced.
  220.    inlab[tag] := R := proc(@e)() | stop("error in decoding record")
  221.    every !R := @e
  222.    return R
  223. end
  224.  
  225. #  Decode  a table.
  226. #
  227. procedure detable(s,tag)
  228.    local t, e
  229.    e := create decode(s,1)    # see derecord above; here it's the default
  230.                 # value that motivates co-expressions.
  231.    inlab[tag] := t := table(@e)
  232.    while t[@e] := @e
  233.    return t
  234. end
  235.  
  236. #  Decode a file.
  237. #
  238. procedure defile(s)
  239.    s := decode(s,1)        # the result is an image of the original file.
  240.    return case s of {        # files aren't so simple ...
  241.       "&input":  &input
  242.       "&output": &output
  243.       "&errout": &errout
  244.       default: s ? {
  245.             ="file("        # open for reading to play it safe
  246.             open(tab(upto(')'))) | stop("cannot open encoded file")
  247.             }
  248.        }
  249. end
  250.