home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OL.LZH / PROCS.LZH / LSCAN.ICN < prev    next >
Text File  |  1991-07-13  |  15KB  |  545 lines
  1. ############################################################################
  2. #
  3. #    Name:     lscan.icn
  4. #
  5. #    Title:     Quasi ? scanning routines for lists.
  6. #
  7. #    Author:     Richard L. Goerwitz
  8. #
  9. #    Date:     JUne 3, 1991
  10. #
  11. #    Version: 1.20
  12. #
  13. ############################################################################
  14. #
  15. #  PURPOSE: String scanning is terrific, but often I am forced to
  16. #  tokenize and work with lists.  So as to make operations on these
  17. #  lists as close to corresponding string operations as possible, I've
  18. #  implemented a series of list analogues to any(), bal(), find(),
  19. #  many(), match(), move(), pos(), tab(), and upto().  Their names are
  20. #  just like corresponding string functions, except with a prepended
  21. #  "l_" (e.g. l_any()).  Functionally, the list routines parallel the
  22. #  string ones closely, except that in place of strings, l_find and
  23. #  l_match accept lists as their first argument.  L_any(), l_many(),
  24. #  and l_upto() all take either sets of lists or lists of lists (e.g.
  25. #  l_tab(l_upto([["a"],["b"],["j","u","n","k"]])).  Note that l_bal(),
  26. #  unlike the builtin bal(), has no defaults for the first four
  27. #  arguments.  This just seemed appropriate, given that no precise
  28. #  list analogue to &cset, etc. occurs.
  29. #
  30. #  The default subject for list scans (analogous to &subject) is
  31. #  l_SUBJ.  The equivalent of &pos is l_POS.  Naturally, these
  32. #  variables are both global.  They are used pretty much like &subject
  33. #  and &pos, except that they are null until a list scanning
  34. #  expression has been encountered containing a call to l_Bscan() (on
  35. #  which, see below).
  36. #
  37. #  Note that environments cannot be maintained quite as elegantly as
  38. #  they can be for the builtin string-scanning functions.  One must
  39. #  use instead a set of nested procedure calls, as explained in the
  40. #  _Icon Analyst_ 1:6 (June, 1991), p. 1-2.  In particular, one cannot
  41. #  suspend, return, or otherwise break out of the nested procedure
  42. #  calls.  They can only be exited via failure.  The names of these
  43. #  procedures, at least in this implementation, are l_Escan and
  44. #  l_Bscan.  Here is one example of how they might be invoked:
  45. #
  46. #      suspend l_Escan(l_Bscan(some_list_or_other), {
  47. #          l_tab(10 to *l_SUBJ) & {
  48. #              if l_any(l1) | l_match(l2) then
  49. #                  old_l_POS + (l_POS-1)
  50. #          }
  51. #      })
  52. #
  53. #  Note that you cannot do this:
  54. #
  55. #      l_Escan(l_Bscan(some_list_or_other), {
  56. #          l_tab(10 to *l_SUBJ) & {
  57. #              if l_any(l1) | l_match(l2) then
  58. #                  suspend old_l_POS + (l_POS-1)
  59. #          }
  60. #      })
  61. #
  62. #  Remember, it's no fair to use suspend within the list scanning
  63. #  expression.  l_Escan must do all the suspending.  It is perfectly OK,
  64. #  though, to nest well-behaved list scanning expressions.  And they can
  65. #  be reliably used to generate a series of results as well.
  66. #
  67. ############################################################################
  68. #
  69. #  Here's another simple example of how one might invoke the l_scan
  70. #  routines:
  71. #
  72. #  procedure main()
  73. #
  74. #      l := ["h","e","l","l","o"," ","t","t","t","h","e","r","e"]
  75. #
  76. #      l_Escan(l_Bscan(l), {
  77. #          hello_list := l_tab(l_match(["h","e","l","l","o"]))
  78. #          every writes(!hello_list)
  79. #          write()
  80. #
  81. #          # Note the nested list-scanning expressions.
  82. #       l_Escan(l_Bscan(l_tab(0)), {
  83. #           l_tab(l_many([[" "],["t"]]) - 1)
  84. #              every writes(!l_tab(0))
  85. #           write()
  86. #          })
  87. #      })
  88. #  
  89. #  end
  90. #
  91. #  The above program simply writes "hello" and "there" on successive
  92. #  lines to the standard output.
  93. #
  94. ############################################################################
  95. #
  96. #  PITFALLS: In general, note that we are comparing lists here instead
  97. #  of strings, so l_find("h", l), for instance, will yield an error
  98. #  message (use l_find(["h"], l) instead).  The point at which I
  99. #  expect this nuance will be most confusing will be in cases where
  100. #  one is looking for lists within lists.  Suppose we have a list,
  101. #
  102. #      l1 := ["junk",[["hello"]," ",["there"]],"!","m","o","r","e","junk"]
  103. #
  104. #  and suppose, moreover, that we wish to find the position in l1 at
  105. #  which the list
  106. #
  107. #      [["hello"]," ",["there"]]
  108. #
  109. #  occurs.  If, say, we assign [["hello"]," ",["there"]] to the
  110. #  variable l2, then our l_find() expression will need to look like
  111. #
  112. #      l_find([l2],l1)
  113. #
  114. ############################################################################
  115. #
  116. #  Extending scanning to lists is really very difficult.  What I think
  117. #  (at least tonight) is that scanning should never have been
  118. #  restricted to strings.  It should have been designed to operate on
  119. #  all homogenous one-dimensional arrays (vectors, for you LISPers).
  120. #  You should be able, in other words, to scan vectors of ints, longs,
  121. #  characters - any data type that seems useful.  The only question in
  122. #  my mind is how to represent vectors as literals.  Extending strings
  123. #  to lists goes beyond the bounds of scanning per-se.  This library is
  124. #  therefore something of a stab in the dark.
  125. #
  126. ############################################################################
  127.  
  128.  
  129. global l_POS
  130. global l_SUBJ
  131. record l_ScanEnvir(subject,pos)
  132.  
  133. procedure l_Bscan(e1)
  134.  
  135.     #
  136.     # Prototype list scan initializer.  Based on code published in
  137.     # the _Icon Analyst_ 1:6 (June, 1991), p. 1-2.
  138.     #
  139.     local l_OuterEnvir
  140.     initial {
  141.     l_SUBJ := []
  142.     l_POS := 1
  143.     }
  144.  
  145.     #
  146.     # Save outer scanning environment.
  147.     #
  148.     l_OuterEnvir := l_ScanEnvir(l_SUBJ, l_POS)
  149.  
  150.     #
  151.     # Set current scanning environment to subject e1 (arg 1).  Pos
  152.     # defaults to 1.  Suspend the saved environment.  Later on, the
  153.     # l_Escan procedure will need this in case the scanning expres-
  154.     # sion as a whole sends a result back to the outer environment,
  155.     # and the outer environment changes l_SUBJ and l_POS.
  156.     #
  157.     l_SUBJ := e1
  158.     l_POS  := 1
  159.     suspend l_OuterEnvir
  160.  
  161.     #
  162.     # Restore the saved environment (plus any changes that might have
  163.     # been made to it as noted in the previous run of comments).
  164.     #
  165.     l_SUBJ := l_OuterEnvir.subject
  166.     l_POS := l_OuterEnvir.pos
  167.  
  168.     #
  169.     # Signal failure of the scanning expression (we're done producing
  170.     # results if we get to here).
  171.     #
  172.     fail
  173.  
  174. end
  175.  
  176.  
  177.  
  178. procedure l_Escan(l_OuterEnvir, e2)
  179.  
  180.     local l_InnerEnvir
  181.  
  182.     #
  183.     # Set the inner scanning environment to the values assigned to it
  184.     # by l_Bscan.  Remember that l_SUBJ and l_POS are global.  They
  185.     # don't need to be passed as parameters from l_Bscan.  What
  186.     # l_Bscan() needs to pass on is the l_OuterEnvir record,
  187.     # containing the values of l_SUBJ and l_POS before l_Bscan() was
  188.     # called.  l_Escan receives this "outer environment" as its first
  189.     # argument, l_OuterEnvir.
  190.     #
  191.     l_InnerEnvir := l_ScanEnvir(l_SUBJ, l_POS)
  192.  
  193.     #
  194.     # Whatever expression produced e2 has passed us a result.  Now we
  195.     # restore l_SUBJ and l_POS, and send that result back to the outer
  196.     # environment.
  197.     #
  198.     l_SUBJ := l_OuterEnvir.subject
  199.     l_POS := l_OuterEnvir.pos
  200.     suspend e2
  201.  
  202.     #
  203.     # Okay, we've resumed to (attempt to) produce another result.  Re-
  204.     # store the inner scanning environment (the one we're using in the
  205.     # current scanning expression).  Remember?  It was saved in l_Inner-
  206.     # Envir just above.
  207.     #
  208.     l_SUBJ := l_InnerEnvir.subject
  209.     l_POS := l_InnerEnvir.pos
  210.  
  211.     #
  212.     # Fail so that the second argument (the one that produced e2) gets
  213.     # resumed.  If it fails to produce another result, then the first
  214.     # argument is resumed, which is l_Bscan().  If l_Bscan is resumed, it
  215.     # will restore the outer environment and fail, causing the entire
  216.     # scanning expression to fail.
  217.     #
  218.     fail
  219.  
  220. end
  221.  
  222.     
  223.  
  224. procedure l_move(i)
  225.  
  226.     /i & stop("l_move:  Null argument.")
  227.     if /l_POS | /l_SUBJ then
  228.     stop("l_move:  Call l_Bscan() first.")
  229.  
  230.     #
  231.     # Sets l_POS to l_POS+i; suspends that portion of l_SUBJ extending
  232.     # from the old l_POS to the new one.  Resets l_POS if resumed,
  233.     # just the way matching procedures are supposed to.  Fails if l_POS
  234.     # plus i is larger than l_SUBJ+1 or if l_POS+i is less than 1.
  235.     #
  236.     suspend l_SUBJ[.l_POS:l_POS <- (0 < (*l_SUBJ+1 >= l_POS+i))]
  237.  
  238. end
  239.  
  240.  
  241.  
  242. procedure l_tab(i)
  243.  
  244.     /i & stop("l_tab:  Null argument.")
  245.     if /l_POS | /l_SUBJ then
  246.     stop("l_tab:  Call l_Bscan() first.")
  247.  
  248.     if i <= 0
  249.     then suspend l_SUBJ[.l_POS:l_POS <- 0 < (*l_SUBJ+1 >= (*l_SUBJ+1)+i)]
  250.     else suspend l_SUBJ[.l_POS:l_POS <- 0 < (*l_SUBJ+1 >= i)]
  251.  
  252. end
  253.  
  254.  
  255.  
  256. procedure l_any(l1,l2,i,j)
  257.  
  258.     #
  259.     # Like any(c,s2,i,j) except that the string & cset arguments are
  260.     # replaced by list arguments.  l1 must be a list of one-element
  261.     # lists, while l2 can be any list (l_SUBJ by default).
  262.     #
  263.  
  264.     local sub_l, x
  265.  
  266.     /l1 & stop("l_any:  Null first argument!")
  267.     if type(l1) == "set" then l1 := sort(l1)
  268.  
  269.     /l2 := l_SUBJ
  270.     if \i then {
  271.     if i < 1 then
  272.         i := *l2 + (i+1)
  273.     }
  274.     else i := \l_POS | 1
  275.     if \j then {
  276.     if j < 1 then
  277.         j := *l2 + (j+1)
  278.     }
  279.     else j := *l_SUBJ+1
  280.  
  281.     (i+1) > j & i :=: j
  282.     every sub_l := !l1 do {
  283.     if not (type(sub_l) == "list", *sub_l = 1) then
  284.         stop("l_any:  Elements of l1 must be lists of length 1.")
  285.     # Let l_match check to see if i+1 is out of range.
  286.     if x := l_match(sub_l,l2,i,i+1) then
  287.         return x
  288.     }
  289.     
  290. end
  291.  
  292.  
  293.  
  294. procedure l_match(l1,l2,i,j)
  295.  
  296.     #
  297.     # Analogous to match(s1,s2,i,j), except that s1 and s2 are lists,
  298.     # and l_match returns the next position in l2 after that portion
  299.     # (if any) which is structurally identical to l1.  If a match is not
  300.     # found, l_match fails.
  301.     #
  302.  
  303.     if /l1
  304.     then stop("l_match:  Null first argument!")
  305.     if type(l1) ~== "list"
  306.     then stop("l_match:  Call me with a list as the first arg.")
  307.  
  308.     /l2 := l_SUBJ
  309.     if \i then {
  310.     if i < 1 then
  311.         i := *l2 + (i+1)
  312.     }
  313.     else i := \l_POS | 1
  314.     
  315.     if \j then {
  316.     if j < 1 then
  317.         j := *l2 + (j+1)
  318.     }
  319.     else j := *l_SUBJ+1
  320.  
  321.     i + *l1 > j & i :=: j
  322.     i + *l1 > j & fail
  323.     if l_comp(l1,l2[i+:*l1]) then
  324.     return i + *l1
  325.  
  326. end
  327.  
  328.     
  329.  
  330. procedure l_comp(l1,l2)
  331.  
  332.     #
  333.     # List comparison routine basically taken from Griswold & Griswold
  334.     # (1st ed.), p. 174.
  335.     #
  336.  
  337.     local i
  338.  
  339.     /l1 | /l2 & stop("l_comp:  Null argument!")
  340.     l1 === l2 & (return l2)
  341.  
  342.     if type(l1) == type(l2) == "list" then {
  343.     *l1 ~= *l2 & fail
  344.     every i := 1 to *l1
  345.     do l_comp(l1[i],l2[i]) | fail
  346.     return l2
  347.     }
  348.  
  349. end
  350.  
  351.  
  352.  
  353. procedure l_find(l1,l2,i,j)
  354.  
  355.     #
  356.     # Like the builtin find(s1,s2,i,j), but for lists.
  357.     #
  358.  
  359.     local x, old_l_POS
  360.  
  361.     /l1 & stop("l_find:  Null first argument!")
  362.  
  363.     /l2 := l_SUBJ
  364.     if \i then {
  365.     if i < 1 then
  366.         i := *l2 + (i+1)
  367.     }
  368.     else i := \l_POS | 1
  369.     if \j then {
  370.     if j < 1 then
  371.         j := *l2 + (j+1)
  372.     }
  373.     else j := *l_SUBJ+1
  374.  
  375.     #
  376.     # See l_upto() below for a discussion of why things have to be done
  377.     # in this manner.
  378.     #
  379.     old_l_POS := l_POS
  380.  
  381.     suspend l_Escan(l_Bscan(l2[i:j]), {
  382.     l_tab(1 to *l_SUBJ) & {
  383.         if l_match(l1) then
  384.         old_l_POS + (l_POS-1)
  385.     }
  386.     })
  387.     
  388. end
  389.  
  390.  
  391.  
  392. procedure l_upto(l1,l2,i,j)
  393.  
  394.     #
  395.     # See l_any() above.  This procedure just moves through l2, calling
  396.     # l_any() for each member of l2[i:j].
  397.     #
  398.  
  399.     local old_l_POS
  400.  
  401.     /l1 & stop("l_upto:  Null first argument!")
  402.     if type(l1) == "set" then l1 := sort(l1)
  403.  
  404.     /l2 := l_SUBJ
  405.     if \i then {
  406.     if i < 1 then
  407.         i := *l2 + (i+1)
  408.     }
  409.     else i := \l_POS | 1
  410.     if \j then {
  411.     if j < 1 then
  412.         j := *l2 + (j+1)
  413.     }
  414.     else j := *l_SUBJ+1
  415.  
  416.     #
  417.     # Save the old pos, then try arb()ing through the list to see if we
  418.     # can do an l_any(l1) at any position.
  419.     #
  420.     old_l_POS := l_POS
  421.  
  422.     suspend l_Escan(l_Bscan(l2[i:j]), {
  423.     l_tab(1 to *l_SUBJ) & {
  424.         if l_any(l1) then
  425.         old_l_POS + (l_POS-1)
  426.     }
  427.     })
  428.  
  429.     #
  430.     # Note that it WILL NOT WORK if you say:
  431.     #
  432.     # l_Escan(l_Bscan(l2[i:j]), {
  433.     #     l_tab(1 to *l_SUBJ) & {
  434.     #         if l_any(l1) then
  435.     #             suspend old_l_POS + (l_POS-1)
  436.     #     }
  437.     # })
  438.     #
  439.     # If we are to suspend a result, l_Escan must suspend that result.
  440.     # Otherwise scanning environments are not saved and/or restored
  441.     # properly.
  442.     #
  443.     
  444. end
  445.  
  446.  
  447.  
  448. procedure l_many(l1,l2,i,j)
  449.  
  450.     local x, old_l_POS
  451.  
  452.     /l1 & stop("l_many:  Null first argument!")
  453.     if type(l1) == "set" then l1 := sort(l1)
  454.  
  455.     /l2 := l_SUBJ
  456.     if \i then {
  457.     if i < 1 then
  458.         i := *l2 + (i+1)
  459.     }
  460.     else i := \l_POS | 1
  461.     if \j then {
  462.     if j < 1 then
  463.         j := *l2 + (j+1)
  464.     }
  465.     else j := *l_SUBJ+1
  466.  
  467.     #
  468.     # L_many(), like many(), is not a generator.  We can therefore
  469.     # save one final result in x, and then later return (rather than
  470.     # suspend) that result.
  471.     #
  472.     old_l_POS := l_POS
  473.     l_Escan(l_Bscan(l2[i:j]), {
  474.     while l_tab(l_any(l1))
  475.     x := old_l_POS + (l_POS-1)
  476.     })
  477.  
  478.     #
  479.     # Fails if there was no positional change (i.e. l_any() did not
  480.     # succeed even once).
  481.     #
  482.     return old_l_POS ~= x
  483.  
  484. end
  485.  
  486.  
  487.  
  488. procedure l_pos(i)
  489.  
  490.     local x
  491.  
  492.     if /l_POS | /l_SUBJ
  493.     then stop("l_move:  Call l_Bscan() first.")
  494.  
  495.     if i <= 0
  496.     then x := 0 < (*l_SUBJ+1 >= (*l_SUBJ+1)+i) | fail
  497.     else x := 0 < (*l_SUBJ+1 >= i) | fail
  498.  
  499.     if x = l_POS
  500.     then return x
  501.     else fail
  502.  
  503. end
  504.  
  505.  
  506.  
  507. procedure l_bal(l1,l2,l3,l,i,j)
  508.  
  509.     local l2_count, l3_count, x, position
  510.  
  511.     /l1 & stop("l_bal:  Null first argument!")
  512.     if type(l1) == "set" then l1 := sort(l1)  # convert to a list
  513.     if type(l2) == "set" then l1 := sort(l2)
  514.     if type(l3) == "set" then l1 := sort(l3)
  515.  
  516.     /l2 := l_SUBJ
  517.     if \i then {
  518.     if i < 1 then
  519.         i := *l2 + (i+1)
  520.     }
  521.     else i := \l_POS | 1
  522.     if \j then {
  523.     if j < 1 then
  524.         j := *l2 + (j+1)
  525.     }
  526.     else j := *l_SUBJ+1
  527.  
  528.     l2_count := l3_count := 0
  529.  
  530.     every x := i to j-1 do {
  531.  
  532.     if l_any(l2, l, x, x+1) then {
  533.         l2_count +:= 1
  534.     }
  535.     if l_any(l3, l, x, x+1) then {
  536.         l3_count +:= 1
  537.     }
  538.     if l2_count = l3_count then {
  539.         if l_any(l1,l,x,x+1)
  540.         then suspend x
  541.     }
  542.     }
  543.  
  544. end
  545.