shithub: mlisp

ref: 962acb87f81bc9ccdd5428c6561dd9cf6f696895
dir: /io.c/

#include "lisp.h"

Stream sysout, sysin;

void
initio(void)
{
	sysout.type = IO_FILE;
	sysout.file = stdout;
	sysin.type = IO_FILE;
	sysin.file = stdin;
}

void
initbuf(Strbuf *buf)
{
	buf->buf = nil;
	buf->pos = 0;
	buf->len = 0;
}
void
freebuf(Strbuf *buf)
{
	free(buf->buf);
}
void
pushchar(Strbuf *buf, char c)
{
	if(buf->buf == nil){
		buf->len = 128;
		buf->buf = malloc(buf->len);
	}
	while(buf->pos >= buf->len){
		buf->len *= 2;
		buf->buf = realloc(buf->buf, buf->len);
	}
	buf->buf[buf->pos++] = c;
}


/*
 * output
 */

void
prf(char *fmt, ...)
{
	char *s, *p;
	va_list ap;
	va_start(ap, fmt);
	s = vsmprint(fmt, ap);
	va_end(ap);
	switch(sysout.type){
	case IO_FILE:
		fwrite(s, 1, strlen(s), sysout.file);
		break;
	case IO_BUF:
		for(p = s; *p != '\0'; p++)
			pushchar(&sysout.strbuf, *p);
		break;
	}
	free(s);
}
void
tyo(char c)
{
	switch(sysout.type){
	case IO_FILE:
		putc(c, sysout.file);
		break;
	case IO_BUF:
		pushchar(&sysout.strbuf, c);
		break;
	}
}

/* figure out whether |...| are needed to print symbol.
 * TODO: actually fix this */
static int
escname(char *s)
{
	if(*s == '\0') return 1;
	for(; *s != '\0'; s++)
		if(islower(*s) || strchr(" \t\n\r()'#\"", *s))
			return 1;
	return 0;
}

void
printatom(C *c, int x)
{
	if(c == nil)
		prf("NIL");
	else if(fixnump(c))
		prf("%lld", (long long int)c->fix);
	else if(flonump(c))
		prf("%f", c->flo);
	else if(stringp(c)){
		if(x)
			prf("%s", c->str);
		else
			prf("\"%s\"", c->str);
	}else{
		assert(atom(c));
		for(; c != nil; c = c->d)
			if(c->a == pname){
				c = c->d->a;
				assert(stringp(c));
				if(!x && escname(c->str))
					prf("|%s|", c->str);
				else
					prf("%s", c->str);
				return;
			}
		prf("%%ATOM%%");
	}
}

void
printsxp(C *c, int x)
{
	int fst;
	if(c != nil && !cellp(c))
		prf("#%p", ((F*)c)->p);
	else if(atom(c))
		printatom(c, x);
	else{
		tyo('(');
		fst = 1;
		for(; c != nil; c = c->d){
			if(!cellp(c) || atom(c)){
				prf(" . ");
				printsxp(c, x);
				break;
			}
			if(!fst)
				tyo(' ');
			printsxp(c->a, x);
			fst = 0;
		}
		tyo(')');
	}
}

void
lprint(C *c)
{
	printsxp(c, 0);
}

void
princ(C *c)
{
	printsxp(c, 1);
}

/*
 * input
 */

int
tyi(void)
{
	switch(sysin.type){
	case IO_FILE:
		return getc(sysin.file);
	case IO_BUF:
		if(sysin.strbuf.pos >= sysin.strbuf.len)
			return EOF;
		return sysin.strbuf.buf[sysin.strbuf.pos++];
	}
	return EOF;
}

static int
chsp(void)
{
	int c;
	if(sysin.nextc){
		c = sysin.nextc;
		sysin.nextc = 0;
		return c;
	}
	c = tyi();
	// remove comments
	if(c == ';')
		while(c != '\n')
			c = tyi();
	if(isspace(c))
		c = ' ';
	return c;
}

static int
ch(void)
{
	int c;
	while(c = chsp(), c == ' ');
	return c;
}

C*
readnum(char *buf)
{
	int c;
	int type;
	fixnum oct;
	fixnum dec;
	flonum flo, fract, div;
	int sign;
	int ndigits;

	sign = 1;
	type = 0;	/* octal */
	oct = 0;
	dec = 0;
	flo = 0.0;
	fract = 0.0;
	div = 10.0;
	ndigits = 0;


	c = *buf;
	if(c == '-' || c == '+'){
		sign = c == '-' ? -1 : 1;
		buf++;
	}

	while(c = *buf++, c != '\0'){
		if(c >= '0' && c <= '9'){
			if(type == 0){
				oct = oct*8 + c-'0';
				dec = dec*10 + c-'0';
				flo = flo*10.0 + c-'0';
			}else{
				type = 2;	/* float */
				fract += (c-'0')/div;
				div *= 10.0;
			}
			ndigits++;
		}else if(c == '.' && type == 0){
			type = 1;	/* decimal */
		}else
			return nil;
	}
	if(ndigits == 0)
		return nil;
// use decimal default for now
//	if(type == 0)
//		return mkfix(sign*oct);
//	if(type == 1)
//		return mkfix(sign*dec);
	if(type == 0 || type == 1)
		return mkfix(sign*dec);
	return mkflo(sign*(flo+fract));
}

C*
readstr(void)
{
	C *s;
	int c;
	Strbuf buf;

	initbuf(&buf);
	while(c = chsp(), c != EOF){
		// TODO: some escapes
		if(c == '"')
			break;
		pushchar(&buf, c);
	}
	pushchar(&buf, '\0');
	s = mkstr(buf.buf);
	freebuf(&buf);
	return s;
}

C*
readatom(void)
{
	C *atm;
	int c;
	Strbuf buf;
	char *p;
	int spec, lc;

	spec = 0;
	lc = 1;
	initbuf(&buf);
	while(c = chsp(), c != EOF){
		if(!spec && strchr(" ()", c)){
			sysin.nextc = c;
			break;
		}
		if(c == '|'){
			lc = 0;
			spec = !spec;
			continue;
		}
		pushchar(&buf, c);
	}
	pushchar(&buf, '\0');
	if(lc)
		for(p = buf.buf; *p; p++)
			*p = toupper(*p);
	if(strcmp(buf.buf, "NIL") == 0){
		freebuf(&buf);
		return nil;
	}
	atm = readnum(buf.buf);
	if(atm == nil)
		atm = intern(buf.buf);
	freebuf(&buf);
	return atm;
}

C*
readlist(void)
{
	int first;
	int c;
	C **p;

	first = 1;
	p = push(nil);
	while(c = ch(), c != ')'){
		/* TODO: only valid when next letter is space */
		if(c == '.'){
			if(first)
				err("error: unexpected '.'");
			*p = readsxp(0);
			if(c = ch(), c != ')')
				err("error: expected ')' (got %c)", c);
			break;
		}
		sysin.nextc = c;
		*p = cons(readsxp(0), nil);
		p = &(*p)->d;
		first = 0;
	}
	return pop();
}

C*
readsxp(int eofok)
{
	int c;
	c = ch();
	if(c == EOF){
		if(eofok)
			return noval;
		err("error: EOF while reading s-exp");
	}
	if(c == '\'')
		return cons(quote, cons(readsxp(0), nil));
	if(c == '#'){
		c = ch();
		if(c == '\'')
			return cons(function, cons(readsxp(0), nil));
		err("expected '");
	}
	if(c == ')')
		err("error: unexpected ')'");
	if(c == '(')
		return readlist();
	if(c == '"')
		return readstr();
	sysin.nextc = c;
	return readatom();
}