ALGOL 68/prelude

From Rosetta Code

The following summarises the useful and various ALGOL 68 prelude templates. These are used in several ALGOL 68 code samples.

Note: These are not part of the classic UNESCO IFIP Working Group 2.1's standard prelude, rather they were specifically created for Rosetta Code's ALGOL 68 code examples.

prelude/general.a68[edit]

Used in: Ternary_logic

# -*- coding: utf-8 -*- #
 
COMMENT
This is an ALGOL 68 prelude file called prelude/general.
It contains small routine that are not part of any standard,
but are none the less useful and widely used.
USAGE
PR READ "prelude/general.a68" PR
END COMMENT
 
##########################################
# Define some general routines and MODES #
##########################################
PRIO MIN=8, MAX=8;
OP MIN = (INT a,b)INT: (a<b|a|b),
MAX = (INT a,b)INT: (a>b|a|b);
OP MIN = (REAL a,b)REAL: (a<b|a|b),
MAX = (REAL a,b)REAL: (a>b|a|b);
 
MODE IUR = UNION(INT, REAL);
OP R = (IUR x)REAL: (x|(REAL r):r, (INT i):REAL(i));
 
MODE IURUC = UNION(INT, REAL, COMPL);
OP C = (IURUC x)COMPL: (x|(COMPL c): c, (REAL r):COMPL(r), (INT i):COMPL(i));
 
MODE CUCCUS = UNION(CHAR, #[]CHAR,# STRING);
OP S = (CUCCUS x)STRING: (x|(STRING s):s, ([]CHAR cc): STRING(cc), (CHAR c):STRING(c));
 
MODE
UCHAR = STRING, LONGCHAR = UCHAR, USTRING=FLEX[0]LONGCHAR,
LBITS = UNION(SHORT SHORT BITS, SHORT BITS, BITS, LONG BITS, LONG LONG BITS),
LBYTES = UNION(SHORT SHORT BYTES, SHORT BYTES, BYTES, LONG BYTES, LONG LONG BYTES),
LINT = UNION(SHORT SHORT INT, SHORT INT, INT, LONG INT, LONG LONG INT),
LREAL = UNION(SHORT SHORT REAL, SHORT REAL, REAL, LONG REAL, LONG LONG REAL),
LCOMPL = UNION(SHORT SHORT COMPL, SHORT COMPL, COMPL, LONG COMPL, LONG LONG COMPL);
MODE SIMPLEOUT = [0]UNION(BOOL, CHAR, STRING, USTRING, LBITS, # LBYTES,# LINT, LREAL, LCOMPL);
MODE SIMPLEOUTF = [0]UNION(FORMAT, SIMPLEOUT);
MODE USIMPLEOUT = SIMPLEOUT # UNION(SIMPLEOUT, SIMPLEOUTF) #;
 
PRIO REPR = 8;
 
# Use MOID with "*:=" OPerators who's where the returned MODE is often VOIDed for convenience #
MODE MOID = VOID;
 
PROC raise exception = (STRING type, USIMPLEOUT argv)VOID:(
BOOL exception = FALSE;
putf(stand error, ($g$, "Exception"," ",type, ": "));
#CASE argv IN#
# (SIMPLEOUSTRING argv):putf(stand error, argv),#
# (SIMPLEOUT argv):#
putf(stand error, ($g" "$, argv))
#ESAC#;
putf(stand error, $l$);
ASSERT (exception)
);
 
# Python style exceptions #
PROC raise undefined = (USIMPLEOUT argv)VOID: raise exception("Undefined", argv);
PROC raise unimplemented=(USIMPLEOUT argv)VOID: raise exception("Unimplemented", argv);
PROC raise value error = (USIMPLEOUT argv)VOID: raise exception("Value Error",argv);
PROC raise index error = (USIMPLEOUT argv)VOID: raise exception("Index Error",argv);
PROC raise type error = (USIMPLEOUT argv)VOID: raise exception("Type Error",argv);
 
BOOL debug := FALSE, trace := FALSE;
 
PRIO INKEYS = 5, INVALUES = 5, NOTINKEYS = 5, NOTINVALUES = 5;
 
# Algol68G specific declarations #
INT match=0, no match=1, out of memory error=2, other error=3; # for RegEx searches #


prelude/is_prime.a68[edit]

Used in: Primality_by_Trial_Division and Trial_factoring_of_a_Mersenne_number.

COMMENT
  This routine is used in more than one place, and is essentially a
  template that can by used for many different types, eg INT, LONG INT...
USAGE
  MODE POWMODSTRUCT = INT, LONG INT, COMPL, FRAC, MODULAS, MATRIX etc
  PR READ "prelude/pow_mod.a68" PR
END COMMENT
PROC pow mod = (POWMODSTRUCT b,in e, mod)POWMODSTRUCT: (
  POWMODSTRUCT sq := b, e := in e;
  POWMODSTRUCT out:= IF ODD e THEN b ELSE 1 FI;
  e:=e OVER 2;
  WHILE e /= 0 DO
    sq := sq * sq %* mod;
    IF ODD e THEN out := out * sq %* mod FI ;
    e:=e OVER 2
  OD;
  out
)


prelude/pow_mod.a68[edit]

Used in: Miller-Rabin test, Multiplicative order and Trial factoring of a Mersenne number.

COMMENT
  This routine is used in more than one place, and is essentially a
  template that can by used for many different types, eg INT, LONG INT...
USAGE
  MODE POWMODSTRUCT = INT, LONG INT, COMPL, FRAC, MODULAS, MATRIX etc
  PR READ "prelude/pow_mod.a68" PR
END COMMENT
PROC pow mod = (POWMODSTRUCT b,in e, mod)POWMODSTRUCT: (
  POWMODSTRUCT sq := b, e := in e;
  POWMODSTRUCT out:= IF ODD e THEN b ELSE 1 FI;
  e:=e OVER 2;
  WHILE e /= 0 DO
    sq := sq * sq %* mod;
    IF ODD e THEN out := out * sq %* mod FI ;
    e:=e OVER 2
  OD;
  out
)


prelude/sort.a68[edit]

Used in: Multiplicative order, Sort an array of composite structures and Sort most popular programming languages.

COMMENT
  This routine is used in more then one place, and is essentially a
  template that can by used for many different types, eg INT, LONG INT...
USAGE
  MODE SORTSTRUCT = INT, LONG INT, STRUCT(STRING name, addr) etc
  OP < = (SORTSTRUCT a,b)BOOL: ~;

  PR READ "prelude/sort.a68" PR;
  [3]SORTSTRUCT list := (a,b,c);
  print((in place shell sort(list), new line))
END COMMENT
 PROC in place shell sort = (REF FLEX []SORTSTRUCT seq)REF[]SORTSTRUCT:(
     INT inc := ( UPB seq + LWB seq + 1 ) OVER 2;
     WHILE inc NE 0 DO
         FOR index FROM LWB seq TO UPB seq DO
             INT i := index;
             SORTSTRUCT el = seq[i];
             WHILE ( i  - LWB seq >= inc | NOT(seq[i - inc] < el) | FALSE ) DO
                 seq[i] := seq[i - inc];
                 i -:= inc
             OD;
             seq[i] := el
         OD;
         inc := IF inc = 2 THEN 1 ELSE ENTIER(inc * 5 / 11) FI
     OD;
     seq
 );
 PROC in place shell sort reverse = (REF FLEX []SORTSTRUCT seq)REF[]SORTSTRUCT:(
     INT inc := ( UPB seq + LWB seq + 1 ) OVER 2;
     WHILE inc NE 0 DO
         FOR index FROM LWB seq TO UPB seq DO
             INT i := index;
             SORTSTRUCT el = seq[i];
             WHILE ( i  - LWB seq >= inc | seq[i - inc] < el | FALSE ) DO
                 seq[i] := seq[i - inc];
                 i -:= inc
             OD;
             seq[i] := el
         OD;
         inc := IF inc = 2 THEN 1 ELSE ENTIER(inc * 5 / 11) FI
     OD;
     seq
 );
 SKIP


prelude/errata.a68[edit]

A collections of OPerators, MODES and variables that are "kind of" implied by Algol68's definition

Used in: Plot coordinate pairs.

prelude/graph_2d.a68[edit]

A simple tookit for producing basic 2d graphs.

Used in: Plot coordinate pairs.


string in string[edit]

The Algol 68G compiler/interpreter provides a procedure string in string, similar to the standard char in string.
Here is a version for other implementations of Algol 68:

# A string in string procedure for use with compilers other than Algol 68G   #
# returns TRUE if s is in t, FALSE otherwise. #
# if pos is not NIL: #
# if s is in t, pos is set to the starting position os s in t, #
# pos is left unchanged is s is not in t #
PROC string in string = ( STRING s, REF INT pos, STRING t )BOOL:
IF s = "" THEN
# s is empty #
IF REF INT(pos) ISNT REF INT(NIL) THEN pos := LWB t FI;
TRUE
ELSE
# s and t are non-empty #
BOOL found := FALSE;
CHAR first char = s[ LWB s ];
INT first pos := LWB t;
INT end pos = UPB t;
INT s length = ( UPB s - LWB s ) + 1;
WHILE NOT found AND first pos <= end pos DO
found := char in string( first char, first pos, t[ first pos : @ first pos ] );
IF NOT found THEN
# the first character is not present #
first pos := end pos + 1
ELIF s = t[ first pos : first pos + ( s length - 1 ) ] THEN
# found the full string s at first pos #
IF REF INT(pos) ISNT REF INT(NIL) THEN pos := first pos FI
ELSE
# haven't got the full string s at first pos #
first pos +:= 1;
found := FALSE
FI
OD;
found
FI # string in string # ;

aArray.a68[edit]

An associative array MODE for STRING keys and values. THis is used by a number of Rosseta Code tasks.

# associative array for STRING elements and keys                             #
 
# the modes allowed as associative array element values - change to suit #
MODE AAVALUE = STRING;
# the modes allowed as associative array element keys - change to suit #
MODE AAKEY = STRING;
 
 
PR read "aArrayBase.a68" PR

aArrayBase.a68[edit]

The MODEs for associative arrays. The AAKEY and AAVALUE MODEs must be defined as required.
If AAKEY is not STRING, a suitable HASH operator will also need to be defined.

# associative array handling using hashing                                   #
# AAKEY and AAVALUE modes and OP HASH(AAKEY)INT must be defined to use this #
 
# nil element value #
REF AAVALUE nil value = NIL;
 
# generates a hash value from a STRING - additional HASH operators should be #
# defined for other AAKEY modes #
OP HASH = ( STRING key )INT:
BEGIN
INT result := ABS ( UPB key - LWB key ) MOD hash modulus;
FOR char pos FROM LWB key TO UPB key
DO
result PLUSAB ( ABS key[ char pos ] - ABS " " );
result MODAB hash modulus
OD;
result
END; # HASH #
 
 
# an element of an associative array #
MODE AAELEMENT = STRUCT( AAKEY key, REF AAVALUE value );
# a list of associative array elements - the element values with a #
# particular hash value are stored in an AAELEMENTLIST #
MODE AAELEMENTLIST = STRUCT( AAELEMENT element, REF AAELEMENTLIST next );
# nil element list reference #
REF AAELEMENTLIST nil element list = NIL;
# nil element reference #
REF AAELEMENT nil element = NIL;
 
# the hash modulus for the associative arrays #
INT hash modulus = 256;
 
# a mode representing an associative array #
MODE AARRAY = STRUCT( [ 0 : hash modulus - 1 ]REF AAELEMENTLIST elements
, INT curr hash
, REF AAELEMENTLIST curr position
);
 
# initialises an associative array so all the hash chains are empty #
OP INIT = ( REF AARRAY array )REF AARRAY:
BEGIN
FOR hash value FROM 0 TO hash modulus - 1 DO ( elements OF array )[ hash value ] := nil element list OD;
array
END; # INIT #
# gets a reference to the value corresponding to a particular key in an #
# associative array - the element is created if it doesn't exist #
PRIO // = 1;
OP // = ( REF AARRAY array, AAKEY key )REF AAVALUE:
BEGIN
REF AAVALUE result;
INT hash value = HASH key;
# get the hash chain for the key #
REF AAELEMENTLIST element := ( elements OF array )[ hash value ];
# find the element in the list, if it is there #
BOOL found element := FALSE;
WHILE ( element ISNT nil element list )
AND NOT found element
DO
found element := ( key OF element OF element = key );
IF found element
THEN
result := value OF element OF element
ELSE
element := next OF element
FI
OD;
IF NOT found element
THEN
# the element is not in the list #
# - add it to the front of the hash chain #
( elements OF array )[ hash value ]
:= HEAP AAELEMENTLIST
:= ( HEAP AAELEMENT := ( key
, HEAP AAVALUE := ""
)
, ( elements OF array )[ hash value ]
);
result := value OF element OF ( elements OF array )[ hash value ]
FI;
result
END; # // #
 
# returns TRUE if array contains key, FALSE otherwise #
PRIO CONTAINSKEY = 1;
OP CONTAINSKEY = ( REF AARRAY array, AAKEY key )BOOL:
BEGIN
# get the hash chain for the key #
REF AAELEMENTLIST element := ( elements OF array )[ HASH key ];
# find the element in the list, if it is there #
BOOL found element := FALSE;
WHILE ( element ISNT nil element list )
AND NOT found element
DO
found element := ( key OF element OF element = key );
IF NOT found element
THEN
element := next OF element
FI
OD;
found element
END; # CONTAINSKEY #
 
# gets the first element (key, value) from the array #
OP FIRST = ( REF AARRAY array )REF AAELEMENT:
BEGIN
curr hash OF array := LWB ( elements OF array ) - 1;
curr position OF array := nil element list;
NEXT array
END; # FIRST #
 
# gets the next element (key, value) from the array #
OP NEXT = ( REF AARRAY array )REF AAELEMENT:
BEGIN
WHILE ( curr position OF array IS nil element list )
AND curr hash OF array < UPB ( elements OF array )
DO
# reached the end of the current element list - try the next #
curr hash OF array +:= 1;
curr position OF array := ( elements OF array )[ curr hash OF array ]
OD;
IF curr hash OF array > UPB ( elements OF array )
THEN
# no more elements #
nil element
ELIF curr position OF array IS nil element list
THEN
# reached the end of the table #
nil element
ELSE
# have another element #
REF AAELEMENTLIST found element = curr position OF array;
curr position OF array := next OF curr position OF array;
element OF found element
FI
END; # NEXT #

The classic UNESCO IFIP Working Group 2.1's standard prelude contents[edit]

Names from the "official" standard prelude: <, <=, +, +:=, +=:, +*, &, ∧, ⌈, ↓, ⌋, ≥, ≤, =, ∨, ⊥, ÷, ÷×, ÷×:=, ÷*, ÷*:=, ÷:=, ×, ×:=, ~, ↑, *, **, *:=, ¬, -, -:=, /, /:=, /=, %, %×, %×:=, %*, %*:=, %:=, >, >=, =, ABS, AND, ARG, BIN, BITS, BOOL, BYTES, CHANNEL, CHAR, COMPL, CONJ, DIVAB, DOWN, ELEM, ENTIER, EQ, FILE, FORMAT, GE, GT, I, IM, INT, LE, LENG, LEVEL, LT, LWB, MINUSAB, MOD, MODAB, NE, NOT, ODD, OR, OVER, OVERAB, PLUSAB, PLUSTO, RE, REAL, REPR, ROUND, SEMA, SHL, SHORTEN, SHR, SIGN, STRING, TIMESAB, UP, UPB, VOID, arccos, arcsin, arctan, associate, backspace, bin possible, bits lengths, bits pack, bits shorths, bits width, blank, bytes lengths, bytes pack, bytes shorths, bytes width, chan, char in string, char number, close, compressible, cos, create, errorchar, estab possible, establish, exp, exp width, fixed, flip, float, flop, get, get bin, get possible, getf, int shorths, int width, last random, line number, ln, lock, make conv, make term, max abs char, max int, max real, newline, newpage, next random, null character, on char error, on format end, on line end, on logical file end, on page end, on physical file end, on value error, open, page number, pi, print, printf, put, put bin, put possible, putf, random, read, read bin, readf, real lengths, real shorths, real width, reidf, reidf possible, reset, reset possible, scratch, set, set char number, set possible, sin, small real, space, sqrt, stand back, stand back channel, stand in, stand in channel, stand out, stand out channel, standconv, stop, tan, whole, write, write bin, writef, L BITS, L BYTES, L COMPL, L INT, L REAL, L arccos, L arcsin, L arctan, L bits pack, L bits width, L bytes pack, L bytes width, L cos, L exp, L exp width, L int width, L last random, L ln, L max int, L max real, L next random, L pi, L random, L real width, L sin, L small real, L sqrt, L tan.

The L indicates extra precision, eg REAL, or LONG REAL or LONG LONG REAL etc, even SHORT REAL etc

These names next were intended for internal compiler use only: אBEYOND, אBFILE, אBOOK, אCOLLECTION, אCOLLITEM, אCONV, אCPATTERN, אFLEXTEXT, אFPATTERN, אFRAME, אGPATTERN, אINSERTION, אINTYPE, אNUMBER, אOUTTYPE, אPATTERN, אPICTURE, אPIECE, אPOS, אROWS, אSFRAME, אSIMPLIN, אSIMPLOUT, אSINSERT, אSTRAIGHTIN, אSTRAIGHTOUT, אTEXT, אalignment, אassociate format, אbfileprotect, אbook bounds, אchainbfile, אchar dig, אcheck pos, אcurrent pos, אdig char, אdo fpattern, אedit string, אfalse, אfile available, אfrom bin, אget char, אget good file, אget good line, אget good page, אget insertion, אget next picture, אgremlins, אidf ok, אindit string, אline ended, אlockedbfile, אlogical file ended, אmatch, אnext pos, אpage ended, אphysical file ended, אput char, אput insertion, אset bin mood, אset char mood, אset mood, אset read mood, אset write mood, אstandardize, אstaticize frames, אstaticize insertion, אstring to L int, אstring to L real, אsubfixed, אsubwhole, אto bin, אundefined, אL standardize