code: 9ferno

ref: 44ce0097b612a1fefd754065bdf8d9d2e5ef60c8
dir: /appl/alphabet/typesets/fstypes.b/

# warning: autogenerated code; don't bother to change this, change mktypeset.b or fs.b instead
implement Fstypes;
include "sys.m";
	sys: Sys;
include "alphabet/reports.m";
include "draw.m";
include "sh.m";
include "alphabet.m";
	extvalues: Extvalues;
	Values: import extvalues;
	proxymod: Proxy;
	Typescmd, Modulecmd: import Proxy;
include "fs.m";
	fs: Fs;
	Value: import fs;
include "fstypes.m";

Pcontext: adt {
	cvt: ref Fscvt;
	ctxt: ref Context;

	loadtypes: fn(ctxt: self ref Pcontext, name: string): (chan of ref Proxy->Typescmd[ref Value], string);
	type2s: fn(ctxt: self ref Pcontext, tc: int): string;
	alphabet: fn(ctxt: self ref Pcontext): string;
	modules: fn(ctxt: self ref Pcontext, r: chan of string);
	find: fn(ctxt: self ref Pcontext, s: string): (ref Module, string);
	getcvt: fn(ctxt: self ref Pcontext): ref Fscvt;
};

proxy(): chan of ref Typescmd[ref Alphabet->Value]
{
	return proxy0().t0;
}

proxy0(): (
		chan of ref Typescmd[ref Alphabet->Value],
		chan of (string, chan of ref Typescmd[ref Fs->Value]),
		ref Fscvt
	)
{
	sys = load Sys Sys->PATH;
	extvalues = checkload(load Extvalues Extvalues->PATH, Extvalues->PATH);
	proxymod = checkload(load Proxy Proxy->PATH, Proxy->PATH);
	fs = checkload(load Fs Fs->PATH, Fs->PATH);
	fs->init();
	cvt := ref Fscvt(Values[ref Value].new());
	(t, newts) := proxymod->proxy(ref Pcontext(cvt, Context.new()));
	return (t, newts, cvt);
}

include "readdir.m";
Context: adt {
	modules: fn(ctxt: self ref Context, r: chan of string);
	loadtypes: fn(ctxt: self ref Context, name: string)
		: (chan of ref Proxy->Typescmd[ref Value], string);
	find: fn(ctxt: self ref Context, s: string): (ref Module, string);
	new:	fn(): ref Context;
};
Module: adt {
	m: Fsmodule;
	run: fn(m: self ref Module, ctxt: ref Draw->Context, r: ref Reports->Report,
		errorc: chan of string, opts: list of (int, list of ref Value),
		args: list of ref Value): ref Value;
	typesig: fn(m: self ref Module): string;
	quit: fn(m: self ref Module);
};
Context.new(): ref Context
{
	return nil;
}
Context.loadtypes(nil: self ref Context, name: string): (chan of ref Typescmd[ref Value], string)
{
	p := "/dis/alphabet/fs/"+name+"types.dis";
	types := load Fssubtypes p;
	if(types == nil)
		return (nil, sys->sprint("cannot load %q: %r", p));
	return (types->proxy(), nil);
}
Context.modules(nil: self ref Context, r: chan of string)
{
	if((readdir := load Readdir Readdir->PATH) != nil){
		(a, nil) := readdir->init("/dis/alphabet/fs", Readdir->NAME|Readdir->COMPACT);
		for(i := 0; i < len a; i++){
			m := a[i].name;
			if((a[i].mode & Sys->DMDIR) == 0 && len m > 4 && m[len m - 4:] == ".dis")
				r <-= m[0:len m - 4];
		}
	}
	r <-= nil;
}
Context.find(nil: self ref Context, s: string): (ref Module, string)
{
	p := "/dis/alphabet/fs/"+s+".dis";
	m := load Fsmodule p;
	if(m == nil)
		return (nil, sys->sprint("cannot load %q: %r", p));
	{
		m->init();
	} exception e {
	"fail:*" =>
		return (nil, "init failed: " + e[5:]);
	}
	return (ref Module(m), nil);
}
Module.run(m: self ref Module, ctxt: ref Draw->Context, r: ref Reports->Report, nil: chan of string,
		opts: list of (int, list of ref Value), args: list of ref Value): ref Value
{
	# add errorc
	return m.m->run(ctxt, r, opts, args);
}
Module.typesig(m: self ref Module): string
{
	return m.m->types();
}
Module.quit(nil: self ref Module)
{
}
Pcontext.type2s(nil: self ref Pcontext, tc: int): string
{
	return Value.type2s(tc);
}

Pcontext.alphabet(nil: self ref Pcontext): string
{
	return "rdcfsmptx";
}

Pcontext.getcvt(ctxt: self ref Pcontext): ref Fscvt
{
	return ctxt.cvt;
}

Pcontext.find(ctxt: self ref Pcontext, s: string): (ref Module, string)
{
	return ctxt.ctxt.find(s);
}

Pcontext.modules(ctxt: self ref Pcontext, r: chan of string)
{
	ctxt.ctxt.modules(r);
}

Pcontext.loadtypes(ctxt: self ref Pcontext, name: string): (chan of ref Typescmd[ref Value], string)
{
	return ctxt.ctxt.loadtypes(name);
}

Fscvt.int2ext(cvt: self ref Fscvt, gv: ref Value): ref Alphabet->Value
{
	if(gv == nil)
		return nil;
	pick v := gv {
	Vd =>
		return ref (Alphabet->Value).Vd(v.i);
	Vf =>
		return ref (Alphabet->Value).Vf(v.i);
	Vr =>
		return ref (Alphabet->Value).Vr(v.i);
	Vs =>
		return ref (Alphabet->Value).Vs(v.i);
	Vc =>
		return ref (Alphabet->Value).Vc(v.i);
	* =>
		id := cvt.values.add(gv);
		return ref (Alphabet->Value).Vz((gv.typec(), id));
	}
}

Fscvt.ext2int(cvt: self ref Fscvt, ev: ref Alphabet->Value): ref Value
{
	if(ev == nil)
		return nil;
	pick v := ev {
	Vd =>
		return ref Value.Vd(v.i);
	Vw =>
		return nil;		# can't happen
	Vf =>
		return ref Value.Vf(v.i);
	Vr =>
		return ref Value.Vr(v.i);
	Vs =>
		return ref Value.Vs(v.i);
	Vc =>
		return ref Value.Vc(v.i);
	Vz =>
		x := cvt.values.v[v.i.id].t1;
		if(x == nil){
			sys->print("fstypes: bad id %d, type %c\n", v.i.id, v.i.typec);
			return nil;
		}
		return x;
	}
}

Fscvt.free(cvt: self ref Fscvt, gv: ref Alphabet->Value, used: int)
{
	pick v := gv {
	Vz =>
		id := v.i.id;
		cvt.values.v[id].t1.free(used);
		cvt.values.del(id);
	}
}

Fscvt.dup(cvt: self ref Fscvt, gv: ref Alphabet->Value): ref Alphabet->Value
{
	pick ev := gv {
	Vz =>
		id := ev.i.id;
		v := cvt.values.v[id].t1;
		nv := v.dup();
		if(nv == nil)
			return nil;
		if(nv != v)
			return ref (Alphabet->Value).Vz((ev.i.typec, cvt.values.add(nv)));
		cvt.values.inc(id);
		return ev;
	* =>
		return nil;
	}
}

checkload[T](m: T, path: string): T
{
	if(m != nil)
		return m;
	sys->fprint(sys->fildes(2), "fstypes: cannot load %s: %r\n", path);
	raise "fail:bad module";
}