# -*- coding: utf-8 -*- #
##########################################################
# Errata: A collections of OPerators, MODES and variables#
# that are "kind of" implied by Algol68's definition #
##########################################################
# Standard Diadic OPerator to initialise an object #
PRIO INIT = 1; # should be 0 like assignment #
INT extra = -5; # to remove or display additional decimal places in output #
COMMENT
#L# - MODE/type may also be prefixed with SHORT or LONG
#l# - PROC/variable may also be prefixed with 'short' or 'long'
#L# - MODE/type may also be prefixed with LONG for unicode
#l# - PROC/variable may also be prefixed with 'long' for unicode
#S# - Diadic OPerators concurrently involving LONG and SHORT
#s# - Diadic+ PROCedure concurrently involving LONG and SHORT
#LENG# & #SHORTEN# widening operators
END COMMENT
FORMAT
#l# bits repr := $g$,
#l# int repr := $g(-0)$,
#l# real repr := $g(-#l# real width-extra, #l# real width-2+extra)$,
#l# compl repr := $f(#l# real repr)"⊥"f(#l# real repr)$,
#u# string repr := $g$,
#u# char repr := $g$,
bool repr := $c("Yes","No")$;
FORMAT
fs := $", "$, # insert a field separator #
#l# real repr fs := $f(#l# real repr)f(fs)$,
nl := $l$, # insert a new line #
#l# real item repr := $g"="f(#l# real repr)$, # e.g. "value=1.00000; " #
#l# int item repr := $g"="f(#l# int repr)$, # e.g. "value=1; " #
item repr := $g"="g$; # e.g. "value=1; " #
FORMAT hr = $68"-"l$;
MODE SLICE = FLEX[0]STRUCT(INT lwb, upb, by); # for tensor slicing #
FORMAT slice repr = $"["g(-0)":"g(-0)":"g(-0)"]"$;
MODE BOUNDS = FLEX[0]STRUCT(INT lwb, upb); # for tensor slicing #
FORMAT bounds repr = $"["g(-0)":"g(-0)"]"$;
OP LWBUPB = ([]INT x)BOUNDS: STRUCT(INT lwb, upb)(LWB x, UPB x);
OP LWBUPB = ([,]INT x)[]BOUNDS: BOUNDS((LWB x, UPB x),(2 LWB x, 2 UPB x));
OP LWBUPB = ([,,]INT x)[]BOUNDS: BOUNDS((LWB x, UPB x),(2 LWB x, 2 UPB x),(3 LWB x, 3 UPB x));
OP LWBUPB = ([,,,]INT x)[]BOUNDS: BOUNDS((LWB x, UPB x),(2 LWB x, 2 UPB x),(3 LWB x, 3 UPB x),(4 LWB x, 4 UPB x));
OP LWBUPB = ([]REAL x)BOUNDS: STRUCT(INT lwb, upb)(LWB x, UPB x);
OP LWBUPB = ([,]REAL x)[]BOUNDS: BOUNDS((LWB x, UPB x),(2 LWB x, 2 UPB x));
OP LWBUPB = ([,,]REAL x)[]BOUNDS: BOUNDS((LWB x, UPB x),(2 LWB x, 2 UPB x),(3 LWB x, 3 UPB x));
OP LWBUPB = ([,,,]REAL x)[]BOUNDS: BOUNDS((LWB x, UPB x),(2 LWB x, 2 UPB x),(3 LWB x, 3 UPB x),(4 LWB x, 4 UPB x));
# SHORT/LONG COMPL etc #
# Some base routined for generators: #
MODE
#L#BITSYIELD= PROC(#L#BITS)VOID, #L#BITSGEN= PROC(#L#BITSYIELD)VOID,
#L#BYTESYIELD= PROC(#L#BYTES)VOID, #L#BYTESGEN= PROC(#L#BYTESYIELD)VOID,
#L#INTYIELD= PROC(#L#INT)VOID, #L#INTGEN= PROC(#L#INTYIELD)VOID,
#L#REALYIELD= PROC(#L#REAL)VOID, #L#REALGEN= PROC(#L#REALYIELD)VOID,
#L#COMPLYIELD= PROC(#L#COMPL)VOID, #L#COMPLGEN= PROC(#L#COMPLYIELD)VOID,
#L#STRINGYIELD=PROC(#L#STRING)VOID,#L#STRINGGEN=PROC(#L#STRINGYIELD)VOID,
#U#CHARYIELD= PROC(#U#CHAR)VOID, #U#CHARGEN= PROC(#U#CHARYIELD)VOID,
BOOLYIELD= PROC( BOOL)VOID, BOOLGEN= PROC( BOOLYIELD)VOID;
# Manage optionally uninitialised variables #
MODE
#L#BITSOPT = UNION(VOID, #L#BITS),
#L#BYTESOPT = UNION(VOID, #L#BYTES),
#L#INTOPT = UNION(VOID, #L#INT),
#L#REALOPT = UNION(VOID, #L#REAL),
#L#COMPLOPT = UNION(VOID, #L#COMPL),
#L#STRINGOPT = UNION(VOID, #L#STRING),
#U#CHAROPT = UNION(VOID, #U#CHAR),
BOOLOPT = UNION(VOID, BOOL);
PRIO ORELSE = 2;
# OPerator to return a "default" value if the OPTion is undefined #
OP
ORELSE=(#L#BITSOPT val,#L#BITS def)BITS: (val|(#L#BITS out):out|def),
ORELSE=(#L#BYTESOPT val,#L#BYTES def)BYTES: (val|(#L#BYTES out):out|def),
ORELSE=(#L#INTOPT val,#L#INT def)INT: (val|(#L#INT out):out|def),
ORELSE=(#L#REALOPT val,#L#REAL def)REAL: (val|(#L#REAL out):out|def),
ORELSE=(#L#COMPLOPT val,#L#COMPL def)COMPL: (val|(#L#COMPL out):out|def),
ORELSE=(#L#STRINGOPT val,#L#STRING def)STRING:(val|(#L#STRING out):out|def),
ORELSE=(#U#CHAROPT val,#U#CHAR def)CHAR: (val|(#U#CHAR out):out|def),
ORELSE=( BOOLOPT val, BOOL def)BOOL: (val|( BOOL out):out|def);
# SHORT/LONG etc. #
OP
# OPerator to determin is an OPTion is defined #
HASOPT = (#L#BITSOPT val)BOOL: ( val | (#L#BITS out): TRUE | FALSE),
HASOPT = (#L#BYTESOPT val)BOOL: ( val | (#L#BYTES out): TRUE | FALSE),
HASOPT = (#L#INTOPT val)BOOL: ( val | (#L#INT out): TRUE | FALSE),
HASOPT = (#L#REALOPT val)BOOL: ( val | (#L#REAL out): TRUE | FALSE),
HASOPT = (#L#COMPLOPT val)BOOL: ( val | (#L#COMPL out): TRUE | FALSE),
HASOPT = (#L#STRINGOPT val)BOOL: ( val | (#L#STRING out): TRUE | FALSE),
HASOPT = (#U#CHAROPT val)BOOL: ( val | (#U#CHAR out): TRUE | FALSE),
HASOPT = ( BOOLOPT val)BOOL: ( val | ( BOOL out): TRUE | FALSE);
# SHORT/LONG etc. #
# Note: ℵ indicates attribute is "private", and
should not be used outside of this prelude #
MODE # limited to 4 dimensions #
REFBITSARRAY =UNION(#L#REF BITS, []#L#REF BITS, [,]#L#REF BITS, [,,]#L#REF BITS, [,,,]#L#REF BITS),
REFINTARRAY =UNION(#L#REF INT, []#L#REF INT, [,]#L#REF INT, [,,]#L#REF INT, [,,,]#L#REF INT),
REFREALARRAY =UNION(#L#REF REAL, []#L#REF REAL, [,]#L#REF REAL, [,,]#L#REF REAL, [,,,]#L#REF REAL),
REFCOMPLARRAY=UNION(#L#REF COMPL,[]#L#REF COMPL,[,]#L#REF COMPL,[,,]#L#REF COMPL,[,,,]#L#REF COMPL),
REFCHARARRAY =UNION(#U#REF CHAR, []#U#REF CHAR, [,]#U#REF CHAR, [,,]#U#REF CHAR, [,,,]#U#REF CHAR),
REFBOOLARRAY =UNION( REF BOOL, [] REF BOOL, [,] REF BOOL, [,,] REF BOOL, [,,,] REF BOOL);
# n.b. cannot handle STRUCTs #
MODE #ℵ#SIMPLEIN = UNION(
REFBITSARRAY,REFINTARRAY,REFREALARRAY,REFCOMPLARRAY,REFCHARARRAY,REFBOOLARRAY
);
MODE # limited to 4 dimensions #
BITSARRAY =UNION(#L#BITS, []#L#BITS, [,]#L#BITS, [,,]#L#BITS, [,,,]#L#BITS),
INTARRAY =UNION(#L#INT, []#L#INT, [,]#L#INT, [,,]#L#INT, [,,,]#L#INT),
REALARRAY =UNION(#L#REAL, []#L#REAL, [,]#L#REAL, [,,]#L#REAL, [,,,]#L#REAL),
COMPLARRAY=UNION(#L#COMPL,[]#L#COMPL,[,]#L#COMPL,[,,]#L#COMPL,[,,,]#L#COMPL),
CHARARRAY =UNION(#U#CHAR, []#U#CHAR, [,]#U#CHAR, [,,]#U#CHAR, [,,,]#U#CHAR),
BOOLARRAY =UNION( BOOL, [] BOOL, [,] BOOL, [,,] BOOL, [,,,] BOOL);
# n.b. cannot handle STRUCTs #
MODE #ℵ#SIMPLEOUT = UNION(
BITSARRAY, INTARRAY, REALARRAY, COMPLARRAY, CHARARRAY, BOOLARRAY
);
MODE NEWIO = PROC(REF FILE)VOID;
MODE # limited to 4 dimensions #
#ℵ#SIMPLEOUTA = [0]SIMPLEOUT,
#ℵ#SIMPLEOUTB = [0]UNION(SIMPLEOUT, SIMPLEOUTA),
#ℵ#SIMPLEOUTC = [0]UNION(SIMPLEOUT, SIMPLEOUTA, SIMPLEOUTB),
OUTMODE = [0]UNION(SIMPLEOUT, SIMPLEOUTA, SIMPLEOUTB, SIMPLEOUTC, NEWIO),
OUTMODEF = [0]UNION(SIMPLEOUT, SIMPLEOUTA, SIMPLEOUTB, SIMPLEOUTC, FORMAT),
#ℵ#SIMPLEINA = [0]SIMPLEIN,
#ℵ#SIMPLEINB = [0]UNION(SIMPLEIN, SIMPLEINA),
#ℵ#SIMPLEINC = [0]UNION(SIMPLEIN, SIMPLEINA, SIMPLEINB),
INMODE = [0]UNION(SIMPLEIN, SIMPLEINA, SIMPLEINB, SIMPLEINC, NEWIO),
INMODEF = [0]UNION(SIMPLEIN, SIMPLEINA, SIMPLEINB, SIMPLEINC, FORMAT);
COMMENT
PROC sget = (STRING in s, INMODE list)VOID: raise unimplemented("sget");
PROC sgetf = (STRING in s, INMODEF list)VOID: (
FILE file;
STRING s := in s;
associate(file, s);
getf(file,list);
close(file)
);
END COMMENT
PROC type of = (OUTMODEF list)STRING: (
STRING out := "(";
STRING sep := "";
FOR i TO UPB list DO
out +:= sprint(i);
CASE list[i] IN
(#L# FORMAT):print("#L#FORMAT"),
CO (#L# PROC(#L#REF #L#FILE)#L#VOID):print("#L#NEWIO"), CO
(#L# BITS v):sprint(("#L#BITS=",v)),
(#L# INT v):sprint(("#L#INT=",v)),
(#L# REAL v):sprint(("#L#REAL=",v)),
(#L# COMPL v):sprint(("#L#COMPL=",v)),
(#U# CHAR v):sprint(("#U#CHAR=",v)),
( BOOL v):sprint(("BOOL=",v)),
([]#L# BITS v):sprint(("[]#L#BITS=",v)),
([]#L# INT v):sprint(("[]#L#INT=",v)),
([]#L# REAL v):sprint(("[]#L#REAL=",v)),
([]#L# COMPL v):sprint(("[]#L#COMPL=",v)),
([]#U# CHAR v):sprint(("[]#U#CHAR=",v)),
([] BOOL v):sprint(("[]BOOL=",v)),
([,]#L# BITS v):sprint(("[,]#L#BITS=",v)),
([,]#L# INT v):sprint(("[,]#L#INT=",v)),
([,]#L# REAL v):sprint(("[,]#L#REAL=",v)),
([,]#L# COMPL v):sprint(("[,]#L#COMPL=",v)),
([,]#U# CHAR v):sprint(("[,]#U#CHAR=",v)),
([,] BOOL v):sprint(("[,]BOOL=",v)),
([,,]#L# BITS v):sprint(("[,,]#L#BITS=",v)),
([,,]#L# INT v):sprint(("[,,]#L#INT=",v)),
([,,]#L# REAL v):sprint(("[,,]#L#REAL=",v)),
([,,]#L# COMPL v):sprint(("[,,]#L#COMPL=",v)),
([,,]#U# CHAR v):sprint(("[,,]#U#CHAR=",v)),
([,,] BOOL v):sprint(("[,,]BOOL=",v))
CO (#L# BYTES v):print(("#L#BYTES",[]#L#CHAR(v)))CO
OUT
sprint("REF[]STRUCT or SHORT/LONG etc")
ESAC;
sep := ","
OD;
out+")"
);
PROC sput = (REF STRING out, OUTMODE list)VOID: (
FILE file;
associate(file, out);
put(file,list);
close(file);
out
);
PROC sputf = (REF STRING out, OUTMODEF list)STRING: (
FILE file;
associate(file, out);
CASE list[1] IN
(FORMAT f):putf(file, (list[1], list[2:])) #BF#
OUT
putf(file,list)
ESAC;
close(file);
out
);
PROC sprint = (OUTMODE list)STRING: (
STRING out;
sput(out, list);
out
);
PROC sprintf = (OUTMODEF list)STRING: (
STRING out;
sputf(out, list);
out
);
SKIP