home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sharew / exoten / icon / codeobj.icn < prev    next >
Encoding:
Text File  |  1990-03-05  |  8.4 KB  |  263 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:    November 16, 1988
  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
  94. #
  95. #  Requires:  co-expressions
  96. #
  97. #  See also: object.icn
  98. #
  99. ############################################################################
  100.  
  101. link escape, gener
  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. #  Produce a one-letter code for the type.
  150. #
  151. procedure typecode(x)
  152.    local code
  153.                 # be careful of records and their constructors
  154.    if image(x) ? ="record constructor " then return "p"
  155.    if image(x) ? ="record" then return "R"
  156.    code := type(x)
  157.    if code == ("list" | "set" | "table" | "co-expression") then
  158.       code := map(code,&lcase,&ucase)
  159.    return code[1]
  160. end
  161.  
  162. #  Generate decoded results.  At the top level, there is only one,
  163. #  but for structures, it is called recursively and generates the
  164. #  the decoded elements. 
  165. #
  166. procedure decode(s,level)
  167.    local p
  168.    if /level then inlab := table()    # global but reset
  169.    every p := separ(s) do {
  170.       suspend case p.type of {
  171.          "l":  inlab[p.value]        # label for an object
  172.          "i":  integer(p.value)
  173.          "s":  escape(p.value)
  174.          "c":  cset(escape(p.value))
  175.          "r":  real(p.value)
  176.          "n":  &null
  177.          "L":  delist(p.value,p.tag)
  178.          "R":  derecord(p.value,p.tag)
  179.          "S":  deset(p.value,p.tag)
  180.          "T":  detable(p.value,p.tag)
  181.          "f":  defile(p.value)
  182.          "C":  create &fail    # can't hurt much to fail
  183.          "p":  (proc(p.value) | stop("encoded procedure not found")) \ 1
  184.          default:  stop("unexpected type in decode: ",p.type)
  185.          }
  186.       }
  187. end
  188.  
  189. #  Generate triples for the encoded values in concatenation.
  190. #
  191. procedure separ(s)
  192.    local p, size
  193.  
  194.    while *s ~= 0 do {
  195.       p := triple()
  196.       s ?:= {
  197.          p.tag := tab(many(&lcase))
  198.          size := tab(many(&digits)) | break
  199.          p.type := move(1)
  200.          p.value := move(size)
  201.          tab(0)
  202.          }
  203.       suspend p
  204.       }
  205. end
  206.  
  207. #  Decode a list. The newly constructed list is added to the table that
  208. #  relates tags to structure values.
  209. #
  210. procedure delist(s,tag)
  211.    local a
  212.    inlab[tag] := a := []    # insert object for label
  213.    every put(a,decode(s,1))
  214.    return a
  215. end
  216.  
  217. #  Decode a set. Compare to delist above.
  218. #
  219. procedure deset(s,tag)
  220.    local S
  221.    inlab[tag] := S := set()
  222.    every insert(S,decode(s,1))
  223.    return S
  224. end
  225.  
  226. #  Decode a record.
  227. #
  228. procedure derecord(s,tag)
  229.    local R, e
  230.    e := create decode(s,1)    # note use of co-expressions to control
  231.                 # generation, since record must be constructed
  232.                 # before fields are produced.
  233.    inlab[tag] := R := proc(@e)() | stop("error in decoding record")
  234.    every !R := @e
  235.    return R
  236. end
  237.  
  238. #  Decode  a table.
  239. #
  240. procedure detable(s,tag)
  241.    local t, e
  242.    e := create decode(s,1)    # see derecord above; here it's the default
  243.                 # value that motivates co-expressions.
  244.    inlab[tag] := t := table(@e)
  245.    while t[@e] := @e
  246.    return t
  247. end
  248.  
  249. #  Decode a file.
  250. #
  251. procedure defile(s)
  252.    s := decode(s,1)        # the result is an image of the original file.
  253.    return case s of {        # files aren't so simple ...
  254.       "&input":  &input
  255.       "&output": &output
  256.       "&errout": &errout
  257.       default: s ? {
  258.             ="file("        # open for reading to play it safe
  259.             open(tab(upto(')'))) | stop("cannot open encoded file")
  260.             }
  261.        }
  262. end
  263.