Classic Algorithms in ALGOL 68

Note how slices (a[LWB a : mid]) keep their original bounds, so the code uses LWB/UPB throughout rather than assuming rows start at 1.

39.1 GCD and LCM with operators

BEGIN
   PRIO GCD = 7, LCM = 7;
   OP GCD = (INT a, b) INT: (b = 0 | ABS a | b GCD (a MOD b));
   OP LCM = (INT a, b) INT: a OVER (a GCD b) * b;
   print((1071 GCD 462, 4 LCM 6, newline))       # 21 12 #
END

39.2 Sieve of Eratosthenes

BEGIN
   INT n = 100;
   [2:n] BOOL is prime;
   FOR i FROM 2 TO n DO is prime[i] := TRUE OD;
   FOR i FROM 2 WHILE i * i <= n DO
      IF is prime[i] THEN
         FOR j FROM i * i BY i TO n DO is prime[j] := FALSE OD
      FI
   OD;
   FOR i FROM 2 TO n DO
      IF is prime[i] THEN print((whole(i, 0), " ")) FI
   OD;
   print(newline)
END

39.3 Quicksort

BEGIN
   PROC quicksort = (REF [] INT a, INT lo, hi) VOID:
      IF lo < hi THEN
         INT pivot = a[(lo + hi) OVER 2];
         INT i := lo, j := hi;
         WHILE i <= j DO
            WHILE a[i] < pivot DO i +:= 1 OD;
            WHILE a[j] > pivot DO j -:= 1 OD;
            IF i <= j THEN
               INT t = a[i]; a[i] := a[j]; a[j] := t;
               i +:= 1; j -:= 1
            FI
         OD;
         quicksort(a, lo, j);
         quicksort(a, i, hi)
      FI;

   [1:12] INT data := (42, 7, 19, 3, 88, 25, 61, 14, 50, 1, 99, 33);
   quicksort(data, LWB data, UPB data);
   FOR i FROM LWB data TO UPB data DO print((whole(data[i], 0), " ")) OD;
   print(newline)
END

39.4 Binary search

PROC binary search = ([] INT a, INT x) INT:
BEGIN
   INT lo := LWB a, hi := UPB a, result := LWB a - 1;   # LWB a - 1 means "not found" #
   WHILE lo <= hi AND result < LWB a DO
      INT mid = (lo + hi) OVER 2;
      IF a[mid] = x THEN result := mid
      ELIF a[mid] < x THEN lo := mid + 1
      ELSE hi := mid - 1
      FI
   OD;
   result
END;

39.5 Merge sort (returning a new row)

Note how slices (a[LWB a : mid]) keep their original bounds, so the code uses LWB/UPB throughout rather than assuming rows start at 1.

BEGIN
   PROC merge sort = ([] INT a) [] INT:
      IF UPB a - LWB a < 1 THEN a
      ELSE
         INT mid = (LWB a + UPB a) OVER 2;
         [] INT left = merge sort(a[LWB a : mid]), right = merge sort(a[mid + 1 : UPB a]);
         [1 : UPB a - LWB a + 1] INT result;
         INT i := LWB left, j := LWB right, k := 1;
         WHILE i <= UPB left AND j <= UPB right DO
            IF left[i] <= right[j] THEN result[k] := left[i]; i +:= 1
            ELSE result[k] := right[j]; j +:= 1
            FI;
            k +:= 1
         OD;
         WHILE i <= UPB left DO result[k] := left[i]; i +:= 1; k +:= 1 OD;
         WHILE j <= UPB right DO result[k] := right[j]; j +:= 1; k +:= 1 OD;
         result
      FI;

   print((merge sort((38, 27, 43, 3, 9, 82, 10)), newline))
END

39.6 Matrix multiplication with an operator

BEGIN
   OP * = ([,] REAL a, b) [,] REAL:
   BEGIN
      [1 LWB a : 1 UPB a, 2 LWB b : 2 UPB b] REAL c;
      FOR i FROM 1 LWB a TO 1 UPB a DO
         FOR j FROM 2 LWB b TO 2 UPB b DO
            REAL s := 0;
            FOR k FROM 2 LWB a TO 2 UPB a DO s +:= a[i, k] * b[k, j] OD;
            c[i, j] := s
         OD
      OD;
      c
   END;

   PROC print matrix = ([,] REAL m) VOID:
      FOR i FROM 1 LWB m TO 1 UPB m DO
         FOR j FROM 2 LWB m TO 2 UPB m DO print(fixed(m[i, j], 8, 2)) OD;
         print(newline)
      OD;

   [,] REAL a = ((1, 2), (3, 4)), b = ((5, 6), (7, 8));
   print matrix(a * b)          # 19 22 / 43 50 #
END

39.7 Towers of Hanoi and Fibonacci with big numbers

(fib(200) has 42 digits; if your a68g reports overflow, increase --precision.)

BEGIN
   PROC hanoi = (INT n, from, to, via) VOID:
      IF n > 0 THEN
         hanoi(n - 1, from, via, to);
         print(("move disk ", whole(n, 0), " from ", whole(from, 0), " to ", whole(to, 0), newline));
         hanoi(n - 1, via, to, from)
      FI;
   hanoi(3, 1, 3, 2);

   LONG LONG INT a := LONG LONG 0, b := LONG LONG 1;
   TO 200 DO LONG LONG INT t = a + b; a := b; b := t OD;
   print(("fib(200) = ", whole(a, 0), newline))
END

39.8 Man or boy in ALGOL 68

Call by name is replaced by explicit parameterless routines (REAL: 1). Because b is only passed *downwards* (as a parameter to inner calls of a), no scope violation occurs.

BEGIN
   PROC a = (INT k, PROC REAL x1, x2, x3, x4, x5) REAL:
   BEGIN
      INT kk := k;
      PROC b = REAL: a(kk -:= 1, b, x1, x2, x3, x4);
      (kk <= 0 | x4 + x5 | b)
   END;
   print((fixed(a(10, REAL: 1, REAL: -1, REAL: -1, REAL: 1, REAL: 0), 0, 0), newline))   # -67 #
END

🧪 Part III Exercises

Declare variables of every primitive mode (including LONG LONG INT, BITS, COMPL, STRING) and print them with print, then with whole/fixed/float.

Write the long form (with LOC) of five variable declarations, then demonstrate an alias, a pointer variable (REF REF INT) and the IS relation.

For each of the six coercions, write one line that requires it, and identify the context in which it occurs.

Write a VECTOR and MATRIX library with operators +, -, * (scalar, dot, matrix–vector, matrix–matrix), ABS, and a transpose operator T.

Implement a generic-looking UNION (INT, REAL, STRING, BOOL) "variant" printer with a conformity clause, and a function that adds two variants (INT + REAL gives REAL, STRING + STRING concatenates, otherwise an error union).

Build a doubly linked list with HEAP nodes: insert at both ends, delete a given value, and print forwards and backwards. Verify there are no REF REF comparison mistakes.

Write a program that reads a text file, counts the frequency of each letter, and prints a table using printf formats.

Implement the dining philosophers problem with PAR and SEMA, avoiding deadlock.

Use a68g's grep in string to extract all e-mail-like tokens from a text file.

Write a W-grammar (metaproductions and hyper-rules) for strings of the form x^n y^2n and show the derivation for n = 2.