############################################################################ # # 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