User defined pipe and redirection operators/ALGOL 68

From Rosetta Code
Works with: ALGOL 68 version Revision 1; one minor extension - PRAGMA READ; one major extension - Algol68G's Currying.
Works with: ALGOL 68G version tested with release 1.18.0-9h.tiny.

Iterator_pipe_operators

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>

Iterator_pipe_utilities

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:

  1. FOR LINE line IN # cat(argv)(
    1. (LINE line)VOID:
      IF string in string(pattern, NIL, line) THEN yield(line) FI
  1. 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;
  1. FOR LINE this IN # arg(#) DO #
    1. (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
  1. 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, );
  1. Define an optional monadic OPerator #

OP TAIL = (INT n)MANYTOONE: tail(n, );</lang>

Iterator_pipe_page

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>

test_Iterator_pipe_page

File: test_Iterator_pipe_page.a68 <lang algol68>#!/usr/local/bin/a68g --script #

  1. 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;

  1. 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;
  1. 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:

Pioneer:  Adriaan van Wijngaarden - Dutch pioneer; ARRA, ALGOL
Number of Algol pioneers: 6
Number of scientists: 15