/*
 * This file is part of tela the Tensor Language.
 * Copyright (c) 1994-1996 Pekka Janhunen
 */

/*
	fileio.ct
	C-like file-I/O functions
	Preprocess with ctpp.
	C-tela code is C++ equipped with []=f() style function definition.
*/

#include <ctype.h>
#include <fstream.h>

#define MAXFILES 100		// Maximum number of open files
#ifdef _UNICOS
#  define OUTCHAR Tchar
#else
#  define OUTCHAR char
#endif

struct Tfile {
	fstream* fsptr;				// pointer to C++ iostream facility class
	FILE *fptr;					// pointer to plain-C FILE struct
	int lastAccessWasFILE;		// nonzero if last access was using plain-C FILE mechanism
};

static Tfile files[MAXFILES] = {{0,0,0}};

[fnum] = fopen(name,mode)
/* fopen("filename",mode) opens a file and returns
   its identifier (integer). The mode parameter can be
   "r", "w" or "a" for reading, writing and appending,
   respectively. If the open is not succesful, -1 is returned.
   See also: fformat, fclose, fgetc, fgets.
   Error codes:
   -1: First arg not a string
   -2: Second arg not a string
   -3: Too many open files
   -4: Bad string for second arg
*/
{
	const int badfnum = -1;
	if (!name.IsString()) return -1;
	Tstring NAME = name;
	if (!mode.IsString()) return -2;
	int i;
	for (i=0; i<MAXFILES; i++)
		if (!files[i].fsptr) break;
	if (i>=MAXFILES) return -3;
	if (mode.length()!=1) return -4;
	if (mode.IntPtr()[0] == 'r') {
		files[i].fsptr = new fstream((char*)NAME,ios::in);
	} else if (mode.IntPtr()[0] == 'w') {
		files[i].fsptr = new fstream((char*)NAME,ios::out);
	} else if (mode.IntPtr()[0] == 'a') {
		files[i].fsptr = new fstream((char*)NAME,ios::app);
	} else return -4;
	fnum = files[i].fsptr && files[i].fsptr->good() ? i : badfnum;
	return 0;
}

static void FormattedOutput(ostream& o, const Tobject& obj, int w=0, unsigned int d=6) {
	long oldflags = o.flags();
	int oldprec = o.precision();
	int oldwidth = o.width();
	o.width(abs(w));
	o.precision(d);
	o.setf((w < 0) ? ios::right : ios::left);
	switch (obj.kind()) {
	case Kint:
		if (obj.IsChar())
			o << Tchar(obj.IntValue());
		else
			o << obj.IntValue();
		break;
	case Kreal:
		o << obj.RealValue();
		break;
	case Kcomplex:
		o << real(obj.ComplexValue());
		o << OUTCHAR((imag(obj.ComplexValue()) < 0) ? '-' : '+');
		o << fabs(imag(obj.ComplexValue())) << 'i';
		break;
	case KIntArray:
		if (obj.IsString()) {
			Tstring s = obj;
			o << s;
		} else
			o << obj;
		break;
	case KRealArray:
	case KComplexArray:
	case KObjectArray:
	case Kfunction:
	case KCfunction:
	case KIntrinsicFunction:
	case Kundef:
	case Kvoid:
		o << obj;
		break;
	}
	o.flags(oldflags);
	o.precision(oldprec);
	o.width(oldwidth);
}

#define str (*(argin[0]))
static int GenericFormat
    (ostream& o, const TConstObjectPtr argin[], const int Nargin, const TObjectPtr argout[], const int Nargout)
{
	int ch,ch1,ch2;
	const int backquote = '`';
	if (!str.IsString() && !str.IsChar()) return 1;
	const Tstring s = str;
	int arg = 1;
	int i;
	for (i=0; i<s.length(); i++) {
		ch = s[i];
		if (ch == backquote) {
			if (i+1>=s.length()) break;
			ch1 = s[i+1];
			if (ch1 == backquote) {
				i++;
				if (i+1<s.length()) {
					ch2 = s[i+1];
					if (ch2 == backquote) {	// now we have three backquotes, output one
						o << OUTCHAR(backquote);
					} else {
						if (arg < Nargin)
							FormattedOutput(o,*argin[arg++]);
					}
				} else {
					if (arg < Nargin)
						FormattedOutput(o,*argin[arg++]);
				}
			} else {
				i++;
				int wsign = +1;
				int w = 0;
				int d = 0;
				if (s[i]=='-') {wsign = -1; i++;}
				for (; i<s.length() && s[i]!=backquote && s[i]!='.' && s[i]!=' '; i++) w = 10*w + (s[i]-'0');
				if (s[i] == '.')
					for (i++; i<s.length() && s[i]!=backquote && s[i]!=' '; i++) d = 10*d + (s[i]-'0');
				for (; i<s.length() && s[i]!=backquote; i++);
				if (d == 0) d = 6;
				FormattedOutput(o,*argin[arg++],wsign*w,d);
			}
		} else
			o << OUTCHAR(ch);
	}
	return 0;
}
#undef str

[] = format(str...)
/* format("format-string",arg1,arg2,...) prints "format-string"
   to standard output, replacing occurrences of `format-spec`
   with consecutive args. `Format-spec` is either empty, i.e. ``,
   or of the form

       `[-]w[.d]`.

   Here w is the field width (unsigned integer) and d is the number
   of significant digits, also unsigned integer. By default the
   argument is printed left-justified, but the optional minus sign
   dictates right justification. The backquote character `  can be
   produced by writing it three times: ```.
   
   Hint: You can add any number of spaces before the closing backquote,
   for example `20.7    `.
   These spaces do not affect the output. This feature can be used
   to justify source code lines.
   See also: fformat, sformat.
   Error codes:
   1: First argument not a string or char */
{
	int errcode = GenericFormat(cout,argin,Nargin,argout,Nargout);
	cout << flush;
	return errcode;
}

[] = fformat(fnum,str...)
/* fformat(fnum,"format-string",arg1,arg2,...) is similar to format,
   except that it does not output to stdout but to opened file.
   See also: format, sformat, fopen.
   Error codes:
   -1: First argument not integer
   -2: First argument not a valid file number
   -3: Second argument not a string or char
   4: File is not open
   */
{
	if (fnum.kind()!=Kint) return -1;
	const int f = fnum.IntValue();
	if (f < 0 || f >= MAXFILES) return -2;
	if (!files[f].fsptr) return 4;
	if (files[f].lastAccessWasFILE) fflush(files[f].fptr);
	int errcode=GenericFormat(*files[f].fsptr,argin+1,Nargin-1,argout,Nargout);
	files[f].lastAccessWasFILE = 0;
	if (errcode) return -3;
	return 0;
}

[s] = sformat(formatstr...)
/* sformat("format-string",arg1,arg2,...) is similar to format,
   except that it does not output to stdout but returns a string
   variable.
   See also: format, fformat, sprintf.
   Error codes:
   -1: First argument not a string or char */
{
	strstream S;
	int errcode=GenericFormat(S,argin,Nargin,argout,Nargout);
	if (errcode) return -abs(errcode);	// make it fatal since s is uninitialized
	S << ends;
	char *charptr = S.str();
	s = charptr;
	delete [] charptr;
	return 0;
}

static char* FindFirstPercent(char*s)
// Return a pointer to the first '%' char in s. Exclude case where there are two '%%'
// in succession, jumps over that and look for next single percent.
// Example: FindFirstPercent("%% a%b") returns pointer to "%b".
//          FindFirstPercent("abc%d") returns pointer to "%d".
//          FindFirstPercent("abcd") returns 0.
{
	for (char *r = s; r; r+=2) {
		r = strchr(r,'%');
		if (!r) return 0;
		if (r[1] != '%') return r;
	}
	return 0;
}

static int GenericFprintf(FILE *fp, char*s, int Nargin, const TConstObjectPtr argin[])
// Returns 0 on success, 1 on bad type of argin
{
	char *r = FindFirstPercent(s);
	if (r) *r = '\0';
	fprintf(fp,s);
	if (r) *r = '%';
	for (int p=0; r && (p < Nargin); p++) {
		char *newr = FindFirstPercent(r+1);
		if (newr) *newr = '\0';
		switch (argin[p]->kind()) {
		case Kint:
			fprintf(fp,r,int(argin[p]->IntValue()));
			break;
		case Kreal:
			fprintf(fp,r,double(argin[p]->RealValue()));
			break;
		case KIntArray:
			if (!argin[p]->IsString()) return 1;
			{
				Tstring ARG = *argin[p];
				fprintf(fp,r,(char*)ARG);
			}
			break;
		default:
			return 1;
		}
		if (newr) *newr = '%';
		r = newr;
	}
	return 0;
}

[] = printf(formatstr...)
/* printf("format-string",arg1,arg2,...) is an interface to the C
   printf function. The format string should have a percent slot
   for every arg. The args may be integer or real scalars or strings.
   See also: fprintf, sprintf, format.
   Error codes:
   1: Bad argument type
   2: First arg not a string
   */
{
	if (!formatstr.IsString()) return 2;
	Tstring FORMATSTR = formatstr;
	int errcode = GenericFprintf(stdout,(char*)FORMATSTR,Nargin-1,argin+1);
	fflush(stdout);
	return errcode;
}

[] = fprintf(fnum,formatstr...)
/* fprintf(fnum,"format-string",arg1,arg2,...) is an interface to the C
   fprintf function. The format string should have a percent slot
   for every arg. The args may be integer or real scalars or strings.
   The file identifier fnum must have been obtained from fopen.

   Notice: The stream is not flushed after every fprintf operation,
   but a flush occurs whenever you switch from using fprintf to
   fformat on the same file. Therefore avoid mixing fprintf and fformat
   on the same file if performance is an issue for you!
   
   See also: fopen, printf, sprintf, format.
   Error codes:
   1: Bad argument type
   2: Second arg not a string
   3: First argument not an integer
   4: Bad file identifier: out of range
   5: File is not open
   6: Internal error: fdopen failed
   */
{
	if (fnum.kind() != Kint) return 3;
	const int f = fnum.IntValue();
	if (f < 0 || f >= MAXFILES) return 4;
	if (!files[f].fsptr) return 5;
	if (!formatstr.IsString()) return 2;
	Tstring FORMATSTR = formatstr;
	if (!files[f].fptr) {
		files[f].fptr = fdopen(files[f].fsptr->rdbuf()->fd(),"w");
		if (!files[f].fptr) return 6;
	}
	if (!files[f].lastAccessWasFILE) *files[f].fsptr << flush;
	int errcode = GenericFprintf(files[f].fptr,(char*)FORMATSTR,Nargin-2,argin+2);
	files[f].lastAccessWasFILE = 1;
	return errcode;
}

[s] = sprintf(formatstr,arg)
/* sprintf("format-string",arg1,arg2,...) is an interface to the C
   sprintf function. The format string should have a percent
   slot for every arg. The args may be integer or real scalars
   or strings.
   See also: sformat.

   LIMITATIONS:
       This implementation allows only one arg (arg1).
       The resulting string may not become larger than
	   500 chars or Tela may crash.
   Error codes:
   -1: First arg not a string
   -2: Args may only be scalar ints or reals, or strings
   */
{
	if (!formatstr.IsString()) return -1;
	const Tkind ak = arg.kind();
	Tstring FORMATSTR = formatstr;
	char buff[500];
	if (ak == Kint)
		sprintf(buff,(char*)FORMATSTR,int(arg.IntValue()));
	else if (ak == Kreal)
		sprintf(buff,(char*)FORMATSTR,double(arg.RealValue()));
	else if (arg.IsString()) {
		Tstring ARG = arg;
		sprintf(buff,(char*)FORMATSTR,(char*)ARG);
	} else return -2;
	s = buff;
	return 0;
}

[] = fclose(fnum)
/* fclose(fnum) closes file with given identification number.
   The fnum must have been previously obtained from fopen.
   See also: fopen, fformat.
   Error codes:
   -1: Bad argument: not integer
   -2: Bad argument: outside range
   3: File was not open
*/
{
	if (fnum.kind()!=Kint) return -1;
	const int f = fnum.IntValue();
	if (f < 0 || f >= MAXFILES) return -2;
	if (!files[f].fsptr) return 3;
	if (files[f].fptr && files[f].lastAccessWasFILE) fclose(files[f].fptr);
	// This assumes that fclose and fsptr->close() both can be done on same file.
	// This should be the case because doing UNIX close() more than once doesn't harm.
	files[f].fsptr->close();
	delete files[f].fsptr;
	files[f].fsptr = 0;
	files[f].fptr = 0;
	files[f].lastAccessWasFILE = 0;
	return 0;
}

[] = remove(fn)
/* remove("file") removes the named file.
   If the file does not exist or some other error occurs,
   no warning or error message is given.
   Error codes:
   1: Argument not a string
   */
{
	if (!fn.IsString()) return 1;
	Tstring FN = fn;
	remove((char*)FN);
	return 0;
}

[ch] = fgetc(fnum)
/* fgetc(fnum) returns the next character from previously
   opened file with identification number fnum, or VOID
   value if end of file has been reached.
   See also: fgets, fopen, feof.
   Error codes:
   -1: Bad argument: not integer
   -2: Bad argument: out of range
   -3: File was not open
*/
{
	if (fnum.kind()!=Kint) return -1;
	const int f = fnum.IntValue();
	if (f < 0 || f >= MAXFILES) return -2;
	if (!files[f].fsptr) return -3;
	Tchar c;
	if (files[f].fsptr->eof())
		ch.SetToVoid();
	else {
		files[f].fsptr->get(c);
		ch = c;
	}
	return 0;
}

[s] = fread(fnum,n)
/* fread(fnum,n) reads next n characters (bytes) from
   previously opened file with identification number fnum,
   and returns the result as a string.
   If EOF is reached during read, the read is terminated earlier,
   resulting in length(s) being less than n (possibly zero).
   See also: fgets, fopen, feof, fgetc.
   Error codes:
   -1: Bad first arg: not integer
   -2: Bad first arg: out of range
   -3: Bad second arg: not integer
   -4: File was not open
   -5: Number of bytes to be read is negative
*/
{
	if (fnum.kind()!=Kint) return -1;
	if (n.kind()!=Kint) return -3;
	int nn = n.IntValue();
	if (nn < 0) nn = 0;
	const int f = fnum.IntValue();
	if (f < 0 || f >= MAXFILES) return -2;
	if (!files[f].fsptr) return -4;
	char *buff = new char [nn];
	size_t ret;
	if (files[f].lastAccessWasFILE) {
		ret = fread(buff,nn,sizeof(char),files[f].fptr);
	} else {
		files[f].fsptr->read(buff,nn);
		ret = files[f].fsptr->gcount();
	}
	s.izeros(ret);
	s.SetStringFlag();
	Tint i;
	for (i=0; i<Tint(ret); i++) s.IntPtr()[i] = (unsigned char)buff[i];
	delete [] buff;
	return 0;
}

[s;endletter] = fgets(fnum;endletters)
/* s=fgets(fnum) reads a string from previously opened
   file with identification number fnum. The string
   is terminated with a newline, which is removed from
   the stream but not returned.
   s=fgets(fnum,t) where t is a string uses characters
   in t as terminators, the default for t is "\n".
   [s,t1]=fgets(..) also returns the terminating character
   in t1.
   See also: fgetc, fopen, feof.
   Error codes:
   -1: Bad first argument: not integer
   -2: Bad first argument: outside range
   -3: File was not open
   -4: Bad second argument: not a string
   */
{
	if (fnum.kind()!=Kint) return -1;
	const int f = fnum.IntValue();
	if (f < 0 || f >= MAXFILES) return -2;
	if (!files[f].fsptr) return -3;
	Tchar *terminators = (Tchar*)"\n";
	Tstring T;
	if (Nargin == 2) {
		if (!endletters.IsString()) return -4;
		T = endletters;
		terminators = (Tchar*)T;
	}
	strstream str;
	char ch;
	do {
		files[f].fsptr->get(ch);
		if (strchr(terminators,ch) || files[f].fsptr->eof()) break;
		str << ch;
	} while (1);
	str << ends;
	char *charptr = str.str();
	s = charptr;
	if (Nargout == 2) {endletter = ch; endletter.SetCharFlag();}
	delete [] charptr;
	return 0;
}

[result] = feof(fnum)
/* feof(fnum) checks whether end of file has been reached
   on previously opened file with identification number fnum.
   Return value is 1 in case of EOF and 0 otherwise.
   Return value is -1 if the file is not open.
   See also: fgetc, fgets, fopen.
   Error codes:
   -1: Bad argument: not integer
   -2: Bad argument: outside range
*/
{
	if (fnum.kind()!=Kint) return -1;
	const int f = fnum.IntValue();
	if (f < 0 || f >= MAXFILES) return -2;
	if (!files[f].fsptr)
		result = -1;
	else if (files[f].lastAccessWasFILE)
		result = feof(files[f].fptr);
	else
		result = files[f].fsptr->eof();
	return 0;
}

[] = ungetc(ch,fnum)
/* ungetc(ch,fnum) puts the character ch back to the file defined
   by identification number fnum. The success of the operation
   depends on the implementation underlying C library ungetc call;
   ANSI C guarantees only one character of pushback but many libraries
   allow more.
   Ungetc does not return a value. If the operation is unsuccessful,
   a warning message is generated.
   Error codes:
   -1: Bad first argument: not integer
   -2: Bad first argument: outside range
   -3: File was not open
   -4: First argument not an integer
   1: Cannot push back character
*/
{
	if (fnum.kind()!=Kint) return -1;
	const int f = fnum.IntValue();
	if (f < 0 || f >= MAXFILES) return -2;
	if (!files[f].fsptr) return -3;
	if (ch.kind()!=Kint) return -4;
	if (files[f].lastAccessWasFILE) {
		if (ungetc(ch.IntValue(),files[f].fptr) == EOF) return 1;
	} else {
		files[f].fsptr->putback(ch.IntValue());
		if (!files[f].fsptr->good()) return 1;
	}
	return 0;
}

inline void ReadInteger(istream* i, int& result)
{
	*i >> result;
}

inline void ReadReal(istream* i, double& result)
{
	*i >> result;
}

static int ReadComplex(istream* i, Tcomplex& result)
{
	double x,y;
	*i >> x;
	const int p = i->peek();
	int retval = 1;
	if (p == '+' || p == '-') {
		*i >> y;
		char ch;
		i->get(ch);		// this passes 'i'
		if (ch != 'i') retval = 0;
		result = Tcomplex(x,y);
	} else if (p == 'i') {
		char ch;
		i->get(ch);		// pass 'i', previously we just peeked
		result = Tcomplex(0,x);
	} else
		result = x;
	return retval;
}

[n...] = fparse(fnum,controlstr)
/* [n,a,b,c,...] = fparse(fnum,"contolstring") scans input file
   with identification number fnum (obtained with fopen).
   Occurrences of `` in "controlstring" denote objects to be
   read and placed to output variables a,b,c,... in order.
   The number of objects succesfully read added by one is
   placed in n in the normal case.
   The notation `i`, `r`, `z` and `c` can be used to read
   integer, real or complex numbers, or single characters.

   For example,

   fnum = fopen("inputfile","r");
   [n,c,i,z] = fparse(fnum,"N`c` = `i`, a = `z`;");
   if (n != 4) error("...");

   would accept the input

   N3=  35,a   =3.4;

   after which c would be '3', i would be 35 and z would
   be 3.4. White space characters in controlstring are special,
   they match any number (including zero) of whitespace characters
   in input. Other characters in controlstring must appear
   literally in input. The variable n would be assigned the value
   4 in this case. Every time an object is succesfully read,
   the return value is incremented. If the end of the control string
   after the last `` item matches the input, the return value is
   incremented once more. Thus, in the above example, n==1 would
   mean that error occurred between `c` and `i``, n==1 would
   indicate error between `i` and `z` and n==3 would indicate a
   missing semicolon after `z`. Perfectly correct input always
   produced n equal to the total number of output arguments,
   four in the above example.

   Currently there is no way to quote the ` character
   in control string. To read `, read it as `c` and later
   check that it really was a backquote.
   
   See also: fopen, feof, fgets, fgetc.
   Error codes:
   -1: First input arg not an integer
   -2: Second input arg not a string
   -3: Bad first argument: outside range
   -4: File is not open
   -5: Unended `` item in control string
   -6: Too few output arguments as compared to control string
   -7: Bad `` item: must be `c`, `i`, `r` or `z`
   -8: `x` item does not end with backquote character
*/
{
	if (fnum.kind()!=Kint) return -1;
	if (!controlstr.IsString()) return -2;
	const int f = fnum.IntValue();
	if (f < 0 || f >= MAXFILES) return -3;
	if (!files[f].fsptr) return -4;
	Tint nval = 0;
	const Tint L = controlstr.length();
	const Tint * const ptr = controlstr.IntPtr();
	Tcomplex zz; char cc; int ii; double rr;
	int i_argout = 1;
	Tint i;
	for (i=0; i<L; i++) {
		if (files[f].fsptr->eof()) break;
		Tint ch = ptr[i];
		if (ch == '`') {
			if (i>=L-1) return -5;
			if (ptr[i+1] == '`') {
				i++;
				if (!ReadComplex(files[f].fsptr,zz)) break;
				if (!files[f].fsptr->good()) break;
				if (i_argout >= Nargout) return -6;
				if (zz.imag() == 0)
					*argout[i_argout++] = zz.real();
				else
					*argout[i_argout++] = zz;
				nval++;
			} else if (ptr[i+1] == 'c' || ptr[i+1] == 'C') {
				if (ptr[i+2] != '`') return -8;
				i+=2;
				files[f].fsptr->get(cc);
				if (files[f].fsptr->eof()) break;
				if (i_argout >= Nargout) return -6;
				*argout[i_argout] = cc;
				argout[i_argout++]->SetCharFlag();
				nval++;
			} else if (ptr[i+1] == 'i' || ptr[i+1] == 'I') {
				if (ptr[i+2] != '`') return -8;
				i+=2;
				ReadInteger(files[f].fsptr,ii);
				if (!files[f].fsptr->good()) break;
				if (i_argout >= Nargout) return -6;
				*argout[i_argout++] = ii;
				nval++;
			} else if (ptr[i+1] == 'r' || ptr[i+1] == 'R') {
				if (ptr[i+2] != '`') return -8;
				i+=2;
				ReadReal(files[f].fsptr,rr);
				if (!files[f].fsptr->good()) break;
				if (i_argout >= Nargout) return -6;
				*argout[i_argout++] = rr;
				nval++;
			} else if (ptr[i+1] == 'z' || ptr[i+1] == 'Z') {
				if (ptr[i+2] != '`') return -8;
				i+=2;
				if (!ReadComplex(files[f].fsptr,zz)) break;
				if (!files[f].fsptr->good()) break;
				if (i_argout >= Nargout) return -6;
				if (zz.imag() == 0)
					*argout[i_argout++] = zz.real();
				else
					*argout[i_argout++] = zz;
				nval++;
			} else
				return -7;
		} else if (isspace(ch)) {
			do {
				files[f].fsptr->get(cc);
				if (files[f].fsptr->eof()) break;
				if (!isspace(cc)) {files[f].fsptr->putback(cc); break;}
			} while (1);
		} else {
			files[f].fsptr->get(cc);
			if (ch != cc || files[f].fsptr->eof()) break;
		}
	}
	n = (i >= L) ? nval+1 : nval;
	return 0;
}