User defined pipe and redirection operators/ALGOL 68
Iterator_pipe_operators
File: Iterator_pipe_operators.a68
MODE
PAGEIN = PAGE,
PAGEAPPEND = REF PAGE,
PAGEOUT = REF PAGE;
MODE
MOID = VOID,
YIELDLINE = PROC(LINE)VOID,
GENLINE = PROC(YIELDLINE)VOID,
FILTER = PROC(GENLINE)GENLINE, # the classic shell filter #
MANYTOONE = PROC([]GENLINE)GENLINE; # eg cat, as in con[cat]enate #
PRIO =: = 5, << = 5, >> = 5;
OP < = (FILTER filter, PAGEIN page)GENLINE: filter(READ page),
< = (MANYTOONE cmd, PAGEIN page)GENLINE: cmd(READ page),
<< = (FILTER filter, PAGEIN page)GENLINE: filter(READ page),
> = (GENLINE gen, PAGEOUT page)VOID: gen(WRITE page),
>> = (GENLINE gen, PAGEAPPEND page)VOID: gen(APPEND page),
=: = (GENLINE gen, FILTER filter)GENLINE: filter(gen),
=: = (GENLINE gen, MANYTOONE cmd)GENLINE: cmd(gen);Iterator_pipe_utilities
File: Iterator_pipe_utilities.a68
PROC cat yield line = ([]GENLINE argv, YIELDLINE yield)VOID:
FOR gen line FROM LWB argv TO UPB argv DO
argv[gen line](yield)
OD;
PROC cat = ([]GENLINE argv)GENLINE:
cat yield line(argv, );
PROC tee yield line = (GENLINE gen, []YIELDLINE args yield, YIELDLINE yield)VOID: (
# FOR LINE line IN # gen(#) DO #
## (LINE line)VOID: (
yield(line);
FOR outn FROM LWB args yield TO UPB args yield DO
args yield[outn](line)
OD
# OD #))
);
PROC tee filter = (GENLINE gen, []YIELDLINE args yield)GENLINE:
tee yield line(gen, args yield, );
PROC tee = ([]YIELDLINE args filter)FILTER:
tee filter(, args filter);
PROC grep yield line = (STRING pattern, []GENLINE argv, YIELDLINE yield)VOID:
# FOR LINE line IN # cat(argv)(
## (LINE line)VOID:
IF string in string(pattern, NIL, line) THEN yield(line) FI
# OD #);
PROC grep = (STRING pattern, []GENLINE argv)GENLINE:
grep yield line(pattern, cat(argv), );
PROC uniq yield line = (GENLINE arg, YIELDLINE yield)VOID:(
UNION(VOID, LINE)prev := EMPTY;
# FOR LINE this IN # arg(#) DO #
## (LINE this)VOID:
CASE prev IN
(LINE case prev): IF NOT(case prev=this) THEN prev := this; yield(this) FI,
(VOID): (prev := this; yield(this))
ESAC
# OD #)
);
PROC uniq = (GENLINE arg)GENLINE:
uniq yield line(arg, );
MODE SORTSTRUCT = LINE;
PR READ "prelude/sort.a68" PR
PROC sort yield line = ([]GENLINE args, YIELDLINE yield)VOID:(
PAGE out; cat(args) > out; in place shell sort(out);
FOR elem FROM LWB out TO UPB out DO
yield(out[elem])
OD
);
PROC sort = (GENLINE arg)GENLINE:
sort yield line(arg, );
PROC head yield line= (INT n, []GENLINE args, YIELDLINE yield)VOID:
FOR argn FROM LWB args TO UPB args DO
GENLINE line gen = args[argn];
INT count := 0;
# FOR LINE line IN # cat(line gen)(#) DO #
## (LINE line)VOID:(
count+:=1;
yield(line);
IF count = n THEN done FI
# OD #));
done: SKIP
OD;
PROC head = (INT n, []GENLINE args)GENLINE:
head yield line(n, args, );
PROC tail yield line = (INT n, []GENLINE args, YIELDLINE yield)VOID:
FOR argn FROM LWB args TO UPB args DO
GENLINE gen line = args[argn];
[0:n-1]LINE window; INT window end := -1;
# FOR LINE line IN # gen line(#) DO #
## (LINE line)VOID:
window[(window end+:=1) MOD n]:= line
# OD #);
FOR line FROM window end-n+1 TO window end DO
IF line>=0 THEN
yield(window[line MOD n])
FI
OD
OD;
PROC tail = (INT n, []GENLINE args)GENLINE:
tail yield line(n, args, );
# Define an optional monadic OPerator #
OP TAIL = (INT n)MANYTOONE: tail(n, );Iterator_pipe_page
File: Iterator_pipe_page.a68
# Define the required OPerators for pipes of user-defined type "PAGE" #
OP +:= = (PAGEOUT page, LINE line)MOID:(
[LWB page:UPB page+1]LINE out;
out[:UPB page]:=page;
out[UPB out]:=line;
page := out
);
PROC page read line = (PAGEIN page, YIELDLINE yield)VOID:
FOR elem FROM LWB page TO UPB page DO
yield(page[elem])
OD;
OP READ = (PAGEIN page)GENLINE:
page read line(page, );
PROC page append line = (PAGEAPPEND page, LINE line)VOID:
IF LWB page > UPB page THEN page := line ELSE page +:= line FI;
OP WRITE = (PAGEOUT page)YIELDLINE: (
page := (FLEX[1:0]LINE l; l);
page append line(page, )
);
OP APPEND = (PAGEAPPEND page)YIELDLINE:
page append line(page, );test_Iterator_pipe_page
File: test_Iterator_pipe_page.a68
#!/usr/local/bin/a68g --script #
# First define what kind of record (aka LINE) we are piping and filtering #
FORMAT line fmt = $xg$;
MODE
LINE = STRING,
PAGE = FLEX[0]LINE,
BOOK = FLEX[0]PAGE;
PR READ "Iterator_pipe_page.a68" PR
PR READ "Iterator_pipe_operators.a68" PR
PR READ "Iterator_pipe_utilities.a68" PR
PAGE list of computer scientists = (
"Wil van der Aalst - business process management, process mining, Petri nets",
"Hal Abelson - intersection of computing and teaching",
"Serge Abiteboul - database theory",
"Samson Abramsky - game semantics",
"Leonard Adleman - RSA, DNA computing",
"Manindra Agrawal - polynomial-time primality testing",
"Luis von Ahn - human-based computation",
"Alfred Aho - compilers book, the 'a' in AWK",
"Stephen R. Bourne - Bourne shell, portable ALGOL 68C compiler",
"Kees Koster - ALGOL 68",
"Lambert Meertens - ALGOL 68, ABC (programming language)",
"Peter Naur - BNF, ALGOL 60",
"Guido van Rossum - Python (programming language)",
"Adriaan van Wijngaarden - Dutch pioneer; ARRA, ALGOL",
"Dennis E. Wisnosky - Integrated Computer-Aided Manufacturing (ICAM), IDEF",
"Stephen Wolfram - Mathematica",
"William Wulf - compilers",
"Edward Yourdon - Structured Systems Analysis and Design Method",
"Lotfi Zadeh - fuzzy logic",
"Arif Zaman - Pseudo-random number generator",
"Albert Zomaya - Australian pioneer of scheduling in parallel and distributed systems",
"Konrad Zuse - German pioneer of hardware and software"
);
PAGE algol pioneers list, the scientists list;
PAGE aa;
# Now do a bit of plumbing: #
cat((
head(4, ) < list of computer scientists,
cat(READ list of computer scientists) =: grep("ALGOL", ) =: tee(WRITE algol pioneers list),
tail(4, READ list of computer scientists)
)) =: sort =: uniq =: tee(WRITE the scientists list) =: grep("aa", ) >> aa;
# Finally check the result: #
printf((
$"Pioneer: "$, line fmt, aa, $l$,
$"Number of Algol pioneers: "g(-0)$, UPB algol pioneers list, $l$,
$"Number of scientists: "g(-0)$, UPB the scientists list, $l$
))Output:
Pioneer: Adriaan van Wijngaarden - Dutch pioneer; ARRA, ALGOL Number of Algol pioneers: 6 Number of scientists: 15