#	PDAE
#
#	Programmer-defined argument evaluation regimes
#
#	Ralph E. Griswold and Michael Novak
#
#	Last modified 5/12/83
#

procedure Allpar(a)
   local i, x, done
   x := list(*a)
   done := list(*a,1)
   every i := 1 to *a do x[i] := @a[i] | fail
   repeat {
      suspend Call(x)
      every i := 1 to *a do
         if done[i] = 1 then ((x[i] := @a[i]) | (done[i] := 0))
      if not(!done = 1) then fail
       }
end

procedure Call(a)
   suspend case *a of {
      1 : a[1]()
      2 : a[1](a[2])
      3 : a[1](a[2],a[3])
      4 : a[1](a[2],a[3],a[4])
      5 : a[1](a[2],a[3],a[4],a[5])
      6 : a[1](a[2],a[3],a[4],a[5],a[6])
      7 : a[1](a[2],a[3],a[4],a[5],a[6],a[7])
      8 : a[1](a[2],a[3],a[4],a[5],a[6],a[7],a[8])
      9 : a[1](a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9])
      10 : a[1](a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],a[10])
      default :  stop("Call : too many args.")
      }
end

procedure Extract(a)
   local i, j, n, x
   x := list(*a/2)
   repeat {
      i := 1
      while i < *a do {
         n := @a[i] | fail
         every 1 to n do
            x[(i + 1)/2] := @a[i + 1] | fail
         a[i + 1] := ^a[i + 1]
         i +:= 2
         }
      suspend Call(x)
      }
end

procedure Lifo(a)
   local i, x, ptr
   x := list(*a)
   ptr := 1
   repeat {
      repeat
         if x[ptr] := @a[ptr]
         then {
            ptr +:= 1
            (a[ptr] := ^a[ptr]) |
            break
            }
         else if (ptr -:=  1) = 0
              then fail
      suspend Call(x)
      ptr := *a
      }
end

procedure Parallel(a)
   local i, x
   x := list(*a)
   repeat {
      every i := 1 to *a do
         x[i] := @a[i] | fail
      suspend Call(x)
      }
end

procedure Reverse(a)
   local i, x, ptr
   x := list(*a)
   ptr := *a
   repeat {
      repeat
         if x[ptr] := @a[ptr]
         then {
            ptr -:= 1
            (a[ptr] := ^a[ptr]) |
            break
            }
         else if (ptr +:= 1) > *a
              then fail
      suspend Call(x)
      ptr := 1
      }
end

procedure Rotate(a)
   local i, x, done
   x := list(*a)
   done := list(*a,1)
   every i := 1 to *a do x[i] := @a[i] | fail
   repeat {
      suspend Call(x)
      every i := 1 to *a do
         if not(x[i] := @a[i]) then {
            done[i] := 0
            if !done = 1 then {
               a[i] := ^a[i]
               x[i] := @a[i] | fail
               }
            else fail
            }
        }
end

procedure Simple(a)
   local i, x
   x := list(*a)
   every i := 1 to *a do
      x[i] := @a[i] | fail
   return Call(x)
end