-- Copyright 1994 by Daniel R. Grayson

use getline;
use actors;
use actors2;
use actors3;
use struct;
use pthread;
use regex;

header "// required for toString routines
#include <engine.h>                         // for IM2_GB_to_string, rawMuta... // TODO: remove this one
#include <interface/NAG.h>                  // for rawHomotopyToString, rawP...
#include <interface/freemodule.h>           // for IM2_FreeModule_to_string
#include <interface/matrix.h>               // for IM2_Matrix_to_string
#include <interface/monoid.h>               // for rawMonoidToString
#include <interface/monomial-ordering.h>    // for IM2_MonomialOrdering_to_s...
#include <interface/mutable-matrix.h>       // for IM2_MutableMatrix_to_string
#include <interface/random.h>               // for system_randomint
#include <interface/ring.h>                 // for IM2_Ring_to_string
#include <interface/ringelement.h>          // for IM2_RingElement_to_string
#include <interface/ringmap.h>              // for IM2_RingMap_to_string
";

internalName(s:string):string := (
     -- was "$" + s in 0.9.2
     s
     );

sleepfun(e:Expr):Expr := (
     when e
     is i:ZZcell do (
	  if isInt(i)
	  then toExpr(sleep(toInt(i)))
	  else WrongArgSmallInteger(1))
     else WrongArgZZ(1));
setupfun("sleep",sleepfun);

nanosleepfun(e:Expr):Expr := (
     when e
     is i:ZZcell do (
	  if isLong(i)
	  then toExpr(nanosleep(toLong(i)))
	  else WrongArgSmallInteger(1))
     else WrongArgZZ(1));
setupfun("nanosleep",nanosleepfun);

forkfun(e:Expr):Expr := (
     when e
     is a:Sequence do (
	  if length(a) == 0
	  then (
	       pid := fork();
	       toExpr(pid))
	  else WrongNumArgs(0))
     else WrongNumArgs(0));
setupfun("fork",forkfun);

getpidfun(e:Expr):Expr := (
     when e
     is o:file do toExpr(o.pid)
     is a:Sequence do (
	  if length(a) == 0
	  then toExpr(getpid())
	  else WrongNumArgs(0))
     else WrongNumArgs(0));
setupfun("processID",getpidfun);


getpgrpfun(e:Expr):Expr := (
     when e
     is a:Sequence do (
	  if length(a) == 0
	  then toExpr(getpgrp())
	  else WrongNumArgs(0))
     else WrongNumArgs(0));
setupfun("groupID",getpgrpfun);

setpgidfun(e:Expr):Expr := (
     when e
     is a:Sequence do (
	  if length(a) == 2
	  then (
	       when a.0 is pid:ZZcell do
	       if !isInt(pid) then WrongArgSmallInteger(1) else
	       when a.1 is pgid:ZZcell do
	       if !isInt(pgid) then WrongArgSmallInteger(2) else (
		    r := setpgid(toInt(pid),toInt(pgid));
		    if r == ERROR
		    then buildErrorPacket("setGroupID: "+syserrmsg())
		    else nullE)
	       else WrongArgZZ(2)
	       else WrongArgZZ(1)
	       )
	  else WrongNumArgs(2))
     else WrongNumArgs(0));
setupfun("setGroupID",setpgidfun);

absfun(e:Expr):Expr := (
     when e
     is i:ZZcell do toExpr(abs(i.v))
     is x:RRcell do toExpr(if signbit(x.v) then -x.v else x.v)
     is x:RRicell do toExpr(abs(x.v))
     is x:CCcell do toExpr(abs(x.v))
     is r:QQcell do toExpr(abs(r.v))
     else WrongArg("a number, real or complex"));
setupfun("abs0",absfun);

sign(e:Expr):Expr := (
    when e
    is x:ZZcell do toExpr(sign(x.v))
    is x:QQcell do toExpr(sign(x.v))
    is x:RRcell do toExpr(sign(x.v))
    is x:CCcell do (
	if isZero(x.v) then toExpr(toCC(0, 0, precision(x.v)))
	else toExpr(x.v / abs(x.v)))
    else WrongArg("a number, real or complex"));
setupfun("sign0", sign);

select(a:Sequence,f:Expr):Expr := (
     b := new array(bool) len length(a) do provide false;
     found := 0;
     foreach x at i in a do (
	  y := applyEE(f,x);
	  when y is err:Error do if err.message == breakMessage then return if err.value == dummyExpr then nullE else err.value else return y else nothing;
	  if y == True then (
	       b.i = true;
	       found = found + 1;
	       )
	  else if y != False then return buildErrorPacket("select: expected predicate to yield true or false");
	  );
     new Sequence len found do (
	  foreach p at i in b do if p then provide a.i));
foo := array(string)();
select(n:int,f:Expr):Expr := (
     b := new array(bool) len n do provide false;
     found := 0;
     for i from 0 to n-1 do (
	  y := applyEE(f,toExpr(i));
	  when y is err:Error do if err.message == breakMessage then return if err.value == dummyExpr then nullE else err.value else return y else nothing;
	  if y == True then (
	       b.i = true;
	       found = found + 1;
	       )
	  else if y != False then return buildErrorPacket("select: expected predicate to yield true or false");
	  );
     Expr(list(new Sequence len found do foreach p at i in b do if p then provide toExpr(i))));
select(e:Expr,f:Expr):Expr := (
     when e
     is a:Sequence do Expr(select(a,f))
     is b:List do (
	  c := select(b.v,f);
	  when c
	  is Error do c
	  is v:Sequence do list(b.Class,v,b.Mutable)
	  else e			  -- shouldn't happen
	  )
     is n:ZZcell do (
	  if isInt(n)
	  then select(toInt(n),f)
	  else WrongArgSmallInteger(1)
	  )
     else WrongArg(0+1,"a list or a string"));
select(n:int,a:Sequence,f:Expr):Expr := (
     b := new array(bool) len length(a) do provide false;
     found := 0;
     foreach x at i in a do (
	  if found < n then (
	       y := applyEE(f,x);
	       when y is err:Error do if err.message == breakMessage then return if err.value == dummyExpr then nullE else err.value else return y else nothing;
	       if y == True then (
		    b.i = true;
		    found = found + 1;
		    )
	       else if y != False then return buildErrorPacket("select: expected predicate to yield true or false");
	       )
	  else b.i = false);
     new Sequence len found do (
	  foreach p at i in b do if p then provide a.i));
select(n:Expr,e:Expr,f:Expr,g:Expr,h:Expr):Expr := (
     when n
     is regexp:stringCell do (
	 when e is form:stringCell do
	 when f is text:stringCell do
	 when g is regexFlags:ZZcell do if !isInt(regexFlags) then WrongArgSmallInteger(4) else
	 when h is matchFlags:ZZcell do if !isInt(matchFlags) then WrongArgSmallInteger(5) else (
	     regexSelect(regexp.v, form.v, text.v, toInt(regexFlags), toInt(matchFlags))) -- see regex.dd
	 else WrongArgZZ(5)
	 else WrongArgZZ(4)
	 else WrongArgString(3)
	 else WrongArgString(2))
     is n:ZZcell do if isInt(n) then
     when e
     is a:Sequence do Expr(select(toInt(n),a,f))
     is b:List do (
	  c := select(toInt(n),b.v,f);
	  when c
	  is Error do c
	  is v:Sequence do list(b.Class,v,b.Mutable)
	  else e			  -- shouldn't happen
	  )
     else WrongArg(1+1,"a list")
     else WrongArg(0+1,"an integer or string")
     else WrongArgZZ(0+1));
select(e:Expr):Expr := (
     when e is a:Sequence do
     if length(a) == 2 then select(a.0,a.1) else
     if length(a) == 3 then select(a.0,a.1,a.2,toExpr(defaultRegexFlags),toExpr(defaultMatchFlags)) else
     if length(a) == 5 then select(a.0,a.1,a.2,a.3,a.4)
     else WrongNumArgs(2,5)
     else WrongNumArgs(2,5));
setupfun("select", select).Protected = false; -- will be overloaded in m2/lists.m2 and m2/regex.m2

-- # typical value: selectPairs, HashTable, Function, HashTable
-- # typical value: selectPairs, ZZ, HashTable, Function, HashTable
selectPairs(nval:int, obj:HashTable, f:Expr):Expr := (
    u := newHashTable(obj.Class,obj.parent);
    u.beingInitialized = true;
    if nval > 0 then
    foreach bucket in obj.table do (
	p := bucket;
	while nval > 0 && p != p.next do (
	    newvalue := applyEEE(f,p.key,p.value);
	    when newvalue
	    is err:Error
	    do (
		if err.message == breakMessage
		then return (
		    if err.value == dummyExpr
		    then nullE
		    else err.value)
		else return newvalue)
	    else if newvalue == True
	    then (
		storeInHashTable(u,p.key,p.hash,p.value);
		nval = nval-1;
		)
	    else (
		if newvalue != False
		then return buildErrorPacket(
		    "expected predicate to yield true or false"));
	    p = p.next));
    Expr(sethash(u,obj.Mutable)));
-- TODO: support iterators
selectPairs(e:Expr):Expr := (
    when e
    is a:Sequence do (
	if length(a) == 2 then (
	    when a.0
	    is obj:HashTable do (
		if obj.Mutable
		then WrongArgImmutableHashTable(1)
		else selectPairs(obj.numEntries, obj, a.1))
	    -- # typical value: selectPairs, BasicList, Function, List
	    else select(pairs(a.0), a.1))
	else if length(a) == 3 then (
	    when a.0
	    is n:ZZcell do (
		if !isInt(n) then WrongArgSmallInteger(1)
		else (
		    when a.1 is obj:HashTable
		    do (
			if obj.Mutable
			then WrongArgImmutableHashTable(2)
			else selectPairs(toInt(n), obj, a.2))
		    -- # typical value: selectPairs, ZZ, BasicList, Function, List
		    else select(a.0, pairs(a.1), a.2, nullE, nullE)))
	    else WrongArgZZ(1))
	else WrongNumArgs(2, 3))
    else WrongNumArgs(2, 3));
setupfun("selectPairs", selectPairs);

any(f:Expr,n:int):Expr := (
     for i from 0 to n-1 do (
	  v := applyEE(f,toExpr(i));
	  when v is err:Error do if err.message == breakMessage then return if err.value == dummyExpr then nullE else err.value else return v else nothing;
	  if v == True then return True;
	  if v != False then return buildErrorPacket("any: expected true or false");
	  );
     False);
any(f:Expr,obj:HashTable):Expr := (
     v := False;
     if obj.Mutable then lockRead(obj.mutex);
     foreach bucket in obj.table do (
	  p := bucket;
	  while true do (
	       if p == p.next then break;
	       v = applyEEE(f,p.key,p.value);
	       if v != False then break;
	       p = p.next;
	       );
	  if v != False then break);
     if obj.Mutable then unlock(obj.mutex);
     when v
     is err:Error do return
	  if err.message == breakMessage then if err.value == dummyExpr then nullE else err.value
	  else v
     else nothing;
     if v != True && v != False then return buildErrorPacket("any: expected true or false");
     v);
any(f:Expr,a:Sequence):Expr := (
     foreach x at i in a do (
	  y := applyEE(f,x);
	  when y is err:Error do if err.message == breakMessage then return if err.value == dummyExpr then nullE else err.value else return y else nothing;
	  if y == True then return True;
	  if y != False then return buildErrorPacket("any: expected true or false");
	  );
     False);
any(f:Expr,e:Expr):Expr := (
     when e
     is a:Sequence do Expr(any(f,a))
     is b:List do Expr(any(f,b.v))
     is i:ZZcell do if isInt(i) then Expr(any(f,toInt(i))) else WrongArgSmallInteger(1)
     is c:HashTable do
     if c.Mutable then WrongArgImmutableHashTable(1) else
     Expr(any(f,c))
     else WrongArg("a list or a hash table"));
any(f:Expr,a:Sequence,b:Sequence):Expr := (
     if length(a) != length(b) then return buildErrorPacket("expected lists of the same length");
     foreach x at i in a do (
	  y := applyEEE(f,x,b.i);
	  when y is err:Error do if err.message == breakMessage then return if err.value == dummyExpr then nullE else err.value else return y else nothing;
	  if y == True then return True;
	  if y != False then return buildErrorPacket("any: expected true or false");
	  );
     False);
any(f:Expr,a:Sequence,y:Expr):Expr := (
     when y
     is c:Sequence do Expr(any(f,a,c))
     is d:List do Expr(any(f,a,d.v))
     else WrongArg("a basic list or sequence"));
any(f:Expr,x:Expr,y:Expr):Expr := (
     when x
     is a:Sequence do Expr(any(f,a,y))
     is b:List do Expr(any(f,b.v,y))
     else WrongArg("a basic list or sequence"));
any(e:Expr):Expr := (
     when e is a:Sequence do (
	  if length(a) == 2 then any(a.1,a.0)
	  else if length(a) == 3 then any(a.2,a.0,a.1)
	  else WrongNumArgs(2,3))
     else WrongNumArgs(2));
setupfun("any",any);

--find(f:Expr,obj:HashTable):Expr := (
--     foreach bucket in obj.table do (	-- also must lock
--	  p := bucket;
--	  while true do (
--	       if p == bucketEnd then break;
--	       r := apply(f,p.key,p.value);
--	       if r != nullE then return r;
--	       p = p.next;
--	       ));
--     nullE);
--find(f:Expr,a:Sequence):Expr := (
--     i := 0;
--     while i < length(a) do (
--	  r := apply(f,a.i);
--	  if r != nullE then return r;
--	  i = i+1;
--	  );
--     nullE);
--find(e:Expr):Expr := (
--     when e is a:Sequence do (
--	  if length(a) != 2
--	  then WrongNumArgs(2)
--	  else (
--	       f := a.1;
--	       x := a.0;
--	       when x
--	       is a:Sequence do Expr(find(f,a))
--	       is b:List do Expr(find(f,b.v))
--	       is c:HashTable do
--	       if c.Mutable then WrongArg(1,"an immutable hash table") else
--	       Expr(find(f,c))
--	       else WrongArg(1+1,"a list")))
--     else WrongNumArgs(2));
--setupfun("find",find);

ascii(e:Expr):Expr := (
    -- # typical value: ascii, BasicList, String
     if isIntArray(e)
     then toExpr((
	  v := toIntArray(e);
	  new string len length(v) do foreach i in v do provide char(i)))
     else
    -- # typical value: ascii, String, Sequence
     when e is s:stringCell do list(
	  new Sequence len length(s.v) do (
	       foreach c in s.v do provide toExpr(int(uchar(c)))))
    -- # typical value: ascii, ZZ, String
     is i:ZZcell do (
	  if isInt(i)
	  then toExpr(new string len 1 do provide char(toInt(i)))
	  else WrongArgSmallInteger(1))
     else buildErrorPacket("expects a string, a small integer, or an array of small integers"));
setupfun("ascii",ascii);

utf8(v:array(int)):Expr := (
     w := newvarstring(length(v)+10);
     foreach i in v do (
	  if (i &     ~0x7f) == 0 then w << char(i) else
	  if (i &    ~0x7ff) == 0 then w << char(0xc0 | (i >> 6)) << char(0x80 | (i & 0x3f)) else
	  if (i &   ~0xffff) == 0 then w << char(0xe0 | (i >> 12)) << char(0x80 | ((i >> 6) & 0x3f)) << char(0x80 | (i & 0x3f)) else
	  if (i & ~0x1fffff) == 0 then w << char(0xf0 | (i >> 18)) << char(0x80 | ((i >> 12) & 0x3f)) << char(0x80 | ((i >> 6) & 0x3f)) << char(0x80 | (i & 0x3f))
	  else ( return buildErrorPacket("encountered integer too large for utf-8 encoding"); w));
     toExpr(takestring(w)));

erru():Expr := buildErrorPacket("string ended unexpectedly during utf-8 decoding");
errb():Expr := buildErrorPacket("unexpected byte encountered in utf-8 decoding");
utf8(y:Expr):Expr := (
     if isIntArray(y) then utf8(toIntArray(y))
     else when y is ss:stringCell do (
	  s := ss.v;
	  n := length(s);
	  x := newvararrayint(n+10);
	  i := 0;
	  while i < n do (
	       c := int(uchar(s.i));
	       if (c & 0x80) == 0 then (
		    x << c;
		    i = i+1;
		    )
	       else if (c & 0xe0) == 0xc0 then (
		    if i+1 < n then (
		    	 d := int(uchar(s.(i+1)));
			 if (d & 0xc0) != 0x80 then return errb();
		    	 x << (((c & ~0xe0) << 6) | (d & ~0xc0));
			 i = i+2;
	       		 )
		    else return erru();
		    )
	       else if (c & 0xf0) == 0xe0 then (
		    if i+2 < n then (
		    	 d := int(uchar(s.(i+1)));
			 if (d & 0xc0) != 0x80 then return errb();
		    	 e := int(uchar(s.(i+2)));
			 if (e & 0xc0) != 0x80 then return errb();
		    	 x << (((c & ~0xf0) << 12) | ((d & ~0xc0) << 6) | (e & ~0xc0));
			 i = i+3;
			 )
		    else return erru();
		    )
	       else if (c & 0xf8) == 0xf0 then (
		    if i+3 < n then (
		    	 d := int(uchar(s.(i+1)));
			 if (d & 0xc0) != 0x80 then return errb();
		    	 e := int(uchar(s.(i+2)));
			 if (e & 0xc0) != 0x80 then return errb();
		    	 f := int(uchar(s.(i+3)));
			 if (f & 0xc0) != 0x80 then return errb();
		    	 x << (((c & ~0xf8) << 18) | ((d & ~0xc0) << 12) | ((e & ~0xc0) << 6) | (f & ~0xc0));
			 i = i+4;
			 )
		    else return erru();
		    )
	       else return errb();
	       );
	  a := takearrayint(x);
     	  Expr(list(new Sequence len length(a) do foreach i in a do provide toExpr(i))))
     is i:ZZcell do (
	  if !isInt(i) then return WrongArgSmallInteger();
	  Expr(utf8(array(int)(toInt(i)))))
     else buildErrorPacket("expects a string, a small integer, or an array of small integers"));
setupfun("utf8",utf8);

errucheck():Expr := buildErrorPacket("string ended unexpectedly during utf-8 checking");
errbcheck():Expr := buildErrorPacket("unexpected byte encountered in utf-8 checking");
utf8check(y:Expr):Expr := (
     when y is ss:stringCell do (
	  s := ss.v;
	  n := length(s);
	  i := 0;
	  while i < n do (
	       c := int(uchar(s.i));
	       if (c & 0x80) == 0 then (
		    i = i+1;
		    )
	       else if (c & 0xe0) == 0xc0 then (
		    if i+1 < n then (
		    	 d := int(uchar(s.(i+1)));
			 if (d & 0xc0) != 0x80 then return errbcheck();
			 i = i+2;
	       		 )
		    else return errucheck();
		    )
	       else if (c & 0xf0) == 0xe0 then (
		    if i+2 < n then (
		    	 d := int(uchar(s.(i+1)));
			 if (d & 0xc0) != 0x80 then return errbcheck();
		    	 e := int(uchar(s.(i+2)));
			 if (e & 0xc0) != 0x80 then return errbcheck();
			 i = i+3;
			 )
		    else return errucheck();
		    )
	       else if (c & 0xf8) == 0xf0 then (
		    if i+3 < n then (
		    	 d := int(uchar(s.(i+1)));
			 if (d & 0xc0) != 0x80 then return errbcheck();
		    	 e := int(uchar(s.(i+2)));
			 if (e & 0xc0) != 0x80 then return errbcheck();
		    	 f := int(uchar(s.(i+3)));
			 if (f & 0xc0) != 0x80 then return errbcheck();
			 i = i+4;
			 )
		    else return errucheck();
		    )
	       else return errbcheck();
	       );
     	  nullE)
     else buildErrorPacket("expects a string"));
setupfun("utf8check",utf8check);

export checknoargs(e:Expr):Expr := (
     when e
     is v:Sequence do (
	  if length(v) == 0 then e else WrongNumArgs(0)
	  )
     else WrongNumArgs(0)
     );

randomint(e:Expr):Expr := (
     when checknoargs(e) is f:Error do return Expr(f) else nothing;
     toExpr(randomint()));
setupfun("randomint",randomint);

outseq(x:file,y:Sequence):Expr := (
     foreach z in y do (
	  when z
	  is w:List do (outseq(x,w.v);)
	  is Nothing do nothing
	  is y:SymbolClosure do (
	       x << if y.frame == globalFrame
	       then y.symbol.word.name
	       else internalName(y.symbol.word.name);
	       )
	  is y:ZZcell do (
	       if isInt(y)
	       then for toInt(y) do x << ' '
	       else return WrongArg(2,"a string, or list or sequence of strings and small integers, or null"))
	  is w:Sequence do (outseq(x,w);)
	  is s:stringCell do (x << s.v;)
	  else return WrongArg(2,"a string, or list or sequence of strings and integers, or null"));
     Expr(x));
outstringfun(e:Expr):Expr := (
     when e
     is a:Sequence do (
	  if length(a) == 2 then (
	       when a.0
	       is x:file do (
		    when a.1
		    is y:stringCell do Expr(x << y.v)
		    is Nothing do Expr(x)
		    is y:SymbolClosure do (
			 x << (
			      if y.frame == globalFrame
	  		      then y.symbol.word.name
	  		      else internalName(y.symbol.word.name)
			      );
			 Expr(x)
			 )
		    is y:List do outseq(x,y.v)
		    is n:Net do Expr(x << n)
		    is y:ZZcell do (
			 if isInt(y)
			 then (
			      for toInt(y) do x << ' ';
			      Expr(x))
			 else WrongArg(2,"a sequence or list of strings, nets, or nulls"))
		    is y:Sequence do outseq(x,y)
		    else WrongArg(2,"a sequence or list of strings, nets, or nulls"))
	       else WrongArg(1,"a file"))
	  else WrongNumArgs(2))
     else WrongNumArgs(2));
setupfun("printString",outstringfun);

lenseq(y:Sequence):int := (
     l := 0;
     foreach z in y do (
	  when z
	  is w:List do (
	       m := lenseq(w.v);
	       if m == -1 then return -1;
	       l = l + m;
	       )
	  is Nothing do nothing
	  is y:SymbolClosure do l = l + length(y.symbol.word.name)
	  is y:ZZcell do (
	       if isInt(y)
	       then (if toInt(y)>0 then l = l + toInt(y);)
	       else return -1)
	  is w:Sequence do (
	       m := lenseq(w);
	       if m == -1 then return -1;
	       l = l + m;
	       )
	  is s:stringCell do (
	       l = l + length(s.v);
	       )
	  else return -1);
     l);
stringlenfun(e:Expr):Expr := (
     when e
     is y:stringCell do toExpr(length(y.v))
     is Nothing do zeroE
     is y:SymbolClosure do toExpr(length(y.symbol.word.name))
     is y:List do (
	  l := lenseq(y.v);
	  if l == -1
	  then WrongArg(1,"a string, or list or sequence of strings and integers, or null")
	  else toExpr(l)
	  )
     is y:ZZcell do e
     is y:Sequence do (
	  l := lenseq(y);
	  if l == -1
	  then WrongArg(1,"a string, or list or sequence of strings and integers, or null")
	  else toExpr(l)
	  )
     else WrongArg(1,"a string, or list or sequence of strings and integers, or null"));
setupfun("stringlen",stringlenfun);

stringcat2(a:Sequence,s:string,i:int):int := ( -- returns next available index
     foreach x in a do (
	  when x
	  is a:Sequence do i = stringcat2(a,s,i)
     	  is y:SymbolClosure do foreach c in y.symbol.word.name do (s.i = c; i = i+1;)
	  is a:List do i = stringcat2(a.v,s,i)
	  is n:ZZcell do for toInt(n) do (s.i = ' '; i = i+1;)
	  is t:stringCell do foreach c in t.v do (s.i = c; i = i+1;)
	  else nothing;
	  );
     i);
export stringcatseq(a:Sequence):Expr := (
     l := lenseq(a);
     if l == -1
     then WrongArg("strings, integers, or symbols")
     else (
	  s := new string len l do provide ' ';
	  stringcat2(a,s,0);
	  toExpr(s)));
stringcatfun(e:Expr):Expr := (
     when e
    -- # typical value: concatenate, BasicList, String
     is a:Sequence do stringcatseq(a)
     is a:List do stringcatseq(a.v)
    -- # typical value: concatenate, Nothing, String
     is Nothing do emptyString
    -- # typical value: concatenate, Symbol, String
     is y:SymbolClosure do toExpr(y.symbol.word.name)
    -- # typical value: concatenate, ZZ, String
     is n:ZZcell do (
	  if isInt(n) then (
	       m := max(toInt(n), 0);
	       toExpr(new string len m do provide ' ')
	       )
	  else buildErrorPacket("encountered a large integer")
	  )
    -- # typical value: concatenate, String, String
     is stringCell do e
     else WrongArg("a sequence or list of strings, integers, or symbols"));
setupfun("concatenate",stringcatfun);

errorfun(e:Expr):Expr := (
     e = stringcatfun(e);
     when e
     is s:stringCell do buildErrorPacket(s.v)
     else buildErrorPacket("expects a string or sequence of strings as its argument"));
setupfun("error",errorfun).Protected = false;		    -- this will be replaced by a toplevel function that calls this one

mingleseq(a:Sequence):Expr := (
     n := length(a);
     b := new array(Sequence) len n do provide emptySequence;
     newlen := 0;
     for i from 0 to n-1 do (
	  when a.i
	  is d:Sequence do ( newlen = newlen + length(d); b.i = d; )
	  is d:List do ( newlen = newlen + length(d.v); b.i = d.v; )
	  else return WrongArg(i+1,"a list or sequence"));
     list ( new Sequence len newlen do
     	  for j from 0 to newlen-1 do for i from 0 to n-1 do
     	  if j < length(b.i) then provide b.i.j));
minglefun(e:Expr):Expr := (
     when e
     is a:Sequence do mingleseq(a)
     is a:List do mingleseq(a.v)
     is Error do e
     else WrongArg("a list or sequence"));
-- # typical value: mingle, BasicList, List
setupfun("mingle", minglefun);

packlist(n:int, v:Sequence):Sequence := (
     d := length(v);
     i := 0;
     new Sequence len (d + n - 1) / n do
     	  provide list(
	       new Sequence len if n < d-i then n else d-i do (
		    j := i;
		    i = i+1;
		    provide v.j)));
packfun(e:Expr):Expr := (
    when e is a:Sequence do
    if length(a) == 2 then (
	when a.0 is n:ZZcell do if !isInt(n) then WrongArgSmallInteger(1) else (
	    s := toInt(n);
	    when a.1
	    is x:List do (
		if s > 0 then list ( packlist(s, x.v) ) else
		if s == 0 && length(x.v) == 0 then emptyList
		else WrongArg(1, "a positive integer"))
	    is x:Sequence do (
		if s > 0 then list ( packlist(s, x) ) else
		if s == 0 && length(x) == 0 then emptyList
		else WrongArg(1, "a positive integer"))
	    is x:stringCell do (
		if s > 0 then list ( map(stringcatfun, packlist(s, strtoseq(x))) ) else
		if s == 0 && length(x.v) == 0 then emptyList
		else WrongArg(1, "a positive integer"))
	    else WrongArg(2, "a basic list, sequence, or string"))
	else WrongArg(1, "a positive integer"))
    else WrongNumArgs(2)
    else WrongNumArgs(2));
setupfun("pack", packfun).Protected = false; -- will be overloaded in m2/lists.m2

getenvfun(e:Expr):Expr := (
     when e
     is s:stringCell do toExpr(getenv(s.v))
     else WrongArgString());
setupfun("getenv",getenvfun);

getfun(e:Expr):Expr := (
     when e
     is f:file do (
	  if f.infd == -1
	  then WrongArg("an open input file")
	  else (
	       when readfile(f.infd)
	       is s:string do (
		    stat := closeIn(f); -- the user may close the output side of a pipe first, so we can find out now if the process exited normally
		    when stat is m:errmsg do buildErrorPacket(m.message)
		    else toExpr(s))
	       else buildErrorPacket("unable to read file: "+syserrmsg())))
     is filename:stringCell do (
	  when get(filename.v)
	  is e:errmsg do buildErrorPacket(e.message)
	  is s:stringCell do toExpr(s.v))
     else WrongArg("a string as filename"));
setupfun("get",getfun);

readprompt := "";
readpromptfun():string := readprompt;

isReadyFun(e:Expr):Expr := (
     when e
     -- # typical value: isReady, Task, Boolean
     is tc:TaskCell do toExpr(taskDone(tc.body.task) && !tc.body.resultRetrieved)
     -- # typical value: isReady, File, Boolean
     is f:file do toExpr (
	  f.input && !f.eof && ( f.insize > f.inindex || isReady(f.infd) > 0 )
	  ||
	  f.listener && (
	       f.connection != -1
	       ||
	       ( sd := acceptNonblocking(f.listenerfd); f.connection = sd; sd != -1 )
	       )
	  )
     else WrongArg("a file or a task"));
setupfun("isReady",isReadyFun);


isCanceledFun(e:Expr):Expr := (
     when e
     -- # typical value: isCanceled, Task, Boolean
     is tc:TaskCell do toExpr(!taskRunning(tc.body.task) && !taskKeepRunning(tc.body.task))
     else WrongArg("a task"));
setupfun("isCanceled",isCanceledFun);


atEOFfun(e:Expr):Expr := (
     when e
     is f:file do toExpr ( !f.input || f.eof || f.insize == f.inindex && isReady(f.infd) > 0
	  && 0 == filbuf(f) )
     else WrongArg("a file"));
setupfun("atEndOfFile",atEOFfun);

allInputFilesOrListeners(s:Sequence):bool := (
     foreach f in s do (
     	  when f is g:file do ( if !g.input && !g.listener then return false; )
     	  else return false;
	  );
     true);
allIntegers(s:Sequence):bool := (
     foreach f in s do (
     	  when f is g:ZZcell do ( if !isInt(g) || toInt(g) < 0 then return false; )
     	  else return false;
	  );
     true);
numberReadyOnes(s:Sequence):int := (
     n := 0;
     foreach f in s do (
     	  when f is g:file do ( if g.input && (g.insize > g.inindex) then n = n+1; )
     	  else nothing;
	  );
     n);
readyOnes(s:Sequence):array(int) := (
     new array(int) len numberReadyOnes(s) do
     foreach f at i in s do
     when f is g:file do ( if g.input && (g.insize > g.inindex) then provide i; )
     else nothing
     );
fdlist(s:Sequence):array(int) := (
     new array(int) len length(s) do
     foreach f in s do
     when f is g:file
     do provide if g.input then g.infd else if g.listener then g.listenerfd else if g.output then g.outfd else -1
     else nothing
     );
wait(s:Sequence):Expr := (
     if allIntegers(s) then (
	  stats := waitNoHang(new array(int) len length(s) do foreach pid in s do provide toInt(pid));
	  Expr(list(new Sequence len length(s) do foreach status in stats do provide toExpr(status))))
     else if !allInputFilesOrListeners(s) then WrongArg("a list of input files or listeners, or a list of small non-negative integers")
     else if numberReadyOnes(s) > 0 then list(toArrayExpr(readyOnes(s)))
     else list(toArrayExpr(select(fdlist(s))))
     );
wait(f:file):Expr := (
     if !f.input then WrongArg("an input file or list of input files")
     else if f.insize > f.inindex then nullE
     else ( filbuf(f); nullE ));
wait(e:Expr):Expr := (
     when e
     is f:List do wait(f.v)
     is v:Sequence do wait(v)
     is f:file do wait(f)
     is x:ZZcell do (
	  if isInt(x) then (
	       ret := wait(toInt(x));
	       if ret == ERROR
	       then buildErrorPacket("wait failed")
	       else toExpr(ret)
	       )
	  else WrongArgSmallInteger()
	  )
     else WrongArg("an integer, or an input file or list of input files")
     );
setupfun("wait",wait);

readE(f:file):Expr := (
     when read(f)
     is e:errmsg do buildErrorPacket(e.message)
     is s:stringCell do Expr(s));

readIO(msg:string):Expr := (
     readprompt = msg;
     oldprompt := stdIO.prompt;
     stdIO.prompt = readpromptfun;
     r := getLine(stdIO);
     stdIO.prompt = oldprompt;
     when r
     is e:errmsg do buildErrorPacket(e.message)
     is s:stringCell do Expr(s)
);

readfun(e:Expr):Expr := (
     when e
     is f:file do readE(f)
     is p:stringCell do readIO(p.v)
     is s:Sequence do (
	  if length(s) == 0
	  then readIO("")
	  else if length(s) == 2
	  then (
	       when s.0
	       is f:file do (
		    if ! f.input
		    then return WrongArg(1,"expected an input file");
		    when s.1
		    is n:ZZcell do (
			 if isInt(n)
			 then (
			      nn := toInt(n);
			      if nn < 0
			      then return WrongArg(2,"a positive integer");
			      if f.inindex < f.insize
			      then (
				   nn = min(nn,f.insize - f.inindex);
				   o := f.inindex;
				   f.inindex = f.inindex + nn;
				   toExpr(new string len nn do for i from 0 to nn-1 do provide f.inbuffer.(o+i))
				   )
			      else (
				   buf := new string len nn do provide ' ';
				   r := read(f.infd,buf,nn);
				   toExpr(new string len r do for i from 0 to r-1 do provide buf.i)
				   )
			      )
			 else WrongArgSmallInteger(2)
			 )
		    else WrongArgZZ(2)
		    )
	       else WrongArg(1,"a file")
	       )
	  else WrongNumArgs(0,1))
     else WrongArg(1,"a file or a string"));
setupfun("read",readfun);

substrfun(e:Expr):Expr := (
     when e is args:Sequence do
     if length(args) == 3 then
     when args.0
     is i:ZZcell do if !isInt(i) then WrongArgSmallInteger(1) else (
	  when args.1 is j:ZZcell do if !isInt(j) then WrongArgSmallInteger(2) else
	  when args.2 is s:stringCell do toExpr(substr(s.v,toInt(i),toInt(j)))
	  else WrongArgString(3)
	  else WrongArgZZ(2))
     is s:stringCell do (
	  when args.1 is i:ZZcell do if !isInt(i) then WrongArgSmallInteger(2) else
	  when args.2 is j:ZZcell do if !isInt(j) then WrongArgSmallInteger(3) else toExpr(substr(s.v,toInt(i),toInt(j)))
	  else WrongArgZZ(3)
	  else WrongArgZZ(2))
     else WrongArg(1,"a string or an integer")
     else if length(args) == 2 then
     when args.0
     is s:stringCell do (
	  when args.1
	  is i:ZZcell do if !isInt(i) then WrongArgSmallInteger(2) else toExpr(substr(s.v,toInt(i)))
	  else WrongArgZZ(2))
     is i:ZZcell do if !isInt(i) then WrongArgSmallInteger(1) else (
	  when args.1
	  is s:stringCell do toExpr(substr(s.v,toInt(i)))
	  else WrongArgString(2))
     is pair:Sequence do (
	  if length(pair) != 2 then WrongArg(1,"a sequence of length 2") else
	  when pair.0 is i:ZZcell do if !isInt(i) then WrongArg(1,"a pair of small integers") else (
	       when pair.1 is j:ZZcell do if !isInt(j) then WrongArg(1,"a pair of small integers") else
	       when args.1 is s:stringCell do toExpr(substr(s.v,toInt(i),toInt(j)))
	       else WrongArgString(2)
	       else WrongArg(1,"a pair of integers"))
	  else WrongArg(1,"a pair of integers"))
     else WrongArg(1,"a string, an integer, or a pair of integers")
     else WrongNumArgs(2,3)
     else WrongNumArgs(2,3));
setupfun("substring",substrfun);

tostring(n:MysqlConnection):string := tostring(Ccode(constcharstarOrNull, "
     #if WITH_MYSQL
       mysql_get_host_info(", n, ")
     #else
       \"not present\"
     #endif
"));

tostring(m:MysqlConnectionWrapper):string := (
     "<<MysqlConnection : " + ( when m.mysql is null do "closed" is n:MysqlConnection do tostring(n) ) + ">>"
     );

tostringfun(e:Expr):Expr := (
     when e
     is i:ZZcell do toExpr(tostring(i.v))
     is x:QQcell do toExpr(tostring(x.v))
     is stringCell do e
     is q:SymbolClosure do toExpr( if q.frame == globalFrame then q.symbol.word.name else internalName(q.symbol.word.name) )
     is f:file do toExpr(f.filename)
     is b:Boolean do toExpr(if b.v then "true" else "false")
     is Nothing do toExpr("null")
     is f:Database do toExpr(f.filename)
     is m:MysqlConnectionWrapper do toExpr(tostring(m))
     is res:MysqlResultWrapper do toExpr(
	  "<<MysqlResult : "
	  + tostring(Ccode(int, "\n # if WITH_MYSQL \n mysql_num_rows(", res.res, ") \n #else \n 0 \n #endif \n"))
	  + " by "
	  + tostring(Ccode(int, "\n # if WITH_MYSQL \n mysql_num_fields(", res.res, ") \n #else \n 0 \n #endif \n"))
	  + ">>")
     is fld:MysqlFieldWrapper do toExpr(
	  "<<MysqlField : "
	  + tostring(Ccode(constcharstarOrNull,"(\n #if WITH_MYSQL \n (", fld.fld, ")->name \n #else \n \"\" \n #endif \n )"))
	  + " : "
	  + tostring(Ccode(int,"\n # if WITH_MYSQL \n (", fld.fld, ")->type \n #else \n 0 \n #endif \n"))
	  + ">>")
     is Net do toExpr("<<net>>")
     is PseudocodeClosure do toExpr("<<pseudocode closure>>")
     is Pseudocode do toExpr("<<pseudocode>>")
     is functionCode do toExpr("<<a function body>>")
     is CompiledFunction do toExpr("<<a compiled function>>")
     is CompiledFunctionClosure do toExpr("<<a compiled function closure>>")
     is CompiledFunctionBody do toExpr("<<a compiled function body>>")
     is x:SymbolBody do toExpr(x.symbol.word.name)
     is FunctionClosure do toExpr("<<a function closure>>")
     is DictionaryClosure do toExpr("<<a dictionary>>")
     is NetFile do toExpr("<<a netfile>>")
     is x:RRcell do toExpr(tostringRR(x.v))
     is x:RRicell do toExpr(tostringRRi(x.v))
     is z:CCcell do toExpr(tostringCC(z.v))
     is Error do toExpr("<<an error message>>")
     is Sequence do toExpr("<<a sequence>>")
     is HashTable do toExpr("<<a hash table>>")
     is List do toExpr("<<a list>>")
     is s:SpecialExpr do tostringfun(s.e)
     is x:RawMonomialCell do toExpr(tostring(x.p))
     is x:RawFreeModuleCell do toExpr(Ccode(string, "IM2_FreeModule_to_string(",x.p,")" ))
     is x:RawMatrixCell do toExpr(Ccode(string, "IM2_Matrix_to_string(",x.p,")" ))
     is x:RawMutableMatrixCell do toExpr(Ccode(string, "IM2_MutableMatrix_to_string(",x.p,")" ))
     is x:RawMutableComplexCell do toExpr(Ccode(string, "rawMutableComplexToString(",x.p,")" ))
     -- NAG stuff begin
     is x:RawHomotopyCell do toExpr(Ccode(string, "rawHomotopyToString(",x.p,")" ))
     is x:RawSLEvaluatorCell do toExpr(Ccode(string, "rawSLEvaluatorToString(",x.p,")" ))
     is x:RawSLProgramCell do toExpr(Ccode(string, "rawSLProgramToString(",x.p,")" ))
     is x:RawStraightLineProgramCell do toExpr(Ccode(string, "rawStraightLineProgramToString(",x.p,")" ))
     is x:RawPathTrackerCell do toExpr(Ccode(string, "rawPathTrackerToString(",x.p,")" ))
     is x:RawPointArrayCell do toExpr(Ccode(string, "rawPointArrayToString(",x.p,")" ))
     -- NAG stuff end
     is x:RawRingMapCell do toExpr(Ccode(string, "IM2_RingMap_to_string(",x.p,")" ))
     is x:RawMonomialOrderingCell do toExpr(Ccode(string, "IM2_MonomialOrdering_to_string(",x.p,")" ))
     is x:RawMonoidCell do toExpr(Ccode(string, "rawMonoidToString(",x.p,")" ))
     is x:RawRingCell do toExpr(Ccode(string, "IM2_Ring_to_string(",x.p,")" ))
     is x:RawRingElementCell do toExpr( Ccode(string, "IM2_RingElement_to_string(",x.p,")" ) )
     is x:RawMonomialIdealCell do toExpr(
	  "<<raw monomial ideal>>"
	  -- Ccode(string, "IM2_MonomialIdeal_to_string(",x.p,")" )
	  )
     is c:RawComputationCell do toExpr(Ccode(string, "IM2_GB_to_string(",c.p,")" ))
     is pythonObjectCell do toExpr("<<a python object>>")
     is x:xmlNodeCell do toExpr(toString(x.v))
     is xmlAttrCell do toExpr("<<libxml attribute>>")
     is x:TaskCell do (
--	  while !isInitialized(x) do nothing;
	  toExpr(
	       "<<task, "
	       + (
		    if x.body.resultRetrieved then "result delivered, task terminated"
		    else if taskDone(x.body.task) then "result available, task done"
		    else if taskRunning(x.body.task) && !taskKeepRunning(x.body.task) then "running, cancellation requested"
		    else if !taskKeepRunning(x.body.task) then "canceled"
		    else if !taskStarted(x.body.task) then "created"
		    else "running"
		    )
	       + ">>"
	       ))
    is x:fileOutputSyncState do toExpr("File Output Sync State")
    is x:pointerCell do (
	buf := newstring(20);
	Ccode(void, "sprintf((char *)", buf, "->array, \"%p\", ", x.v, ")");
	Ccode(void, buf, "->len = strlen((char *)", buf, "->array)");
	toExpr(buf))
    is x:atomicIntCell do (
	buf := newstring(20);
	Ccode(void, "sprintf((char *)", buf, "->array, \"%d\", ", load(x.v), ")");
	Ccode(void, buf, "->len = strlen((char *)", buf, "->array)");
	toExpr(buf))
);
setupfun("simpleToString",tostringfun);

changeBase(e:Expr):Expr := (
    when e
    is a:Sequence do (
	if length(a) == 2 then (
	    when a.0
	    is x:ZZcell do (
		when a.1
		is y:ZZcell do (
		    if !isInt(y)
		    then return WrongArgSmallInteger(2);
		    newbase := toInt(y);
		    if newbase > 62 || newbase < 2
		    then buildErrorPacket("expected new base between 2 and 62")
		    else toExpr(tostring(x.v, newbase)))
		else WrongArgZZ(2))
	    is x:stringCell do (
		when a.1
		is y:ZZcell do (
		    if !isInt(y)
		    then return WrongArgSmallInteger(2);
		    oldbase := toInt(y);
		    if oldbase > 62 || oldbase == 1 || oldbase < 0
		    then return buildErrorPacket(
			"expected old base to be 0 or between 2 and 62");
		    r := toInteger(tocharstar(x.v), oldbase);
		    when r
		    is null do buildErrorPacket("string is not a valid number")
		    is n:ZZ do toExpr(n))
		else WrongArgZZ(2))
	    else WrongArg(1, "an integer or string"))
	else WrongNumArgs(2))
    else WrongNumArgs(2));
setupfun("changeBase0", changeBase);

connectionCount(e:Expr):Expr := (
     when e is f:file do if f.listener then toExpr(f.numconns)
     else WrongArg(1,"an open socket listening for connections")
     else WrongArg(1,"a file")
     );
setupfun("connectionCount", connectionCount);

format(e:Expr):Expr := (
     when e
     is s:stringCell do toExpr("\"" + present(s.v) + "\"")
     is ZZcell do e
     is QQcell do e
     is RRcell do format(Expr(Sequence(e)))
     is RRicell do format(Expr(Sequence(e)))
     is CCcell do format(Expr(Sequence(e)))
     is args:Sequence do (
	  s := printingPrecision;
	  ac := printingAccuracy;
	  l := printingLeadLimit;
	  t := printingTrailLimit;
	  sep := printingSeparator;
	  n := length(args);
	  if n == 0 || n > 6 then return WrongNumArgs(1,6);
	  if n > 1 then when args.0 is p:ZZcell do if !isInt(p) then return WrongArgSmallInteger(2) else s = toInt(p)
	  is Nothing do nothing else return WrongArgZZ(1);
	  if n > 2 then when args.1 is p:ZZcell do if !isInt(p) then return WrongArgSmallInteger(2) else ac = toInt(p)
	  is Nothing do nothing else return WrongArgZZ(2);
	  if n > 3 then when args.2 is p:ZZcell do if !isInt(p) then return WrongArgSmallInteger(2) else l = toInt(p)
	  is Nothing do nothing else return WrongArgZZ(3);
	  if n > 4 then when args.3 is p:ZZcell do if !isInt(p) then return WrongArgSmallInteger(2) else t = toInt(p)
	  is Nothing do nothing else return WrongArgZZ(4);
	  if n > 5 then when args.4 is p:stringCell do sep = p.v else return WrongArgString(5);
	  when args.(n-1)
	  is x:ZZcell do toExpr(concatenate(format(s,ac,l,t,sep,toRR(x.v,defaultPrecision))))
	  is x:QQcell do toExpr(concatenate(format(s,ac,l,t,sep,toRR(x.v,defaultPrecision))))
	  is x:RRcell do toExpr(concatenate(format(s,ac,l,t,sep,x.v)))
	  is z:CCcell do toExpr(format(s,ac,l,t,sep,false,false,z.v))
	  else WrongArgRR(n)
	  )
     else WrongArg("string, or real number, integer, integer, integer, string"));
setupfun("format", format).Protected = false; -- will be overloaded in m2/methods.m2

numfun(e:Expr):Expr := (
     when e
     is r:QQcell do toExpr(numerator(r.v))
     else WrongArg("a rational number"));
setupfun("numerator",numfun);
denfun(e:Expr):Expr := (
     when e
     is r:QQcell do toExpr(denominator(r.v))
     else WrongArg("a rational number"));
setupfun("denominator",denfun);

join(a:Sequence):Expr := (
     newlen := 0;
     foreach x at i in a do (
	  when x
	  is b:Sequence do (newlen = newlen + length(b);)
	  is c:List do (newlen = newlen + length(c.v);)
	  else (
	      -- if x is iterable, convert it to a sequence
	      r := toSequence(x);
	      when r
	      is b:Sequence do (
		  newlen = newlen + length(b);
		  a.i = b)
	      is err:Error do return buildErrorPacket(
		  "while converting argument " + tostring(i + 1) +
		  " to a sequence, the following error occurred: " +
		  err.message)
	      else return buildErrorPacket(
		  "unknown error converting argument " + tostring(i + 1) +
		  " to a sequence")));
     z := new Sequence len newlen do (
	  foreach x in a do (
	       when x
	       is b:Sequence do foreach y in b do provide y
	       is c:List do foreach y in c.v do provide y
	       else nothing;
	       ));
     when a.0
     is Sequence do Expr(z)
     is c:List do list(c.Class,z,c.Mutable)
     else nullE			    -- shouldn't happen anyway
     );

join(e:Expr):Expr := (
     when e
     is a:Sequence do (
	  n := length(a);
	  if n == 0 then return e;
	  when a.0
	  is Sequence do join(a)
	  is List do join(a)
	  else applyEE(getGlobalVariable(joinIteratorsS), e))
     is c:List do if c.Mutable then Expr(copy(c)) else e
     else WrongArg("lists or sequences"));
setupfun("join",join);

threadLocal hadseq := false;
deeplen(a:Sequence):int := (
     n := 0;
     foreach x in a do (
	  when x
	  is b:Sequence do (
	       hadseq = true;
	       n = n + deeplen(b);
	       )
	  else (
	       n = n+1;
	       );
	  );
     n);
threadLocal deepseq := emptySequence;
threadLocal deepindex := 0;
deepinsert(a:Sequence):int := (
     n := 0;
     foreach x in a do (
	  when x
	  is b:Sequence do n = n + deepinsert(b)
	  else (
	       deepseq.deepindex = x;
	       deepindex = deepindex+1;
	       n = n+1;
	       );
	  );
     n);
deepsplice(a:Sequence):Sequence := (
     -- warning: this returns its arg if no change is required.
     hadseq = false;
     newlen := deeplen(a);
     if hadseq then (
     	  deepseq = new Sequence len newlen do provide nullE;
     	  deepindex = 0;
     	  deepinsert(a);
     	  w := deepseq;
     	  deepseq = emptySequence;
     	  w)
     else a);
deepsplice(e:Expr):Expr := (
     when e
     is args:Sequence do Expr(deepsplice(args))
     is a:List do (
	  r := deepsplice(a.v);
	  if r == a.v
	  then (
	       if a.Mutable
	       then list(a.Class,copy(r),a.Mutable)
	       else e)
	  else list(a.Class,r,a.Mutable))
     else e);
setupfun("deepSplice",deepsplice);

horizontalJoin(s:Sequence):Expr := (
     s = deepsplice(s);
     ln := 0;
     foreach f at i in s do (
	  when f
	  is Nothing do nothing
	  is Net do (ln = ln + 1;)
	  is stringCell do (ln = ln + 1;)
	  else return WrongArg(i+1,"a net, string, or null"));
     v := new array(Net) len ln do (
	  foreach f in s do (
	       when f
	       is Nothing do nothing
	       is n:Net do provide n
	       is s:stringCell do provide toNet(s.v)
	       else nothing));
     Expr(HorizontalJoin(v)));
horizontalJoin(e:Expr):Expr := (
     when e
     -- # typical value: horizontalJoin, BasicList, Net
     is s:Sequence do horizontalJoin(s)
     is s:List do horizontalJoin(s.v)
     -- # typical value: horizontalJoin, Net, Net
     is n:Net do e
     -- # typical value: horizontalJoin, String, Net
     is s:stringCell do Expr(toNet(s.v))
     -- # typical value: horizontalJoin, Nothing, Net
     is Nothing do horizontalJoin(emptySequence)
     else WrongArg("a net, a string, or a list or sequence of nets and strings"));
setupfun("horizontalJoin",horizontalJoin);

stack(s:Sequence):Expr := (
     s = deepsplice(s);
     ln := 0;
     foreach f at i in s do (
	  when f
	  is Nothing do nothing
	  is Net do (ln = ln + 1;)
	  is stringCell do (ln = ln + 1;)
	  else return WrongArg(i+1,"a net, string, or null"));
     v := new array(Net) len ln do (
	  foreach f in s do (
	       when f
	       is Nothing do nothing
	       is n:Net do provide n
	       is s:stringCell do provide toNet(s.v)
	       else nothing));
     Expr(VerticalJoin(v)));
stack(e:Expr):Expr := (
     when e
    -- # typical value: stack, BasicList, Net
     is s:Sequence do stack(s)
     is s:List do stack(s.v)
    -- # typical value: stack, Net, Net
     is n:Net do e
    -- # typical value: stack, String, Net
     is s:stringCell do Expr(toNet(s.v))
    -- # typical value: stack, Nothing, Net
     is Nothing do stack(emptySequence)
     else WrongArg("a sequence of nets and strings"));
setupfun("stack",stack);

exec(a:Sequence):Expr := (
     newargv := new array(string) len length(a) do provide "";
     foreach x at i in a do (
	  when x
	  is s:stringCell do newargv.i = s.v
	  else return WrongArgString(i+1));
     exec(newargv);
     buildErrorPacket("exec failed"));
exec(e:Expr):Expr := (
     when e
     is a:Sequence do exec(a)
     is a:List do exec(a.v)
     is stringCell do exec(Sequence(e))
     else WrongArg( "a string or a sequence or list of strings"));
setupfun("exec",exec);

youngest(e:Expr):Expr := (
     when e
     is y:HashTable do if !y.Mutable then nullE else e
     is b:Sequence do (
	  if length(b) == 0
	  then nullE
	  else (
	       h := hash_t(0);
	       e = nullE;
	       foreach x in b do (
		    when x
		    is y:HashTable do if y.Mutable && y.hash>h then ( h = y.hash; e = x; ) else nothing
		    is y:file do if y.hash>h then ( h = y.hash; e = x; ) else nothing
		    is y:CompiledFunctionClosure do if y.hash>h then ( h = y.hash; e = x; ) else nothing
		    is y:SymbolClosure do if y.symbol.hash>h then ( h = y.symbol.hash; e = x; ) else nothing
		    else nothing;
		    );
	       e))
     else nullE);
setupfun("youngest", youngest);

toRR(e:Expr):Expr := (
     when e
     is x:ZZcell do toExpr(toRR(x.v,defaultPrecision))
     is x:QQcell do toExpr(toRR(x.v,defaultPrecision))
     is RRcell do e
     is x:RRicell do toExpr(midpointRR(x.v))
     is s:Sequence do (
	  if length(s) != 2 then WrongNumArgs(1,2) else
	  when s.0 is prec:ZZcell do (
	       if !isULong(prec.v) then WrongArgSmallUInteger(1)
	       else (
	       	    when s.1
     	       	    is x:ZZcell do toExpr(toRR(x.v,toULong(prec.v)))
	       	    is x:QQcell do toExpr(toRR(x.v,toULong(prec.v)))
     	       	    is x:RRcell do toExpr(toRR(x.v,toULong(prec.v)))
                 is x:RRicell do toExpr(midpointRR(x.v,toULong(prec.v)))
		    else WrongArg(1,"an integral, rational, or real number")
		    )
	       )
	  else WrongArgZZ(1)
	  )
     else WrongArg("an integral, rational, or real number, or a pair"));
setupfun("toRR",toRR);
                                                     
toRRi(e:Expr):Expr := (
    when e
    	 is x:ZZcell do toExpr(toRRi(x.v))
	     is x:QQcell do toExpr(toRRi(x.v))
	     is x:RRcell do toExpr(toRRi(x.v))
	     is x:RRicell do e
    	 is s:Sequence do (
	     if length(s) > 3 then WrongNumArgs(1,3) else
	     if length(s) == 2 then (
               when s.0 is x:ZZcell do (
               	       when s.1 is y:ZZcell do toExpr(toRRi(x.v,y.v))
                                is y:QQcell do toExpr(toRRi(x.v,y.v))
                                is y:RRcell do toExpr(toRRi(x.v,y.v))
                    	        else WrongArg(1,"a pair of integral, rational, or real numbers"))
                       is x:QQcell do (
               	       when s.1 is y:ZZcell do toExpr(toRRi(x.v,y.v))
                                is y:QQcell do toExpr(toRRi(x.v,y.v))
                                is y:RRcell do toExpr(toRRi(x.v,y.v))
                    	        else WrongArg(1,"a pair of integral, rational, or real numbers"))
                       is x:RRcell do (
               	       when s.1 is y:ZZcell do toExpr(toRRi(x.v,y.v))
                                is y:QQcell do toExpr(toRRi(x.v,y.v))
                                is y:RRcell do toExpr(toRRi(x.v,y.v))
                    	        else WrongArg(1,"a pair of integral, rational, or real numbers"))
                       else WrongArg(1,"a pair of integral, rational, or real numbers"))
	    else when s.0 is prec:ZZcell do (
	           when s.1 is x:ZZcell do (
                       when s.2 is y:ZZcell do toExpr(toRRi(x.v,y.v,toULong(prec.v)))
                                is y:QQcell do toExpr(toRRi(x.v,y.v,toULong(prec.v)))
                                is y:RRcell do toExpr(toRRi(x.v,y.v,toULong(prec.v)))
                                else WrongArg(1,"a pair of integral, rational, or real numbers, with a precision"))
                       is x:QQcell do (
                       when s.2 is y:ZZcell do toExpr(toRRi(x.v,y.v,toULong(prec.v)))
                                is y:QQcell do toExpr(toRRi(x.v,y.v,toULong(prec.v)))
                                is y:RRcell do toExpr(toRRi(x.v,y.v,toULong(prec.v)))
                                else WrongArg(1,"a pair of integral, rational, or real numbers, with a precision"))
                       is x:RRcell do (
                       when s.2 is y:ZZcell do toExpr(toRRi(x.v,y.v,toULong(prec.v)))
                                is y:QQcell do toExpr(toRRi(x.v,y.v,toULong(prec.v)))
                                is y:RRcell do toExpr(toRRi(x.v,y.v,toULong(prec.v)))
                                else WrongArg(1,"a pair of integral, rational, or real numbers, with a precision"))
	       else WrongArg(1,"a pair of integral, rational, or real numbers, with a precision"))
	    else buildErrorPacket(EngineError("The first argument should be an integer")))
   	 else WrongArg(1,"a pair or triple  of integral, rational, or real numbers"));
setupfun("toRRi",toRRi);
                                                     
rightRR(e:Expr):Expr := (
     when e
        is x:RRicell do toExpr(rightRR(x.v))
        else WrongArg("an interval"));
setupfun("right",rightRR);
                                                     
leftRR(e:Expr):Expr := (
     when e
        is x:RRicell do toExpr(leftRR(x.v))
        else WrongArg("an interval"));
setupfun("left",leftRR);
                                                     
widthRR(e:Expr):Expr := (
     when e
        is x:RRicell do toExpr(widthRR(x.v))
        else WrongArg("an interval"));
setupfun("diameter",widthRR).Protected = false;
                                                     
midpointRR(e:Expr):Expr := (
     when e
        is x:RRicell do toExpr(midpointRR(x.v))
        else WrongArg("an interval"));
setupfun("midpoint",midpointRR);
                                                     
isEmptyRRi(e:Expr):Expr := (
     when e
        is x:RRicell do toExpr(isEmpty(x.v))
        else WrongArg("an interval"));
setupfun("isEmptyRRi",isEmptyRRi);
                                                     
subsetRRi(e:Expr):Expr := (
     when e is s:Sequence do (
	    if length(s) > 3 then WrongNumArgs(1,3) else
	    if length(s) == 2 then (
               when s.0 is x:ZZcell do (
               	    when s.1 is y:ZZcell do (toExpr(x.v===y.v))
		    	             is y:QQcell do (toExpr(x.v===y.v))
			                 is y:RRcell do (toExpr(x.v===y.v))
                             is y:RRicell do (toExpr(contains(x.v,y.v)))
                    else WrongArg(1,"a pair of integral, rational, real numbers or intervals"))
               is x:QQcell do (
               	    when s.1 is y:ZZcell do (toExpr(x.v===y.v))
		    	             is y:QQcell do (toExpr(x.v===y.v))
			                 is y:RRcell do (toExpr(x.v===y.v))
                             is y:RRicell do (toExpr(contains(x.v,y.v)))
                    else WrongArg(1,"a pair of integral, rational, real numbers or intervals"))
               is x:RRcell do (
               	    when s.1 is y:ZZcell do (toExpr(x.v===y.v))
		    	             is y:QQcell do (toExpr(x.v===y.v))
			                 is y:RRcell do (toExpr(x.v===y.v))
                             is y:RRicell do (toExpr(contains(x.v,y.v)))
                    else WrongArg(1,"a pair of integral, rational, real numbers or intervals"))
                is x:RRicell do (
               	    when s.1 is y:ZZcell do (toExpr(x.v===y.v))
		    	             is y:QQcell do (toExpr(x.v===y.v))
			                 is y:RRcell do (toExpr(x.v===y.v))
                             is y:RRicell do (toExpr(contains(x.v,y.v)))
                    else WrongArg(1,"a pair of integral, rational, real numbers or intervals"))
                else WrongArg(1,"a pair of integral, rational, real numbers or intervals")) else
            WrongArg(1,"a pair of integral, rational, real numbers or intervals"))
         else WrongArg(1,"a pair of integral, rational, real numbers or intervals"));
setupfun("subsetRRi",subsetRRi);
                                                     
intersectRRi(e:Expr):Expr := (
    when e
    	 is s:Sequence do (
	     if length(s) > 3 then WrongNumArgs(1,3) else
	     if length(s) == 2 then (
               when s.0 is x:RRicell do (
               	       when s.1 is y:RRicell do toExpr(intersectRRi(x.v,y.v))
                    	        else WrongArg(1,"a pair of intervals"))
                       else WrongArg("a pair of intervals"))
	    else when s.0 is prec:ZZcell do (
	           when s.1 is x:RRicell do (
                       when s.2 is y:RRicell do toExpr(intersectRRi(x.v,y.v,toULong(prec.v)))
                                else WrongArg(1,"a pair of intervals"))
	       else WrongArg(1,"a pair of intervals"))
	    else WrongArg(1,"a pair of intervals"))
   	 else WrongArg("a pair of intervals"));
setupfun("intersectRRi",intersectRRi);

toCC(e:Expr):Expr := (
     when e
     is x:ZZcell do toExpr(toCC(x.v,defaultPrecision)) -- # typical value: toCC, ZZ, CC
     is x:QQcell do toExpr(toCC(x.v,defaultPrecision)) -- # typical value: toCC, QQ, CC
     is x:RRcell do toExpr(toCC(x.v)) -- # typical value: toCC, RR, CC
     is CCcell do e -- # typical value: toCC, CC, CC
     is s:Sequence do (
	  if length(s) == 2 then (
	       when s.0 is prec:ZZcell do (
		    if !isULong(prec.v) then WrongArgSmallUInteger(1)
		    else (
			 when s.1
			 is x:ZZcell do toExpr(toCC(x.v,toULong(prec.v))) -- # typical value: toCC, ZZ, ZZ, CC
			 is x:QQcell do toExpr(toCC(x.v,toULong(prec.v))) -- # typical value: toCC, ZZ, QQ, CC
			 is x:RRcell do toExpr(toCC(x.v,toULong(prec.v))) -- # typical value: toCC, ZZ, RR, CC
			 is x:CCcell do toExpr(toCC(x.v,toULong(prec.v))) -- # typical value: toCC, ZZ, CC, CC
			 else WrongArg("a rational number, real number, or an integer")
			 )
		    )
	       is x:RRcell do (
		    when s.1 is y:RRcell do toExpr(toCC(x.v,y.v))	    -- # typical value: toCC, RR, RR, CC
		    else WrongArgRR()
		    )
	       else WrongArgZZ(1)
	       )
	  else if length(s) == 3 then (
	       when s.0 is prec:ZZcell do (
		    -- # typical value: toCC, ZZ, ZZ, ZZ, CC
		    -- # typical value: toCC, ZZ, ZZ, QQ, CC
		    -- # typical value: toCC, ZZ, ZZ, RR, CC
		    -- # typical value: toCC, ZZ, QQ, ZZ, CC
		    -- # typical value: toCC, ZZ, QQ, QQ, CC
		    -- # typical value: toCC, ZZ, QQ, RR, CC
		    -- # typical value: toCC, ZZ, RR, ZZ, CC
		    -- # typical value: toCC, ZZ, RR, QQ, CC
		    -- # typical value: toCC, ZZ, RR, RR, CC
		    if !isULong(prec.v) then WrongArgSmallUInteger(1)
		    else toExpr(toCC(
			      when s.1
			      is x:QQcell do toRR(x.v,toULong(prec.v))
			      is x:ZZcell do toRR(x.v,toULong(prec.v))
			      is x:RRcell do toRR(x.v,toULong(prec.v))
			      else (
				   return WrongArg("a rational number, real number, or an integer");
				   toRR(0,toULong(prec.v)) -- dummy
				   )
			      ,
			      when s.2
			      is x:QQcell do toRR(x.v,toULong(prec.v))
			      is x:ZZcell do toRR(x.v,toULong(prec.v))
			      is x:RRcell do toRR(x.v,toULong(prec.v))
			      else (
				   return WrongArg("a rational number, real number, or an integer");
				   toRR(0,toULong(prec.v)) -- dummy
				   ))))
	       else WrongArgZZ(1))
	  else WrongNumArgs(1,3))
     else WrongArg("a real or complex number, or 2 or 3 arguments"));
setupfun("toCC",toCC);

precision(e:Expr):Expr := (
     when e
     is x:RRcell do toExpr(precision(x.v))
     is x:RRicell do toExpr(precision(x.v))
     is x:CCcell do toExpr(precision(x.v))
     else WrongArgRR());
setupfun("precision0",precision);

powermod(e:Expr):Expr := (
     when e is s:Sequence do
     if length(s) == 3 then
     when s.0 is base:ZZcell do
     when s.1 is exp:ZZcell do
     when s.2 is mod:ZZcell do (
	 -- # typical value: powermod, ZZ, ZZ, ZZ, ZZ
	 if isNegative(exp.v) && !isInvertible(base.v, mod.v)
	 then buildErrorPacket(
	     tostring(base.v) + " is not invertible mod " + tostring(mod.v))
	 else toExpr(powermod(base.v,exp.v,mod.v)))
     else WrongArgZZ(3)
     else WrongArgZZ(2)
     else WrongArgZZ(1)
     else WrongNumArgs(3)
     else WrongNumArgs(3));
setupfun("powermod",powermod);

partsRR(x:Expr):Expr := (
     when x is xxx:RRcell do (
	  xx := xxx.v;
	  p := Ccode(ulong,"(unsigned long)(",xx,")->_mpfr_prec");
	  sz := 8 * Ccode(int,"sizeof(*(",xx,")->_mpfr_d)");
	  n := (p+sz-1)/sz;
	  numbits := n * sz;
	  sgn := toExpr(Ccode(long,"(long)(",xx,")->_mpfr_sign"));
	  expt := toExpr(Ccode(long,"(long)(",xx,")->_mpfr_exp"));
	  m := zeroZZ;
	  for i from int(n)-1 to 0 by -1 do (
	       m = (m << sz) + toInteger(Ccode(ulong,"(unsigned long)(",xx,")->_mpfr_d[",i,"]"));
	       );
	  Expr(Sequence(toExpr(p),sgn,expt,toExpr(m),toExpr(numbits))))
     else WrongArg("a real number"));
setupfun("partsRR",partsRR);
                                                     
-- Should there be an RRi version of partsRR?

segmentationFault(e:Expr):Expr := (segmentationFault();e);
setupfun("segmentationFault",segmentationFault);

-- Local Variables:
-- compile-command: "echo \"make: Entering directory \\`$M2BUILDDIR/Macaulay2/d'\" && make -C $M2BUILDDIR/Macaulay2/d actors4.o "
-- End:
