# -*- 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