##############################################################################################
#                                                                                            #
# Agena Library File                                                                         #
#                                                                                            #
# These are procedures written in Agena and are part of the standard distribution.           #
# Do not delete or edit this file.                                                           #
#                                                                                            #
# See Chapter 6 for information on how to extend Agena's functionality.                      #
#                                                                                            #
##############################################################################################

# CHANGE THE PATCHLEVEL IF YOU MODIFY library.agn or any other agn library WITHOUT COMPILING
# A NEW C VERSION. NO Agena library update: comment the following assignment.

#environ.libpatchlevel := 1;

# printf as known from C; found in the 'compat.lua' file shipped with Lua; extended 1.12.0 u1
printf := proc(?) is
   local fd := varargs[1];
   if io.isfdesc(fd) then  # 1.12.0 u1
      io.write(fd, strings.format(unpack(varargs, 2, nargs)));
      io.sync(fd)
   else
      io.write(strings.format(unpack(varargs)));
      io.sync()  # for Solaris to print text immediately at the console
   fi;
end;


##############################################################################################
# operating system functions, add-ons to the os library                                      #
##############################################################################################

# os.list: list the contents of a directory (optionally recursively), October 12, 2008, 0.12.2;
# extended 0.24.1, July 04, 2009; patched July 12, 2009; patched November 20, 2009; fixed and
# extended 0.31.3, March 23, 2010; extended 1.1.0 November 26, 2010

os.list := proc(dirname, ?) is
   local olddirname, restorecwd, dir, p, pattern, topp, options, isrec;
   if unassigned(dirname) then dirname := os.chdir() fi;
   if dirname :- string then  # Agena 1.3.1 fix
      argerror(dirname, 'os.list', 'expected a string or null')
   fi;
   olddirname := os.chdir();
   dirname := replace(dirname, '\\', '/');
   #for i from size dirname to 1 by -1 while size dirname > 1 and dirname[i] = '/' do  # Agena 1.3.1: remove trailing slashes
   for i from size dirname downto 1 while size dirname > 1 and dirname[i] = '/' do  # Agena 1.3.1/2.30 RC 1: remove trailing slashes
      dirname := dirname[1 to -2]
   od;
   p := dirname split '/';
   topp := top(p);
   options := unique(varargs);
   if 'r' in options then  # recursive descent ?  Agena 1.1.0
      delete 'r' from options;
      isrec := true;
   fi;
   if topp <> null and ('*' in topp or '?' in topp or topp = '.') then
      # is there a joker or dot in the end of the path ?
      if topp <> '.' then insert topp into options fi;  # 1.9.4
      pop top from p;
      dirname := join(p, '/')
   fi;
   if unique(p) = seq('..') then  # process something like '../../..'
      local q := os.chdir() split '/';
      if size q <= size p then
         dirname := '/'
      else
         for i to size p do
            pop top from q
         od;
         dirname := join(q, '/')
      fi
   fi;
   if size dirname = 2 and dirname[2] = ':' then  # drive letter has been passed ?
      restorecwd := true;
      os.chdir(dirname);
      dirname := '/'
   elif dirname = '' then  # dirname was something like '*.c' ?
      dirname := os.chdir()
   fi;
   dir := os.listcore(dirname, unpack(options));  # listcore does not understand the 'r' option, 1.9.4
   if dir = null then
      if restorecwd then os.chdir(olddirname) fi;
      return null
   fi;
   if isrec then  # traverse subfolders recursively, Agena 1.1.0, patched Agena 1.3.1, patched 1.6.12, patched 1.9.4
      local olddirname, subdir;
      insert 'r' into options;
      olddirname := os.chdir();
      os.chdir(dirname);
      for i in os.list(dirname, 'dirs') do
         subdir := os.list(dirname & '/' & i, unpack(options));
         for j in subdir do
            insert i & '/' & j into dir
         od
      od;
      os.chdir(olddirname);
   fi;
   if restorecwd then os.chdir(olddirname) fi;
   sort(dir);
   return dir, dirname
end;


os.isUNIX := proc() is  # 0.13.4 patch
   local sysname := os.system()[1];
   return sysname in {'SunOS', 'Linux', 'linux', 'HP-UX'} or
          'IRIX' in sysname = 1 or
          'AIX' in sysname = 1 or
          'FreeBSD' in sysname = 1
end;


# If a package consists of both a C dynamic link library and an Agena source file, then
# issue a warning if the C dynamic link library could not be found. 0.32.2a
package.checkclib := proc(pn :: string) is
   if not(pn in tables.indices(package.loaded)) then
      print('Warning, the C dynamic link library for package `' & pn & '` could not be found.');
      print('You can only try to use those package functions written in the Agena language.');
      create table _G[pn]  # initialise package table
   fi
end;


# 0.31.6
io.pcall := proc(call :: string, option) is
   local p, r;
   if unassigned(option) then
      option := 'r'
   elif not(option in {'r', 'w'}) then
      error('Error in `io.pcall`: second argument must be either \'r\' or \'w\'.')
   fi;
   p := io.popen(call, option);
   r := io.readlines(p);
   io.close(p);
   return if filled(r) then r else fail fi
end;


##############################################################################################
#  Table functions, add-on to tables package                                                 #
##############################################################################################

# intersection of two tables or sequences u, v; uses binary search; if no option (any) is given,
# the second set is sorted before comparison.
# The type of return is determined by the type of the first argument.
# Algorithm for binary comparison taken from Niklaus Wirth,
# `Algorithmen und Datenstrukturen mit Modula-2`, 4th ed., 1986, p. 58
# 0.9.1, 14.01.2008; extended 0.12.2, 14.12.2008; patched 0.24.2, 05.07.2009; tuned 12.07.2009

bintersect := proc(u :: {table, sequence}, v :: {table, sequence}, option) is
   local m, l, r, x, y, nx, ny, temp, result;
   # always binsearch in the bigger table
   nx := size u; ny := size v;
   if nx < ny then
      x, y := u, if assigned(option) then v else copy(v) fi;
   else
      y, x := is assigned(option) then u else copy(u) si, v;
      nx, ny := ny, nx
   fi;
   if unassigned(option) then sort(y) fi;
   if u :: table then
      create table result(nx)
   else
      create sequence result(nx)
   fi;
   for i in x do
      l := 1; r := ny;
      while l < r do
         m := (l + r) \ 2;
         if y[m] < i then
            l := m + 1
         else
            r := m
         fi
      od;
      if i = y[r] then
         insert i into result
      fi
   od;
   return result
end;


# difference u \ v, u and v being tables or sequences; uses binary search; if no
# option (any) is given, the second set is sorted before comparison.
# The type of return is determined by the type of the first argument.
# Algorithm for binary comparison taken from Niklaus Wirth,
# `Algorithmen und Datenstrukturen mit Modula-2`, 4th ed., 1986, p. 58
# 0.9.1, 14.01.2008; extended 0.12.2, 14.12.2008; patched 0.24.2, 05.07.2009; tuned 12.07.2009

bminus := proc(u :: {table, sequence}, v :: {table, sequence}, option) is
   local m, n, l, r, y, result;
   y := is assigned(option) then v else copy(v) si;
   if unassigned(option) then sort(y) fi;
   n := size y;
   if u :: table then
      create table result(n)
   else
      create sequence result(n)
   fi;
   for i in u do
      l := 1; r := n;
      while l < r do
         m := (l + r) \ 2;
         if y[m] < i then
            l := m + 1
         else
            r := m
         fi
      od;
      if i <> y[r] then
         insert i into result
      fi
   od;
   return result
end;


# compares the values of two tables or sequences; uses binary search; if no option (any) is given,
# the second set is sorted before comparison.
# Algorithm for binary comparison taken from Niklaus Wirth,
# `Algorithmen und Datenstrukturen mit Modula-2`, 4th ed., 1986, p. 58
# 0.12.2, 10.11.2008; changed 0.12.2, 14.12.2008; patched 0.24.2, 05.07.2009; tuned 12.07.2009
# modified 0.32.2b, 29.05.2010

bisequal := proc(u :: {table, sequence}, v :: {table, sequence}, option) is
   local m, l, r, x, y, nx, ny, temp, result;
   nx := size u; ny := size v;
   if nx < ny then
      x, y := u, if assigned(option) then v else copy(v) fi;
   else
      y, x := is assigned(option) then u else copy(u) si, v;
      nx, ny := ny, nx
   fi;
   if unassigned(option) then sort(y) fi;
   for i in x do
      l := 1; r := ny;
      while l < r do
         m := (l + r) \ 2;
         if y[m] < i then
            l := m + 1
         else
            r := m
         fi
      od;
      if i <> y[r] then
         return false
      fi
   od;
   return true
end;


#/ create a table with values a .. b. If b is omitted, values 1 .. a are created.
   Written June 17, 2007; tuned 19.01.2008 /#

tables.seqt := proc(a :: number, b) is
   local start, stop, c, result;
   if unassigned(b) then
      start := 1; stop := a
   else
      if b :- number then
         argerror(b, 'tables.seqt', 'number expected')
      fi;
      start := a; stop := b
   fi;
   create table result(stop-start+1);
   c := 0;
   for i from start to stop do
      inc c;
      result[c] := i
   od;
   return result
end;


# find duplicate values in a table or sequence, 0.9.1, 25.01.2008; patched 09.03.2008; extended 14.12.2008;
# tuned 12.07.2009, tuned 11.05.2014
duplicates := proc(tbl :: {table, sequence, register}, option) is
   local t, lastone, result, c;
   t := if assigned(option) then tbl else copy(tbl) fi;  # do not overwrite original table
   if unassigned(option) then sort(t) fi;
   if tbl :: register then
      create register result(size tbl)
   else
      result := if tbl :: table then [] else seq() fi
   fi;
   lastone := null;  # null never is a value in a table or sequence - with registers, any null's or ignored
   c := 0;
   for i in t do
      if i = lastone and not(i in result) then
         insert i into result;
         inc c
      fi;
      lastone := i;
   od;
   if result :: register then  # 2.3.0 RC 3
      registers.reduce(result, c)
   fi
   return result
end;


##############################################################################################
# system functions, add-ons to base library                                                  #
##############################################################################################

environ.anames := proc(option) is
   # description: returns the global environment as a table
   # written July 27, 2005; modified Sept 20, 2005; Dec 17, 2006; Nov 12, 2007 & Dec 08, 2007
   # modified November 02, 2009
   # Originally created by Joe Riel, San Diego, CA, for Maple V.
   create local table result;
   for i, j in _G do
      if assigned(option) and typeof(j) <> option then  # option is a type name
         skip
      fi;
      insert i into result
   od;
   sort(result);
   return result
end;


# determine global variables inside procedures. Call with f = <procname>
# by David Manura, 2008, written originally for Lua 5.1.
environ.globals := proc(f, env) is  # changed 2.2.1
   local fp, flag, r;
   fp := f or 1;
   create sequence r;
   flag := false;
   if fp :: number then inc fp fi;
   env := env or environ.getfenv(1);  # Agena 1.6.0 patch
   local gref := debug.getinfo(fp, 'g').globals;
   for i to size gref by gref.ncols do
      local op, name, linenum := unpack(gref, i, i+2);
      if assigned(name) and unassigned(env[name]) then
         insert name : (linenum or undefined) into r;
         flag := true
      fi
   od;
   return if flag then r else null fi
end;


environ.isselfref := proc(s) is
   if s :: pair then
      local ps := environ.pointer(s);
      if environ.pointer(left(s)) = ps or environ.pointer(right(s)) = ps then  # Agena 1.8.9 fix
         return true
      fi;
   fi;
   return recurse(s, << x -> environ.pointer(x) = environ.pointer(s) >>)
end;


environ.minnumber := math.nextafter(-infinity, 0);  # 1.6.0
environ.maxnumber := math.nextafter(infinity, 0);   # 1.6.0


# function to conduct a Cantor set equality operation in argument lists
isequal := proc(a, b) is
   return a = b
end


# Checks whether the structure o is a table, set, pair, or sequence, and whether it is of the type given by <main>, and
# whether all its elements are of type <sub>'. It returns true or false. March 12, 2012
# checktype([], table, table): -> true
checktype := proc(o, main :: string, sub :: string) is
   if o :- main then
      return false
   fi;
   case type(o)
      of table, sequence, set, register then
         if size o = 0 and sub <> 'null' then return false fi;  # Agena 1.8.3 u1 patch
         for i in o do
            if i :- sub then
               return false
            fi
         od;
         return true
      of pair then
         return left(o) :: sub and right(o) :: sub
      else
         return false
   esac
end;


# a simple interface to administer the remember table of a function; February 05, 2008
rtable.remember := proc(f :: procedure, t) is
   if nargs = 1 then
      return rtable.rget(f)
   elif t :- table and t <> null then
      argerror(t, 'rtable.remember', 'table or null expected as second argument')
   fi;
   if rtable.rmode(f) <> 'rtable' then rtable.rinit(f) fi;  # not(hasrtable(f))
   if t = null then
      rtable.rdelete(f);
      environ.gc()
   else
      for i, j in t do
         if i :- table and j :- table then
            rtable.rset(f, [i], [j])
         elif i :: table and j :: table and size i > 0 and size j > 0 then
            rtable.rset(f, i, j)
         else
            error('Error in `rtable.remember`: wrong type of argument or invalid table entries.')
         fi
      od
   fi
end;


# a simple interface to administer the defaults rotable of a function; May 23, 2009
rtable.defaults := proc(f :: procedure, t) is
   if nargs = 1 then
      return rtable.rget(f)
   elif t :- table and t <> null then
      error('Error in `rtable.defaults`: need a table or null as second argument.')
   fi;
   if rtable.rmode(f) <> 'rtable' then rtable.roinit(f) fi;  # not(hasrtable(f))
   if t = null then
      rtable.rdelete(f);
      environ.gc()
   else
      for i, j in t do
         if i :- table and j :- table then
            rtable.rset(f, [i], [j])
         elif i :: table and j :: table and size i > 0 and size j > 0 then
            rtable.rset(f, i, j)
         else
            error('Error in `rtable.defaults`: wrong type of argument or invalid table entries.')
         fi
      od
   fi
end;


# short names for io.write* functions
write := proc(?) is
   io.write(unpack(varargs));
   io.sync()  # for UNIX/Solaris to print text at console immediately
end;


writeline := proc(?) is
   io.writeline(unpack(varargs));
   io.sync()  # for UNIX/Solaris to print text at console immediately
end;


environ.infolevel := [];  # table queried by `userinfo` function


#/package.register := proc(tbl :: table, ?) is
   if nargs < 2 then error('Error in `package.register`: need at least a table and a string.') fi;
   local r;
   r := if assigned(tbl.loaded) then tbl.loaded else [] fi;
   for i in varargs do
      if i :- string then
         error('Error in `package.register`: string expected.')
      fi;
      if not(i in r) then
         insert i into r
      fi
   od;
   tbl.loaded := r
end;/#


# written July 08, 2008, 0.12.0; patched February 23/28, 2009, 0.13.0; modified 0.24.0, June 27, 2009;
# extended 0.26.0, August 04, 2009; extended December 24, 2009; extended June 11, 2013
with := proc(t :: string, ?) is
   local names, fnames, overwritten, pkgstr, resagn, resso, err, libpkgagn, searchpath, pathsep;
   create table names, table overwritten;
   if t = 'environ.aux' then
      error('Error in `with`: `environ.aux` cannot be initialised.')
   fi;
   pathsep := environ.kernel('pathsep');
   searchpath := os.chdir() & pathsep & mainlibname & pathsep & libname;
   for i in searchpath split pathsep do
      # try to find and load C library with the given name in the given folder
      resso := package.loadclib(t, i);
      # try to find a library .agn file in the given folder
      libpkgagn := i & '/' & t & '.agn';
      resagn, err := loadfile(libpkgagn);
      if resagn <> null then
         # file has been found and is syntactically correct
         run(libpkgagn);
         break  # quit the loop
      elif resagn = null and 'Error in' in err then
         # file has been found but there was a syntax error; if the file has not been found,
         # then res is null as well, but the error message is `cannot open <filename> ...`
         error(err)
      elif resso = true then  # C library and agn library file must reside in the same folder
         break
      fi
   od;
   if unassigned(_G[t]) then
      error('Error in `with`: package `' & t & '` not found.')
   else  # register package
      package.loaded[t] := _G[t];
      insert t into package.readlibbed
   fi;
   # is there a package initialization procedure ? ...
   if assigned(_G[t].init) and _G[t].init :: procedure then
      _G[t].init()  # ... If so, then execute it
   elif assigned(_G[t].aux) and _G[t].aux :: table and assigned(_G[t].aux.init) and _G[t].aux.init :: procedure then  # 1.11.8 change
      _G[t].aux.init()  # ... If so, then execute it
   fi;
   if nargs = 1 or isboolean(varargs..[nargs-1]) then
      # If function names have been put into the <pkgname>.aux table, do not assign short names for these function names;
      # otherwise assign short names for _all_ other package functions.
      # Note that `t` is a string and not a name, so we need to index _G with t ( _G.t ) to get access
      # to the `loaded` package table.
      fnames := tables.indices(_G[t]);  # Agena 1.6.0
      delete 'loaded', 'aux' from fnames;  # also ignore names in the <pkgname>.loaded table.
      fnames := unique(fnames)
   else
      # traverse all optional arguments
      fnames := varargs;
      if size fnames <> nargs - 1 then writeline('Warning: optional argument is null, skipping.') fi;  # 0.13.0 fix
   fi;
   for i in fnames do
      if i :- string then
         argerror(i, 'with', 'optional argument must be a string')  # 2.0.0
      fi;
      if not assigned(_G[t][i]) then writeline('Warning: ', i, ' does not exist.'); skip fi;
      # do not change to :: operator, since :: also checks for user-defined types and thus ignores the basic type.
      if type(_G[t][i]) = procedure or (nargs <> 1 and _G[t][i] :: table) then  # 1.4.0
         # only assign short names for package procedures;
         # in case of more than one argument to with, assign short names to tables, as well.
         if assigned(_G[i]) then
            if _G[i] :: table then
               writeline('Warning: procedure name `', i, '` is also a table name, skipping.');  # 2.1.1
               skip
            fi;
            if assigned(environ.withprotected) and (i in environ.withprotected) then
               writeline('Warning: trying to reassign protected name `', i, '`, skipping.');
               skip
            fi;
            insert i into overwritten
         fi;
         _G[i] := _G[t][i];  # assign package procedure to global environment
         insert i into names
      fi
   od;
   if environ.withverbose <> false then  # write user information
      if filled(overwritten) then  # write names that have been reassigned
         sort(overwritten);
         writeline('Warning: ', join(overwritten, ', '), ' ',
            if size(overwritten) = 1 then 'has' else 'have' fi, ' been reassigned.\n');
      fi;
      if nargs = 1 or varargs..[nargs-1] = true then  # 2.0.0
         if assigned(_G[t].initstring) then  # print package welcome message
            writeline(_G[t].initstring)
         fi;
         sort(names);
         print(join(names, ', '))
      fi
   fi;
   return names  # return list of short names
end;


# writes regular Agena data to the open file denoted by file descriptor fd. Does recognize
# user-defined data, but does not support procedures, threads, userdata, and lightuserdata.
#
# The data is written in the following steps:
#
# 1) the type of object is stored first,
# 2) in case of a table, sequence, or set, the number of entries is stored to the file,
# 3) then the data itself is written.
#
# If a third argument is given (may be any), then the function does not issue an error if it
# found a type that it can not handle. In this case, nothing is written to the file.
#
# October 25, 2008, 0.12.2; extended December 14/31, 2008

binio.writeobject := proc(fd, data, option) is
   # check type of data
   case type(data)
      of number then
         local isint := not(float(data));
         # if data is an integer then
         if isint and data > -1 and data < 256 then
            binio.writechar(fd, 0, data);
         elif isint and data > environ.kernel('minlong') and data < environ.kernel('maxlong') then  # Agena 1.8.3 u1 patch
            # write integer as a uint32_t (4 bytes) which consumes less space than a lua_Number;
            # on 16-bit systems a long is bigger than int.
            binio.writechar(fd, 1);
            binio.writelong(fd, data)
         else  # write number as lua_Number
               # (converting `short` numbers to strings and converting them back again produces round-off errors)
            binio.writechar(fd, 2);
            binio.writenumber(fd, data)
         fi;
      of string then
         if size data > 255 then
            binio.writechar(fd, 3);
            binio.writestring(fd, data)
         else
            binio.writechar(fd, 4);
            binio.writeshortstring(fd, data)
         fi
      # from now on the function is called recursively (except with the last two queries)
      of table then
         local utypeset;
         utypeset := gettype(data);
         binio.writechar(fd, 5 || abs(utypeset <> null)*32);
         binio.writenumber(fd, size data);  # number of entries;
            # 1.8.12 u1,  size does not always return correct number of entries with tables containing holes
         if utypeset <> null then
            binio.writestring(fd, utypeset)
         fi;
         for i, j in data do
            binio.writeobject(fd, i);  # write key
            binio.writeobject(fd, j)   # write value
         od
      of set then
         binio.writechar(fd, 6);
         binio.writenumber(fd, size data);  # number of entries
         for i in data do
            binio.writeobject(fd, i)  # write element
         od
      of sequence then
         local utypeset := gettype(data);
         binio.writechar(fd, 7 || abs(utypeset <> null)*32);
         binio.writenumber(fd, size data);  # number of entries
         if utypeset <> null then
            binio.writestring(fd, utypeset)
         fi;
         for i in data do
            binio.writeobject(fd, i)  # write value
         od
      of pair then
         local utypeset := gettype(data);
         binio.writechar(fd, 8 || abs(utypeset <> null)*32);
         if utypeset <> null then
            binio.writestring(fd, utypeset)
         fi;
         binio.writeobject(fd, left(data));
         binio.writeobject(fd, right(data))
      of complex then
         binio.writechar(fd, 9);
         binio.writeobject(fd, real(data));
         binio.writeobject(fd, imag(data))
      of boolean then
         binio.writechar(fd, 10);
         case data
            of false then binio.writechar(fd, 0);
            of true then binio.writechar(fd, 1);
            of fail then binio.writechar(fd, 2)
         esac
      of 'null' then
         binio.writechar(fd, 11)
      of procedure then  # Agena 1.6.1
         local str := toseq(strings.dump(data));  # writing a string to the binary file does not work
         if size str > environ.kernel('maxlong') then
            error('Error in `binio.writeobject`: procedure too large.')
         fi;
         binio.writechar(fd, 12);
         binio.writelong(fd, size str);
         for i in str do
            binio.writechar(fd, abs(i))
         od
      of register then  # Agena 2.3.0 RC 3
         binio.writechar(fd, 13);
         binio.writenumber(fd, registers.gettop(data));  # number of visible entries
         for i in data do
            binio.writeobject(fd, i)  # write value
         od
      else
         if not(option) then
            error('Error in `binio.writeobject`: type ' & type(data) & ' not supported.')
         fi  # 0.31.7 patch
   esac
end;


# save an object to the given file denoted by fn (a string); 0.12.2, 26.10.2008

save := proc(o, fn :: string) is
   local fd;
   if environ.isselfref(o) then
      error('Error in `save`: first argument is a self-referencing object.')
   fi;
   if os.exists(fn) then  # avoid overwriting and thus corrupting the file, 0.31.8
      os.remove(fn)
   fi;
   try  # 2.2.6
      fd := binio.open(fn)
   catch
      error('Error in `save`: could not create ' & fn & '.')
   yrt;
   binio.lock(fd);  # Agena 1.8.5
   # write file header
   binio.writebytes(fd, strings.tobytes('AGENAWORKSPACE'));
   binio.writechar(fd, 1);
   binio.writechar(fd, 0);
   # write data
   binio.writeobject(fd, o);
   binio.unlock(fd);  # Agena 1.8.5
   try
      binio.close(fd)
   catch
      error('Error in `save`: could not close ' & fn & '.')
   yrt
end;


# read an object from the given file denoted by fn (a string) and return it; 0.12.2, 26.10.2008;
# extended for binio.close error handling April 06, 2009, 0.14.0
read := proc(fn :: string) is
   local fd, o;
   try  # 2.2.5
      fd := binio.open(fn, true);  # open in read mode only
   catch
      error('Error in `read`: could not open ' & fn & '.')
   yrt;
   o := binio.readobject(fd);
   try
      binio.close(fd)
   catch
      error('Error in `read`: could not close ' & fn & '.')
   yrt;
   return o
end;


# Extracts the given columns from two-dimensional tables or sequences. The type of return is determined
# by the type of the first argument and is either a table/sequence of tables/sequences if the option 'structure'
# is given, or a multiple return of tables or sequences. Agena 1.7.1 pl 1. 18.07.2012

columns := proc(L, ?) is
   local R, S, T, retstruct;
   retstruct := false;
   if size varargs = 0 then
      error('Error in `columns`: expected at least two arguments or positive column numbers.')
   elif varargs[nargs-1] = 'structure' then
      varargs[nargs-1] := null;
      retstruct := true  # return result in a structure, do not unpack it
   fi;
   if not isposint(unpack(varargs)) then
      error('Error in `columns`: expected positive column numbers.')
   fi;
   if L :: table then
      create table S(size L), table T(nargs-1)
   elif L :: sequence then
      create sequence S(size L), sequence T(nargs-1)
   else
      argerror(L, 'columns', 'expected a table or sequence')
   fi;
   if not filled(L) then
      error('Error in `columns`: structure is empty.')
   fi;
   for k in varargs do
      R := copy(S);
      for i, j in L do
         if j :- table and j :- sequence then
            argerror(j, 'columns', 'first argument must consist of tables or sequences')
         fi;
         if size j >= k then
            R[i] := j[k]
         else
            error('Error in `columns`: column does not exist.')
         fi
      od;
      insert R into T
   od;
   if retstruct then
      return T
   else
      return unpack(T)
   fi
end;


# Joins two or more tables or sequences together horizontally. The arguments must either be
# tables only, or sequences only. The tables or sequences all must have the same size.
# The type of return is determined my the type of the arguments. Agena 1.7.1 pl 1. 18.07.2012
augment := proc(?) is
   local first, firstsize, R, retseq;
   if nargs < 2 then
      error('Error in `augment`, must get at least two structures.')
   fi;
   if not(istable(unpack(varargs)) or isseq(unpack(varargs))) then
      error('Error in `augment`: expected either tables or sequences.')
   fi;
   firstsize := size varargs[1];
   if varargs[1] :: table then
      create table R(firstsize)
   else
      create sequence R(firstsize); retseq := true
   fi;
   for i to firstsize do
      first := varargs[1, i];
      insert if retseq then seq(first) else [first] fi into R
   od;
   for i from 2 to nargs do
      if firstsize <> size(varargs[i]) then
         error('Error in `augment`: structures must have the same size.')
      fi;
      for j to firstsize do
         insert varargs[i, j] into R[j]
      od
   od;
   return R
end;


##############################################################################################
# Additional strings package procedures                                                      #
##############################################################################################

# The C version is twice as fast, but with this Agena function, at least the mapping tables
# can be changed easily if Agena is not run on codepage 1252. Rewritten September 08, 2011;
# patched 21.08.2012

strings.diamap := proc(str :: string) is
   if unassigned(strings.f2c or strings.c2f) then  # initialise substitution tables only once
      # Mapping table for codepage 1252 (Windows Latin-1), maps characters in a file to console layout
      strings.f2c := seq(
         0, 1, 2, 3, 4, 5, 6, 7, 8, 9,
         10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
         20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
         30, 31, 32, 33, 34, 35, 36, 37, 38, 39,
         40, 41, 42, 43, 44, 45, 46, 47, 48, 49,
         50, 51, 52, 53, 54, 55, 56, 57, 58, 59,
         60, 61, 62, 63, 64, 65, 66, 67, 68, 69,
         70, 71, 72, 73, 74, 75, 76, 77, 78, 79,
         80, 81, 82, 83, 84, 85, 86, 87, 88, 89,
         90, 91, 92, 93, 94, 95, 96, 97, 98, 99,
         100, 101, 102, 103, 104, 105, 106, 107, 108, 109,  # 100 .. 109
         110, 111, 112, 113, 114, 115, 116, 117, 118, 119,  # 110 .. 119
         120, 121, 122, 123, 124, 125, 126, 127, 128, 129,  # 120 .. 129
         130, 131, 132, 133, 134, 135, 136, 137, 138, 139,  # 130 .. 139
         153, 141, 142, 143, 144, 145, 146, 147, 148, 149,  # 140 .. 149
         150, 151, 152, 153, 154, 155, 148, 157, 158, 159,  # 150 .. 159
         160, 161, 162, 163, 164, 165, 166, 245, 168, 169,  # 160 .. 169
         170, 171, 172, 173, 174, 175, 176, 177, 178, 179,  # 170 .. 179
         180, 181, 182, 183, 184, 185, 186, 187, 188, 189,  # 180 .. 189
         190, 168, 183, 181, 182, 199, 142, 143, 146, 128,  # 190 .. 199
         212, 144, 210, 211, 222, 214, 215, 216, 209, 165,  # 200 .. 209
         227, 224, 226, 229, 153, 215, 157, 235, 233, 234,  # 210 .. 219
         154, 237, 232, 225, 133, 160, 131, 198, 132, 134,  # 220 .. 229
         145, 135, 138, 130, 136, 137, 141, 161, 140, 139,  # 230 .. 239
         208, 164, 149, 162, 147, 228, 148, 247, 155, 151,  # 240 .. 249
         163, 150, 129, 236, 231, 152                       # 250 .. 255
      );
      # Mapping table for codepage 1252 (Windows Latin-1), maps characters from console to file format
      strings.c2f := seq(
         0, 1, 2, 3, 4, 5, 6, 7, 8, 9,
         10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
         20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
         30, 31, 32, 33, 34, 35, 36, 37, 38, 39,
         40, 41, 42, 43, 44, 45, 46, 47, 48, 49,
         50, 51, 52, 53, 54, 55, 56, 57, 58, 59,
         60, 61, 62, 63, 64, 65, 66, 67, 68, 69,
         70, 71, 72, 73, 74, 75, 76, 77, 78, 79,
         80, 81, 82, 83, 84, 85, 86, 87, 88, 89,
         90, 91, 92, 93, 94, 95, 96, 97, 98, 99,
         100, 101, 102, 103, 104, 105, 106, 107, 108, 109,  # 100 .. 109
         110, 111, 112, 113, 114, 115, 116, 117, 118, 119,  # 110 .. 119
         120, 121, 122, 123, 124, 125, 126, 127, 199, 252,  # 120 .. 129
         233, 226, 228, 224, 229, 231, 234, 235, 232, 239,  # 130 .. 139
         238, 236, 196, 197, 201, 230, 198, 244, 246, 242,  # 140 .. 149
         251, 249, 255, 214, 220, 248, 156, 216, 158, 159,  # 150 .. 159
         225, 237, 243, 250, 241, 209, 166, 167, 191, 169,  # 160 .. 169
         170, 171, 172, 173, 174, 175, 176, 177, 178, 179,  # 170 .. 179
         180, 193, 194, 192, 184, 185, 186, 187, 188, 189,  # 180 .. 189
         190, 191, 192, 193, 194, 195, 196, 197, 227, 195,  # 190 .. 199
         200, 201, 202, 203, 204, 205, 206, 207, 240, 208,  # 200 .. 209
         202, 203, 200, 213, 205, 206, 207, 217, 218, 219,  # 210 .. 219
         220, 221, 204, 223, 211, 223, 212, 210, 245, 213,  # 220 .. 229
         230, 254, 222, 218, 219, 217, 253, 221, 238, 239,  # 230 .. 239
         240, 241, 242, 243, 244, 167, 246, 247, 248, 249,  # 240 .. 249
         250, 251, 252, 253, 254, 255                       # 250 .. 255
      );
   fi;
   if nargs = 1 then
      # one argument ? -> assume that arg has been read from a file
      return utils.singlesubs(str, strings.f2c)
   else
      # more than one argument ?  -> assume that you want to write to a file
      return utils.singlesubs(str, strings.c2f)
   fi
end;


# A wrapper around strings.gmatch which returns all occurrences of pattern in str in a sequence.
# January 24, 2010
strings.gmatches := proc(str :: string, pattern :: string) is
   local f, r, result;
   create sequence result;
   f := strings.gmatch(str, pattern);
   r := f();
   while r do
      insert r into result;
      r := f()
   od;
   return result
end;


strings.ljustify := proc(str, n :: number, ?) is
   local filler, r;
   if str :: number then  # 1.11.2u1
      str := tostring(str)
   elif str :- string then
      argerror(str, 'strings.ljustify', 'first argument must be a number or string')
   fi;
   if n < 1 then
      error('Error in `strings.ljustify`: second argument must be positive.')
   fi;
   if nargs = 2 then
      filler := ' '
   else
      filler := varargs[1];
      if filler :- string then
         argerror(filler, 'strings.ljustify', 'third argument must be a string')
      fi
   fi;
   r := str & strings.repeat(filler, n - size str);
   if size r <= n then
      return r
   else
      return r[1 to n]
   fi
end;


strings.rjustify := proc(str, n :: number, ?) is
   local filler, r;
   if str :: number then  # 1.11.2u1
      str := tostring(str)
   elif str :- string then
      argerror(str, 'strings.rjustify', 'first argument must be a number or string')
   fi;
   if n < 1 then
      error('Error in `strings.rjustify`: second argument must be positive.')
   fi;
   if nargs = 2 then
      filler := ' '
   else
      filler := varargs[1];
      if filler :- string then
         argerror(filler, 'strings.rjustify', 'third argument must be a string')
      fi
   fi;
   r := strings.repeat(filler, n - size str) & str;
   if size r <= n then
      return r
   else
      return r[-n to -1]
   fi
end;


strings.align := proc(str :: string, len) :: string is
   local r, line, text, linelen;
   if unassigned(len) then len := 79 fi;
   if len :- number or len < 1 then
      error('Error in `strings.align`: length must be a positive integer.')
   fi;
   linelen := 0;
   text := str split ' ';
   create sequence r;
   line := '';
   for i in text do
      inc linelen, size i;
      if linelen - abs(line[-1] = ' ') >= len then
         if line[-1] = ' ' then line := line[1 to -2] fi;
         insert line into r;
         line := '';
         linelen := size i
      fi;
      inc linelen;
      line := line & i & ' '
   od;
   insert line[1 to -2] into r;
   return join(r, '\n')
end;


strings.mfind := proc(str :: string, pat :: string, pos, plain) is  # Agena 1.10.0
   local p;
   if assigned(pos) and pos :- number then
      error('Error in `strings.mfind`: expected a number for argument #3.')
   fi;
   if assigned(plain) and pos :- boolean then
      error('Error in `strings.mfind`: expected a boolean for argument #4.')
   fi;
   p := instr(str, pat, 'borders', pos, plain);
   if unassigned(p) then return null fi;
   create local seq r;
   while p <> null do
      insert p into r;
      break when right(p) = left(p) - 1;  # prevent infinite loop
      p := instr(str, pat, 'borders', right(p) + 1, plain)
   od;
   return r
end;


##############################################################################################
#  Mathematical functions, add-on to math package                                            #
##############################################################################################

create table math.aux;

# number of digits in number n; improved May 01, 2014
math.ndigits := << n :: number -> entier(ln(n)/ln(10) + 1) >>;


# returns the n-th decimal place of a number (in the fractional part)
math.nthdigit := proc(x :: number, d :: number) is  # 2.2.0
   if x = 0 then
      return 0  # 2.2.5
   elif float(d) or d < 1 then
      error('Error in `math.nthdigit`: second argument must be a positive.')
   fi;
   if d > 0 then
      dec d
   fi;
   return int(x/10**d % 10)
end;


# splits a number representing a sexagesimal number in TI-30 DMS format into its parts and returns
# three numbers: the degrees, minutes, and seconds.  Example: -10.3045 represents -10°30'45''
# The implementation using strings is much more accurate than determining the parts numerically
# (try converting 8.45).
# See also: math.dd, math.dms.
math.splitdms := proc(x :: number) is
   local m, s, str, pos;
   str := strings.format('%20.8f', x);
   pos := ('.' in str) + 1;
   m := tonumber(str[pos to pos + 1]);
   s := tonumber(strings.include(str[pos + 2 to -1], 3, '.'));
   return int(x), m, s
end;

# converts a number representing a sexagesimal number in TI-30 DMS format into its decimal representation,
# and returns a number. Example: 10.3045 representing 10°30'45'' returns 10.5125.
# See also: math.dms, math.splitdms.
math.dd := << x :: number -> math.todecimal(math.splitdms(x)) >>;

# converts a number representing a decimal sexagesimal number into its TI-30 DMS number representation.
# Example: 10.5125 returns 10.3045.
# See also: math.dd, math.splitdms.
math.dms := proc(x :: number) is
   local f := frac(x)*60;
   return int(x) + int(f)/100 + frac(f)*6e-3
end;


# rounds upwards towards the nearest integer; faster than the C API implementation
# 0.10.0 as of April 20, 2008; patched 0.26.1, August 11, 2009; improved May 01, 2014
ceil := << x :: {number, complex} -> -entier(-x) >>;


# greatest common divisor, 0.9.0 as of Jan 09, 2008; patched 0.26.1, 11.08.2009
math.gcd := proc(x :: number, y :: number) is
   local z;
   if float(x) or float(y) then
     return 1
   else
      while y <> 0 do
         z := x % y;
         x := y;
         y := z
      od
   fi;
   return x
end;


# least common multiple, 0.9.0 as of Jan 09, 2008; patched 0.26.1, 11.08.2009
math.lcm := proc(x :: number, y :: number) is
   if y = 0 then
      return 0
   else
      return abs(x/math.gcd(x, y)*y)
   fi
end;


# Cotangent, 0.9.1 as of Jan 11, 2008, improved 2.1.2
cot := proc(x :: {number, complex}) is
   if x = 0 then
      return undefined
   else
      return -tan(Pi/2+x)
   fi
end;


# Hyperbolic Cotangent, 0.10.0 as of April 20, 2008, improved 2.1.2
coth := proc(x :: {number, complex}) is
   return 1/tanh(x)
end;


# Secant, 0.9.1 as of Jan 11, 2008, improved 2.1.2
sec := proc(x :: {number, complex}) is
   return 1/cos(x)
end;


# Cosecant, 0.9.1 as of Jan 11, 2008, improved 2.1.2
csc := proc(x :: {number, complex}) is
   return 1/sin(x)
end;


# inverse hyperbolic sine, 0.9.1 as of Jan 11, 2008; patched 0.33.1 as of June 20, 2010
arcsinh := proc(x) is
   if x :: number then
      return ln( x + sqrt(1 + x*x) )
   elif x :: complex then
      # see Handbook of Mathematical Functions, by Milton Abramowitz and Irene A. Stegun 9th Printing, p. 87
      return -I*arcsin(I*x)
   else
      argerror(x, 'arcsinh', 'number or complex value expected')
   fi
end;


# inverse hyperbolic cosine, 0.9.1 as of Jan 11, 2008; patched 0.26.1, 10.08.2009
# patched 0.33.1 as of June 20, 2010; patched and tuned 2.3.3 as of December 04, 2014
arccosh := proc(x) is
   if x :: number then
      return math.arccosh(x)  # returns  ln( x + sign(x)*sqrt(x*x - 1) )
   elif x :: complex then
      # see Handbook of Mathematical Functions, by Milton Abramowitz and Irene A. Stegun, 9th Printing, p. 87
      if x = 0 then
         return 1/2*I*Pi
      elif imag(x) > 0 then
         return I*arccos(x)
      elif imag(x) = 0 then
         if real(x) > 1 then
            #return ln( x + sign(x)*sqrt((x-1)*(x+1)) )
            return ln( x + sign(x)*sqrt(x*x - 1) )
         else
            return I*arccos(x)
         fi
      else
         return -I*arccos(x)
      fi
   else
      argerror(x, 'arccosh', 'number or complex value expected')
   fi
end;


# inverse hyperbolic tangent, 0.9.1 as of Jan 11, 2008
arctanh := proc(x :: {number, complex}) is
   return 0.5 * ln( (1+x)/(1-x) )
end;


arcsech := proc(z) is  # 0.33.1 as of June 20, 2010
   if z :: number then
      return ln(1/z + sqrt(1/(z*z) - 1))
   elif z :: complex then
      if imag(z) < 0 then
         return I*arcsec(z)
      elif imag(z) = 0 then
         if real(z) < 0 or real(z) > 1 then
            return I*arcsec(z)
         else
            # don't use `return -I*arcsec(z)` for it won't work on Sparcs
            return ln(1/z + sqrt(1/(z*z) - 1))
         fi
      else
         return -I*arcsec(z)
      fi
   else
      argerror(z, 'arcsech', 'number or complex value expected')
   fi
end;


arccsc := proc(x :: {number, complex}) is
   return arcsin(1/x)
end;


arccsch := proc(x :: {number, complex}) is  # 0.33.1 as of June 20, 2010
   return I*arcsin(1/(I*x))
end;


arccot := proc(x :: {number, complex}) is  # 0.33.1 as of June 20, 2010
   return Pi/2 - arctan(x)
end;


csch := proc(x :: {number, complex}) is  # 0.33.1 as of June 20, 2010
   return 1/sinh(x)
end;


sech := proc(x :: {number, complex}) is  # 0.33.1 as of June 20, 2010
   return 1/cosh(x)
end;


# The C version is a little bit slower. Improved 2.1.3
math.zeroin := proc(x :: number, eps) is
   if eps = null then
      eps := Eps
   elif eps :- number then
      argerror(eps, 'math.zeroin', 'second argument must be a number');
   fi;
   if abs(x) < eps then return 0 else return x fi
end;


# The C version is not much faster.
heaviside := proc(x :: number) is
   if x > 0 then return 1
   elif x < 0 then return 0
   else return undefined
   fi
end;


beta := proc(z :: {number, complex}, w :: {number, complex}) is  # 0.33.1 as of June 20, 2010; optimised 2.1.3, 23.01.2014
   if z :: number and w :: number then
      if z < 0 and w > 0 then
         return (-1)^w * beta((1 - z - w)!0, w!0)
      elif z > 0 and w < 0 then
         return (-1)^z * beta((1 - z - w)!0, z!0)
      fi
   fi;
   if z :: number then z := z!0 fi;
   if w :: number then w := w!0 fi;
   return exp(lngamma(z) + lngamma(w) - lngamma(z+w))
end;


# the fractional part of x, improved 2.1.3
#frac := << x :: {number, complex} -> x - int(x) >>;


# complex constant I = 0+i
I := 0!1;


math.tosgesim := proc(x :: number) is  # 1.12.7
   local h, m, s, f;
   h := int(x);
   f := frac(x);
   m := int(f*60);
   s := roundf(frac(f*60)*60, 3);
   return h, m, s
end;


# factorial function; added 0.22.0, 23.05.2009; this Agena implementation is as
# fast as the former C version.
fact := proc(x :: number) is
  if float(x) then  # is x not an integer ?
     return undefined
  else
     return exp(lngamma(x + 1))
  fi
end;

#/ set precompiled results for 0! to 101! to `fact`
   first 101 factorials created with Maple V Release 4
   for i from 0 to 101 by 3 do
      printf(`   %0.16e, %0.16e, %0.16e,\n`, factorial(i), factorial(i+1), factorial(i+2))
   od:
/#

rtable.defaults(fact, [
   0~1.0000000000000000e+00, 1.0000000000000000e+00, 2.0000000000000000e+00,
   6.0000000000000000e+00, 2.4000000000000000e+01, 1.2000000000000000e+02,
   7.2000000000000000e+02, 5.0400000000000000e+03, 4.0320000000000000e+04,
   3.6288000000000000e+05, 3.6288000000000000e+06, 3.9916800000000000e+07,
   4.7900160000000000e+08, 6.2270208000000000e+09, 8.7178291200000000e+10,
   1.3076743680000000e+12, 2.0922789888000000e+13, 3.5568742809600000e+14,
   6.4023737057280000e+15, 1.2164510040883200e+17, 2.4329020081766400e+18,
   5.1090942171709440e+19, 1.1240007277776076e+21, 2.5852016738884976e+22,
   6.2044840173323943e+23, 1.5511210043330985e+25, 4.0329146112660563e+26,
   1.0888869450418352e+28, 3.0488834461171386e+29, 8.8417619937397019e+30,
   2.6525285981219105e+32, 8.2228386541779228e+33, 2.6313083693369353e+35,
   8.6833176188118864e+36, 2.9523279903960414e+38, 1.0333147966386144e+40,
   3.7199332678990121e+41, 1.3763753091226345e+43, 5.2302261746660111e+44,
   2.0397882081197443e+46, 8.1591528324789773e+47, 3.3452526613163807e+49,
   1.4050061177528798e+51, 6.0415263063373835e+52, 2.6582715747884487e+54,
   1.1962222086548019e+56, 5.5026221598120889e+57, 2.5862324151116818e+59,
   1.2413915592536072e+61, 6.0828186403426756e+62, 3.0414093201713378e+64,
   1.5511187532873822e+66, 8.0658175170943878e+67, 4.2748832840600255e+69,
   2.3084369733924138e+71, 1.2696403353658275e+73, 7.1099858780486345e+74,
   4.0526919504877216e+76, 2.3505613312828785e+78, 1.3868311854568983e+80,
   8.3209871127413901e+81, 5.0758021387722479e+83, 3.1469973260387937e+85,
   1.9826083154044400e+87, 1.2688693218588416e+89, 8.2476505920824706e+90,
   5.4434493907744306e+92, 3.6471110918188685e+94, 2.4800355424368305e+96,
   1.7112245242814131e+98, 1.1978571669969891e+100, 8.5047858856786231e+101,
   6.1234458376886086e+103, 4.4701154615126843e+105, 3.3078854415193864e+107,
   2.4809140811395398e+109, 1.8854947016660502e+111, 1.4518309202828586e+113,
   1.1324281178206297e+115, 8.9461821307829752e+116, 7.1569457046263802e+118,
   5.7971260207473679e+120, 4.7536433370128417e+122, 3.9455239697206586e+124,
   3.3142401345653532e+126, 2.8171041143805502e+128, 2.4227095383672732e+130,
   2.1077572983795277e+132, 1.8548264225739843e+134, 1.6507955160908461e+136,
   1.4857159644817614e+138, 1.3520015276784029e+140, 1.2438414054641307e+142,
   1.1567725070816415e+144, 1.0873661566567430e+146, 1.0329978488239059e+148,
   9.9167793487094968e+149, 9.6192759682482119e+151, 9.4268904488832477e+153,
   9.3326215443944152e+155, 9.3326215443944152e+157, 9.4259477598383594e+159
]);


# converts any integral number s of a base source to a number of base target
# 0.22.3, June 13, 2009; rewritten 2.2.0 RC 2, May 24, 2014

math.aux.convertbase_error := << i -> error('Error in `math.convertbase`: invalid character `' & i & '` in first argument.') >>;

math.aux.convertbase_hash := seq(
   '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
   'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z')

math.convertbase := proc(x, source :: number, target :: number) is
   local s, r, digit, str, base10;
   if float(source) or not(source > 0 and source < 37)
      or float(target) or not(target > 0 and target < 37) then
      error('Error in `math.convertbase`: base out of range or not an integer.')  # then issue an error
   fi;
   create sequence s(14);
   r := '';
   base10 := source = 10;
   if x :: number then
      if x < 0 then
         x := -x; r := '-'
      fi;
      if float(x) then
         math.aux.convertbase_error(x)
      elif not base10 then
         x := tostring(x)
      fi
   elif x :: string then
      if x = '' then
         error('Error in `math.convertbase`: first argument is the empty string.')
      elif x[1] = '-' then
         try
            x := x[2 to -1]
         catch
            error('Error in `math.convertbase`: first argument is a malformed string.')
         yrt;
         r := '-'
      fi;
      if base10 and strings.isnumber(x) then x := tonumber(x) fi
   else
      error('Error in `math.convertbase`: invalid type for first argument, must be an integer or a string.')
   fi;
   if x :: string then  # transform to base 10
      local c, v;
      v := 0;
      c := size x - 1;
      for i in upper x do
         digit := abs i;
         if digit > 64 and digit < 91 then    # 'A' to 'Z' ?
            dec digit, 55
         elif digit > 47 and digit < 58 then  # '0' to '9' ?
            dec digit, 48
         else
            math.aux.convertbase_error(i)
         fi;
         if digit >= source then math.aux.convertbase_error(i) fi;
         v := v + digit*source**c;
         dec c
      od;
      x := v
   fi;
   if x = 0 then
      r := '0'
   else
      while x > 0 do
         insert x % target into s;
         x := x \ target
      od;
      for i from size s downto 1 do  # 2.3.0 RC 1
         r := r & math.aux.convertbase_hash[s[i] + 1]
      od
   fi;
   return r
end;


#/ fraction written by Robert J. Craig, AT&T Bell Laboratories,
      1200 East Naperville Road, Naperville, IL 60566-7045
   Ported to Agena, 17.08.2009, 0.26.4

   Given a number, v, this function outputs two integers, d and n, such that v := n / d
   to accuracy epsilon := | (v - n/d) / v | <= error.
   Input:   v = decimal number you want replaced by fraction.
            error = accuracy to which the fraction should represent the number v.
   Output:  n = numerator of representing fraction.
              d = denominator of representing fraction.
   Return value:  -1.0 if (v < MIN || v > MAX || error < 0.0)
          | (v - n/d) / v | otherwise.
   Reference:  Jerome Spanier and Keith B. Oldham, "An Atlas
      of Functions," Springer-Verlag, 1987, pp. 665-7. /#

math.fraction := proc(v :: number, err) is
   local n, d, D, N, t, epsilon, r, m, signum;
   if abs(v) < 3.0e-10 or abs(v) > 4.0e+10 then
      error('Error in `math.fraction`: number to small or too big.')
   fi;
   if unassigned(err) then err := 0 fi;
   if err :- number or err < 0 then
      error('Error in `math.fraction`: error tolerance must be a nonnegative number.')
   fi;
   signum := 1;
   if v < 0 then signum := -1; v := -v fi;
   d, D -> 1;
   n := int(v);
   N := n + 1;
   do
      r := 0;
      if v*d <> n then
         r := (N - v*D)/(v*d - n);
         if r <= 1 then
            t := N; N := n; n := t;
            t := D; D := d; d := t
         fi
      fi;
      epsilon := abs(1 - n/(v*d));
      if epsilon > err then
         m := 1;
         do
            mul m, 10
         as m*epsilon < 1;
         epsilon := 1/m * int(0.5 + m*epsilon)
      fi;
      if epsilon <= err then
         return signum * n, d, epsilon
      fi;
      break when r = 0;
      if r <= 1.0 then
         r := 1.0/r
      fi;
      inc N, n * int(r);
      inc D, d * int(r);
      inc n, N;
      inc d, D
   od;
   return signum * n, d, epsilon
end;


##################################################################################
# utils package functions                                                        #
##################################################################################

create table utils.aux;

#  calendar functions

utils.weekday := proc(y, m, d, option) is
   # decription: returns day of week
   # synopsis:
   #    weekday(year, month, day) - returns integer, where 0 := Sunday .. 6 := Saturday
   #    weekday(year, month, day, anyvalue) - returns day of week as a string
   # written September 04, 2005
   if y = null then
      local Date := os.date('!*t');
      return utils.weekday(Date['year'], Date['month'], Date['day'], 0)
   fi;
   local result :=
      (((1461*(y+4800+ (m-14)\12 )) \ 4) +
       ((367*(m-2-12*((m-14)\12))) \ 12) -
       3*(((y+4900+(m-14)\12) \ 100) \ 4) + d) % 7;
   if option = null then
      return result
   else
      local nameWeekDay := [0 ~ 'Sunday', 1 ~ 'Monday', 2 ~ 'Tuesday', 3 ~ 'Wednesday',
         4 ~ 'Thursday', 5 ~ 'Friday', 6 ~ 'Saturday'];
      return nameWeekDay[result]
   fi
end;


# written by Alexander Walz - August 02, 2005; modified December 17, 2006; November 03, 2007
# utils.isleapyear := << y::number -> y % 4 = 0 and not(y % 100 = 0) or y % 400 = 0 >>;


# utils.writecsv: create a CSV file from a table, set, or sequence
# written September 30, 2006; April 30, 2007; Juni 28, 2007; Jan 14, 2008; June 12, 2009;
# October 09, 2012, improved March 11, 2013.
# Write all entries or keys and value(s) of a table, set, or sequence to a text file.
# Default: only values are written
# Synopsis:
#    tbl - a table, set, or sequence
#    filename - the name of the file to be written
#    delim - (optional) if the value is a structure itself, then all entries in this substructure are
#            separated by the given delimitor (a string); default is a semicolon.
#            If the keyoption is also given, then the key and the value(s) are also separated by the
#            given delimitor.
#    keyoption (optional, a boolean) - write keys, too.
#    dot: the decimal dot in a number is replaced by the given character.

utils.aux.tostring := proc(x, dot) is
   case type x
      of number then
         if unassigned(dot) then  # Agena 1.8.3, 1.10.0
            return x
         else
            return replace(tostring(x), '.', dot)
         fi
      of string, boolean then  # Agena 2.3.0 RC 2
         return x
      of 'null' then
         return tostring(x)
      else  # write pairs as an object instead of a tuple
         return type(x) & '(' & environ.pointer(x) & ')'
   esac
end;


utils.writecsv := proc(tbl, filename, delim, keyoption, dot) is
   local file;
   if not(type(tbl) in {table, set, sequence}) then
      argerror(tbl, 'utils.writecsv', 'expected a table, set, or sequence for first argument')
   fi;
   if unassigned(delim) then
      delim := ';'
   elif delim :: pair then
      if left(delim) <> 'delim' then
         error('Error in `utils.writecsv`: unknown option.')
      elif right(delim) :- string then
         error('Error in `utils.writecsv`: invalid right-hand side of delim option.')
      else
         delim := right(delim)
      fi
   elif delim :- string then
      argerror(delim, 'utils.writecsv', 'expected a string')
   fi;
   if assigned(dot) and not(dot :: string and size dot = 1) then
      error('Error in `utils.writecsv`: decimal dot must be replaced by a single character.')
   fi;
   file := io.open(filename, 'w');
   for i, j in tbl do
      if keyoption then  # write key
         io.write(file, utils.aux.tostring(i), delim)
      fi;
      case type j  # write value
         of table, set, sequence, register then  # write values in substructure
            local c, s := 0, size j;
            for v in j do
               inc c;
               io.write(file, utils.aux.tostring(v, dot));
               if c < s then
                  io.write(file, delim)
               fi
            od;
            io.write(file, '\n')
         else
            io.writeline(file, utils.aux.tostring(j, dot))
      esac
   od;
   io.close(file)
end;


# Reads in CSV files with a given delimitor, or ';' by default
# options: see below
# April 22, 2010, 0.31.7; 1.3.3, 1.6.0; 1.7.1 pl 1, 18.07.2012, 18.12.2012, 24.01.2013, 09.06.2013

utils.aux.removequotes := proc(s :: sequence, quote :: string) :: sequence is
   return << x -> if x :: string and (quote in x) = 1 and quote atendof x then x[2 to -2] else x fi >> @ s
end;


utils.readcsv := proc(fn :: string, ?) is
   local alloptions, comma, convert, delim, fd, fields, flat, headerline, headermapfields, header, ignorefn, L, line,
   linenumber, linesize, ignorespaces, ignorespacesgiven, mapfields, mapfn, newseq, option, options, output,
   removesinglequotes, removedoublequotes, skipemptylines, skipspaces, subst, value, nconvert;  # 2.2.1 fix to former global `nconvert`
   if not(os.exists(fn)) then
      error('Error in `utils.readcsv`: file `' & fn & '` does not exist.')  # 1.7.1 pl 1
   fi;
   create sequence L;
   delim := ';';
   flat := false;                # return values in each line in a new sequence
   skipemptylines := true;       # empty lines are not read
   skipspaces := false;          # lines including only spaces are not ignored
   ignorespaces := true;         # all spaces in a line are removed
   ignorespacesgiven := false;   # ignorespaces option passed ?
   header := false;              # does file include a header in the first line ?
   mapfn := null;                # no function given to be mapped on input
   nconvert := true;             # attempt to convert string to a number
   removesinglequotes := false;  # remove surrounding single quotes from field read
   removedoublequotes := false;  # remove surrounding double quotes from field read
   newseq := false;              # if only one field per line is given, always put field to be read into a new sequence
   fields := null;               # only return the fields given in a table or sequence and in the order of the elements
                                 # in this table or sequence
   mapfields := null;            # a table or sequence of pairs of the form posint:function. Applies the given function
                                 # to the field in the CSV file
   subst := null;                # substitute value with another one
   comma := false;               # transforms floats with a decimal comma to British notation
   ignorefn := null;             # checks whether a line matches a given condition defined by a boolean function
   alloptions := {'comma', 'convert', 'delim', 'field', 'fields', 'flat', 'header', 'ignorespaces', 'mapfields', 'newseq',
      'output', 'remove', 'skipemptylines', 'skipspaces', 'subs', 'ignore'};
   options := checkoptions('utils.readcsv', varargs,
      delim = string, flat = boolean, newseq = boolean, convert = boolean, skipemptylines = boolean, skipspaces = boolean,
      header = boolean, comma = boolean, ignore = procedure, true);
   delim := alternate(delim, options.delim);
   flat := alternate(flat, options.flat);
   newseq := alternate(newseq, options.newseq);
   nconvert := alternate(nconvert, options.convert);
   skipemptylines := alternate(skipemptylines, options.skipemptylines);
   skipspaces := alternate(skipspaces, options.skipspaces);
   header := alternate(header, options.header);
   comma := alternate(comma, options.comma);
   for i in varargs do
      if i :: pair then
         option := left(i);
         value := right(i);
         if not(option in alloptions) then
            error('Error in `utils.readcsv`: unknown option `' & tostring(option) & '`.')
         fi;
         case option
            of 'output' then  # Agena 1.3.3
               if not(value in {'record', 'matrix'}) then
                  error('Error in `utils.readcsv`: unknown option `' & tostring(value) & '`.')
               fi;
               output := value
            of 'field' then  # Agena 1.8.0 u1
               if not(value :: string or isposint(value)) then
                  argerror(value, 'utils.readcsv', 'posint or string for field option expected')
               fi;
               fields := seq(value)
            of 'remove' then  # Agena 1.7.1 pl 1
               if value = 'quotes' then
                  removesinglequotes := true
               fi;
               if value = 'doublequotes' then
                  removedoublequotes := true
               fi;
               if not(value in {'quotes', 'doublequotes'}) then
                  error('Error in `utils.readcsv`: \'quotes\' or \'dquotes\' expected for remove option, got ' & tostring(value) & '.')
               fi
            of 'ignorespaces' then
               if value :- boolean then
                  argerror(value, 'utils.readcsv', 'boolean for ignorespaces option expected')
               fi;
               ignorespaces := value;
               ignorespacesgiven := true  # Agena 1.3.3
            of 'subs' then  # Agena 1.8.3
               if value :: pair then
                  subst := [value]
               elif checktype(value, table, pair) or checktype(value, sequence, pair) then
                  subst := value
               else
                  argerror(value, 'utils.readcsv', 'pair/structure of pairs for subs option expected')
               fi
            of 'fields' then  # Agena 1.8.0 u1
               if not(value :: table or value :: sequence) then
                  argerror(value, 'utils.readcsv', 'table or sequence for fields option expected')
               fi;
               for i in value do
                  if not(i :: string or isposint(i)) then
                     argerror(i, 'utils.readcsv', 'posint or string in fields option expected')
                  fi
               od;
               fields := value
            of 'mapfields' then  # Agena 1.8.0 u1
               if value :- table and value :- sequence then
                  argerror(value, 'utils.readcsv', 'table or sequence for mapfields option expected')
               fi;
               for i in value do
                  if i :- pair or not(isposint(left(i)) or left(i) :: string) or right(i) :- procedure then
                     error('Error in `utils.readcsv`: posint:procedure or string:procedure in mapfields\noption expected.')
                  fi
               od;
               mapfields := value
            of 'ignore' then  # Agena 1.12.4 u2
               ignorefn := value
         esac
      elif i :: procedure then
         mapfn := i
      else
         argerror(i, 'utils.readcsv', 'pair expected')
      fi
   od;
   if not(ignorespacesgiven) and delim = ' ' then ignorespaces := false fi;  # Agena 1.3.3
   linenumber := 0;  # 1.12.4 u2
   fd := io.open(fn);
   for keys i in io.lines(fd) do
      inc linenumber;
      skip when skipemptylines and i = '' or skipspaces and trim(i) = '';
      skip when ignorefn and ignorefn(i) = true;
      line := i;
      if ignorespaces then
         line := replace(line, ' ', '')
      fi;
      line := line split delim;
      linesize := size line;
      if comma then  # Agena 1.8.3
         line := << x -> if strings.iscenumeric(x) then replace(x, ',', '.') else x fi >> @ line
      fi;
      if removesinglequotes then  # Agena 1.7.1 pl 1
         line := utils.aux.removequotes(line, '\'')
      fi;
      if removedoublequotes then  # Agena 1.7.1 pl 1
         line := utils.aux.removequotes(line, '\"')
      fi;
      if nconvert then  # Agena 1.6.0, 1.11.7
         line := tonumber @ line
      fi;
      if header then  # Agena 1.8.9 u1
         header := false;
         headerline, headermapfields -> line;
         if fields then
            local t, newheader;
            create table newheader;
            t := copy(fields);
            for i in fields do
               if i :: string then
                  if not(i in headerline) then
                     error('Error in `utils.readcsv`: field `' & i & '` does not exist, at CSV line ' & linenumber & '.')
                  fi;
                  t := subs(i:whereis(headerline, i)[1], t);  # replace field name with column number
                  insert i into newheader
               else
                  if i < 1 or i > linesize then
                     error('Error in `utils.readcsv`: field `' & i & '` does not exist, at CSV line ' & linenumber & '.')
                  fi;
                  insert headerline[i] into newheader
               fi
            od;
            headerline := newheader;
            fields := t
         fi;
         if mapfields then
            local t, li;
            create table t;
            for i in mapfields do
               li := left(i);
               if li :: string then
                  if not(li in headermapfields) then
                     error('Error in `utils.readcsv`: field `' & li & '` does not exist, at CSV line ' & linenumber & '.')
                  elif fields and not(li in headerline) then
                     error('Error in `utils.readcsv`: field `' & li & '` does not exist in return, at CSV line ' & linenumber & '.')
                  fi;
                  li := whereis(headermapfields, li)[1]
               else
                  if li < 1 or li > linesize then
                     error('Error in `utils.readcsv`: field `' & li & '` does not exist, at CSV line ' & linenumber & '.')
                  elif fields and not(li in fields) then
                     error('Error in `utils.readcsv`: field `' & li & '` does not exist in return, at CSV line ' & linenumber & '.')
                  fi
               fi;
               insert li:right(i) into t
            od;
            mapfields := t
         fi;
         skip
      fi;  # end of header; Agena 1.3.3
      if mapfields then  # Agena 1.8.0 u1
         local t, c;
         t := copy(line);
         for i in mapfields do
            c := left(i);
            if c :: number then
               if c < 1 or c > linesize then
                  error('Error in `utils.readcsv`: field `' & c & '` does not exist, at CSV line ' & linenumber & '.')
               fi;
            else
               if unassigned(headerline) then
                  error('Error in `utils.readcsv`: cannot index `' & c & '` field, header option not given, at CSV line ' & linenumber & '.')
               fi;
            fi;
            t[c] := (right(i))(t[c])  # 2.0.0 RC 3
         od;
         line := t
      fi;
      if fields then  # Agena 1.8.0 u1, `values` does not work with `unpack`
         create local seq t;
         for i in fields do
            if i :: number and (i < 1 or i > linesize) then
               error('Error in `utils.readcsv`: field `' & i & '` does not exist, at CSV line ' & linenumber & '.')
            elif i :: string and unassigned(headerline) then
               error('Error in `utils.readcsv`: cannot index `' & i & '` field, header option not given, at CSV line ' & linenumber & '.')
            fi;
            insert line[i] into t  # extract fields ...
         od;
         line := t;  # ... and replace original line values with extracted fields
         linesize := size line
      fi;
      if subst then  # Agena 1.8.3
         for i in subst do
            line := subs(i, line)
         od
      fi;
      if mapfn then  # Agena 1.6.0/1.8.0 u1
         line := mapfn @ line
      fi;
      if linesize > 1 then
         if flat then    # Agena 1.6.0
            insert unpack(line) into L
         else
            insert line into L
         fi
      else  # only one value per line ?
         if newseq then
            insert line into L
         else
            insert line[1] into L
         fi
      fi
   od;
   io.close(fd);
   if unassigned(output) then
      return L
   elif output = 'record' then
      local result, nops;
      nops := size L;
      create table result(nops);
      if unassigned(headerline) then
         headerline := nseq(1, size L[1])  # changed, Agena 1.8.0 u1
      fi;
      for i in headerline do
         result[i] := []
      od;
      for i from 1 to nops do
         for k, j in L[i] do
            insert j into result[headerline[k]]
         od
      od;
      return result
   else  # output = 'matrix', Agena 1.8.0 u1
      if unassigned(linalg) then
         readlib 'linalg'
      fi;
      for i in L do
         if not(checktype(i, sequence, number)) then
            error('Error in `utils.readcsv`: return includes non-numbers.')
         fi
      od;
      return linalg.matrix(unpack(L))
   fi
end;


# `utils.aux.decoderawxml` has originally been written by Roberto Ierusalimschy for Lua 5.1. Taken from From LuaWiki:
# http://lua-users.org/wiki/LuaXML, modified by Alexander Walz, May 27, 2012, Agena 1.6.1

utils.aux.parseargs := proc(s) is  # Agena 1.6.1
   local arg := [];
   strings.gsub(s, '([%w:]+)=([\"\'])(.-)%2', proc(w, _, a) is arg[w] := a end);
   return if filled(arg) then arg else null fi
end;


# Reads an XML file and converts it into a table. It supports namespaces and conducts syntax checks.
utils.aux.decoderawxml := proc(s :: string, nocomment :: boolean) is  # Agena 1.6.1, 1.11.2
   local ni, c, label, xarg, empty, i, j, text, stack, topelem, ssize, r;
   create table stack, table topelem;
   insert topelem into stack;
   i, j -> 1;
   do
      local text, found, qb, qe;
      qb, qe := strings.find(s, '%<%?.+%?%>', i);  # skip XML header declaration <?xml version="1.0"?>
      if qb then
         i := qe + 1;
         topelem['__header'] := s[qb to qe]
      fi;
      ni, j, c, label, xarg, empty := strings.find(s, '<(%/?)([%w\:\.\_-]+)(.-)(%/?)>', i);  # 1.11.2 fix for dots and underscores in label
      break when unassigned(ni);
      text := if ni = 1 or i > ni-1 then '' else strings.lrtrim(s[i to ni-1]) fi;  # 1.11.2
      if nocomment then  # 1.6.10
         qb, qe := strings.find(text, '%<%!%-.+%-.%>');
         if qb then
            inc i, qe;
            skip
         fi
      fi;
      found := strings.find(text, '^%s*$');
      if empty = '/' then  # empty element tag
         if not found then
            insert ['label' ~ label, label ~ text, 'xarg' ~ utils.aux.parseargs(xarg), 'empty' ~ 1] into topelem
         else
            insert ['label' ~ label, label ~ '', 'xarg' ~ utils.aux.parseargs(xarg), 'empty' ~ 1] into topelem
         fi
      elif c = '' then   # start tag
         if not found then
            topelem := ['label' ~ label, label ~ text, 'xarg' ~ utils.aux.parseargs(xarg)]
         else
            topelem := ['label' ~ label, label ~ '', 'xarg' ~ utils.aux.parseargs(xarg)]
         fi;
         insert topelem into stack  # new level
      else  # end tag
         local toclose;
         toclose := purge(stack);  # remove topelem
         topelem := top(stack);
         if size stack < 1 then
            error('Error in `utils.aux.decoderawxml`: nothing to close with ' & label & '.')
         fi;
         if toclose.label <> label then
            error('Error in `utils.aux.decoderawxml`: trying to close `' & toclose.label & '` with `' & label & '`.')
         fi;
         if not found then
            toclose[label] := text;
            toclose.label := label
         fi;
         settype(toclose, 'rawxml');
         insert toclose into topelem
      fi;
      i := j + 1
   od;
   text := if i > size s then '' else s[i to -1] fi;
   ssize := size stack;
   if not strings.find(text, '^%s*$') then
      stack[ssize][label] := text
   fi;
   if ssize > 1 then
      local err := top(stack);
      error('Error in `utils.aux.decoderawxml`: unclosed tag `' & err.label & '`.')
   fi;
   r := stack[1];
   settype(r, 'rawxml');
   return r
end;


utils.aux.decodexml_convert := proc(v) is  # Agena 1.6.1
   local r := tonumber(v);  # try to convert into a number or complex number
   if r = 'true' then  # checking for type string before slows down the function significantly
      r := true
   elif r = 'false' then
      r := false
   elif r = 'fail' then
      r := fail
   fi;
   return r
end;


# converts a table created by `utils.aux.decoderawxml` to a string containing an XML stream
# Agena 1.6.1, extended 1.6.7, patched 1.6.10, 1.11.2 speed-up
utils.decodexml := proc(x, ?) is
   local y, r, flag, nocomment, transform;
   nocomment := false;
   transform := true;
   for i in varargs do
      if i = 'nocomment' then
         nocomment := true
      elif i :: boolean then
         transform := i
      else
         error('Error in `utils.decodexml`: option must either be a Boolean or \'nocomment\', got ' & tostring(i) & '.')
      fi
   od;
   if x :: string then
      x := utils.aux.decoderawxml(x, nocomment)
   elif x :- 'rawxml' then
      argerror(x, 'utils.decodexml', 'expected a rawxml table or a string')
   fi;
   create table r;
   r.header := x.header;
   flag := true;
   for i to size x do
      y := x[i];
      if y :: 'rawxml' then
         local l, v;
         l := y.label;
         v := y[l];
         if v :: string and v <> '' then
            if transform <> false then v := utils.aux.decodexml_convert(v) fi  # convert string to (complex) number or Boolean
         elif y :: 'rawxml' then
            v := utils.decodexml(y, unpack(varargs))
         else
            error('Error in `utils.decodexml`: cannot process ' & typeof(y) & '.')
         fi;
         # convert namespace / replace magic XML characters in variable name (label)
         for j in '-:.' do
            l := replace(l, j, '_')
         od;
         # assign value(s) to final result, 1.6.7
         if assigned(r[l]) then  # 1.6.10, multiple entries of an XML object ?
            if flag then  # put initial entries into a table, so that all objects are in the same hierarchy
               r[l] := [r[l]];
               flag := false
            fi;
            insert v into r[l]
         else
            r[l] := v
         fi
      fi
   od;
   return r
end;


utils.readxml := proc(fn :: string, ?) is  # Agena 1.6.10 extension, 1.11.2 change
   local nocomment, transform;
   if not(os.exists(fn)) then
      error('Error in `utils.readxml`: file does not exist.')
   fi;
   nocomment := false;
   transform := true;
   for i in varargs do
      if i = 'nocomment' then
         nocomment := 'nocomment'
      elif i :: boolean then
         transform := i
      else
         error('Error in `utils.readxml`: option must either be a Boolean or \'nocomment\', got ' & tostring(i) & '.')
      fi
   od;
   return utils.decodexml(io.readfile(fn, true), transform, nocomment)
end;


# converts a table created by `utils.readrawxml` to a string containing an XML stream, Agena 1.6.3, 1.6.7
utils.aux.encodexml := proc(x :: table, t, indent, c, tag) is
   local i, j, k, l, s, u, y;
   k := tables.indices(x);
   sort(k);
   s := size k;
   for n to s do
      i := k[n];  # index
      skip when i = 'header';  # do not insert XML version header once again
      j := x[i];  # entry
      u := i :: string;  # unique XML object ?
      if u then
         insert '<', i, '>' into t
      fi;
      if j :: table then
         if checktype(tables.indices(j), table, string) then
            insert '\n', strings.repeat(' ', c + indent) into t;
            t := utils.aux.encodexml(j, t, indent, c + indent)
         else  # XML object occurs multiple times
            t := utils.aux.encodexml(j, t, indent, c, i)
         fi;
         insert '\n', strings.repeat(' ', c) into t
      else
         case type(j)
            of number, boolean then
               insert tostring(j) into t
            of complex then
               insert real(j) & if imag(j) >= 0 then '+' & imag(j) else imag(j) fi & '*I' into t
            else
               insert j into t
         esac
      fi;
      if u then
         insert '</', i, '>', '\n', strings.repeat(' ', c) into t
      fi;
      if assigned(tag) and n < s then
         insert '</', tag, '>', '\n', strings.repeat(' ', c), '<', tag, '>' into t
      fi
   od;
   to 2 do pop top from t od;  # pop last two entries (newline and spaces)
   return t
end;


utils.encodexml := proc(t :: table, indent, plain) is  # Agena 1.6.3
   local r, s;
   create table s;
   if assigned(t.header) then insert t.header, '\n' into s fi;
   if unassigned(indent) then indent := 3 fi;
   r := utils.aux.encodexml(t, s, indent, 0);
   return is unassigned(plain) then join(r) else r si
end;


utils.writexml := proc(fn :: string, tt :: table, indent) is  # Agena 1.6.3
   local fd, r;
   fd := io.open(fn, 'w');
   r := utils.encodexml(tt, indent, false);
   for i in r do
      io.write(fd, i)
   od;
   io.close(fd)
end;


# Agena 1.6.10, patched 1.9.4, 1.11.6
utils.findfiles := proc(f, what, ?) is
   local files, L, r, e, fn, fd, rec, whole, dirname;
   if nargs = 1 then
      error('Error in `utils.findfiles`: need at least two arguments.')
   fi;
   if not(what :: procedure or what :: string) then
      error('Error in `utils.findfiles`: second argument must be a procedure or string.')
   fi;
   for i in varargs do
      if i = 'r' then   # recurse into subdirectories ?
         rec := 'r'
      elif i = 'whole' then  # concat all lines of the file before processing it ?
         whole := true
      else
         error('Error in `utils.findfiles`: unknown option.')
      fi
   od;
   if what :: procedure then
      fn := what
   elif what :- string then
      argerror(what, 'utils.findfiles', 'second argument must be either a string or function')
   fi;
   if f :: string then
      files, dirname := os.list(f, 'files', rec);  # Agena 1.11.5u1 fix
      if unassigned(dirname) then  # only a file name without jokers has been given ?
         f := replace(f, '\\', '/');  # Agena 1.11.5u1 fix
         if '/' in f then   # Agena 1.11.6 fix
            local fseq := f split '/';
            f := pop(fseq);
            dirname := join(fseq, '/')
         else
            dirname := os.chdir()  # Agena 1.10.3 patch
         fi
      fi
   elif f :: table and size f = 2 and f[1] :: table and f[2] :: string then
      files := f[1]; dirname := f[2]
   else
      error('Error in `utils.findfiles`: expected a table of a table and a string.')
   fi;
   if files = null then  # Agena 1.6.11
      local attribs := os.fstat(dirname & '/' & f);
      if attribs <> fail and attribs.mode = 'FILE' then  # single file passed as first argument ?
         files := [f]
      else
         error('Error in `utils.findfiles`: file(s) not found.')
      fi
   fi;
   create table r, table e;
   if what :: string then  # 1.11.6
      for i in files do
         if whole then
            L := protect(io.readfile, if dirname = '/' then '/' & i else dirname & '/' & i fi, false, what)  # Agena 1.11.6 fix
         else
            L := protect(io.infile, if dirname = '/' then '/' & i else dirname & '/' & i fi, what)
         fi;
         if L = true then
            insert i into r
         elif L = lasterror or L = fail then
            insert [i, lasterror] into e
         fi
      od
   else
      for i in files do
         if whole then
            L := protect(io.readfile, if dirname = '/' then '/' & i else dirname & '/' & i fi);
            if L = lasterror then
               insert [i, lasterror] into e
            elif fn(L) = true then
               insert i into r
            fi
         else
            fd := protect(io.open, if dirname = '/' then '/' & i else dirname & '/' & i fi, 'r');
            if fd = lasterror then  # exception when trying to read file i ?
               insert [i, lasterror] into e
            else
               for keys j in io.lines(fd) do
                  if fn(j) = true then  # if not found then return is null
                     insert i into r;
                     break
                  fi
               od;
               io.close(fd)
            fi
         fi
      od
   fi;
   return r, e
end;


# Writes a table of key~value pairs to a traditional initialisation file. If values are
# not tables, they are written at the beginning of the file. If values are tables of
# key~value pairs, then they are written to the corresponding sections.

# By default, the function writes the entries and sections in ascending order. You may
# change the order of the sections and the specific sections to be written by passing a
# table array of section names with the sections option, e.g. sections=['Salad', 'Pizza']
# first writes all entries of the Salad section, and then the Pizza section is written.

# An optional spacer in front and behind the equals signs may be given by passing the
# spacer option which accepts any string, e.g. spacer='\t'. Default is the empty string.

# A floating point value may be written with a decimal comma instead of a decimal dot
# by passing the comma=true option, default is comma=false.

utils.writeini := proc(o :: table, filename :: string, ?) is  # Agena 2.3.0 RC 2
   local fd, options, comma, sections, spacer, subinds, nl, main;
   comma := false;
   sections := null;
   spacer := '';
   options := checkoptions('utils.writeini', varargs,
      comma = boolean, sections = table, spacer = string, true);
   comma := if alternate(comma, options.comma) then ',' else '.' fi;
   sections := alternate(sections, options.sections);
   spacer := alternate(spacer, options.spacer);
   main := [];
   fd := io.open(filename, 'w');
   # first try to write all existing main level key~value pairs
   for i, j in o do
      if i :- string then
         io.close(fd);
         argerror (i, 'utils.writeini', 'table key is not a string')
      else
         if j :- table then
            insert i into main
         fi
      fi;
   od;
   if filled(main) then  # there are key~value pairs at the main level ?
      sort(main);
      for i in main do
         nl := true;
         io.writeline(fd, i, spacer, '=', spacer, utils.aux.tostring(o[i], comma))
      od
   fi;
   if nl then io.writeline(fd) fi;
   # now write all sections
   if unassigned(sections) then
      for i, j in o do
         skip when j :: string;  # already wrote value
         if j :- table then
            io.close(fd);
            error('Error in `utils.writeini`: value is corrupt.')
         else
            io.writeline(fd, '[' & i & ']\n');  # write section name
            subinds := tables.indices(j);
            sort(subinds);
            for k in subinds do
               io.writeline(fd, k, spacer, '=', spacer, utils.aux.tostring(o[i, k], comma))
            od;
            io.writeline(fd)
         fi
      od
   else
      if sections :- table then
         io.close(fd);
         argerror(sections, 'utils.writeini', 'third argument must be a table')
      fi;
      for i in sections do
         if i :- string then
            io.close(fd);
            argerror(sections, 'utils.writeini', 'section name must be a string')
         fi;
         if o[i] :- table then
            io.close(fd);
            error('Error in `utils.writeini`: section `' & i & '` does not exist or is corrupted.')
         fi;
         subinds := tables.indices(o[i]);
         sort(subinds);
         io.writeline(fd, '[', i, ']\n');
         for j in subinds do
            io.writeline(fd, j, spacer, '=', spacer, utils.aux.tostring(o[i, j], comma))
         od;
         io.writeline(fd)
      od
   fi;
   io.close(fd);
end;


##############################################################################################
# Protected names that cannot be overwritten by with                                         #
##############################################################################################

insert 'with', 'write', 'read', 'writeline' into environ.withprotected


##############################################################################################
# assign version information to environ.Release, new in 0.14.0                               #
##############################################################################################

local s := _RELEASE split ' ';
delete '>>', 'Update' from s;
create sequence environ.release(4);
insert s[1] into environ.release;
for i in s[2] split '.' do
   insert tonumber(i) into environ.release
od;
if assigned(environ.libpatchlevel) then
   insert environ.libpatchlevel into environ.release
else
   insert 0 into environ.release
fi;
clear s;


##############################################################################################
# data formating procedures for `print` function, new in 0.22.0                              #
##############################################################################################

# procedure to print table values to the console in a user-defined format; May 16, 2009;
# July 05, 2009; July 11, 2009

# Container for auxiliary functions
environ.aux := [];

environ.aux.printaux := proc(x, obj) is
   if environ.pointer(x) = environ.pointer(obj) or environ.isselfref(x) then  # self-referencing object ?
      io.write('circum_' & typeof(x) & '(' & environ.pointer(x) & ')')  # avoid stack overflows
   else
      case type x
         of number then
            io.write(x)
         of string then
            if environ.aux.printenclosestrings :: string then
               io.write(environ.aux.printenclosestrings & x & environ.aux.printenclosestrings)
            else
               io.write(x)
            fi
         of 'null', boolean then
            io.write(tostring(x))
         of table, set, sequence, pair, complex, register then
            print(x, nonewline = true)  # recursively call print again
         else
            io.write(type(x), '(', environ.pointer(x), ')')
      esac
   fi
end;


environ.aux.printlongtable := proc(o :: table) is
   local sizeo, message, smessage, inds, sizeinds, numericinds, stringinds;
   sizeo := size o;
   message := 'more ...';
   smessage := size message;
   inds := tables.indices(o);
   # since sort cannot sort both numbers and strings, separate them, sort them individually
   numericinds := << x -> x :: number >> $ inds;
   # if the size of the numericinds table is too big, unpack fails, so do not use it
   for keys i in numericinds do
      inds[i] := null  # delete all numeric keys from inds
   od;
   numericinds := tables.entries(numericinds);  # 0.31.7 patch
   sort(numericinds);
   stringinds := << x -> x :: string >> $ inds;
   for keys i in stringinds do
      inds[i] := null  # delete all string keys from inds
   od;
   stringinds := tables.entries(stringinds);    # 0.31.7 patch
   sort(stringinds);
   # add all other data types at end of inds table
   inds := (numericinds union stringinds) union inds;
   sizeinds := size inds;
   environ.kernel(longtable = false);
   for i to sizeinds do
      environ.aux.printaux(inds[i], o);
      io.write(' ~ ');
      environ.aux.printaux(o[inds[i]], o);
      if i < sizeo then
         io.writeline();
         if environ.more :: number and i % environ.more = 0 then
            local key;
            io.write(message);
            key := io.getkey();
            io.write(strings.repeat('\b', smessage));
            io.write(strings.repeat(' ', smessage));
            io.write(strings.repeat('\b', smessage));
            break when abs(key) in {27, 81, 113}
         fi
      fi
   od;
   environ.kernel(longtable = true)
end;


# procedure to print tables to the console in a user-defined format; extended 03.01.2010, 0.30.1;
# patched 12.04.2010, 0.31.5; patched 19.04.2010, 0.31.7, extended 30.06.2010, 0.33.3
environ.aux.printtable := proc(o :: table) is
   local mtweak := getmetatable(o);
   if mtweak and mtweak.__weak then environ.gc() fi;  # with weak structures, first collect a gc to avoid printing errors
   if environ.kernel('longtable') then
      return environ.aux.printlongtable(o)
   fi;
   local udef := typeof(o) <> table;
   local opening := if udef then typeof(o) & '(' else '[' fi;
   local closing := if udef then ')' else ']' fi;
   io.write(opening);
   if size o = 0 then
      io.write(closing)
   else
      local attr := environ.attrib(o);  # 0.32.4 patch
      if attr.hash_assigned = 0 and not(attr.array_hasholes) then  # is o an array without holes ?
         local sizeo := size o;
         for i to sizeo do
            environ.aux.printaux(o[i], o);
            if i < sizeo then io.write(', ') fi
         od
      else  # o is (an array and) a dictionary; sort numeric and string indices
         local inds, sizeinds, numericinds, stringinds, printkeys;
         printkeys := true;  # 0.33.3 addition: print keys only if keys are nonposints and not consecutive
         inds := tables.indices(o);
         # since sort cannot sort both numbers and strings, separate them, sort them individually
         numericinds := << x -> x :: number >> $ inds;
         # if the size of the numericinds table is too big, unpack fails, so do not use it
         for keys i in numericinds do
            inds[i] := null  # delete all numeric keys from inds
         od;
         numericinds := tables.entries(numericinds);  # 0.31.7 patch
         sort(numericinds);
         stringinds := select(<< x -> x :: string >>, inds);  # do not use $ op for it always returns elements with start index 1
         for keys i in stringinds do  # 2.3.0 RC 4 fix
            inds[i] := null  # delete all string keys from inds
         od;
         stringinds := tables.entries(stringinds);    # 0.31.7 patch
         sort(stringinds);
         # add all other data types at end of inds table
         inds := (numericinds union stringinds) union inds;
         sizeinds := size inds;
         if attr.array_assigned = 0 and attr.hash_assigned > 0 then  # 0.33.3
            local flag := true;
            for i to sizeinds do
               #insert i into indics
               if i <> inds[i] then
                  # table o is actually an array but its elements are currently stored in its hash part
                  # -> do not print its keys
                  flag := false;
                  break
               fi
            od
            printkeys := not flag;
         fi;
         for i to sizeinds do
            if printkeys then
               environ.aux.printaux(inds[i], o);
               io.write(' ~ ')
            fi;
            environ.aux.printaux(o[inds[i]], o);
            if i < sizeinds then io.write(', ') fi
         od
      fi;
      io.write(closing);
   fi;
end;


# procedure to print set values to the console in a user-defined format; May 16, 2009;
# extended 03.01.2010, 0.30.1; patched 12.04.2010, 0.31.5
environ.aux.printset := proc(o :: set) is
   local mtweak, udef, opening, closing;
   mtweak := getmetatable(o);
   if mtweak and mtweak.__weak then environ.gc() fi;  # with weak structures, first collect a gc to avoid printing errors
   udef := typeof(o) <> set;
   opening := if udef then typeof(o) & '(' else '{' fi;
   closing := if udef then ')' else '}' fi;
   io.write(opening);
   if size o = 0 then
      io.write(closing)
   else
      local entries, sizeentries, numericentries, stringentries;
      entries := toseq(o);
      numericentries := << x -> x :: number >> $ entries;
      sort(numericentries);
      entries := << x -> x :- number >> $ entries;
      stringentries := << x -> x :: string >> $ entries;
      sort(stringentries);
      entries := << x -> x :- string >> $ entries;
      entries := (numericentries union stringentries) union entries;
      sizeentries := size entries;
      for j to sizeentries  do
         environ.aux.printaux(entries[j], o);
         if j < sizeentries then io.write(', ') fi
      od;
      io.write(closing)
   fi
end;


# procedure to print sequence values to the console in a user-defined format; May 16, 2009
environ.aux.printsequence := proc(o :: sequence) is
   local mtweak := getmetatable(o);
   if mtweak and mtweak.__weak then environ.gc() fi;  # with weak structures, first collect a gc to avoid printing errors
   if typeof(o) = sequence then
      io.write('seq(')
   else
      io.write(typeof(o), '(')
   fi;
   if size o = 0 then
      io.write(')')
   else
      local sizeo := size(o);  # changed 0.24.4 to prevent a space put after the last value
      for j to sizeo do
         environ.aux.printaux(o[j], o);
         if j < sizeo then io.write(', ') fi
      od;
      io.write(')')
   fi;
end;


# procedure to print register values to the console in a user-defined format; October 15, 2014
environ.aux.printregister := proc(o :: register) is
   local mtweak := getmetatable(o);
   if mtweak and mtweak.__weak then environ.gc() fi;  # with weak structures, first collect a gc to avoid printing errors
   io.write('reg(');
   if size o = 0 then
      io.write(')')
   else
      local sizeo := registers.gettop(o);  # only print all values up to the current top
      for j to sizeo do
         environ.aux.printaux(o[j], o);
         if j < sizeo then io.write(', ') fi
      od;
      io.write(')')
   fi;
end;


# procedure to print pairs to the console in a user-defined format; May 16, 2009; extended May 03, 2010
environ.aux.printpair := proc(o :: pair) is
   local l, r, isutype := left(o), right(o), typeof(o) <> pair;
   if isutype then
      io.write(typeof(o), '(')
   fi;
   environ.aux.printaux(l, o);
   if isutype then
      io.write(', ')
   else
      io.write(':')
   fi;
   environ.aux.printaux(r, o);
   if isutype then
      io.write(')')
   fi
end;


# procedure to print complex numbers to the console in a user-defined format; May 16, 2009
# improved treatment of undefined!(+/-)infinity situation June 26, 2010; improved treatment
# of n!undefined situation where n is a finite number August 31, 2010.
environ.aux.printcomplex := proc(o :: complex) is
   local re, im := real(o), imag(o);
   if environ.kernel('zeroedcomplex') then
      if abs(re) < Eps then re := 0 fi;
      if abs(im) < Eps then im := 0 fi
   fi;
   if nan(o) then  # changed to `nan` operator, 2.1.2
     re := undefined;
     im := undefined;
   fi;
   if re <> 0 then
      io.write(re)
   fi;
   if im < 0 then
      if im = -1 then
         io.write('-I')
      else
         io.write(im, '*I')
      fi
   elif im > 0 then
      if re <> 0 then io.write('+') fi;
      if im = 1 then
         io.write('I')
      else
         io.write(im, '*I')
      fi
   elif re = 0 and im = 0 then
      io.write(0)
   fi;
end;


# procedure to print C library procedures to the console in a user-defined format
environ.printprocedure := proc(o :: procedure) is
   io.write(typeof(o), '(', environ.pointer(o), ')');
end;


##############################################################################################
# Initialization of Environment Variables                                                    #
##############################################################################################

environ.withverbose := true;  # true means that information on short names already assigned will be printed


##############################################################################################
# determine path to main Agena library                                                       #
##############################################################################################

for i in << x -> ('/lib' atendof lower(x)) <> null >> $ libname split environ.kernel('pathsep') do
   local list := os.list(i, '*.agn');
   if has(list, 'library.agn') and has(list, 'ansi.agn') then
      mainlibname := i;
      break;
   fi
od;

##############################################################################################
# determine operating system and cpu type                                                    #
##############################################################################################

local _syscall := os.system();
local _os := lower(_syscall[1]);
if _os = 'windows' then
   environ.os, environ.cpu := 'windows', 'x86'
elif _os = 'darwin' then
   environ.os := 'macosx'
   if _syscall[4] = 'powerpc' or _syscall[4] = 'Power Macintosh' then
      environ.cpu := 'ppc'
   else
      environ.cpu := 'x86'
   fi
elif 'dos' in _os then
   environ.os, environ.cpu := 'dos', 'x86'
elif _os = 'sunos' then
   environ.os := 'solaris';
   if _syscall[4] = 'sun4u' then
      environ.cpu := 'sparc'
   else
      environ.cpu := 'x86'
   fi
else
   environ.os, environ.cpu := _os, lower(_syscall[4])
fi;
clear _os, _syscall;


##############################################################################################
# Linux version of `os.cpuinfo`                                                              #
##############################################################################################

if environ.os = 'linux' then
   os.cpuinfo := proc() is
      local L, r, j;
      L := remove( << x -> trim(x) = '' >>, io.readlines('/proc/cpuinfo'));
      create table r;
      for i in L do
         j := lower(i);  # changed 1.12.9
         if unassigned(r.brand) and ('model name' in j = 1 or 'processor' in j = 1) then
	    local cputype := trim(top(i split ':'));  # Agena 1.12.9
	    if not strings.isnumber(cputype) then  # avoid confusing the processor number with the cpu type, e.g.
	       # on single-core ARM processors, the processor entry in /proc/cpuinfo stands for the cpu instead of
	       # the processor number
           r.brand := trim(top(i split ':'))
	    fi
         fi;
         if unassigned(r.level) and 'cpu family' in j = 1 then
            r.level := tonumber(trim(top(i split ':')))
         fi;
         if unassigned(r.model) and 'model' in j = 1 and 'model name' in j = null then
            r.model := tonumber(trim(top(i split ':')))
         fi;
         if unassigned(r.frequency) and ('cpu mhz' in j = 1 or 'bogomips' in j = 1) then
            r.frequency := tonumber(trim(top(i split ':')))
         fi;
         if unassigned(r.stepping) and 'stepping' in j = 1 then
            r.stepping := tonumber(trim(top(i split ':')))
         fi;
         if unassigned(r.vendor) and 'vendor_id' in j = 1 then
            r.vendor := trim(top(i split ':'))
         fi
      od;
      r.ncpu := size(<< x -> 'processor' in lower(x) = 1 >> $ L);  # Linux 2.3.3 patch
      case os.endian()
         of fail then r.bigendian := fail;
         of 1 then r.bigendian := true;
         else
            r.bigendian := false
      esac;
      return r
   end
fi;


# If executed by the ANSI version of Agena, load substitutes for some C99 library functions.
if (os.isANSI() or environ.os = 'haiku') and mainlibname <> null then
   run (mainlibname & '/ansi.agn')
fi;


##############################################################################################
# For compatibility of the ANSI version of Agena                                             #
##############################################################################################

# If executed by the ANSI version of Agena, load substitutes for some C99 library functions.
if (os.isANSI() or environ.os = 'haiku') and mainlibname <> null then
   run (mainlibname & '/ansi.agn')
fi;

# Initialise default number of digits for mapm package in the OS/2 and DOS editions

#if (os.isOS2() or os.isDOS()) and mapm :: table and assigned(mapm.xdigits) then
#   mapm.xdigits(17)
#fi;


##############################################################################################
# Argument checks and error messages                                                         #
##############################################################################################

argerror := proc(v, procname :: string, message :: string) is  # Agena 1.8.5 u1, changed 2.1.1
   error('Error in `' & procname & '`: ' & message & ', got ' & typeof(v) & '.')
end;


##############################################################################################
# Backward compatibility to Agena 1.6.15 and earlier                                         #
##############################################################################################

os.curdir := proc() is
   return os.chdir()
end;


##############################################################################################
# Backward compatibility to Agena 1.8.5 and earlier                                          #
##############################################################################################

io.flush := io.sync;

##############################################################################################
# Backward compatibility to Agena 1.8.14 and earlier                                         #
##############################################################################################

# Converts a Julian date into its calendar date representation, returning three integer values:
# the year, the month, and the day. Taken from an Excel file import library written for Modula-2.
utils.cdate := proc(julian :: number) is
   if unassigned(astro) then import astro fi;
   return astro.cdate(julian)
end;

# Alias to the former Agena version of isleapyear
utils.isleapyear := proc(julian :: number) is
   if unassigned(astro) then import astro fi;
   return astro.isleapyear(julian)
end;

utils.decode64 := utils.decodeb64;  # to circumvent a silly typo

##############################################################################################
# Backward compatibility to Agena 2.1.8 and earlier                                          #
##############################################################################################

notisposint := isnonposint;
notisnegint := isnonnegint;

