home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OL.LZH / PROCS.LZH / PDAE.ICN < prev    next >
Text File  |  1991-07-13  |  4KB  |  158 lines
  1.  
  2. #
  3. #    Name:    pdae.icn
  4. #
  5. #    Title:    Programmer-defined argument evaluation
  6. #
  7. #    Author:    Ralph E. Griswold
  8. #
  9. #    Date:    January 1, 1990
  10. #
  11. ############################################################################
  12. #  
  13. #  These procedures use co-expressions to model the built-in argu-
  14. #  ment evaluation regime of Icon and also provide new ones.
  15. #  
  16. #       Allpar{e1,e2, ...}   parallel evaluation with last result
  17. #                            used for short sequences
  18. #  
  19. #       Extract{e1,e2, ...}  extract results of even-numbered argu-
  20. #                            ments according to odd-numbered values
  21. #  
  22. #       Lifo{e1,e2, ...}     models standard Icon ``lifo'' evalua-
  23. #                            tion
  24. #  
  25. #       Parallel{e1,e2, ...} parallel evaluation terminating on
  26. #                            shortest sequence
  27. #  
  28. #       Reverse{e1,e2, ...}  left-to-right reversal of lifo evalua-
  29. #                            tion
  30. #  
  31. #       Rotate{e1,e2, ...}   parallel evaluation with shorter
  32. #                            sequences re-evaluated
  33. #  
  34. #       Simple{e1,e2, ...}   simple evaluation with only success or
  35. #                            failure
  36. #
  37. #  In all cases, the first argument is "applied".
  38. #
  39. #  Comments:
  40. #
  41. #     Because of the handling of the scope of local identif-
  42. #  iers in co-expressions, expressions in programmer-defined argu-
  43. #  ment evaluation regimes cannot communicate through local identif-
  44. #  iers.  Some constructions, such as break and return, cannot be
  45. #  used in arguments to programmer-defined argument evaluation
  46. #  regimes.
  47. #  
  48. ############################################################################
  49. #
  50. #  Requires:  co-expressions
  51. #
  52. ############################################################################
  53.  
  54. procedure Allpar(a)
  55.    local i, x, done
  56.    x := list(*a)
  57.    done := list(*a,1)
  58.    every i := 1 to *a do x[i] := @a[i] | fail
  59.    repeat {
  60.       suspend x[1]!x[2:0]
  61.       every i := 1 to *a do
  62.          if done[i] = 1 then ((x[i] := @a[i]) | (done[i] := 0))
  63.       if not(!done = 1) then fail
  64.        }
  65. end
  66.  
  67. procedure Extract(a)
  68.    local i, j, n, x
  69.    x := list(*a/2)
  70.    repeat {
  71.       i := 1
  72.       while i < *a do {
  73.          n := @a[i] | fail
  74.          every 1 to n do
  75.             x[(i + 1)/2] := @a[i + 1] | fail
  76.          a[i + 1] := ^a[i + 1]
  77.          i +:= 2
  78.          }
  79.       suspend x[1]!x[2:0]
  80.       }
  81. end
  82.  
  83. procedure Lifo(a)
  84.    local i, x, ptr
  85.    x := list(*a)
  86.    ptr := 1
  87.    repeat {
  88.       repeat
  89.          if x[ptr] := @a[ptr]
  90.          then {
  91.             ptr +:= 1
  92.             (a[ptr] := ^a[ptr]) |
  93.             break
  94.             }
  95.          else if (ptr -:=  1) = 0
  96.               then fail
  97.       suspend x[1]!x[2:0]
  98.       ptr := *a
  99.       }
  100. end
  101.  
  102. procedure Parallel(a)
  103.    local i, x
  104.    x := list(*a)
  105.    repeat {
  106.       every i := 1 to *a do
  107.          x[i] := @a[i] | fail
  108.       suspend x[1]!x[2:0]
  109.       }
  110. end
  111.  
  112. procedure Reverse(a)
  113.    local i, x, ptr
  114.    x := list(*a)
  115.    ptr := *a
  116.    repeat {
  117.       repeat
  118.          if x[ptr] := @a[ptr]
  119.          then {
  120.             ptr -:= 1
  121.             (a[ptr] := ^a[ptr]) |
  122.             break
  123.             }
  124.          else if (ptr +:= 1) > *a
  125.               then fail
  126.       suspend x[1]!x[2:0]
  127.       ptr := 1
  128.       }
  129. end
  130.  
  131. procedure Rotate(a)
  132.    local i, x, done
  133.    x := list(*a)
  134.    done := list(*a,1)
  135.    every i := 1 to *a do x[i] := @a[i] | fail
  136.    repeat {
  137.       suspend x[1]!x[2:0]
  138.       every i := 1 to *a do
  139.          if not(x[i] := @a[i]) then {
  140.             done[i] := 0
  141.             if !done = 1 then {
  142.                a[i] := ^a[i]
  143.                x[i] := @a[i] | fail
  144.                }
  145.             else fail
  146.             }
  147.         }
  148. end
  149.  
  150. procedure Simple(a)
  151.    local i, x
  152.    x := list(*a)
  153.    every i := 1 to *a do
  154.       x[i] := @a[i] | fail
  155.    return x[1]!x[2:0]
  156. end
  157.  
  158.