home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROCS.ZIP / PDCO.ICN < prev    next >
Encoding:
Text File  |  1992-09-28  |  3.8 KB  |  164 lines
  1. ############################################################################
  2. #
  3. #    File:     pdco.icn
  4. #
  5. #    Subject:  Procedures for programmer-defined control operations
  6. #
  7. #    Author:   Ralph E. Griswold and Robert J. Alexander
  8. #
  9. #    Date:     September 18, 1990
  10. #
  11. ###########################################################################
  12. #  
  13. #  These procedures use co-expressions to used to model the built-in
  14. #  control structures of Icon and also provide new ones.
  15. #  
  16. #       Alt{e1,e2}         models e1 | e2
  17. #  
  18. #       Colseq{e1,e2, ...} produces results of e1, e2, ... alter-
  19. #                          nately
  20. #  
  21. #       Comseq{e1,e2}      compares result sequences of e1 and e2
  22. #  
  23. #       Cond{e1,e2, ...}   models the generalized Lisp conditional
  24. #  
  25. #       Every{e1,e2}       models every e1 do e2
  26. #  
  27. #       Galt{e1,e2, ...}   models generalized alternation: e1 | e2 |
  28. #                          ...
  29. #
  30. #    Gconj{e1,e2,...}  models generalized conjunction: e1 & e2 & ...
  31. #
  32. #    The programmer-defined control operation above shows an interesting
  33. #    technique for modeling conjunction via recursive generative
  34. #    procedures.
  35. #  
  36. #       Lcond{e1,e2, ...}  models the Lisp conditional
  37. #  
  38. #       Limit{e1,e2}       models e1 \ e2
  39. #  
  40. #       Ranseq{e1,e2, ...} produces results of e1, e2, ... at random
  41. #  
  42. #       Repalt{e}          models |e
  43. #  
  44. #       Resume{e1,e2,e3}   models every e1 \ e2 do e3
  45. #  
  46. #       Select{e1,e2}      produces results from e1 by position
  47. #                          according to e2
  48. #  
  49. #  Comments:
  50. #
  51. #     Because of the handling of the scope of local identif-
  52. #  iers in co-expressions, expressions in programmer-defined control
  53. #  operations cannot communicate through local identifiers.  Some
  54. #  constructions, such as break and return, cannot be used in argu-
  55. #  ments to programmer-defined control operations.
  56. #  
  57. ############################################################################
  58. #
  59. #  Requires:  co-expressions
  60. #
  61. ############################################################################
  62.  
  63. procedure Alt(L)
  64.    local x
  65.    while x := @L[1] do suspend x
  66.    while x := @L[2] do suspend x
  67. end
  68.  
  69. procedure Colseq(L)
  70.    suspend |@!L
  71. end
  72.  
  73. procedure Comseq(L)
  74.    local x1, x2
  75.    while x1 := @L[1] do
  76.       (x1 === @L[2]) | fail
  77.    if @L[2] then fail else return *L[1]
  78. end
  79.  
  80. procedure Cond(L)
  81.    local i, x
  82.    every i := 1 to *L do
  83.       if x := @L[i] then {
  84.          suspend x
  85.          suspend |@L[i]
  86.          fail
  87.          }
  88. end
  89.  
  90. procedure Every(L)
  91.    while @L[1] do @^L[2]
  92. end
  93.  
  94. procedure Galt(L)
  95.    local C
  96.    every C := !L do suspend |@C
  97. end
  98.  
  99. procedure Gconj(L)
  100.    suspend Gconj_(L,1)
  101. end
  102.  
  103. procedure Gconj_(L,i,v)
  104.    local e
  105.    if e := L[i] then {
  106.       suspend v:= |@e & Gconj_(L,i + 1,v)
  107.       L[i] := ^e
  108.       }
  109.    else suspend v
  110. end
  111.  
  112. procedure Lcond(L)
  113.    local i
  114.    every i := 1 to *L by 2 do
  115.       if @L[i] then {
  116.          suspend |@L[i + 1]
  117.          fail
  118.          }
  119. end
  120.  
  121. procedure Limit(L)
  122.    local i, x
  123.    while i := @L[2] do {
  124.       every 1 to i do
  125.          if x := @L[1] then suspend x
  126.          else break
  127.       L[1] := ^L[1]
  128.       }
  129. end
  130.  
  131. procedure Ranseq(L)
  132.    local x
  133.    while x := @?L do suspend x
  134. end
  135.  
  136. procedure Repalt(L)
  137.    local x
  138.    repeat {
  139.       while x := @L[1] do suspend x
  140.       if *L[1] = 0 then fail
  141.       else L[1] := ^L[1]
  142.       }
  143. end
  144.  
  145. procedure Resume(L)
  146.    local i
  147.    while i := @L[2] do {
  148.       L[1] := ^L[1]
  149.       every 1 to i do if @L[1] then @^L[3] else break
  150.       }
  151. end
  152.  
  153. procedure Select(L)
  154.    local i, j, x
  155.    j := 0
  156.    while i := @L[2] do {
  157.       while j < i do
  158.          if x := @L[1] then j +:= 1
  159.          else fail
  160.       if i = j then suspend x
  161.       else stop("selection sequence error")
  162.       }
  163. end
  164.