View source for User defined pipe and redirection operators/ALGOL 68

{{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''.}}
==Iterator_pipe_operators==
'''File: Iterator_pipe_operators.a68'''
<syntaxhighlight 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);</syntaxhighlight>

==Iterator_pipe_utilities==
'''File: Iterator_pipe_utilities.a68'''
<syntaxhighlight 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, );</syntaxhighlight>
==Iterator_pipe_page==
'''File: Iterator_pipe_page.a68'''
<syntaxhighlight 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:
  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, );</syntaxhighlight>

==test_Iterator_pipe_page==
'''File: test_Iterator_pipe_page.a68'''
<syntaxhighlight 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$
))</syntaxhighlight>
'''Output:'''
<pre>
Pioneer:  Adriaan van Wijngaarden - Dutch pioneer; ARRA, ALGOL
Number of Algol pioneers: 6
Number of scientists: 15
</pre>