ref: babf901b4a508c3ec5d1f89655f10377bbdf9637
dir: /appl/alphabet/proxy.b/
implement Proxy;
include "sys.m";
sys: Sys;
include "draw.m";
include "sh.m";
include "alphabet/reports.m";
include "alphabet.m";
Debug: con 0;
proxy[Ctxt,Cvt,M,V,EV](ctxt: Ctxt): (
chan of ref Typescmd[EV],
chan of (string, chan of ref Typescmd[V])
) for {
M =>
typesig: fn(m: self M): string;
run: fn(m: self M, ctxt: ref Draw->Context, r: ref Reports->Report, errorc: chan of string,
opts: list of (int, list of V), args: list of V): V;
quit: fn(m: self M);
Ctxt =>
loadtypes: fn(ctxt: self Ctxt, name: string): (chan of ref Proxy->Typescmd[V], string);
type2s: fn(ctxt: self Ctxt, tc: int): string;
alphabet: fn(ctxt: self Ctxt): string;
modules: fn(ctxt: self Ctxt, r: chan of string);
find: fn(ctxt: self Ctxt, s: string): (M, string);
getcvt: fn(ctxt: self Ctxt): Cvt;
Cvt =>
int2ext: fn(cvt: self Cvt, v: V): EV;
ext2int: fn(cvt: self Cvt, ev: EV): V;
free: fn(cvt: self Cvt, v: EV, used: int);
dup: fn(cvt: self Cvt, v: EV): EV;
}
{
sys = load Sys Sys->PATH;
t := chan of ref Typescmd[EV];
newts := chan of (string, chan of ref Typescmd[V]);
spawn proxyproc(ctxt, t, newts);
return (t, newts);
}
proxyproc[Ctxt,Cvt,M,V,EV](
ctxt: Ctxt,
t: chan of ref Typescmd[EV],
newts: chan of (string, chan of ref Typescmd[V])
)
for{
M =>
typesig: fn(m: self M): string;
run: fn(m: self M, ctxt: ref Draw->Context, r: ref Reports->Report, errorc: chan of string,
opts: list of (int, list of V), args: list of V): V;
quit: fn(m: self M);
Ctxt =>
loadtypes: fn(ctxt: self Ctxt, name: string): (chan of ref Proxy->Typescmd[V], string);
type2s: fn(ctxt: self Ctxt, tc: int): string;
alphabet: fn(ctxt: self Ctxt): string;
modules: fn(ctxt: self Ctxt, r: chan of string);
find: fn(ctxt: self Ctxt, s: string): (M, string);
getcvt: fn(ctxt: self Ctxt): Cvt;
Cvt =>
int2ext: fn(cvt: self Cvt, v: V): EV;
ext2int: fn(cvt: self Cvt, ev: EV): V;
free: fn(cvt: self Cvt, v: EV, used: int);
dup: fn(cvt: self Cvt, v: EV): EV;
}
{
typesets: list of (string, chan of ref Typescmd[V]);
cvt := ctxt.getcvt();
for(;;)alt{
gr := <-t =>
if(gr == nil){
for(; typesets != nil; typesets = tl typesets)
(hd typesets).t1 <-= nil;
exit;
}
pick r := gr {
Load =>
(m, err) := ctxt.find(r.cmd);
if(m == nil){
r.reply <-= (nil, err);
}else{
c := chan of ref Modulecmd[EV];
spawn modproxyproc(cvt, m, c);
r.reply <-= (c, nil);
}
Alphabet =>
r.reply <-= ctxt.alphabet();
Free =>
cvt.free(r.v, r.used);
r.reply <-= 0;
Dup =>
r.reply <-= cvt.dup(r.v);
Type2s =>
r.reply <-= ctxt.type2s(r.tc);
Loadtypes =>
ts := typesets;
typesets = nil;
c: chan of ref Typescmd[V];
for(; ts != nil; ts = tl ts){
if((hd ts).t0 == r.name)
c = (hd ts).t1;
else
typesets = hd ts :: typesets;
}
err: string;
if(c == nil)
(c, err) = ctxt.loadtypes(r.name);
if(c == nil)
r.reply <-= (nil, err);
else{
et := chan of ref Typescmd[EV];
spawn extproxyproc(ctxt, ctxt.alphabet(), c, et);
r.reply <-= (et, nil);
}
Modules =>
spawn ctxt.modules(r.reply);
* =>
sys->fprint(sys->fildes(2), "unknown type of proxy request %d\n", tagof gr);
raise "unknown type proxy request";
}
typesets = <-newts :: typesets =>
;
}
}
modproxyproc[Cvt,V,EV,M](cvt: Cvt, m: M, c: chan of ref Modulecmd[EV])
for{
M =>
typesig: fn(m: self M): string;
run: fn(m: self M, ctxt: ref Draw->Context, r: ref Reports->Report, errorc: chan of string,
opts: list of (int, list of V), args: list of V): V;
quit: fn(m: self M);
Cvt =>
int2ext: fn(cvt: self Cvt, v: V): EV;
ext2int: fn(cvt: self Cvt, ev: EV): V;
free: fn(cvt: self Cvt, ev: EV, used: int);
}
{
while((gr := <-c) != nil){
pick r := gr {
Typesig =>
r.reply <-= m.typesig();
Run =>
# XXX could start (or invoke) a new process so that we don't potentially
# block concurrency while we're starting the command.
{
iopts: list of (int, list of V);
for(o := r.opts; o != nil; o = tl o){
il := extlist2intlist(cvt, (hd o).t1);
iopts = ((hd o).t0, il) :: iopts;
}
iopts = revip(iopts);
v := cvt.int2ext(m.run(r.ctxt, r.report, r.errorc, iopts, extlist2intlist(cvt, r.args)));
free(cvt, r.opts, r.args, v != nil);
r.reply <-= v;
} exception {
"type error" =>
if(Debug)
sys->fprint(sys->fildes(2), "error: type conversion failed");
if(r.errorc != nil)
r.errorc <-= "error: type conversion failed";
r.reply <-= nil;
}
}
}
m.quit();
}
extproxyproc[Ctxt,Cvt,V,EV](ctxt: Ctxt, alphabet: string, t: chan of ref Typescmd[V], et: chan of ref Typescmd[EV])
for{
Ctxt =>
type2s: fn(ctxt: self Ctxt, tc: int): string;
getcvt: fn(ctxt: self Ctxt): Cvt;
Cvt =>
int2ext: fn(cvt: self Cvt, v: V): EV;
ext2int: fn(cvt: self Cvt, ev: EV): V;
free: fn(cvt: self Cvt, ev: EV, used: int);
dup: fn(cvt: self Cvt, ev: EV): EV;
}
{
cvt := ctxt.getcvt();
for(;;){
gr := <-et;
if(gr == nil)
break;
pick r := gr {
Load =>
reply := chan of (chan of ref Modulecmd[V], string);
t <-= ref Typescmd[V].Load(r.cmd, reply);
(c, err) := <-reply;
if(c == nil){
r.reply <-= (nil, err);
}else{
ec := chan of ref Modulecmd[EV];
spawn extmodproxyproc(cvt, c, ec);
r.reply <-= (ec, nil);
}
Alphabet =>
t <-= ref Typescmd[V].Alphabet(r.reply);
Free =>
cvt.free(r.v, r.used);
Dup =>
r.reply <-= cvt.dup(r.v);
Type2s =>
for(i := 0; i < len alphabet; i++)
if(alphabet[i] == r.tc)
break;
if(i == len alphabet)
t <-= ref Typescmd[V].Type2s(r.tc, r.reply);
else
r.reply <-= ctxt.type2s(r.tc);
Loadtypes =>
reply := chan of (chan of ref Typescmd[V], string);
t <-= ref Typescmd[V].Loadtypes(r.name, reply);
(c, err) := <-reply;
if(c == nil)
r.reply <-= (nil, err);
else{
t <-= ref Typescmd[V].Alphabet(areply := chan of string);
ec := chan of ref Typescmd[EV];
spawn extproxyproc(ctxt, <-areply, c, ec);
r.reply <-= (ec, nil);
}
Modules =>
t <-= ref Typescmd[V].Modules(r.reply);
* =>
sys->fprint(sys->fildes(2), "unknown type of proxy request %d\n", tagof gr);
raise "unknown type proxy request";
}
}
et <-= nil;
}
extmodproxyproc[Cvt,V,EV](cvt: Cvt, c: chan of ref Modulecmd[V], ec: chan of ref Modulecmd[EV])
for{
Cvt =>
int2ext: fn(cvt: self Cvt, v: V): EV;
ext2int: fn(cvt: self Cvt, ev: EV): V;
free: fn(cvt: self Cvt, ev: EV, used: int);
}
{
while((gr := <-ec) != nil){
pick r := gr {
Typesig =>
c <-= ref Modulecmd[V].Typesig(r.reply);
Run =>
{
iopts: list of (int, list of V);
for(o := r.opts; o != nil; o = tl o){
il := extlist2intlist(cvt, (hd o).t1);
iopts = ((hd o).t0, il) :: iopts;
}
iopts = revip(iopts);
c <-= ref Modulecmd[V].Run(
r.ctxt,
r.report,
r.errorc,
iopts,
extlist2intlist(cvt, r.args),
reply := chan of V
);
v := cvt.int2ext(<-reply);
free(cvt, r.opts, r.args, v != nil);
r.reply <-= v;
}
}
}
}
revip[V](l: list of (int, V)): list of (int, V)
{
m: list of (int, V);
for(; l != nil; l = tl l)
m = hd l :: m;
return m;
}
extlist2intlist[V,EV,Cvt](cvt: Cvt, vl: list of EV): list of V
for{
Cvt =>
int2ext: fn(cvt: self Cvt, v: V): EV;
ext2int: fn(cvt: self Cvt, ev: EV): V;
}
{
l, m: list of V;
for(; vl != nil; vl = tl vl)
l = cvt.ext2int(hd vl) :: l;
for(; l != nil; l = tl l)
m = hd l :: m;
return m;
}
free[V,Cvt](cvt: Cvt, opts: list of (int, list of V), args: list of V, used: int)
for{
Cvt =>
free: fn(cvt: self Cvt, ev: V, used: int);
}
{
for(; args != nil; args = tl args)
cvt.free(hd args, used);
for(; opts != nil; opts = tl opts)
for(args = (hd opts).t1; args != nil; args = tl args)
cvt.free(hd args, used);
}