code: 9ferno

ref: 44ce0097b612a1fefd754065bdf8d9d2e5ef60c8
dir: /appl/alphabet/alphabet.shmod.b/

View raw version
implement Alphabetsh, Shellbuiltin;
include "sys.m";
	sys: Sys;
include "draw.m";
include "sh.m";
	sh: Sh;
	Context, Listnode: import sh;
	n_WORD: import sh;
include "alphabet/reports.m";
	reports: Reports;
	report, Report: import reports;
include "readdir.m";
	readdir: Readdir;
include "alphabet.m";
	alphabet: Alphabet;
	Value, CHECK, ONDEMAND: import alphabet;
include "alphabet/abc.m";

Alphabetsh: module {};

myself: Shellbuiltin;

initbuiltin(ctxt: ref Sh->Context, shmod: Sh): string
{
	sys = load Sys Sys->PATH;
	myself = load Shellbuiltin "$self";
	sh = shmod;
	if (myself == nil)
		ctxt.fail("bad module", sys->sprint("file2chan: cannot load self: %r"));

	alphabet = load Alphabet Alphabet->PATH;
	if(alphabet == nil)
		ctxt.fail("bad module", sys->sprint("alphabet: cannot load %q: %r", Alphabet->PATH));
	reports = load Reports Reports->PATH;
	if(reports == nil)
		ctxt.fail("bad module", sys->sprint("alphabet: cannot load %q: %r", Reports->PATH));
	readdir = load Readdir Readdir->PATH;
	if(readdir == nil)
		ctxt.fail("bad module", sys->sprint("alphabet: cannot load %q: %r", Readdir->PATH));

	alphabet->init();
	alphabet->setautodeclare(1);

	if((decls := ctxt.get("autodeclares")) != nil){
		for(; decls != nil; decls = tl decls){
			d := hd decls;
			if(d.cmd == nil){
				err: string;
				(d.cmd, err) = sh->parse(d.word);
				if(err != nil){
					sys->fprint(sys->fildes(2), "alphabet: warning: bad autodeclaration: %s\n", err);
					continue;
				}
			}
			{
				declares(ctxt, nil::d::nil);
			}exception{
			"fail:*" =>
				;
			}
		}
	}

	ctxt.addbuiltin("declare", myself);
	ctxt.addbuiltin("declares", myself);
	ctxt.addbuiltin("undeclare", myself);
	ctxt.addbuiltin("define", myself);
	ctxt.addbuiltin("import", myself);
	ctxt.addbuiltin("autodeclare", myself);
	ctxt.addbuiltin("type", myself);
	ctxt.addbuiltin("typeset", myself);
	ctxt.addbuiltin("autoconvert", myself);
	ctxt.addbuiltin("-", myself);
	ctxt.addbuiltin("info", myself);
	ctxt.addbuiltin("clear", myself);

#	ctxt.addsbuiltin("-", myself);
	ctxt.addsbuiltin("rewrite", myself);
	ctxt.addsbuiltin("modules", myself);
	ctxt.addsbuiltin("types", myself);
	ctxt.addsbuiltin("usage", myself);
	return nil;
}

runbuiltin(c: ref Sh->Context, nil: Sh,
			cmd: list of ref Listnode, nil: int): string
{
	case (hd cmd).word {
	"declare" =>
		return declare(c, cmd);
	"declares" =>
		return declares(c, cmd);
	"undeclare" =>
		return undeclare(c, cmd);
	"define" =>
		return define(c, cmd);
	"import" =>
		return importf(c, cmd);
	"type" =>
		return importtype(c, cmd);
	"typeset" =>
		return typeset(c, cmd);
	"autoconvert" =>
		return autoconvert(c, cmd);
	"autodeclare" =>
		if(len cmd != 2)
			usage(c, "usage: autodeclare 0/1");
		alphabet->setautodeclare(int word(hd tl cmd));
	"info" =>
		return info(c, cmd);
	"clear" =>
		a := load Alphabet Alphabet->PATH;
		if(a == nil)
			c.fail("bad module", sys->sprint("alphabet: cannot load %q: %r", Alphabet->PATH));
		alphabet->quit();
		alphabet = a;
		alphabet->init();
		alphabet->setautodeclare(1);
	"-" =>
		return eval(c, cmd);
	}
	return nil;
}

whatis(nil: ref Sh->Context, nil: Sh, mod: string, wtype: int): string
{
	if(wtype == OTHER){
		(qname, sig, def) := alphabet->getmodule(mod);
		if(qname == nil)
			return nil;
		s := sys->sprint("declare %q %q", qname, sig);
		if(def != nil){
			for(i := len sig-1; i >= 0; i--){
				if(sig[i] == '>'){
					sig = sig[0:i-1];
					break;
				}
			}
			s += sys->sprint("; define %q {(%s); %s}", qname, sig, sh->cmd2string(def));
		}
		return s;
	}
	return nil;
}

getself(): Shellbuiltin
{
	return myself;
}

runsbuiltin(ctxt: ref Context, nil: Sh,
			argv: list of ref Listnode): list of ref Listnode
{
	case (hd argv).word {
	"rewrite" =>
		return rewrite(ctxt, argv);
	"modules" =>
		return sh->stringlist2list(alphabet->getmodules());
	"types" =>
		ts := "";
		if(tl argv != nil)
			ts = word(hd tl argv);
		r := sh->stringlist2list(alphabet->gettypes(ts));
		if(r == nil)
			ctxt.fail("error", sys->sprint("unknown typeset %q", ts));
		return r;
	"usage" =>
		if(len argv != 2)
			usage(ctxt, "usage qname");
		(qname, u, nil) := alphabet->getmodule(word(hd tl argv));
		if(qname == nil)
			ctxt.fail("error", "module not declared");
		return ref Listnode(nil, u) :: nil;
	}
	return nil;
}

usage(ctxt: ref Context, s: string)
{
	ctxt.fail("usage", "usage: " + s);
}

declares(ctxt: ref Sh->Context, argv: list of ref Listnode): string
{
	argv = tl argv;
	if(argv == nil || (hd argv).cmd == nil)
		ctxt.fail("usage", "usage: declares decls");
	decls := (hd argv).cmd;
	declares := load Declares Declares->PATH;
	if(declares == nil)
		ctxt.fail("bad module", sys->sprint("alphabet: cannot load %q: %r", Declares->PATH));
	{
		declares->init();
	} exception e {
	"fail:*" =>
		ctxt.fail("declares init", e[5:]);
	}

	spawn printerrors(errorc := chan of string);
	e := declares->declares(alphabet, decls, errorc, nil);
	declares->quit();
	if(e != nil)
		ctxt.fail("bad declaration", sys->sprint("alphabet: declaration failed: %s", e));
	return nil;
}

rewrite(ctxt: ref Sh->Context, argv: list of ref Listnode): list of ref Listnode
{
	argv = tl argv;
	n := len argv;
	if(n != 1 && n != 2 || (hd argv).cmd == nil)
		usage(ctxt, "rewrite {expr} [desttype]");
	spawn printerrors(errorc := chan of string);
	desttype := "";
	if(n == 2)
		desttype = word(hd tl argv);
	(c, usage) := alphabet->rewrite((hd argv).cmd, desttype, errorc);
	errorc <-= nil;
	if(c == nil)
		raise "fail:bad expression";
	return (ref Listnode(c, nil) :: ref Listnode(nil, usage) :: nil);
}

# XXX add support for optional ONDEMAND and CHECK flags
declare(ctxt: ref Sh->Context, argv: list of ref Listnode): string
{
	argv = tl argv;
	n := len argv;
	if(n < 1 || n > 2)
		usage(ctxt, "declare qname [type]");
	decltype := "";
	if(n == 2)
		decltype = word(hd tl argv);
	e := alphabet->declare(word(hd argv), decltype, 0);
	if(e != nil)
		ctxt.fail("error", sys->sprint("cannot declare %s: %s", word(hd argv), e));
	return nil;
}

undeclare(ctxt: ref Sh->Context, argv: list of ref Listnode): string
{
	argv = tl argv;
	if(argv == nil)
		usage(ctxt, "undeclare name...");
	for(; argv != nil; argv = tl argv){
		if((e := alphabet->undeclare(word(hd argv))) != nil)
			sys->fprint(sys->fildes(2), "alphabet: cannot undeclare %q: %s\n", word(hd argv), e);
	}
	return nil;
}

# usage define name expr
define(ctxt: ref Sh->Context, argv: list of ref Listnode): string
{
	argv = tl argv;
	if(len argv != 2 || (hd tl argv).cmd == nil)
		usage(ctxt, "define name {expr}");
	
	spawn printerrors(errorc := chan of string);

	err := alphabet->define((hd argv).word, (hd tl argv).cmd, errorc);
	errorc <-= nil;
	if(err != nil)
		raise "fail:bad define: "+err;
	return nil;
}

importf(ctxt: ref Sh->Context, argv: list of ref Listnode): string
{
	argv = tl argv;
	if(argv == nil)
		usage(ctxt, "import qname...");
	errs := 0;
	for(; argv != nil; argv = tl argv){
		e := alphabet->importmodule(word(hd argv));
		if(e != nil){
			sys->fprint(sys->fildes(2), "alphabet: cannot import %s: %s\n", word(hd argv), e);
			errs++;
		}
	}
	if(errs)
		raise "fail:import error";
	return nil;
}

importtype(ctxt: ref Sh->Context, argv: list of ref Listnode): string
{
	argv = tl argv;
	if(argv == nil)
		usage(ctxt, "type qname...");
	errs := 0;
	for(; argv != nil; argv = tl argv){
		e := alphabet->importtype(word(hd argv));
		if(e != nil){
			sys->fprint(sys->fildes(2), "alphabet: cannot import type %s: %s\n", word(hd argv), e);
			errs++;
		}
	}
	if(errs)
		raise "fail:type declare error";
	return nil;
}

typeset(ctxt: ref Sh->Context, argv: list of ref Listnode): string
{
	argv = tl argv;
	if(len argv != 1)
		usage(ctxt, "typeset qname");
	spawn printerrors(errorc := chan of string);
	e := alphabet->loadtypeset(word(hd argv), nil, errorc);	# XXX errorc?
	errorc <-= nil;
	if(e != nil)
		ctxt.fail("error", sys->sprint("cannot load typeset %q: %s", word(hd argv), e));
	return nil;
}

autoconvert(ctxt: ref Sh->Context, argv: list of ref Listnode): string
{
	argv = tl argv;
	if(len argv != 3)
		usage(ctxt, "autoconvert src dst fn");
	src := word(hd argv);
	dst := word(hd tl argv);
	expr := (hd tl tl argv).cmd;
	if(expr == nil)
		expr = ref Sh->Cmd(Sh->n_WORD, nil, nil, (hd tl tl argv).word, nil);
	spawn printerrors(errorc := chan of string);
	e := alphabet->autoconvert(src, dst, expr, errorc);
	errorc <-= nil;
	if(e != nil)
		ctxt.fail("error", sys->sprint("cannot autoconvert %s to %s via %s: %s",
				src, dst, word(hd tl tl argv), e));
	return nil;
}

info(ctxt: ref Sh->Context, argv: list of ref Listnode): string
{
	first := 1;
	if(tl argv != nil)
		usage(ctxt, "info");
	for(tsl := alphabet->gettypesets(); tsl != nil; tsl = tl tsl){
		ts := hd tsl;
		r := alphabet->gettypesetmodules(ts);
		if(r == nil)
			continue;
		if(first == 0)
			sys->print("\n");
		sys->print("typeset %s\n", ts);
		while((mod := <-r) != nil){
			(qname, u, nil) := alphabet->getmodule(ts+"/"+mod);
			if(qname != nil)
				sys->print("%s %s\n", qname, u);
		}
		first = 0;
	}
	acl := alphabet->getautoconversions();
	if(acl != nil)
		sys->print("\n");

	for(; acl != nil; acl = tl acl){
		(src, dst, via) := hd acl;
		sys->print("autoconvert %q %q %s\n", src, dst, sh->cmd2string(via));
	}
	return nil;
}

eval(ctxt: ref Sh->Context, argv: list of ref Listnode): string
{
	argv = tl argv;
	if(argv == nil || (hd argv).cmd == nil)
		usage(ctxt, "- {expr} [arg...]");
	c := (hd argv).cmd;
	if(c == nil)
		c = mkw((hd argv).word);


	args: list of ref Value;
	for(argv = tl argv; argv != nil; argv = tl argv){
		if((hd argv).cmd != nil)
			args = ref Value.Vc((hd argv).cmd) :: args;
		else
			args = ref Value.Vs((hd argv).word) :: args;
	}
	return alphabet->eval(c, ctxt.drawcontext, rev(args));
}

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

word(n: ref Listnode): string
{
	if (n.word != nil)
		return n.word;
	if (n.cmd != nil)
		n.word = sh->cmd2string(n.cmd);
	return n.word;
}

printerrors(c: chan of string)
{
	while((s := <-c) != nil)
		sys->fprint(sys->fildes(2), "e: %s\n", s);
}

mkw(w: string): ref Sh->Cmd
{
	return ref Sh->Cmd(n_WORD, nil, nil, w, nil);
}