BSD 4_3 development

[unix-history] / usr / contrib / icon / src / lib / pdae.icn

#       PDAE(2)
#
#       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