path: root/appl/lib/fslib.b

implement Fslib;

#
# Copyright © 2003 Vita Nuova Holdings Limited
#

include "sys.m";
	sys: Sys;
include "draw.m";
include "sh.m";
include "fslib.m";

# Fsdata stream conventions:
# 
# Fsdata: adt {
#	dir: ref Sys->Dir;
#	data: array of byte;
# };
# Fschan: type chan of (Fsdata, chan of int);
# c: Fschan;
# 
# a stream of values sent on c represent the contents of a directory
# hierarchy. after each value has been received, the associated reply
# channel must be used to prompt the sender how next to proceed.
# 
# the first item sent on an fsdata channel represents the root directory
# (it must be a directory), and its name holds the full path of the
# hierarchy that's being transferred.  the items that follow represent
# the contents of the root directory.
# 
# the set of valid sequences of values can be described by a yacc-style
# grammar, where the terminal tokens describe data values (Fsdata adts)
# passed down the channel.  this grammar describes the case where the
# entire fs tree is traversed in its entirety:
# 
# dir:	DIR dircontents NIL
# 	|	DIR NIL
# dircontents: entry
# 	|	dircontents entry
# entry: FILE filecontents NIL
# 	| FILE NIL
# 	| dir
# filecontents: DATA
# 	| filecontents DATA
# 
# the tests for the various terminal token types, given a token (of type
# Fsdata) t:
# 
# 	FILE		t.dir != nil && (t.dir.mode & Sys->DMDIR) == 0
# 	DIR		t.dir != nil && (t.dir.mode & Sys->DMDIR)
# 	DATA	t.data != nil
# 	NIL		t.data == nil && t.dir == nil
# 
# when a token is received, there are four possible replies:
# 	Quit
# 		terminate the stream immediately.  no more tokens will
# 		be on the channel.
# 
# 	Down
# 		descend one level in the hierarchy, if possible.  the next tokens
# 		will represent the contents of the current entry.
# 
# 	Next
# 		get the next entry in a directory, or the next data
# 		block in a file, or travel one up the hierarchy if
#		it's the last entry or data block in that directory or file.
# 
# 	Skip
# 		skip to the end of a directory or file's contents.
#		if we're already at the end, this is a no-op (same as Next)
# 
# grammar including replies is different.  a token is the tuple (t, reply),
# where reply is the value that was sent over the reply channel.  Quit
# always causes the grammar to terminate, so it is omitted for clarity.
# thus there are 12 possible tokens (DIR_DOWN, DIR_NEXT, DIR_SKIP, FILE_DOWN, etc...)
#
# dir: DIR_DOWN dircontents NIL_NEXT
# 	| DIR_DOWN dircontents NIL_SKIP
# 	| DIR_DOWN dircontents NIL_DOWN
# 	| DIR_NEXT
# dircontents:
# 	| FILE_SKIP
# 	| DIR_SKIP
# 	| file dircontents
# 	| dir dircontents
# file: FILE_DOWN filecontents NIL_NEXT
# 	| FILE_DOWN filecontents NIL_SKIP
# 	| FILE_DOWN filecontents NIL_DOWN
# 	| FILE_NEXT
# filecontents:
# 	| data
# 	| data DATA_SKIP
# data: DATA_NEXT
# 	| data DATA_NEXT
# 
# both the producer and consumer of fs data on the channel must between
# them conform to the second grammar. if a stream of fs data
# is sent with no reply channel, the stream must conform to the first grammar.

valuec := array[] of {
	tagof(Value.V) => 'v',
	tagof(Value.X) => 'x',
	tagof(Value.P) => 'p',
	tagof(Value.S) => 's',
	tagof(Value.C) => 'c',
	tagof(Value.T) => 't',
	tagof(Value.M) => 'm',
};

init()
{
	sys = load Sys Sys->PATH;
}

# copy the contents (not the entry itself) of a directory from src to dst.
copy(src, dst: Fschan): int
{
	indent := 1;
	myreply := chan of int;
	for(;;){
		(d, reply) := <-src;
		dst <-= (d, myreply);
		r := <-myreply;
		case reply <-= r {
		Quit =>
			return Quit;
		Next =>
			if(d.dir == nil && d.data == nil)
				if(--indent == 0)
					return Next;
		Skip =>
			if(--indent == 0)
				return Next;
		Down =>
			if(d.dir != nil || d.data != nil)
				indent++;
		}
	}
}

Report.new(): ref Report
{
	r := ref Report(chan of string, chan of (string, chan of string), chan of int);
	spawn reportproc(r.startc, r.enablec, r.reportc);
	return r;
}

Report.start(r: self ref Report, name: string): chan of string
{
	if(r == nil)
		return nil;
	errorc := chan of string;
	r.startc <-= (name, errorc);
	return errorc;
}

Report.enable(r: self ref Report)
{
	r.enablec <-= 0;
}

reportproc(startc: chan of (string, chan of string), startreports: chan of int, errorc: chan of string)
{
	realc := array[2] of chan of string;
	p := array[len realc] of string;
	a := array[0] of chan of string;;

	n := 0;
	for(;;) alt{
	(prefix, c) := <-startc =>
		if(n == len realc){
			realc = (array[n * 2] of chan of string)[0:] = realc;
			p = (array[n * 2] of string)[0:] = p;
		}
		realc[n] = c;
		p[n] = prefix;
		n++;
	<-startreports =>
		if(n == 0){
			errorc <-= nil;
			exit;
		}
		a = realc;
	(x, report) := <-a =>
		if(report == nil){
#			errorc <-= "exit " + p[x];
			--n;
			if(n != x){
				a[x] = a[n];
				a[n] = nil;
				p[x] = p[n];
				p[n] = nil;
			}
			if(n == 0){
				errorc <-= nil;
				exit;
			}
		}else if(a == realc)
			errorc <-= p[x] + ": " + report;
	}
}

type2s(c: int): string
{
	case c{
	'a' =>
		return "any";
	'x' =>
		return "fs";
	's' =>
		return "string";
	'v' =>
		return "void";
	'p' =>
		return "gate";
	'c' =>
		return "command";
	't' =>
		return "entries";
	'm' =>
		return "selector";
	* =>
		return sys->sprint("unknowntype('%c')", c);
	}
}

typeerror(tc: int, v: ref Value): string
{
	sys->fprint(sys->fildes(2), "fs: bad type conversion, expected %s, was actually %s\n", type2s(tc), type2s(valuec[tagof v]));
	return "type conversion error";
}

Value.t(v: self ref Value): ref Value.T
{
	pick xv :=v {T => return xv;}
	raise typeerror('t', v);
}
Value.c(v: self ref Value): ref Value.C
{
	pick xv :=v {C => return xv;}
	raise typeerror('c', v);
}
Value.s(v: self ref Value): ref Value.S
{
	pick xv :=v {S => return xv;}
	raise typeerror('s', v);
}
Value.p(v: self ref Value): ref Value.P
{
	pick xv :=v {P => return xv;}
	raise typeerror('p', v);
}
Value.x(v: self ref Value): ref Value.X
{
	pick xv :=v {X => return xv;}
	raise typeerror('x', v);
}
Value.v(v: self ref Value): ref Value.V
{
	pick xv :=v {V => return xv;}
	raise typeerror('v', v);
}
Value.m(v: self ref Value): ref Value.M
{
	pick xv :=v {M => return xv;}
	raise typeerror('m', v);
}

Value.typec(v: self ref Value): int
{
	return valuec[tagof v];
}

Value.discard(v: self ref Value)
{
	if(v == nil)
		return;
	pick xv := v {
	X =>
		(<-xv.i).t1 <-= Quit;
	P =>
		xv.i <-= (Nilentry, nil);
	M =>
		xv.i <-= (nil, nil, nil);
	V =>
		xv.i <-= 0;
	T =>
		xv.i.sync <-= 0;
	}
}

sendnulldir(c: Fschan): int
{
	reply := chan of int;
	c <-= ((ref Sys->nulldir, nil), reply);
	if((r := <-reply) == Down){
		c <-= ((nil, nil), reply);
		if(<-reply != Quit)
			return Quit;
		return Next;
	}
	return r;
}

quit(errorc: chan of string)
{
	if(errorc != nil)
		errorc <-= nil;
	exit;
}

report(errorc: chan of string, err: string)
{
	if(errorc != nil)
		errorc <-= err;
}

# true if a module with type sig t1 is compatible with a caller that expects t0
typecompat(t0, t1: string): int
{
	(rt0, at0, ot0) := splittype(t0);
	(rt1, at1, ot1) := splittype(t1);
	if((rt0 != rt1 && rt0 != 'a') || at0 != at1)		# XXX could do better for repeated args.
		return 0;
	for(i := 1; i < len ot0; i++){
		for(j := i; j < len ot0; j++)
			if(ot0[j] == '-')
				break;
		(ok, t) := opttypes(ot0[i], ot1);
		if(ok == -1 || ot0[i:j] != t)
			return 0;
		i = j + 1;
	}
	return 1;
}

splittype(t: string): (int, string, string)
{
	if(t == nil)
		return (-1, nil, nil);
	for(i := 1; i < len t; i++)
		if(t[i] == '-')
			break;
	return (t[0], t[1:i], t[i:]);
}

opttypes(opt: int, opts: string): (int, string)
{
	for(i := 1; i < len opts; i++){
		if(opts[i] == opt && opts[i-1] == '-'){
			for(j := i+1; j < len opts; j++)
				if(opts[j] == '-')
					break;
			return (0, opts[i+1:j]);
		}
	}
	return (-1, nil);
}

cmdusage(s, t: string): string
{
	if(s == nil)
		return nil;
	for(oi := 0; oi < len t; oi++)
		if(t[oi] == '-')
			break;
	if(oi < len t){
		single, multi: string;
		for(i := oi; i < len t - 1;){
			for(j := i + 1; j < len t; j++)
				if(t[j] == '-')
					break;

			optargs := t[i+2:j];
			if(optargs == nil)
				single[len single] = t[i+1];
			else{
				multi += sys->sprint(" [-%c", t[i+1]);
				for (k := 0; k < len optargs; k++)
					multi += " " + type2s(optargs[k]);
				multi += "]";
			}
			i = j;
		}
		if(single != nil)
			s += " [-" + single + "]";
		s += multi;
	}
	multi := 0;
	if(oi > 2 && t[oi - 1] == '*'){
		multi = 1;
		oi -= 2;
	}
	for(k := 1; k < oi; k++)
		s += " " + type2s(t[k]);
	if(multi)
		s += " [" + type2s(t[k]) + "...]";
	s += " -> " + type2s(t[0]);
	return s;
}