Initial upstream version 9.4.3upstream/9.4.3

1 files changed, 1197 insertions, 0 deletions

diff --git a/ipl/procs/pdco.icn b/ipl/procs/pdco.icn
new file mode 100644
index 0000000..cd239c1
--- /dev/null
+++ b/ipl/procs/pdco.icn
@@ -0,0 +1,1197 @@
+############################################################################
+#
+#	File:     pdco.icn
+#
+#	Subject:  Procedures for programmer-defined control operations
+#
+#	Authors:  Ralph E. Griswold and Robert J. Alexander
+#
+#	Date:     March 4, 2003
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#  These procedures use co-expressions to used to model the built-in
+#  control structures of Icon and also provide new ones.
+#
+#   AddTabbyPDCO{e, i}	adds tabby to treadling sequence
+#  
+#   AllparAER{e1,e2, ...}
+#			parallel evaluation with last result
+#			used for short sequences
+#
+#   AltPDCO{e1,e2}	models e1 | e2
+#
+#   BinopPDCO{op,e1,e2} produces the result of applying op to e1 and e2
+#
+#   CFapproxPDCO{e}	produce sequence of approximations for the
+#			continued-fraction sequence e
+#  
+#   ComparePDCO{e1,e2}	compares result sequences of e1 and e2
+#  
+#   ComplintPDCO{e}	produces the integers not in e
+#
+#   CondPDCO{e1,e2, ...}
+#			models the generalized Lisp conditional
+#
+#   CumsumPDCO{e}	generates the cumulative sum of the terms of e
+#  
+#   CycleparAER{e1,e2, ...}
+#			parallel evaluation with shorter sequences
+#			re-evaluated
+#
+#   DecimatePDCO{e1, e2}
+#			"decimate" e1 by deleting e2-numbered terms
+#			(e2 is assumed to be an increasing sequence).
+#
+#   DecimationPDCO{e}	produce a decimation sequence from e1 by
+#			deleting even-valued terms and replacing
+#			odd-valued terms by their position.
+#
+#   DecollatePDCO{e, i}	decollate e according to parity of i
+#
+#   DeltaPDCO{e1}	produces the difference of the values in e1
+#
+#   ElevatePDCO{e1, m, n}
+#			elevate e1 mod n to n values
+#  
+#   EveryPDCO{e1,e2}	models every e1 do e2
+#
+#   ExtendSeqPDCO{e1,i}	extends e1 to i results
+#  
+#   ExtractAER{e1,e2, ...}
+#			extract results of even-numbered arguments
+#			according to odd-numbered values
+#
+#   FifoAER{e1,e2, ...}	reversal of lifo evaluation
+#
+#   FriendlyPDCO{m, k, e3}
+#			friendly sequence starting at k shaft mod m
+#
+#   GaltPDCO{e1,e2, ...}
+#			produces the results of concatenating the
+#   		   	sequences for e1, e2, ...
+#
+#   GconjPDCO{e1,e2,...}
+#			models generalized conjunction: e1 & e2 & ...
+#
+#   The programmer-defined control operation above shows an interesting
+#   technique for modeling conjunction via recursive generative
+#   procedures.
+#
+#   HistoPDCO{e,i}	generates histogram for e limited to i terms;
+#			default 100.
+#
+#   IncreasingPDCO{e}	filters out non-increasing values in integer
+#			sequence
+#
+#   IndexPDCO{e1,e2}	produce e2-th terms from e1
+#
+#   InterPDCO{e1,e2, ...}
+#			produces results of e1, e2, ... alternately
+#  
+#   LcondPDCO{e1,e2, ...}
+#			models the Lisp conditional
+#
+#   LengthPDCO{e}	returns the length of e
+#  
+#   LifoAER{e1,e2, ...}	models standard Icon "lifo" evaluation
+#
+#   LimitPDCO{e1,e2}	models e1 \ e2
+#
+#   ListPDCO{e,i}	produces a list of the first i results from e
+#
+#   LowerTrimPDCO{e}	lower trim
+#
+#   MapPDCO{e1,e2}	maps values of e1 in the order they first appear
+#			to values of e2 (as needed)
+#
+#   OddEven{e}		forces odd/even sequence
+#
+#   PalinPDCO{e}	x produces results of concatenating the
+#			sequences for e and then its reverse.
+#
+#   ParallelPDCO{e1,e2, ...}
+#			synonym for InterPDCO{e1, e2, ...}
+#  
+#   ParallelAER{e1,e2, ...}
+#			parallel evaluation terminating on
+#			shortest sequence
+#
+#   PatternPalinPDCO{e, i}
+#			produces pattern palindrome.  If i is given,
+#			e is truncated to length i.
+#
+#   PeriodPDCO{e, i}	generates the periodic part of e; i values are
+#			used to find the period
+#
+#   PermutePDCO{e1,e2}	permutes each n-subsequence of e1 by the
+#   		  	n positional values in lists from e2.  If a list does
+#			not consist of all the integers in the range 1 to
+#   		  	n, "interesting" things happen (see the use
+#   		   	of map() for transpositions).
+#
+#   PivotPDCO{e, m}	produces pivot points from e % m; m default 100
+#
+#   PosDiffPDCO{e1,e2}	produces positions at which e1 and e2 differ
+#
+#   PositionsPDCO{e, i}	generates the positions at which i occurs in e.
+#  
+#   RandomPDCO{e1,e2, ...}
+#			produces results of e1, e2, ... at random
+#
+#   ReducePDCO{op, x, e}
+#			"reduces" the sequence e by starting with the value x
+#			and repetitively applying op to the current
+#		  	value and values from e.
+#
+#   RemoveDuplPDCO{e}	removes duplicate adjacent values.
+#  
+#   RepaltPDCO{e}	models |e
+#
+#   RepeatPDCO{e1, e2}	repeats the sequence for e1 e2 times
+#
+#   ReplPDCO{e1,e2}	replicates each value in e1 by the corresponding
+#   		   	integer value in e2.
+#  
+#   ResumePDCO{e1,e2,e3}
+#			models every e1 \ e2 do e3
+#
+#   ReversePDCO{e, i}  	produces the results of e in reverse order. If i
+#			is given, e is truncated to i values.
+#  
+#   RotatePDCO(e, i)	rotates the sequence for e left by i; negative
+#   		   	i rotates to the right
+#
+#   SelfreplPDCO{e1,i}	produces e1 * i copies of e1
+#
+#   SeqlistPDCO{e1, i}	produce list with first i values of e1; i
+#			defaults to all values
+#  
+#   SimpleAER{e1,e2, ...}
+#			simple evaluation with only success or
+#			failure
+#
+#   SkipPDCO{e1,e2}	generate e1 skipping each e2 terms
+#
+#   SmodPDCO{e1,e2}	reduce terms in e1 (shaft) modulus e2
+#
+#   SpanPDCO{e,m}	fill in between consecutive (integer) values in
+#			e % m; m default 100
+#
+#   SumlimitPDCO{e, i, j}
+#			produces values of e until their sum exceeds
+#			i.  Values less than j are discarded.
+#
+#   TrinopPDCO{op,e2,e2,e3}
+#			produces the result of applying op to e1, e2, and e3
+#
+#   UndulantPDCO{e}	produces the undulant for e.
+#
+#   UniquePDCO{e}	produces the unique results of e in the order
+#			they first appear
+#
+#   UnopPDCO{e1,e2}	produces the result of applying e1 to e2
+#
+#   UpperTrimPDCO{e}	upper trim
+#
+#   ValrptPDCO{e1,e2}	synonym for ReplPDCO
+#
+#   WobblePDCO{e}	produces e(1), e(2), e(1), e(2), e(3), e(2), ...
+#  
+#   Comments:
+#
+#   Because of the handling of the scope of local identifiers in
+#   co-expressions, expressions in programmer-defined control
+#   operations cannot communicate through local identifiers.  Some
+#   constructions, such as break and return, cannot be used in argu-
+#   ments to programmer-defined control operations.
+#  
+############################################################################
+#
+#  Requires:  co-expressions
+#
+############################################################################
+#
+#  Links:  lists, periodic, rational
+#
+############################################################################
+
+link lists
+link periodic
+link rational
+
+procedure AddTabbyPDCO(L)	#: PDCO to add tabby to treadling
+   local i
+
+   i := @L[2] | 4		# number of regular treadles
+
+   suspend InterPDCO([L[1], create |((i + 1) | (i + 2))])
+
+end
+
+procedure AllparAER(L)		#: PDAE for parallel evaluation with repeats
+   local i, L1, done
+
+   L1 := list(*L)
+
+   done := list(*L,1)
+
+   every i := 1 to *L do L1[i] := @L[i] | fail
+
+   repeat {
+      suspend L1[1] ! L1[2:0]
+      every i := 1 to *L do
+         if done[i] = 1 then ((L1[i] := @L[i]) | (done[i] := 0))
+      if not(!done = 1) then fail
+      }
+
+end
+
+procedure AltPDCO(L)		#: PDCO to model alternation
+
+   suspend |@L[1]
+   suspend |@L[2]
+
+end
+
+procedure BinopPDCO(L)		#: PDCO to apply binary operation to sequences
+   local op, x, y
+
+   repeat {
+      op := @L[1]
+      op := proc(op, 2) | fail
+      (x := @L[2] & y := @L[3]) | fail
+      suspend op(x, y)
+      }
+
+end
+
+procedure CFapproxPDCO(L)	#: PDCO for continued-fraction approximations
+  local prev_n, prev_m, n, m, t
+
+  prev_n := [1]
+  prev_m := [0, 1]
+
+  put(prev_n, (@L[1]).denom) | fail
+
+  while t := @L[1] do {
+     n := t.denom * get(prev_n) + t.numer * prev_n[1]
+     m := t.denom * get(prev_m) + t.numer * prev_m[1]
+     suspend rational(n, m, 1)
+     put(prev_n, n)
+     put(prev_m, m)
+     if t.denom ~= 0 then {		# renormalize
+        every !prev_n /:= t.denom
+        every !prev_m /:= t.denom
+        }
+     }
+
+end
+
+procedure ComparePDCO(L)	#: PDCO to compare sequences
+   local x1, x2
+
+   while x1 := @L[1] do
+      (x1 === @L[2]) | fail
+   if @L[2] then fail else return
+
+end
+
+procedure ComplintPDCO(L)	#: PDCO to generate integers not in sequence
+   local i, j			# EXPECTS MONOTONE NON-DECREASING SEQUENCE
+
+   j := 0
+
+   while i := @L[1] do {
+      i := integer(i) | stop("*** invalid value in sequence to Compl{}")
+      suspend j to i - 1
+      j := i + 1
+      }
+
+   suspend seq(j)
+
+end
+
+procedure CondPDCO(L)		#: PDCO for generalized Lisp conditional
+   local i, x
+
+   every i := 1 to *L do
+      if x := @L[i] then {
+         suspend x
+         suspend |@L[i]
+         fail
+         }
+
+end
+
+procedure CumsumPDCO(L)		#: PDCO to produce cumulative sum
+   local i
+
+   i := 0
+
+   while i +:= @L[1] do
+      suspend i
+
+end
+
+procedure CycleparAER(L)	#: PDAE for parallel evaluation with cycling
+   local i, L1, done
+
+   L1 := list(*L)
+
+   done := list(*L,1)
+
+   every i := 1 to *L do L1[i] := @L[i] | fail
+
+   repeat {
+      suspend L1[1]!L1[2:0]
+      every i := 1 to *L do {
+         if not(L1[i] := @L[i]) then {
+            done[i] := 0
+            if !done = 1 then {
+               L[i] := ^L[i]
+               L1[i] := @L[i] | fail
+               }
+            else fail
+            }
+         }
+      }
+end
+
+procedure DecimatePDCO(L)	#: PDCO to decimate sequence
+   local i, j, count
+
+   count := 0
+
+   while j := @L[2] do {
+      while i := @L[1] | fail do {
+         count +:= 1
+         if count = j then break next
+         else suspend i
+         }
+      }
+
+end
+
+procedure DecimationPDCO(L)	#: PDCO to create decimation sequence
+   local i, count
+
+   count := 0
+
+   while i := @L[1] do {
+      count +:= 1
+      if i % 2 = 1 then suspend count
+      }
+
+end
+procedure DecollatePDCO(L)	#: PDCO to decollate sequence
+   local i, j, x
+
+   i := @L[2] | 1
+
+   i %:= 2
+ 
+   j := 0
+
+   while x := @L[1] do {
+      j +:= 1
+      if j % 2 = i then suspend x
+      }
+
+end
+
+procedure DeltaPDCO(L)		#: PDCO to generate difference sequence 
+   local i, j
+
+   i := @L[1] | fail
+
+   while j := @L[1] do {
+      suspend j - i
+      i := j
+      }
+
+end
+
+procedure ElevatePDCO(L)	#: PDCO to elevate sequence
+   local n, m, shafts, i, j, k
+
+   m := @L[2] | fail
+   n := @L[3] | fail
+
+   shafts := list(m)
+
+   every !shafts := []
+
+   every i := 1 to m do
+      every put(shafts[i], i to n by m)
+
+   while j := @L[1] do {
+      i := j % m + 1
+      k := get(shafts[i])
+      suspend k
+      put(shafts[i], k)
+      }
+
+end
+
+procedure EveryPDCO(L)		#: PDCO to model iteration
+
+   while @L[1] do @^L[2]
+
+end
+
+procedure ExtendSeqPDCO(L)	#: PDCO to extend sequence
+   local count
+
+   count := integer(@L[2]) | fail
+   if count < 1 then fail
+
+   repeat {
+      suspend |@L[1] do {
+         count -:= 1
+         if count = 0 then fail
+         }
+      if *L[1] == 0 then fail
+      L[1] := ^L[1]
+      }
+
+end
+
+procedure ExtractAER(L)		#: PDAE to extract values
+   local i, j, n, L1
+
+   L1 := list(*L/2)
+
+   repeat {
+      i := 1
+      while i < *L do {
+         n := @L[i] | fail
+         every 1 to n do
+            L1[(i + 1)/2] := @L[i + 1] | fail
+         L[i + 1] := ^L[i + 1]
+         i +:= 2
+         }
+      suspend L1[1] ! L1[2:0]
+      } 
+
+end
+
+procedure FifoAER(L)		#: PDAE for reversal of lifo evaluation
+   local i, L1, j
+
+   L1 := list(*L)
+
+   j := *L
+
+   repeat {
+      repeat {
+         if L1[j] := @L[j]
+         then {
+            j -:= 1
+            (L[j] := ^L[j]) | break
+            }
+         else if (j +:= 1) > *L then fail
+         }
+      suspend L1[1] ! L1[2:0]
+      j := 1
+      }
+
+end
+
+procedure FriendlyPDCO(L)	# PDCO for friendly sequences
+   local mod, state, value
+
+   mod := @L[1] | fail
+   state := @L[2]
+   if /state then state := ?mod
+
+   repeat {
+      suspend state
+      value := @L[3] | fail
+      if value % 2 = 0 then state +:= 1
+      else state -:= 1
+      state := residue(state, mod, 1)
+      }
+
+end
+
+procedure GaltPDCO(L)		#: PDCO to concatenate sequences
+   local C
+
+   every C := !L do
+      suspend |@C
+
+end
+
+procedure GconjPDCO(L)		#: PDCO for generalized conjunction
+
+   suspend Gconj_(L,1)
+
+end
+
+procedure Gconj_(L,i,v)
+
+   local e
+   if e := L[i] then {
+      suspend v:= |@e & Gconj_(L,i + 1,v)
+      L[i] := ^e
+      }
+   else suspend v
+
+end
+
+procedure HistoPDCO(L)		#: histogram
+   local limit, results, seq
+
+   limit := @L[2] | 100
+
+   seq := []
+
+   while put(seq, @L[1])
+
+   results := list(max ! seq, 0)
+
+   every results[!seq] +:= 1
+
+   suspend !results
+
+end
+
+
+procedure IncreasingPDCO(L)	#: PDCO to filter out non-increasing values
+   local last, current
+
+   last := @L[1] | fail
+
+   suspend last
+
+   while current := @L[1] do {
+      if current <= last then next
+      else {
+         suspend current
+         last := current
+         }
+      }
+
+end
+
+procedure IndexPDCO(L)		#: PDCO to select terms by position
+   local i, j, x
+
+   j := @L[2] | fail
+
+   every i := seq() do {	# position
+      x := @L[1] | fail
+      if j = i then {
+         suspend x
+         repeat {
+            j := @L[2] | fail
+            if j > i then break
+            }
+         }
+      }
+
+end
+
+procedure InterPDCO(L)		#: PDCO to interleave sequences
+
+   suspend |@!L
+
+end
+
+procedure LcondPDCO(L)		#: PDCO for Lisp conditional
+   local i
+
+   every i := 1 to *L by 2 do
+      if @L[i] then {
+         suspend |@L[i + 1]
+         fail
+         }
+
+end
+
+procedure LengthPDCO(L)		#: PDCO to produce length of sequence
+   local i
+
+   i := 0
+
+   while @L[1] do i +:= 1
+
+   return i
+
+end
+
+procedure LifoAER(L)		#: PDAE for standard lifo evaluation
+   local i, L1, j
+
+   L1 := list(*L)
+
+   j := 1
+
+   repeat {
+      repeat
+         if L1[j] := @L[j]
+         then {
+            j +:= 1
+            (L[j] := ^L[j]) | break
+            }
+         else if (j -:=  1) = 0
+            then fail
+      suspend L1[1] ! L1[2:0]
+      j := *L
+      }
+
+end
+
+procedure LimitPDCO(L)		#: PDCO to model limitation
+   local i, x
+
+   while i := @L[2] do {
+      every 1 to i do
+         if x := @L[1] then suspend x
+         else break
+      L[1] := ^L[1]
+      }
+
+end
+
+procedure ListPDCO(L)		#: list from sequence
+   local limit, result
+
+   limit := @L[2] | 100
+
+   result := []
+
+   every put(result, |@L[1]) \ limit
+
+   return result
+
+end
+
+procedure LowerTrimPDCO(L)	#: lower trimming
+   local i
+
+   while i := @L[1] do {
+      i -:= 1
+      if i ~= 0 then suspend i
+      }
+
+end
+
+procedure MapPDCO(L)		#: PDCO to map values
+   local maptbl, x
+
+   maptbl := table()
+
+   while x := @L[1] do {
+      /maptbl[x] := (@L[2] | fail)
+      suspend maptbl[x]
+      }
+
+end
+
+procedure OddEvenPDCO(L)	#: PDCO to force odd/even sequence
+   local val, val_old
+
+   while val := @L[1] do {
+      if val % 2 = \val_old % 2 then
+         suspend val_old + 1
+      suspend val
+      val_old := val
+      }
+
+end
+
+procedure PalinPDCO(L)		#: PDCO to produce palindromic sequence
+   local tail, x
+
+   tail := []
+
+   while x := @L[1] do {
+      suspend x
+      push(tail, x)
+      } 
+
+   every suspend !tail
+
+end
+
+procedure ParallelPDCO(L)	#: synonym for Inter
+
+   ParallelPDCO := InterPDCO		# redefine for next use
+
+   suspend InterPDCO(L)
+
+end
+
+procedure ParallelAER(L)	#: PDAE for parallel evaluation
+   local i, L1
+
+   L1 := list(*L)
+
+   repeat {
+      every i := 1 to *L do
+         L1[i] := @L[i] | fail
+      suspend L1[1] ! L1[2:0]
+      }
+
+end
+
+procedure PatternPalinPDCO(L)	#: PDCO to produce pattern palindrome
+   local tail, x, limit
+
+   tail := []
+
+   limit := @L[2] | (2 ^ 15)	# good enough
+
+   every 1 to limit do {
+      x := @L[1] | break
+      suspend x
+      push(tail, x)
+      } 
+
+   get(tail)
+
+   pull(tail)
+
+   every suspend !tail
+
+end
+
+procedure PeriodPDCO(L)		#: PDCO for periodic part of sequence
+   local limit, result
+
+   limit := @L[2] | 300
+
+   result := []
+
+   every put(result, |@L[1]) \ limit
+
+   result := repeater(result)
+
+   suspend !result[2]
+
+end
+
+procedure PermutePDCO(L)	#: PDCO for permutations
+   local temp1, temp2, chunk, i, x
+
+   repeat {
+      temp1 := @L[2] | fail
+      temp2 := []
+      every put(temp2, i := 1 to *temp1)
+      chunk := []
+      every 1 to i do
+         put(chunk, @L[1]) | fail
+      suspend !lmap(temp1, temp2, chunk)
+      }
+
+end
+
+procedure PivotPDCO(L)		#: PDCO to generate pivot points
+   local current, direction, m, new
+
+   m := @L[2]
+   /m := 100
+   direction := "+"
+
+   current := @L[1] % m | fail
+
+   suspend current
+
+   repeat {
+      new := @L[1] % m | break
+      if new = current then next
+      case direction of {
+         "+":  {
+            if new > current then {
+               current := new
+               next
+               }
+            else {
+               suspend current
+               current := new
+               direction := "-"
+               }
+            }
+         "-":  {
+            if new < current then {
+               current := new
+               next
+               }
+            else {
+               suspend current
+               current := new
+               direction := "+"
+               }
+            }
+         }
+
+      }
+
+   return current
+
+end
+
+procedure PositionsPDCO(L)	# positions in e of i
+   local i, count, j
+
+   i := integer(@L[2]) | fail
+
+   count := 0
+
+   while j := @L[1] do {
+      count +:= 1
+      if j = i then suspend count
+      }
+
+end
+
+procedure PosDiffPDCO(L)	# PDCO to generate positions of difference
+   local i, x, y
+
+   i := 0
+
+   while x := @L[1] & y := @L[2] do {
+      i +:= 1
+      if x ~=== y then suspend i
+      }
+
+end
+
+procedure RandomPDCO(L)		#: PDCO to generate from sequences at random
+   local x
+
+   while x := @?L do suspend x
+
+end
+
+procedure RepaltPDCO(L)		#: PDCO to model repeated alternation
+   local x
+
+   repeat {
+      suspend |@L[1]
+      if *L[1] == 0 then fail
+      L[1] := ^L[1]
+      }
+
+end
+
+procedure ReducePDCO(L)		#: PDCO to reduce sequence using binary operation
+   local op, x
+
+   op := proc(@L[1], 2) | stop("*** invalid operation for Reduce{}")
+   x := @L[2] | fail
+
+   while x := op(x, @L[3])
+
+   return x
+
+end
+
+procedure RepeatPDCO(L)		#: PDCO to repeat sequence
+   local i, x
+
+   while i := @L[2] do {
+      if not(i := integer(i)) then stop("*** invalid repetition in Repeat{}")
+      every 1 to i do {
+         suspend |@L[1]
+         L[1] := ^L[1]
+         }
+      }
+
+end
+
+procedure RemoveDuplPDCO(L)	#: PDCO for remove duplicate values in a sequence
+   local old, new
+
+   old := @L[1] | fail
+   suspend old
+
+   repeat {
+      new := @L[1] | fail
+      if new === old then next
+      else {
+         suspend new
+         old := new
+         }
+      }
+
+end
+
+procedure ReplPDCO(L)		#: PDCO to replicate values in a sequence
+   local x, i
+
+   i := 1		# default
+
+   while x := @L[1] do {
+      i := @L[2]
+      suspend (1 to i) & x
+      }
+
+end
+
+procedure ResumePDCO(L)		#: PDCO to model limited iteration
+   local i
+
+   while i := @L[2] do {
+      L[1] := ^L[1]
+      every 1 to i do if @L[1] then @^L[3] else break
+      }
+
+end
+
+procedure ReversePDCO(L)	#: PDCO to reverse sequence
+   local result, limit
+
+   result := []
+
+   limit := @L[2]
+
+   /limit := 2 ^ 15		# enough
+
+   every 1 to limit do
+       push(result, @L[1]) | break
+
+   suspend !result
+
+end
+
+procedure RotatePDCO(L)		#: PDCO to rotate sequence
+   local result, i, x
+
+   i := integer(@L[2]) | stop("*** invalid specification in Rotate{}")
+
+   result := []
+
+   if i <= 0 then {		# if not to right, works for infinite sequence
+      every 1 to -i do
+         put(result, @L[1]) | break
+      while x := @L[1] do
+         suspend x
+      suspend !result
+      }
+
+   else {
+      while put(result, @L[1])
+      suspend !lrotate(result, i)
+      }
+
+end
+
+procedure SelfreplPDCO(L)	#: PDCO to produce multiple of values in sequence
+   local i, j
+
+   j := @L[2] | 1
+   j := integer(j) | stop("*** invalid second argument to Selfrepl{}")
+
+   while i := @L[1] do {
+      i := integer(i) | stop("*** invalid value in Selfrepl{}")
+      suspend (1 to i * j) & i
+      }
+
+end
+
+procedure SeqlistPDCO(L)	#: PDCO to return list of values
+   local result, limit
+
+   result := []
+
+   limit := @L[2] | 2 ^ 15	# crude ...
+
+   every 1 to limit do
+      put(result, @L[1]) | break
+
+   return result
+
+end
+
+procedure SimpleAER(L)		#: PDAE for simple evaluation
+   local i, L1
+
+   L1 := list(*L)
+
+   every i := 1 to *L do
+      L1[i] := @L[i] | fail
+
+   return L1[1] ! L1[2:0]
+
+end
+
+procedure SkipPDCO(L)		#: PDCO to skip terms
+   local gap
+
+   suspend @L[1]
+
+   repeat {
+      gap := @L[2] | fail
+      every 1 to gap do
+         @L[1] | fail
+      suspend @L[1]
+      }
+
+end
+
+procedure SmodPDCO(L)		#: generalized modular reduction
+   local i, m
+
+   while i := @L[1] do {
+      m := @L[2] | fail
+      suspend residue(i, m, 1)
+      }
+
+end
+
+procedure SpanPDCO(L)		#: fill in gaps in integer sequences
+   local i, j, m
+
+   j := @L[1] | fail
+
+   m := @L[2]
+   /m := 100
+
+   while i := residue(@L[1], m, 1) do {
+      if i > j then suspend j to i - 1
+      else if i < j then suspend j to i + 1 by -1
+      j := i
+      } 
+
+   suspend j
+
+end
+
+procedure SumlimitPDCO(L) 	#: PDCO to sum sequence to a limit
+   local sum, min, limit, i
+
+   limit := integer(@L[2]) | 2 ^ 15
+   min := integer(@L[3]) | 0
+   sum := 0
+
+   while i := @L[1] do {
+      if i < min then next
+      if (sum + i) > limit then fail
+      sum +:= i
+      suspend i
+      }
+
+end
+
+procedure TrinopPDCO(L)		#: PDCO to apply trinary operator to sequences
+   local op, x, y, z
+
+   repeat {
+      op := proc(@L[1], 3) | fail
+       x := @L[2] & y := @L[3] & z := @L[4] | fail
+      suspend op(x, y, z)
+      }
+
+end
+
+procedure UndulantPDCO(L)	#: PDCO to produce undulant
+   local i, j, dir
+
+   i := @L[1] | fail
+
+   suspend i			# first value always is in undulant
+
+   j := i			# last term in undulant
+
+   while i := @L[1] do {	# get initial direction
+      if i > j then {
+         dir := -1
+         break
+         }
+      else if i < j then {
+         dir := 1
+         break
+         }
+     } 
+
+   j := i
+
+   while i := @L[1] do {
+      if i < j then  {
+         if dir = -1 then {
+            suspend j
+            j := i
+            dir := 1
+            }
+         else j := i
+         }
+      if i > j then {
+         if dir = 1 then {
+            suspend j
+            j := i
+            dir := -1
+            }
+         else j := i
+         }
+      }
+
+   fail
+
+end
+
+procedure UniquePDCO(L)		#: PDCO to filter out duplication values
+   local done, x
+
+   done := set()
+
+   while x := @L[1] do
+      if member(done, x) then next
+      else {
+         insert(done, x)
+         suspend x
+         }
+
+end
+
+procedure UnopPDCO(L)		#: PDCO to apply unary operation to sequence
+   local op, x
+
+   repeat {
+      op := @L[1]
+      op := proc(op, 1) | fail
+      x := @L[2]  | fail
+      suspend op(x)
+      }
+
+end
+
+procedure UpperTrimPDCO(L)	#: upper sequence trimming
+   local done, i
+
+   done := set()
+
+   while i := @L[1] do {
+      if not member(done, i) then
+         insert(done, i)
+      else suspend i
+      }
+
+end
+
+procedure ValrptPDCO(L)		#: synonym for Repl
+
+   ValrptPDCO := ReplPDCO
+
+   suspend ReplPDCO(L)
+
+end
+
+procedure WobblePDCO(L)		#: PDCO to produce sequence values alternately
+   local x, y
+
+   x := @L[1] | fail
+   suspend x
+
+   while y := @L[1] do {
+      suspend y | x | y
+      x := y
+      }
+
+end