home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROCS.ZIP / PDAE.ICN < prev    next >
Encoding:
Text File  |  1992-09-28  |  4.0 KB  |  157 lines
  1. ###########################################################################
  2. #
  3. #    File:     pdae.icn
  4. #
  5. #    Subject:  Procedures for 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(L)
  55.    local i, L1, done
  56.    L1 := list(*L)
  57.    done := list(*L,1)
  58.    every i := 1 to *L do L1[i] := @L[i] | fail
  59.    repeat {
  60.       suspend L1[1] ! L1[2:0]
  61.       every i := 1 to *L do
  62.          if done[i] = 1 then ((L1[i] := @L[i]) | (done[i] := 0))
  63.       if not(!done = 1) then fail
  64.        }
  65. end
  66.  
  67. procedure ExtrLct(L)
  68.    local i, j, n, L1
  69.    L1 := list(*L/2)
  70.    repeat {
  71.       i := 1
  72.       while i < *L do {
  73.          n := @L[i] | fail
  74.          every 1 to n do
  75.             L1[(i + 1)/2] := @L[i + 1] | fail
  76.          L[i + 1] := ^L[i + 1]
  77.          i +:= 2
  78.          }
  79.       suspend L1[1] ! L1[2:0]
  80.       }
  81. end
  82.  
  83. procedure Lifo(L)
  84.    local i, L1, ptr
  85.    L1 := list(*L)
  86.    ptr := 1
  87.    repeat {
  88.       repeat
  89.          if L1[ptr] := @L[ptr]
  90.          then {
  91.             ptr +:= 1
  92.             (L[ptr] := ^L[ptr]) | break
  93.             }
  94.          else if (ptr -:=  1) = 0
  95.               then fail
  96.       suspend L1[1] ! L1[2:0]
  97.       ptr := *L
  98.       }
  99. end
  100.  
  101. procedure Parallel(L)
  102.    local i, L1
  103.    L1 := list(*L)
  104.    repeat {
  105.       every i := 1 to *L do
  106.          L1[i] := @L[i] | fail
  107.       suspend L1[1] ! L1[2:0]
  108.       }
  109. end
  110.  
  111. procedure Reverse(L)
  112.    local i, L1, ptr
  113.    L1 := list(*L)
  114.    ptr := *L
  115.    repeat {
  116.       repeat
  117.          if L1[ptr] := @L[ptr]
  118.          then {
  119.             ptr -:= 1
  120.             (L[ptr] := ^L[ptr]) |
  121.             break
  122.             }
  123.          else if (ptr +:= 1) > *L
  124.               then fail
  125.       suspend L1[1] ! L1[2:0]
  126.       ptr := 1
  127.       }
  128. end
  129.  
  130. procedure Rotate(L)
  131.    local i, L1, done
  132.    L1 := list(*L)
  133.    done := list(*L,1)
  134.    every i := 1 to *L do L1[i] := @L[i] | fail
  135.    repeat {
  136.       suspend L1[1]!L1[2:0]
  137.       every i := 1 to *L do
  138.          if not(L1[i] := @L[i]) then {
  139.             done[i] := 0
  140.             if !done = 1 then {
  141.                L[i] := ^L[i]
  142.                L1[i] := @L[i] | fail
  143.                }
  144.             else fail
  145.             }
  146.         }
  147. end
  148.  
  149. procedure Simple(L)
  150.    local i, L1
  151.    L1 := list(*L)
  152.    every i := 1 to *L do
  153.       L1[i] := @L[i] | fail
  154.    return L1[1] ! L1[2:0]
  155. end
  156.  
  157.