User defined pipe and redirection operators: Difference between revisions

{{works with|ALGOL 68|Revision 1; one minor extension - PRAGMA READ; one major extension - Algol68G's [[wp:Currying|Currying]].}}{{works with|ALGOL 68G|tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-1.18.0/algol68g-1.18.0-9h.tiny.el5.centos.fc11.i386.rpm/download 1.18.0-9h.tiny].}}

{{wont work with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d] - due to extensive use of '''format'''[ted] ''transput''.}}

'''File: Iterator_pipe_operators.a68'''

<lang algol68>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);</lang>'''File: Iterator_pipe_utilities.a68'''

<lang algol68>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, );</lang>'''File: Iterator_pipe_page.a68'''

<lang algol68># 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:

page +:= line;

OP WRITE = (PAGEOUT page)YIELDLINE: (

page := LINE();

page append line(page, )

);

OP APPEND = (PAGEAPPEND page)YIELDLINE:

page append line(page, );</lang>'''File: test_Iterator_pipe_page.a68'''

<lang algol68>#!/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$

))</lang>

'''Output:'''

<pre>

Pioneer: Adriaan van Wijngaarden - Dutch pioneer; ARRA, ALGOL

Number of Algol pioneers: 6

Number of scientists: 15

</pre>