home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
OL.LZH
/
PROCS.LZH
/
PDCO.ICN
< prev
next >
Wrap
Text File
|
1991-07-13
|
4KB
|
164 lines
############################################################################
#
# Name: pdco.icn
#
# Title: Programm-defined control operations
#
# Author: Ralph E. Griswold and Robert J. Alexander
#
# Date: September 18, 1990
#
############################################################################
#
# These procedures use co-expressions to used to model the built-in
# control structures of Icon and also provide new ones.
#
# Alt{e1,e2} models e1 | e2
#
# Colseq{e1,e2, ...} produces results of e1, e2, ... alter-
# nately
#
# Comseq{e1,e2} compares result sequences of e1 and e2
#
# Cond{e1,e2, ...} models the generalized Lisp conditional
#
# Every{e1,e2} models every e1 do e2
#
# Galt{e1,e2, ...} models generalized alternation: e1 | e2 |
# ...
#
# Gconjunct{e1,e2,...} models generalized conjunction: e1 & e2 & ...
#
# The programmer-defined control operation above shows an interesting
# technique for modeling conjunction via recursive generative
# procedures.
#
# Lcond{e1,e2, ...} models the Lisp conditional
#
# Limit{e1,e2} models e1 \ e2
#
# Ranseq{e1,e2, ...} produces results of e1, e2, ... at random
#
# Repalt{e} models |e
#
# Resume{e1,e2,e3} models every e1 \ e2 do e3
#
# Select{e1,e2} produces results from e1 by position
# according to e2
#
# Comments:
#
# Because of the handling of the scope of local identif-
# iers 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
#
############################################################################
procedure Alt(L)
local x
while x := @L[1] do suspend x
while x := @L[2] do suspend x
end
procedure Colseq(L)
suspend |@!L
end
procedure Comseq(L)
local x1, x2
while x1 := @L[1] do
(x1 === @L[2]) | fail
if @L[2] then fail else return *L[1]
end
procedure Cond(L)
local i, x
every i := 1 to *L do
if x := @L[i] then {
suspend x
suspend |@L[i]
fail
}
end
procedure Every(L)
while @L[1] do @^L[2]
end
procedure Galt(L)
local C
every C := !L do suspend |@C
end
procedure Gconjunct(L)
suspend Gconjunct_(L,1)
end
procedure Gconjunct_(L,i,v)
local e
if e := L[i] then {
suspend v:= |@e & Gconjunct_(L,i + 1,v)
L[i] := ^e
}
else suspend v
end
procedure Lcond(L)
local i
every i := 1 to *L by 2 do
if @L[i] then {
suspend |@L[i + 1]
fail
}
end
procedure Limit(L)
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 Ranseq(L)
local x
while x := @?L do suspend x
end
procedure Repalt(L)
local x
repeat {
while x := @L[1] do suspend x
if *L[1] = 0 then fail
else L[1] := ^L[1]
}
end
procedure Resume(L)
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 Select(L)
local i, j, x
j := 0
while i := @L[2] do {
while j < i do
if x := @L[1] then j +:= 1
else fail
if i = j then suspend x
else stop("selection sequence error")
}
end