implement Shellbuiltin;
# blend in better with sh syntax: use parens.

include "sys.m";
	sys: Sys;
	fprint, fildes: import sys;
include "draw.m";
include "sh.m";
	sh: Sh;
	Redir, Listnode, Context: import sh;
	myself: Shellbuiltin;
	n_BLOCK,  n_VAR, n_BQ, n_BQ2, n_REDIR,
	n_DUP, n_LIST, n_SEQ, n_CONCAT, n_PIPE, n_ADJ,
	n_WORD, n_NOWAIT, n_SQUASH, n_COUNT,
	n_ASSIGN, n_LOCAL, Node, GLOB : import sh;

OAPPEND: con 16r80000;		# make sure this doesn't clash with O* constants in sys.m

include "bufio.m";
include "sexprs.m";
	sexpr: Sexprs;
	Sexp: import sexpr;
include "filepat.m";
	filepat: Filepat;

include "libc.m";
	libc: Libc;
	isdigit: import libc;

Nil: ref Sexp;
T: ref Sexp;
Env: ref Sexp;
Procedure: ref Sexp;
Labeled: ref Sexp;
Unbound: ref Sexp;
stderr: ref Sys->FD;

initbuiltin(ctxt: ref Context, shmod: Sh): string
{
	sys = load Sys Sys->PATH;
	libc = load Libc Libc->PATH;
	filepat = load Filepat Filepat->PATH;
	sexpr = load Sexprs Sexprs->PATH;
	sexpr->init();
	sh = shmod;
	myself = load Shellbuiltin "$self";
	stderr = fildes(2);
	if (myself == nil)
		ctxt.fail("bad module", sys->sprint("echo: cannot load self: %r"));
	ctxt.addbuiltin("eval", myself);
	ctxt.addbuiltin("FullForm", myself);
	Nil = ref Sexp.String("nil", nil);
	T = ref Sexp.String("t", nil);
	Procedure = ref Sexp.String("&procedure", "");
	Labeled = ref Sexp.String("&labeled", "");
	Unbound = ref Sexp.String("&unbound", "");
	Env = ref Sexp.List(nil);
	return nil;
}

whatis(nil: ref Sh->Context, nil: Sh, nil: string, nil: int): string
{
	return nil;
}

getself(): Shellbuiltin
{
	return myself;
}

runbuiltin(ctxt: ref Context, nil: Sh,
			argv: list of ref Listnode, last: int): string
{
	case (hd argv).word {
	"eval" =>
		return builtin_eval(ctxt, argv, last);
	"FullForm" =>
		return builtin_fullform(ctxt, argv, last);
	}
	return nil;
}

runsbuiltin(nil: ref Sh->Context, nil: Sh,
			nil: list of ref Listnode): list of ref Listnode
{
	return nil;
}

argusage(ctxt: ref Context)
{
	ctxt.fail("usage", "usage: arg [opts {command}]... - args");
}

typs:= array[] of {"BLOCK", "VAR", "BQ", "BQ2", "REDIR", 
	"DUP", "LIST", "SEQ", "CONCAT", "PIPE", "ADJ", "WORD",
	"NOWAIT", "SQUASH", "COUNT", "ASSIGN", "LOCAL"};


stack: list of list of ref Sexp;

push(s:string)
{
		l := hd stack;
		stack = tl stack;
		l = ref Sexp.String(s, "") :: l;
		stack = l :: stack;
}

pushs(s: ref Sexp)
{
		l := hd stack;
		stack = tl stack;
		l = s :: l;
		stack = l :: stack;
}

pushlist()
{
		nlist : list of ref Sexp;
		nlist = nil;
		stack = nlist :: stack;
}

poplist()
{
		nlist := hd stack;
		stack = tl stack;
		l := hd stack;
		stack = tl stack;
		l = ref Sexp.List(reverse(nlist)) :: l;
		stack = l :: stack;

}
typname:= array[] of {"Block", "Var", "BQuote", "SquashQuote", "Redir", 
	"Dup", "List", "Seq", "Concat", "Pipe", "Adj", "Word",
	"Nowait", "Squash", "Count", "Set", "SetLocal"};

n2s(n: ref Node): ref Sexp
{
	stack = nil;
	nlist : list of ref Sexp;
	nlist = nil;
	stack = nlist :: stack;
	transform(n);
	nlist = hd stack;
	if(nlist != nil && (hd nlist) != nil)
		return (hd nlist);
	return nil;
}

transform(n: ref Node)
{
	if(n == nil)
		return;
#	fprint(stderr, "dbg: %s\n", typs[n.ntype]);
#	if(n.ntype == n_WORD)
#		fprint(stderr, "\t%s\n",  n.word);
	case n.ntype {
	n_BLOCK => 
		pushlist();
		push(typname[n.ntype]);
		transform(n.left);
		poplist();
	n_ADJ =>
		transform(n.left);
		transform(n.right);
	n_SEQ =>
		push("Seq");
		while(n != nil && n.ntype == n_SEQ) {
			pushlist();
			transform(n.left);
			poplist();
			n = n.right;
		}
		pushlist();
		transform(n);
		poplist();
	n_WORD =>
		push(n.word);
	n_VAR =>
		if(n.left.ntype == n_BLOCK){
			pushlist();
			transform(n.left.left);
			poplist();
		}else{
			pushlist();
			push(typname[n.ntype]);
			transform(n.left);
			if (n.right != nil)
				transform(n.right);
			poplist();
		}
	n_SQUASH or n_COUNT or n_BQ or n_BQ2 or n_NOWAIT =>	
		pushlist();
		push(typname[n.ntype]);
		transform(n.left);
		poplist();
	n_CONCAT =>
		pushlist();
		push("Concat");
		transform(n.left);
		transform(n.right);
		poplist();
	n_ASSIGN =>
		push("Assign");
		transform(n.left);
		transform(n.right);
	n_LOCAL =>
		push("LocalAssign");
		transform(n.left);
		transform(n.right);
	n_LIST =>
		pushlist();
		transform(n.left);
		poplist();
	n_PIPE =>
		pushlist();
		push(typname[n.ntype]);
		pushlist();
		transform(n.left);
		poplist();
		pushlist();
		transform(n.right);
		poplist();
		poplist();
	n_REDIR =>
		pushlist();
		push(typname[n.ntype]);
		s := redirstr(n.redir.rtype);
		push(s);
		if(n.redir.fd1 != -1)
			pushs(fdassignstr(0, n.redir));
		transform(n.left);
		transform(n.right);
		poplist();
	n_DUP =>
		pushlist();
		push(typname[n.ntype]);
		push(redirstr(n.redir.rtype));
		if(n.redir.fd1 != -1)
			pushs(fdassignstr(1, n.redir));
		poplist();
	* =>
		pushlist();
		push(typname[n.ntype]);
		transform(n.left);
		transform(n.right);
		poplist();
	}
}


builtin_eval(ctxt: ref Context, argv: list of ref Listnode, nil: int): string
{
	argv = tl argv;
	n: ref Node;
	s := "";
	if(argv == nil)
		return "arg error";
	if((hd argv).cmd == nil)
		n = ref Node(n_WORD, nil, nil, (hd argv).word, nil);
	else
		n = (hd argv).cmd;
#	se := n2s(n);
	se := eval(cdr(n2s(n)), Env, ctxt);
	if(se != nil)
		s = se.text() + "\n";
	{
		a := array of byte s;
		if (sys->write(sys->fildes(1), a, len a) != len a) {
			sys->fprint(sys->fildes(2), "echo: write error: %r\n");
			return "write error";
		}
		return nil;
	}exception{
		"write on closed pipe" =>
			sys->fprint(sys->fildes(2), "echo: write error: write on closed pipe\n");
			return "write error";
	}
}

builtin_fullform(nil: ref Context, argv: list of ref Listnode, nil: int): string
{
	argv = tl argv;
	n: ref Node;
	s := "";
	if(argv == nil)
		return "arg error";
	if((hd argv).cmd == nil)
		n = ref Node(n_WORD, nil, nil, (hd argv).word, nil);
	else
		n = (hd argv).cmd;
	se := n2s(n);
	if(se != nil)
		s = se.text() + "\n";
	{
		a := array of byte s;
		if (sys->write(sys->fildes(1), a, len a) != len a) {
			sys->fprint(sys->fildes(2), "echo: write error: %r\n");
			return "write error";
		}
		return nil;
	}exception{
		"write on closed pipe" =>
			sys->fprint(sys->fildes(2), "echo: write error: write on closed pipe\n");
			return "write error";
	}
}

reverse[T](l: list of T): list of T
{
	t: list of T;
	for(; l != nil; l = tl l)
		t = hd l :: t;
	return t;
}

numberp(e: ref Sexp): int
{
	if(e == nil)
		return 0;
	pick s := e {
	String =>
		for(i:=0; i<len s.s; i++)
			if(!isdigit(s.s[i]))
				return 0;
		return 1;
	* =>
		return 0;
	}
}

atom(e: ref Sexp): int
{
	if(e == nil)
		return 0;
	pick s := e {
	String =>
		return 1;
	List =>
		if(s.l == nil)
			return 1;
		else
			return 0;
	* =>
		return 0;
	}
}

car(e: ref Sexp): ref Sexp
{
	if(e == nil)
		return nil;
	pick s := e {
	List =>
		if(s.l == nil)
			return ref Sexp.List(nil);
		else 
			return hd s.l;
	* =>
		return nil;
	}
}

cdr(e: ref Sexp): ref Sexp
{
	if(e == nil)
		return nil;
	pick s := e {
	List =>
		if(s.l == nil)
			return ref Sexp.List(nil);
		else 
			return ref Sexp.List(tl s.l);
	* =>
		return nil;
	}
}

caadr(e: ref Sexp): ref Sexp {return car(car(cdr(e)));}
caar(e: ref Sexp): ref Sexp {return car(car(e));}
cadar(e: ref Sexp): ref Sexp {return car(cdr(car(e)));}
caddar(e: ref Sexp): ref Sexp {return car(cdr(cdr(car(e))));}
cadddr(e: ref Sexp): ref Sexp {return car(cdr(cdr(cdr(e))));}
caddr(e: ref Sexp): ref Sexp {return car(cdr(cdr(e)));}
cadr(e: ref Sexp): ref Sexp {return car(cdr(e));}
cdadr(e: ref Sexp): ref Sexp {return cdr(car(cdr(e)));}
cdar(e: ref Sexp): ref Sexp {return cdr(car(e));}
cddr(e: ref Sexp): ref Sexp {return cdr(cdr(e));}

eq(e: ref Sexp, f: ref Sexp): int
{
	if(e == nil || f == nil)
		return 0;
	if(null(e) && null(f))
		return 1;
	pick s := e {
	String =>
		pick r := f {
		String =>
			return s.s == r.s;
		* =>
			return 0;
		}
	* =>
		return 0;
	}
}

null(e: ref Sexp): int
{
	if(e == nil)
		return 0;
	pick s:=e {
	List =>
		if(s.l == nil)
			return 1;
	}
	return 0;
}

cons(e: ref Sexp, f: ref Sexp): ref Sexp
{
	if(e == nil || f == nil)
		return nil;
	pick s := f {
	List =>
		return ref Sexp.List(e :: s.l);
	}
	return nil;
}

evsetq(var, val, env: ref Sexp): ref Sexp
{
	slot := lookup(var, env);
	if(eq(slot, Unbound)){
		return evtoplevelsetq(var, val, env);
	}else{
		return car(rplaca(slot, val));
	}
}

rplaca(x, y: ref Sexp): ref Sexp
{
	if(x  == nil)
		return nil;
	pick s := x {
	List =>
		if(s.l == nil)
			s.l = y :: nil;
		else{
			e := hd s.l;
#			*e = *y;
# TODO get rid of the Pick from Sexp
			fprint(stderr, "from %s to %s\n", e.text(), y.text());
			pick ee := e{
			List =>
				pick yy := y{
				List =>
					ee.l = yy.l;
				* =>
					error("type mismatch");
				}
			String =>
				pick yy  := y {
				String =>
					ee.s = yy.s;
				* =>
					error("type mismatch");
				}
			}
		}
	}
	return x;
}

evtoplevelsetq(var, val, env: ref Sexp): ref Sexp
{
	if(null(cdr(env))){
		return cadar(rplaca(env, cons(cons(var,caar(env)), cons(val, cdar(env)))));
	}else{
		return evtoplevelsetq(var, val, cdr(env));
	}
}

value(name, env: ref Sexp): ref Sexp
{
#	fprint(stderr, "value %s in %s\n", name.text(), env.text());
	return value1(name, lookup(name, env));
}

value1(name, slot: ref Sexp): ref Sexp
{
	if(eq(slot, Unbound)) {
		return glob(name);
#		return error("value1 unbound");
	} else
		return car(slot);
#		return slot;
}

error(s: string): ref Sexp
{
	fprint(stderr, "error at %s\n", s);
	return nil;
}

lookup(name, env: ref Sexp): ref Sexp
{
	if(null(env))
		return Unbound;
	else
		return lookup1(name, caar(env), cdar(env), env);
}

lookup1(name, vars, vals, env: ref Sexp): ref Sexp
{
#	fprint(stderr, "lookup1 name %s, vars %s, vals %s\n", name.text(), vars.text(), vals.text());
	if(null(vars))
		return lookup(name, cdr(env));
	else if(eq(name, car(vars))){
		if(atom(car(vals)))
			return vals;
		else if(eq(caar(vals), Labeled))
			return ref Sexp.List(ref Sexp.List(Procedure :: cadar(vals) :: caddar(vals) :: env :: nil) :: nil);
		else
			return vals;
	} else
		return lookup1(name, cdr(vars), cdr(vals), env);
}

evcon(n, env: ref Sexp, ctxt: ref Context): ref Sexp
{
	if(null(n))
		return error("evcon");
	if(eq(eval(caar(n), env, ctxt), T))
		return eval(cadar(n), env, ctxt);
	else
		return evcon(cdr(n), env, ctxt);
}

evlis(n, env: ref Sexp, ctxt: ref Context): ref Sexp
{
	if(n == nil || null(n))
		return ref Sexp.List(nil);
	else
		return cons(eval(car(n), env, ctxt), evlis(cdr(n), env, ctxt));
}

bind(vars, args, env: ref Sexp): ref Sexp
{
	return cons(cons(vars, args), env);
}

apply(fun, args: ref Sexp, ctxt: ref Context): ref Sexp
{
#	fprint(stderr, "apply %s to %s\n", fun.text(), args.text());
	if(eq(car(fun), Procedure))
		return eval(caddr(fun), bind(cadr(fun), args, cadddr(fun)), ctxt);
	else
		s := ctxt.run(s2list(cons(fun, args)), 0);
		if(s == "")
			return ref Sexp.String("", "");
		else
			return cons(fun, args);
#		return error("apply");
}

eval(n, env: ref Sexp, ctxt: ref Context): ref Sexp
{
#	fprint(stderr, "eval %s in %s\n", n.text(), env.text());
	if(n == nil)
		return nil;
	else if(atom(n)){
		if(eq(n, Nil))
			return n;
		else if(eq(n, T))
			return n;
		else if(numberp(n))
			return n;
		else
			return value(n, env);
	}else if(atom(car(n))){
		e := car(n);
		pick  s := e {
		String =>
		case s.s {
		"quote" =>
			return cadr(n);
		"atom" =>
			if(atom(eval(cadr(n), env, ctxt)))
				return T;
			else
				return Nil;
		"eq" =>
			if(eq(eval(cadr(n), env, ctxt), eval(caddr(n), env, ctxt)))
				return T;
			else
				return Nil;
		"car" =>
			return car(eval(cadr(n), env, ctxt));
		"cdr" =>
			return cdr(eval(cadr(n), env, ctxt));
		"cons" =>
			return cons(eval(cadr(n), env, ctxt), eval(caddr(n), env, ctxt));
		"cond" =>
			return evcon(cdr(n), env, ctxt);
		"setq" =>
			return evsetq(cadr(n), eval(caddr(n), env, ctxt), env);
		"lambda" =>
			return ref Sexp.List(Procedure :: cadr(n) :: caddr(n) :: env :: nil);
		"define" =>
			Env = ref Sexp.List(cons(cons(caadr(n), caar(env)),
				cons(ref Sexp.List(Labeled :: cdadr(n) :: caddr(n) :: nil), 
				cdar(env))) :: nil);
#			fprint(stderr, "new env %s\n", Env.text());
		"Assign" =>
			return assign(cadr(n), evlis(cddr(n), env, ctxt), env, ctxt, 0);
		"LocalAssign" =>
			return assign(cadr(n), evlis(cddr(n), env, ctxt), env, ctxt, 1);
		"Var" =>
			return getvar(cadr(n), env, ctxt);
		"Block" =>
			return n;
		"Seq" =>
			return progn(cdr(n), env, ctxt);
		"Glob" =>
			return glob(cdr(n));
		"Count" =>
			return countvar(cadr(n), env, ctxt);
		"Pipe" =>
			return n;
		* =>
			return apply(eval(car(n), env, ctxt), evlis(cdr(n), env, ctxt), ctxt);
		}
		}
	}else{
		return apply(eval(car(n), env, ctxt), evlis(cdr(n), env, ctxt), ctxt);
	}
	return nil;
}


progn(e, env: ref Sexp, ctxt: ref Context): ref Sexp
{
	if(e == nil)
		return nil;
	for(;;){
		h := car(e);
		t := cdr(e);
		if(t != nil && !null(t)){
			eval(h, env, ctxt);
		}else{
			return eval(h, env, ctxt);
		}
		e = t;
	}		
}

assign(var, vals, nil: ref Sexp, ctxt: ref Context, local: int): ref Sexp
{
	if(local)
		ctxt.setlocal(var.text(), ref Listnode(nil, vals.text()) :: nil);
	else
		ctxt.set(var.text(), ref Listnode(nil, vals.text()) :: nil);
	return Nil;
}

countvar(e, nil: ref Sexp, ctxt: ref Context): ref Sexp
{
	s := getvar(e, nil, ctxt);
	if(s == nil)
		return Nil;
	pick ss := s{
	String =>
		return ref Sexp.String("1", "");
	List =>
		return ref Sexp.String(string len ss.l, "");
	}
	return Nil;
}

getvar(e, nil: ref Sexp, ctxt: ref Context): ref Sexp
{
	pick s := e {
	String =>
		l := ctxt.get(s.s);
		if(l != nil){
			(ee, t, err) := sexpr->Sexp.parse((hd l).word);
			if(ee != nil)
				return ee;
		}
	}
	return Nil;
}


ln2s(l: list of ref Listnode): ref Sexp
{
	ret := ref Sexp.List(nil);

	while (l != nil) {
		n := hd l;
		if(n.cmd != nil)
			ret.l = n2s(n.cmd) :: ret.l;
		else{
			(e, t, err) := sexpr->Sexp.parse(n.word);
			if (e != nil)
				ret.l = e :: ret.l;
		}
		l = tl l;
	}
	ret.l = reverse(ret.l);
	return ret;
}

#
# globbing and general wildcard handling
#

containswildchar(s: string): int
{
	# try and avoid being fooled by GLOB characters in quoted
	# text. we'll only be fooled if the GLOB char is followed
	# by a wildcard char, or another GLOB.
	for (i := 0; i < len s; i++) {
		if (s[i] == GLOB && i < len s - 1) {
			case s[i+1] {
			'*' or '[' or '?' or GLOB =>
				return 1;
			}
		}
	}
	return 0;
}

# remove GLOBs, and quote other wildcard characters
patquote(word: string): string
{
	outword := "";
	for (i := 0; i < len word; i++) {
		case word[i] {
		'[' or '*' or '?' or '\\' =>
			outword[len outword] = '\\';
		GLOB =>
			i++;
			if (i >= len word)
				return outword;
		}
		outword[len outword] = word[i];
	}
	return outword;
}

# get rid of GLOB characters
deglob(s: string): string
{
	j := 0;
	for (i := 0; i < len s; i++) {
		if (s[i] != GLOB) {
			if (i != j)		# a worthy optimisation???
				s[j] = s[i];
			j++;
		}
	}
	if (i == j)
		return s;
	return s[0:j];
}

glob(e: ref Sexp): ref Sexp
{
	if(e == nil || null(e))
		return nil;
	new : ref Sexp;
	if(!atom(e))
		ee := car(e);
	else
		ee = e;
	pick s:=e {
	String =>
		if (containswildchar(s.s)) {
			qword := patquote(s.s);
			files := filepat->expand(qword);
			if (files == nil)
				files = deglob(s.s) :: nil;
			new = stringlist2list(files);
		} else
			new = e;
	}
	n := glob(cdr(e));
	if(n == nil)
		return new;
	else
		return cons(new, n);
}

stringlist2list(sl: list of string): ref Sexp
{
	ret := ref Sexp.List(nil);

	while (sl != nil) {
		ret.l = ref Sexp.String(hd sl, "") :: ret.l;
		sl = tl sl;
	}
	return ret;
}


s2list(e: ref Sexp): list of ref Listnode
{
	ret: list of ref Listnode;
	if(e == nil)
		return nil;
	pick s:=e {
	List =>
	sl := s.l;
	while (sl != nil) {
		pick ss := hd sl {
		String =>
			ret = ref Listnode(nil, ss.s) :: ret;
		List =>
			ret = ref Listnode(nil, ss.text()) :: ret;
		}
		sl = tl sl;
	}
	}
	return revlist(ret);
}

revstringlist(l: list of string): list of string
{
	t: list of string;

	while(l != nil) {
		t = hd l :: t;
		l = tl l;
	}
	return t;
}

revlist(l: list of ref Listnode): list of ref Listnode
{
	t: list of ref Listnode;

	while(l != nil) {
		t = hd l :: t;
		l = tl l;
	}
	return t;
}

redirstr(rtype: int): string
{
	case rtype {
	* or
	Sys->OREAD =>	return "R";
	Sys->OWRITE =>	return "W";
	Sys->OWRITE|OAPPEND =>	return "A";
	Sys->ORDWR =>	return "RW";
	}
}

fdassignstr(isassign: int, redir: ref Redir): ref Sexp
{
	l: string = nil;
	if (redir.fd1 >= 0)
		l = string redir.fd1;
	
	if (isassign) {
		r: string = nil;
		if (redir.fd2 >= 0)
			r = string redir.fd2;
		return ref Sexp.List(ref Sexp.String(l, "") :: ref Sexp.String(r, "") :: nil);
	}
	return ref Sexp.List(ref Sexp.String(l, "")  :: nil);
}